diff options
| -rw-r--r-- | ObjXSub.h | 904 | ||||
| -rw-r--r-- | globals.c | 84 | ||||
| -rw-r--r-- | perl.c | 4 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rw-r--r-- | win32/Makefile | 116 | ||||
| -rw-r--r-- | win32/dl_win32.xs | 4 | ||||
| -rw-r--r-- | win32/ipdir.c | 186 | ||||
| -rw-r--r-- | win32/ipenv.c | 116 | ||||
| -rw-r--r-- | win32/iplio.c | 357 | ||||
| -rw-r--r-- | win32/ipmem.c | 39 | ||||
| -rw-r--r-- | win32/ipproc.c | 620 | ||||
| -rw-r--r-- | win32/ipsock.c | 681 | ||||
| -rw-r--r-- | win32/ipstdio.c | 756 | ||||
| -rw-r--r-- | win32/ipstdiowin.h | 22 | ||||
| -rw-r--r-- | win32/perlobj.def | 4 | ||||
| -rw-r--r-- | win32/runperl.c | 1055 | ||||
| -rw-r--r-- | win32/win32.c | 837 | ||||
| -rw-r--r-- | win32/win32.h | 4 | ||||
| -rw-r--r-- | win32/win32sck.c | 9 | ||||
| -rw-r--r-- | win32/win32thread.c | 6 |
20 files changed, 2642 insertions, 3163 deletions
@@ -1,132 +1,668 @@ #ifndef __ObjXSub_h__ #define __ObjXSub_h__ -// variables -#undef uid -#define uid pPerl->Perl_uid -#undef euid -#define euid pPerl->Perl_euid -#undef gid -#define gid pPerl->Perl_gid -#undef egid -#define egid pPerl->Perl_egid -#undef endav -#define endav pPerl->Perl_endav + +/* Varibles */ +#undef Argv +#define Argv pPerl->Perl_Argv +#undef Cmd +#define Cmd pPerl->Perl_Cmd +#undef DBcv +#define DBcv pPerl->Perl_DBcv +#undef DBgv +#define DBgv pPerl->Perl_DBgv +#undef DBline +#define DBline pPerl->Perl_DBline +#undef DBsignal +#define DBsignal pPerl->Perl_DBsignal +#undef DBsingle +#define DBsingle pPerl->Perl_DBsingle +#undef DBsub +#define DBsub pPerl->Perl_DBsub +#undef DBtrace +#define DBtrace pPerl->Perl_DBtrace +#undef No +#define No pPerl->Perl_No +#undef Sv +#define Sv pPerl->Perl_Sv +#undef Xpv +#define Xpv pPerl->Perl_Xpv +#undef Yes +#define Yes pPerl->Perl_Yes +#undef amagic_generation +#define amagic_generation pPerl->Perl_amagic_generation +#undef ampergv +#define ampergv pPerl->Perl_ampergv #undef an -#define an pPerl->Perl_an +#define an pPerl->Perl_an +#undef archpat_auto +#define archpat_auto pPerl->Perl_archpat_auto +#undef argvgv +#define argvgv pPerl->Perl_argvgv +#undef argvoutgv +#define argvoutgv pPerl->Perl_argvoutgv +#undef basetime +#define basetime pPerl->Perl_basetime +#undef beginav +#define beginav pPerl->Perl_beginav +#undef bodytarget +#define bodytarget pPerl->Perl_bodytarget +#undef bostr +#define bostr pPerl->Perl_bostr +#undef bufend +#define bufend pPerl->Perl_bufend +#undef bufptr +#define bufptr pPerl->Perl_bufptr +#undef cddir +#define cddir pPerl->Perl_cddir +#undef chopset +#define chopset pPerl->Perl_chopset +#undef collation_ix +#define collation_ix pPerl->Perl_collation_ix +#undef collation_name +#define collation_name pPerl->Perl_collation_name +#undef collation_standard +#define collation_standard pPerl->Perl_collation_standard +#undef collxfrm_base +#define collxfrm_base pPerl->Perl_collxfrm_base +#undef collxfrm_mult +#define collxfrm_mult pPerl->Perl_collxfrm_mult +#undef colors +#define colors pPerl->Perl_colors +#undef colorset +#define colorset pPerl->Perl_colorset #undef compcv -#define compcv pPerl->Perl_compcv +#define compcv pPerl->Perl_compcv +#undef compiling +#define compiling pPerl->Perl_compiling +#undef comppad +#define comppad pPerl->Perl_comppad +#undef comppad_name +#define comppad_name pPerl->Perl_comppad_name +#undef comppad_name_fill +#define comppad_name_fill pPerl->Perl_comppad_name_fill +#undef comppad_name_floor +#define comppad_name_floor pPerl->Perl_comppad_name_floor #undef cop_seqmax -#define cop_seqmax pPerl->Perl_cop_seqmax +#define cop_seqmax pPerl->Perl_cop_seqmax +#undef copline +#define copline pPerl->Perl_copline +#undef cryptseen +#define cryptseen pPerl->Perl_cryptseen +#undef cshlen +#define cshlen pPerl->Perl_cshlen +#undef cshname +#define cshname pPerl->Perl_cshname +#undef curcop +#define curcop pPerl->Perl_curcop +#undef curcopdb +#define curcopdb pPerl->Perl_curcopdb +#undef curinterp +#define curinterp pPerl->Perl_curinterp +#undef curpad +#define curpad pPerl->Perl_curpad +#undef curpm +#define curpm pPerl->Perl_curpm +#undef curstack +#define curstack pPerl->Perl_curstack +#undef curstash +#define curstash pPerl->Perl_curstash +#undef curstname +#define curstname pPerl->Perl_curstname +#undef curthr +#define curthr pPerl->Perl_curthr +#undef cxstack +#define cxstack pPerl->Perl_cxstack +#undef cxstack_ix +#define cxstack_ix pPerl->Perl_cxstack_ix +#undef cxstack_max +#define cxstack_max pPerl->Perl_cxstack_max +#undef dbargs +#define dbargs pPerl->Perl_dbargs +#undef debdelim +#define debdelim pPerl->Perl_debdelim +#undef debname +#define debname pPerl->Perl_debname +#undef debstash +#define debstash pPerl->Perl_debstash +#undef debug +#define debug pPerl->Perl_debug +#undef defgv +#define defgv pPerl->Perl_defgv +#undef defoutgv +#define defoutgv pPerl->Perl_defoutgv #undef defstash -#define defstash pPerl->Perl_defstash +#define defstash pPerl->Perl_defstash +#undef delaymagic +#define delaymagic pPerl->Perl_delaymagic +#undef diehook +#define diehook pPerl->Perl_diehook +#undef dirty +#define dirty pPerl->Perl_dirty +#undef dlevel +#define dlevel pPerl->Perl_dlevel +#undef dlmax +#define dlmax pPerl->Perl_dlmax +#undef do_undump +#define do_undump pPerl->Perl_do_undump +#undef doextract +#define doextract pPerl->Perl_doextract +#undef doswitches +#define doswitches pPerl->Perl_doswitches #undef dowarn -#define dowarn pPerl->Perl_dowarn +#define dowarn pPerl->Perl_dowarn +#undef dumplvl +#define dumplvl pPerl->Perl_dumplvl +#undef e_fp +#define e_fp pPerl->Perl_e_fp +#undef e_tmpname +#define e_tmpname pPerl->Perl_e_tmpname +#undef egid +#define egid pPerl->Perl_egid +#undef endav +#define endav pPerl->Perl_endav +#undef envgv +#define envgv pPerl->Perl_envgv +#undef errgv +#define errgv pPerl->Perl_errgv +#undef error_count +#define error_count pPerl->Perl_error_count +#undef euid +#define euid pPerl->Perl_euid +#undef eval_cond +#define eval_cond pPerl->Perl_eval_cond +#undef eval_mutex +#define eval_mutex pPerl->Perl_eval_mutex +#undef eval_owner +#define eval_owner pPerl->Perl_eval_owner +#undef eval_root +#define eval_root pPerl->Perl_eval_root +#undef eval_start +#define eval_start pPerl->Perl_eval_start #undef evalseq -#define evalseq pPerl->Perl_evalseq +#define evalseq pPerl->Perl_evalseq +#undef expect +#define expect pPerl->Perl_expect +#undef extralen +#define extralen pPerl->Perl_extralen +#undef fdpid +#define fdpid pPerl->Perl_fdpid +#undef filemode +#define filemode pPerl->Perl_filemode +#undef firstgv +#define firstgv pPerl->Perl_firstgv +#undef forkprocess +#define forkprocess pPerl->Perl_forkprocess +#undef formfeed +#define formfeed pPerl->Perl_formfeed +#undef formtarget +#define formtarget pPerl->Perl_formtarget +#undef generation +#define generation pPerl->Perl_generation +#undef gensym +#define gensym pPerl->Perl_gensym +#undef gid +#define gid pPerl->Perl_gid +#undef globalstash +#define globalstash pPerl->Perl_globalstash +#undef he_root +#define he_root pPerl->Perl_he_root #undef hexdigit -#define hexdigit pPerl->Perl_hexdigit -#undef sub_generation -#define sub_generation pPerl->Perl_sub_generation -#undef origenviron -#define origenviron pPerl->Perl_origenviron -#undef environ -#define environ pPerl->Perl_environ +#define hexdigit pPerl->Perl_hexdigit +#undef hints +#define hints pPerl->Perl_hints +#undef in_clean_all +#define in_clean_all pPerl->Perl_in_clean_all +#undef in_clean_objs +#define in_clean_objs pPerl->Perl_in_clean_objs +#undef in_eval +#define in_eval pPerl->Perl_in_eval +#undef in_my +#define in_my pPerl->Perl_in_my +#undef in_my_stash +#define in_my_stash pPerl->Perl_in_my_stash +#undef incgv +#define incgv pPerl->Perl_incgv +#undef initav +#define initav pPerl->Perl_initav +#undef inplace +#define inplace pPerl->Perl_inplace +#undef last_in_gv +#define last_in_gv pPerl->Perl_last_in_gv +#undef last_lop +#define last_lop pPerl->Perl_last_lop +#undef last_lop_op +#define last_lop_op pPerl->Perl_last_lop_op +#undef last_uni +#define last_uni pPerl->Perl_last_uni +#undef lastfd +#define lastfd pPerl->Perl_lastfd +#undef lastgotoprobe +#define lastgotoprobe pPerl->Perl_lastgotoprobe +#undef lastscream +#define lastscream pPerl->Perl_lastscream +#undef lastsize +#define lastsize pPerl->Perl_lastsize +#undef lastspbase +#define lastspbase pPerl->Perl_lastspbase +#undef laststatval +#define laststatval pPerl->Perl_laststatval +#undef laststype +#define laststype pPerl->Perl_laststype +#undef leftgv +#define leftgv pPerl->Perl_leftgv +#undef lex_brackets +#define lex_brackets pPerl->Perl_lex_brackets +#undef lex_brackstack +#define lex_brackstack pPerl->Perl_lex_brackstack +#undef lex_casemods +#define lex_casemods pPerl->Perl_lex_casemods +#undef lex_casestack +#define lex_casestack pPerl->Perl_lex_casestack +#undef lex_defer +#define lex_defer pPerl->Perl_lex_defer +#undef lex_dojoin +#define lex_dojoin pPerl->Perl_lex_dojoin +#undef lex_expect +#define lex_expect pPerl->Perl_lex_expect +#undef lex_fakebrack +#define lex_fakebrack pPerl->Perl_lex_fakebrack +#undef lex_formbrack +#define lex_formbrack pPerl->Perl_lex_formbrack +#undef lex_inpat +#define lex_inpat pPerl->Perl_lex_inpat +#undef lex_inwhat +#define lex_inwhat pPerl->Perl_lex_inwhat +#undef lex_op +#define lex_op pPerl->Perl_lex_op +#undef lex_repl +#define lex_repl pPerl->Perl_lex_repl +#undef lex_starts +#define lex_starts pPerl->Perl_lex_starts +#undef lex_state +#define lex_state pPerl->Perl_lex_state +#undef lex_stuff +#define lex_stuff pPerl->Perl_lex_stuff +#undef lineary +#define lineary pPerl->Perl_lineary +#undef linestart +#define linestart pPerl->Perl_linestart +#undef linestr +#define linestr pPerl->Perl_linestr +#undef localizing +#define localizing pPerl->Perl_localizing +#undef localpatches +#define localpatches pPerl->Perl_localpatches +#undef main_cv +#define main_cv pPerl->Perl_main_cv +#undef main_root +#define main_root pPerl->Perl_main_root +#undef main_start +#define main_start pPerl->Perl_main_start +#undef mainstack +#define mainstack pPerl->Perl_mainstack +#undef malloc_mutex +#define malloc_mutex pPerl->Perl_malloc_mutex +#undef markstack +#define markstack pPerl->Perl_markstack +#undef markstack_max +#define markstack_max pPerl->Perl_markstack_max +#undef markstack_ptr +#define markstack_ptr pPerl->Perl_markstack_ptr +#undef max_intro_pending +#define max_intro_pending pPerl->Perl_max_intro_pending +#undef maxo +#define maxo pPerl->Perl_maxo +#undef maxscream +#define maxscream pPerl->Perl_maxscream +#undef maxsysfd +#define maxsysfd pPerl->Perl_maxsysfd +#undef mess_sv +#define mess_sv pPerl->Perl_mess_sv +#undef mh +#define mh pPerl->Perl_mh +#undef min_intro_pending +#define min_intro_pending pPerl->Perl_min_intro_pending +#undef minus_F +#define minus_F pPerl->Perl_minus_F +#undef minus_a +#define minus_a pPerl->Perl_minus_a +#undef minus_c +#define minus_c pPerl->Perl_minus_c +#undef minus_l +#define minus_l pPerl->Perl_minus_l +#undef minus_n +#define minus_n pPerl->Perl_minus_n +#undef minus_p +#define minus_p pPerl->Perl_minus_p +#undef modcount +#define modcount pPerl->Perl_modcount +#undef multi_close +#define multi_close pPerl->Perl_multi_close +#undef multi_end +#define multi_end pPerl->Perl_multi_end +#undef multi_open +#define multi_open pPerl->Perl_multi_open +#undef multi_start +#define multi_start pPerl->Perl_multi_start +#undef multiline +#define multiline pPerl->Perl_multiline +#undef mystrk +#define mystrk pPerl->Perl_mystrk +#undef na +#define na pPerl->Perl_na +#undef nexttoke +#define nexttoke pPerl->Perl_nexttoke +#undef nexttype +#define nexttype pPerl->Perl_nexttype +#undef nextval +#define nextval pPerl->Perl_nextval +#undef nice_chunk +#define nice_chunk pPerl->Perl_nice_chunk +#undef nice_chunk_size +#define nice_chunk_size pPerl->Perl_nice_chunk_size +#undef nomemok +#define nomemok pPerl->Perl_nomemok +#undef nrs +#define nrs pPerl->Perl_nrs +#undef nthreads +#define nthreads pPerl->Perl_nthreads +#undef nthreads_cond +#define nthreads_cond pPerl->Perl_nthreads_cond +#undef numeric_local +#define numeric_local pPerl->Perl_numeric_local +#undef numeric_name +#define numeric_name pPerl->Perl_numeric_name +#undef numeric_standard +#define numeric_standard pPerl->Perl_numeric_standard +#undef ofmt +#define ofmt pPerl->Perl_ofmt +#undef ofs +#define ofs pPerl->Perl_ofs +#undef ofslen +#define ofslen pPerl->Perl_ofslen +#undef oldbufptr +#define oldbufptr pPerl->Perl_oldbufptr +#undef oldlastpm +#define oldlastpm pPerl->Perl_oldlastpm +#undef oldname +#define oldname pPerl->Perl_oldname +#undef oldoldbufptr +#define oldoldbufptr pPerl->Perl_oldoldbufptr +#undef op +#define op pPerl->Perl_op +#undef op_mask +#define op_mask pPerl->Perl_op_mask +#undef op_seqmax +#define op_seqmax pPerl->Perl_op_seqmax +#undef opsave +#define opsave pPerl->Perl_opsave #undef origalen -#define origalen pPerl->Perl_origalen +#define origalen pPerl->Perl_origalen +#undef origargc +#define origargc pPerl->Perl_origargc +#undef origargv +#define origargv pPerl->Perl_origargv +#undef origenviron +#define origenviron pPerl->Perl_origenviron +#undef origfilename +#define origfilename pPerl->Perl_origfilename +#undef ors +#define ors pPerl->Perl_ors +#undef orslen +#define orslen pPerl->Perl_orslen +#undef osname +#define osname pPerl->Perl_osname +#undef pad_reset_pending +#define pad_reset_pending pPerl->Perl_pad_reset_pending +#undef padix +#define padix pPerl->Perl_padix +#undef padix_floor +#define padix_floor pPerl->Perl_padix_floor +#undef parsehook +#define parsehook pPerl->Perl_parsehook +#undef patchlevel +#define patchlevel pPerl->Perl_patchlevel +#undef patleave +#define patleave pPerl->Perl_patleave +#undef pending_ident +#define pending_ident pPerl->Perl_pending_ident +#undef perl_destruct_level +#define perl_destruct_level pPerl->Perl_perl_destruct_level +#undef perldb +#define perldb pPerl->Perl_perldb +#undef pidstatus +#define pidstatus pPerl->Perl_pidstatus +#undef preambleav +#define preambleav pPerl->Perl_preambleav +#undef preambled +#define preambled pPerl->Perl_preambled +#undef preprocess +#define preprocess pPerl->Perl_preprocess #undef profiledata -#define profiledata pPerl->Perl_profiledata -#undef xiv_arenaroot -#define xiv_arenaroot pPerl->Perl_xiv_arenaroot -#undef xiv_root -#define xiv_root pPerl->Perl_xiv_root -#undef xnv_root -#define xnv_root pPerl->Perl_xnv_root -#undef xrv_root -#define xrv_root pPerl->Perl_xrv_root -#undef xpv_root -#define xpv_root pPerl->Perl_xpv_root -#undef stack_base -#define stack_base pPerl->Perl_stack_base -#undef stack_sp -#define stack_sp pPerl->Perl_stack_sp -#undef stack_max -#define stack_max pPerl->Perl_stack_max -#undef op -#define op pPerl->Perl_op -#undef scopestack -#define scopestack pPerl->Perl_scopestack -#undef scopestack_ix -#define scopestack_ix pPerl->Perl_scopestack_ix -#undef scopestack_max -#define scopestack_max pPerl->Perl_scopestack_max +#define profiledata pPerl->Perl_profiledata +#undef reg_eval_set +#define reg_eval_set pPerl->Perl_reg_eval_set +#undef reg_flags +#define reg_flags pPerl->Perl_reg_flags +#undef reg_start_tmp +#define reg_start_tmp pPerl->Perl_reg_start_tmp +#undef reg_start_tmpl +#define reg_start_tmpl pPerl->Perl_reg_start_tmpl +#undef regbol +#define regbol pPerl->Perl_regbol +#undef regcc +#define regcc pPerl->Perl_regcc +#undef regcode +#define regcode pPerl->Perl_regcode +#undef regdata +#define regdata pPerl->Perl_regdata +#undef regdummy +#define regdummy pPerl->Perl_regdummy +#undef regendp +#define regendp pPerl->Perl_regendp +#undef regeol +#define regeol pPerl->Perl_regeol +#undef regflags +#define regflags pPerl->Perl_regflags +#undef regindent +#define regindent pPerl->Perl_regindent +#undef reginput +#define reginput pPerl->Perl_reginput +#undef reglastparen +#define reglastparen pPerl->Perl_reglastparen +#undef regnarrate +#define regnarrate pPerl->Perl_regnarrate +#undef regnaughty +#define regnaughty pPerl->Perl_regnaughty +#undef regnpar +#define regnpar pPerl->Perl_regnpar +#undef regparse +#define regparse pPerl->Perl_regparse +#undef regprecomp +#define regprecomp pPerl->Perl_regprecomp +#undef regprev +#define regprev pPerl->Perl_regprev +#undef regprogram +#define regprogram pPerl->Perl_regprogram +#undef regsawback +#define regsawback pPerl->Perl_regsawback +#undef regseen +#define regseen pPerl->Perl_regseen +#undef regsize +#define regsize pPerl->Perl_regsize +#undef regstartp +#define regstartp pPerl->Perl_regstartp +#undef regtill +#define regtill pPerl->Perl_regtill +#undef regxend +#define regxend pPerl->Perl_regxend +#undef restartop +#define restartop pPerl->Perl_restartop +#undef retstack +#define retstack pPerl->Perl_retstack +#undef retstack_ix +#define retstack_ix pPerl->Perl_retstack_ix +#undef retstack_max +#define retstack_max pPerl->Perl_retstack_max +#undef rightgv +#define rightgv pPerl->Perl_rightgv +#undef rs +#define rs pPerl->Perl_rs +#undef rsfp +#define rsfp pPerl->Perl_rsfp +#undef rsfp_filters +#define rsfp_filters pPerl->Perl_rsfp_filters +#undef runops +#define runops pPerl->Perl_runops +#undef rx +#define rx pPerl->Perl_rx #undef savestack -#define savestack pPerl->Perl_savestack +#define savestack pPerl->Perl_savestack #undef savestack_ix #define savestack_ix pPerl->Perl_savestack_ix #undef savestack_max #define savestack_max pPerl->Perl_savestack_max -#undef tmps_floor -#define tmps_floor pPerl->Perl_tmps_floor -#undef tmps_ix -#define tmps_ix pPerl->Perl_tmps_ix -#undef retstack -#define retstack pPerl->Perl_retstack -#undef retstack_ix -#define retstack_ix pPerl->Perl_retstack_ix -#undef retstack_max -#define retstack_max pPerl->Perl_retstack_max -#undef markstack -#define markstack pPerl->Perl_markstack -#undef markstack_ptr -#define markstack_ptr pPerl->Perl_markstack_ptr -#undef markstack_max -#define markstack_max pPerl->Perl_markstack_max -#undef maxo -#define maxo pPerl->Perl_maxo -#undef op_mask -#define op_mask pPerl->Perl_op_mask -#undef curpad -#define curpad pPerl->Perl_curpad -#undef Sv -#define Sv pPerl->Perl_Sv -#undef Xpv -#define Xpv pPerl->Perl_Xpv -#undef tokenbuf -#define tokenbuf pPerl->Perl_tokenbuf +#undef sawampersand +#define sawampersand pPerl->Perl_sawampersand +#undef sawstudy +#define sawstudy pPerl->Perl_sawstudy +#undef sawvec +#define sawvec pPerl->Perl_sawvec +#undef scopestack +#define scopestack pPerl->Perl_scopestack +#undef scopestack_ix +#define scopestack_ix pPerl->Perl_scopestack_ix +#undef scopestack_max +#define scopestack_max pPerl->Perl_scopestack_max +#undef screamfirst +#define screamfirst pPerl->Perl_screamfirst +#undef screamnext +#define screamnext pPerl->Perl_screamnext +#undef scrgv +#define scrgv pPerl->Perl_scrgv +#undef secondgv +#define secondgv pPerl->Perl_secondgv +#undef seen_zerolen +#define seen_zerolen pPerl->Perl_seen_zerolen +#undef sh_path +#define sh_path pPerl->Perl_sh_path +#undef siggv +#define siggv pPerl->Perl_siggv +#undef sighandlerp +#define sighandlerp pPerl->Perl_sighandlerp +#undef signalstack +#define signalstack pPerl->Perl_signalstack +#undef sortcop +#define sortcop pPerl->Perl_sortcop +#undef sortcxix +#define sortcxix pPerl->Perl_sortcxix +#undef sortstack +#define sortstack pPerl->Perl_sortstack +#undef sortstash +#define sortstash pPerl->Perl_sortstash +#undef splitstr +#define splitstr pPerl->Perl_splitstr +#undef stack_base +#define stack_base pPerl->Perl_stack_base +#undef stack_max +#define stack_max pPerl->Perl_stack_max +#undef stack_sp +#define stack_sp pPerl->Perl_stack_sp +#undef start_env +#define start_env pPerl->Perl_start_env #undef statbuf -#define statbuf pPerl->Perl_statbuf -#undef timesbuf -#define timesbuf pPerl->Perl_timesbuf -#undef di -#define di pPerl->Perl_di -#undef ds -#define ds pPerl->Perl_ds -#undef dc -#define dc pPerl->Perl_dc -#undef sv_undef -#define sv_undef pPerl->Perl_sv_undef +#define statbuf pPerl->Perl_statbuf +#undef statcache +#define statcache pPerl->Perl_statcache +#undef statgv +#define statgv pPerl->Perl_statgv +#undef statname +#define statname pPerl->Perl_statname +#undef statusvalue +#define statusvalue pPerl->Perl_statusvalue +#undef statusvalue_vms +#define statusvalue_vms pPerl->Perl_statusvalue_vms +#undef stdingv +#define stdingv pPerl->Perl_stdingv +#undef strchop +#define strchop pPerl->Perl_strchop +#undef strtab +#define strtab pPerl->Perl_strtab +#undef sub_generation +#define sub_generation pPerl->Perl_sub_generation +#undef sublex_info +#define sublex_info pPerl->Perl_sublex_info +#undef subline +#define subline pPerl->Perl_subline +#undef subname +#define subname pPerl->Perl_subname +#undef sv_arenaroot +#define sv_arenaroot pPerl->Perl_sv_arenaroot +#undef sv_count +#define sv_count pPerl->Perl_sv_count +#undef sv_mutex +#define sv_mutex pPerl->Perl_sv_mutex #undef sv_no -#define sv_no pPerl->Perl_sv_no +#define sv_no pPerl->Perl_sv_no +#undef sv_objcount +#define sv_objcount pPerl->Perl_sv_objcount +#undef sv_root +#define sv_root pPerl->Perl_sv_root +#undef sv_undef +#define sv_undef pPerl->Perl_sv_undef #undef sv_yes -#define sv_yes pPerl->Perl_sv_yes -#undef na -#define na pPerl->Perl_na - -#undef yydebug -#define yydebug pPerl->Perl_yydebug -#undef yynerrs -#define yynerrs pPerl->Perl_yynerrs -#undef yyerrflag -#define yyerrflag pPerl->Perl_yyerrflag -#undef yychar -#define yychar pPerl->Perl_yychar -#undef yyval -#define yyval pPerl->Perl_yyval -#undef yylval -#define yylval pPerl->Perl_yylval +#define sv_yes pPerl->Perl_sv_yes +#undef tainted +#define tainted pPerl->Perl_tainted +#undef tainting +#define tainting pPerl->Perl_tainting +#undef thisexpr +#define thisexpr pPerl->Perl_thisexpr +#undef thr_key +#define thr_key pPerl->Perl_thr_key +#undef threadnum +#define threadnum pPerl->Perl_threadnum +#undef threads_mutex +#define threads_mutex pPerl->Perl_threads_mutex +#undef threadsv_names +#define threadsv_names pPerl->Perl_threadsv_names +#undef thrsv +#define thrsv pPerl->Perl_thrsv +#undef timesbuf +#define timesbuf pPerl->Perl_timesbuf +#undef tmps_floor +#define tmps_floor pPerl->Perl_tmps_floor +#undef tmps_ix +#define tmps_ix pPerl->Perl_tmps_ix +#undef tmps_max +#define tmps_max pPerl->Perl_tmps_max +#undef tmps_stack +#define tmps_stack pPerl->Perl_tmps_stack +#undef tokenbuf +#define tokenbuf pPerl->Perl_tokenbuf +#undef top_env +#define top_env pPerl->Perl_top_env +#undef toptarget +#define toptarget pPerl->Perl_toptarget +#undef uid +#define uid pPerl->Perl_uid +#undef unsafe +#define unsafe pPerl->Perl_unsafe +#undef warnhook +#define warnhook pPerl->Perl_warnhook +#undef xiv_arenaroot +#define xiv_arenaroot pPerl->Perl_xiv_arenaroot +#undef xiv_root +#define xiv_root pPerl->Perl_xiv_root +#undef xnv_root +#define xnv_root pPerl->Perl_xnv_root +#undef xpv_root +#define xpv_root pPerl->Perl_xpv_root +#undef xrv_root +#define xrv_root pPerl->Perl_xrv_root -// functions +/* Functions */ #undef amagic_call #define amagic_call pPerl->Perl_amagic_call @@ -952,123 +1488,147 @@ #undef sublex_start #define sublex_start pPerl->Perl_sublex_start #undef sv_2bool -#define sv_2bool pPerl->Perl_sv_2bool +#define sv_2bool pPerl->Perl_sv_2bool #undef sv_2cv -#define sv_2cv pPerl->Perl_sv_2cv +#define sv_2cv pPerl->Perl_sv_2cv #undef sv_2io -#define sv_2io pPerl->Perl_sv_2io +#define sv_2io pPerl->Perl_sv_2io #undef sv_2iv -#define sv_2iv pPerl->Perl_sv_2iv +#define sv_2iv pPerl->Perl_sv_2iv #undef sv_2mortal -#define sv_2mortal pPerl->Perl_sv_2mortal +#define sv_2mortal pPerl->Perl_sv_2mortal #undef sv_2nv -#define sv_2nv pPerl->Perl_sv_2nv +#define sv_2nv pPerl->Perl_sv_2nv #undef sv_2pv -#define sv_2pv pPerl->Perl_sv_2pv +#define sv_2pv pPerl->Perl_sv_2pv +#undef sv_2uv +#define sv_2uv pPerl->Perl_sv_2uv #undef sv_add_arena -#define sv_add_arena pPerl->Perl_sv_add_arena +#define sv_add_arena pPerl->Perl_sv_add_arena #undef sv_backoff -#define sv_backoff pPerl->Perl_sv_backoff +#define sv_backoff pPerl->Perl_sv_backoff #undef sv_bless -#define sv_bless pPerl->Perl_sv_bless +#define sv_bless pPerl->Perl_sv_bless #undef sv_catpv -#define sv_catpv pPerl->Perl_sv_catpv +#define sv_catpv pPerl->Perl_sv_catpv #undef sv_catpvf -#define sv_catpvf pPerl->Perl_sv_catpvf +#define sv_catpvf pPerl->Perl_sv_catpvf #undef sv_catpvn -#define sv_catpvn pPerl->Perl_sv_catpvn +#define sv_catpvn pPerl->Perl_sv_catpvn #undef sv_catsv -#define sv_catsv pPerl->Perl_sv_catsv +#define sv_catsv pPerl->Perl_sv_catsv #undef sv_chop -#define sv_chop pPerl->Perl_sv_chop +#define sv_chop pPerl->Perl_sv_chop #undef sv_clean_all -#define sv_clean_all pPerl->Perl_sv_clean_all +#define sv_clean_all pPerl->Perl_sv_clean_all #undef sv_clean_objs -#define sv_clean_objs pPerl->Perl_sv_clean_objs +#define sv_clean_objs pPerl->Perl_sv_clean_objs #undef sv_clear -#define sv_clear pPerl->Perl_sv_clear +#define sv_clear pPerl->Perl_sv_clear #undef sv_cmp -#define sv_cmp pPerl->Perl_sv_cmp +#define sv_cmp pPerl->Perl_sv_cmp +#undef sv_cmp_locale +#define sv_cmp_locale pPerl->Perl_sv_cmp_locale +#undef sv_collxfrm +#define sv_collxfrm pPerl->Perl_sv_collxfrm +#undef sv_compile_2op +#define sv_compile_2op pPerl->Perl_sv_compile_2op #undef sv_dec -#define sv_dec pPerl->Perl_sv_dec +#define sv_dec pPerl->Perl_sv_dec #undef sv_derived_from -#define sv_derived_from pPerl->Perl_sv_derived_from +#define sv_derived_from pPerl->Perl_sv_derived_from #undef sv_dump -#define sv_dump pPerl->Perl_sv_dump +#define sv_dump pPerl->Perl_sv_dump #undef sv_eq -#define sv_eq pPerl->Perl_sv_eq +#define sv_eq pPerl->Perl_sv_eq #undef sv_free -#define sv_free pPerl->Perl_sv_free +#define sv_free pPerl->Perl_sv_free #undef sv_free_arenas -#define sv_free_arenas pPerl->Perl_sv_free_arenas +#define sv_free_arenas pPerl->Perl_sv_free_arenas #undef sv_gets -#define sv_gets pPerl->Perl_sv_gets +#define sv_gets pPerl->Perl_sv_gets #undef sv_grow -#define sv_grow pPerl->Perl_sv_grow +#define sv_grow pPerl->Perl_sv_grow #undef sv_inc -#define sv_inc pPerl->Perl_sv_inc +#define sv_inc pPerl->Perl_sv_inc #undef sv_insert -#define sv_insert pPerl->Perl_sv_insert +#define sv_insert pPerl->Perl_sv_insert #undef sv_isa -#define sv_isa pPerl->Perl_sv_isa +#define sv_isa pPerl->Perl_sv_isa #undef sv_isobject -#define sv_isobject pPerl->Perl_sv_isobject +#define sv_isobject pPerl->Perl_sv_isobject +#undef sv_iv +#define sv_iv pPerl->Perl_sv_iv #undef sv_len -#define sv_len pPerl->Perl_sv_len +#define sv_len pPerl->Perl_sv_len #undef sv_magic -#define sv_magic pPerl->Perl_sv_magic +#define sv_magic pPerl->Perl_sv_magic #undef sv_mortalcopy -#define sv_mortalcopy pPerl->Perl_sv_mortalcopy -#undef sv_mortalgrow -#define sv_mortalgrow pPerl->sv_mortalgrow +#define sv_mortalcopy pPerl->Perl_sv_mortalcopy #undef sv_newmortal -#define sv_newmortal pPerl->Perl_sv_newmortal +#define sv_newmortal pPerl->Perl_sv_newmortal #undef sv_newref -#define sv_newref pPerl->Perl_sv_newref +#define sv_newref pPerl->Perl_sv_newref +#undef sv_nv +#define sv_nv pPerl->Perl_sv_nv #undef sv_pvn -#define sv_pvn pPerl->Perl_sv_pvn +#define sv_pvn pPerl->Perl_sv_pvn #undef sv_pvn_force -#define sv_pvn_force pPerl->Perl_sv_pvn_force +#define sv_pvn_force pPerl->Perl_sv_pvn_force #undef sv_reftype -#define sv_reftype pPerl->Perl_sv_reftype +#define sv_reftype pPerl->Perl_sv_reftype #undef sv_replace -#define sv_replace pPerl->Perl_sv_replace +#define sv_replace pPerl->Perl_sv_replace #undef sv_report_used -#define sv_report_used pPerl->Perl_sv_report_used +#define sv_report_used pPerl->Perl_sv_report_used #undef sv_reset -#define sv_reset pPerl->Perl_sv_reset +#define sv_reset pPerl->Perl_sv_reset #undef sv_setiv -#define sv_setiv pPerl->Perl_sv_setiv +#define sv_setiv pPerl->Perl_sv_setiv #undef sv_setnv -#define sv_setnv pPerl->Perl_sv_setnv +#define sv_setnv pPerl->Perl_sv_setnv +#undef sv_setpv +#define sv_setpv pPerl->Perl_sv_setpv +#undef sv_setpvf +#define sv_setpvf pPerl->Perl_sv_setpvf +#undef sv_setpviv +#define sv_setpviv pPerl->Perl_sv_setpviv +#undef sv_setpvn +#define sv_setpvn pPerl->Perl_sv_setpvn #undef sv_setref_iv -#define sv_setref_iv pPerl->Perl_sv_setref_iv +#define sv_setref_iv pPerl->Perl_sv_setref_iv #undef sv_setref_nv -#define sv_setref_nv pPerl->Perl_sv_setref_nv +#define sv_setref_nv pPerl->Perl_sv_setref_nv #undef sv_setref_pv -#define sv_setref_pv pPerl->Perl_sv_setref_pv +#define sv_setref_pv pPerl->Perl_sv_setref_pv #undef sv_setref_pvn -#define sv_setref_pvn pPerl->Perl_sv_setref_pvn -#undef sv_setpv -#define sv_setpv pPerl->Perl_sv_setpv -#undef sv_setpvf -#define sv_setpvf pPerl->Perl_sv_setpvf -#undef sv_setpvn -#define sv_setpvn pPerl->Perl_sv_setpvn +#define sv_setref_pvn pPerl->Perl_sv_setref_pvn #undef sv_setsv -#define sv_setsv pPerl->Perl_sv_setsv -#undef sv_unglob -#define sv_unglob pPerl->sv_unglob +#define sv_setsv pPerl->Perl_sv_setsv +#undef sv_setuv +#define sv_setuv pPerl->Perl_sv_setuv +#undef sv_taint +#define sv_taint pPerl->Perl_sv_taint +#undef sv_tainted +#define sv_tainted pPerl->Perl_sv_tainted +#undef sv_true +#define sv_true pPerl->Perl_sv_true #undef sv_unmagic -#define sv_unmagic pPerl->Perl_sv_unmagic +#define sv_unmagic pPerl->Perl_sv_unmagic #undef sv_unref -#define sv_unref pPerl->Perl_sv_unref +#define sv_unref pPerl->Perl_sv_unref +#undef sv_untaint +#define sv_untaint pPerl->Perl_sv_untaint #undef sv_upgrade -#define sv_upgrade pPerl->Perl_sv_upgrade +#define sv_upgrade pPerl->Perl_sv_upgrade #undef sv_usepvn -#define sv_usepvn pPerl->Perl_sv_usepvn +#define sv_usepvn pPerl->Perl_sv_usepvn +#undef sv_uv +#define sv_uv pPerl->Perl_sv_uv +#undef sv_vcatpvfn +#define sv_vcatpvfn pPerl->Perl_sv_vcatpvfn #undef sv_vsetpvfn -#define sv_vsetpvfn pPerl->Perl_sv_vsetpvfn +#define sv_vsetpvfn pPerl->Perl_sv_vsetpvfn #undef taint_env #define taint_env pPerl->Perl_taint_env #undef taint_not @@ -1432,53 +1432,53 @@ CPerlObj::ErrorNo(void) void CPerlObj::Init(void) { - curcop = &compiling; - cxstack_ix = -1; - cxstack_max = 128; - chopset = " \n-"; + curcop = &compiling; + cxstack_ix = -1; + cxstack_max = 128; + chopset = " \n-"; #ifdef USE_THREADS - threadsv_names = THREADSV_NAMES; - tmps_ix = -1; - tmps_floor = -1; + threadsv_names = THREADSV_NAMES; + tmps_ix = -1; + tmps_floor = -1; #endif - maxo = MAXO; - sh_path = SH_PATH; - runops = RUNOPS_DEFAULT; + maxo = MAXO; + sh_path = SH_PATH; + runops = RUNOPS_DEFAULT; #ifdef CSH - cshname = CSH; + cshname = CSH; #endif - rsfp = Nullfp; - expect = XSTATE; + rsfp = Nullfp; + expect = XSTATE; #ifdef USE_LOCALE_COLLATE - collation_standard = TRUE; - collxfrm_mult = 2; + collation_standard = TRUE; + collxfrm_mult = 2; #endif #ifdef USE_LOCALE_NUMERIC - numeric_standard = TRUE; - numeric_local = TRUE; + numeric_standard = TRUE; + numeric_local = TRUE; #endif /* !USE_LOCALE_NUMERIC */ /* constants (these are not literals to facilitate pointer comparisons) */ - Yes = "1"; - No = ""; - hexdigit = "0123456789abcdef0123456789ABCDEFx"; - patleave = "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}"; - splitstr = " "; - perl_destruct_level = 0; - maxsysfd = MAXSYSFD; - statname = Nullsv; - maxscream = -1; - op_mask = NULL; - dlmax = 128; - curcopdb = NULL; - copline = NOLINE; - laststatval = -1; - laststype = OP_STAT; - generation = 100; + Yes = "1"; + No = ""; + hexdigit = "0123456789abcdef0123456789ABCDEFx"; + patleave = "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}"; + splitstr = " "; + perl_destruct_level = 0; + maxsysfd = MAXSYSFD; + statname = Nullsv; + maxscream = -1; + op_mask = NULL; + dlmax = 128; + curcopdb = NULL; + copline = NOLINE; + laststatval = -1; + laststype = OP_STAT; + generation = 100; #ifdef WIN32 - New(2904, environ, 1, char*); - *environ = NULL; + New(2904, environ, 1, char*); + *environ = NULL; #endif } @@ -1486,24 +1486,14 @@ CPerlObj::Init(void) bool do_exec(char *cmd) { - return PerlProc_Cmd(cmd); + return PerlProc_Cmd(cmd); } int do_aspawn(void *vreally, void **vmark, void **vsp) { - return PerlProc_aspawn(vreally, vmark, vsp); + return PerlProc_aspawn(vreally, vmark, vsp); } - -EXTERN_C void boot_DynaLoader _((CPERLarg_ CV* cv)); - -void CPerlObj::BootDynaLoader(void) -{ - char *file = __FILE__; - dXSUB_SYS; - newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); -} - #endif /* WIN32 */ #endif /* PERL_OBJECT */ @@ -940,9 +940,7 @@ print \" \\@INC:\\n @INC\\n\";"); CvPADLIST(compcv) = comppadlist; boot_core_UNIVERSAL(); -#if defined(WIN32) && defined(PERL_OBJECT) - BootDynaLoader(); -#endif + if (xsinit) (*xsinit)(THIS); /* in case linked C routines want magical variables */ #if defined(VMS) || defined(WIN32) || defined(DJGPP) @@ -827,7 +827,6 @@ char * regcppop _((void)); void dump _((char *pat,...)); #ifdef WIN32 int do_aspawn _((void *vreally, void **vmark, void **vsp)); -void BootDynaLoader(void); #endif #ifdef DEBUGGING diff --git a/win32/Makefile b/win32/Makefile index b77c4091a1..5da435915d 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -89,10 +89,8 @@ LIB32=$(LINK32) -lib # !IF "$(RUNTIME)" == "" ! IF "$(OBJECT)" == "-DPERL_OBJECT" -OBJECTFLAGS = -TP $(OBJECT) RUNTIME = -MT ! ELSE -OBJECTFLAGS = RUNTIME = -MD ! ENDIF !ENDIF @@ -114,14 +112,14 @@ WINIOMAYBE = ! IF "$(CCTYPE)" == "MSVC20" OPTIMIZE = -Od $(RUNTIME) -Z7 -D_DEBUG -DDEBUGGING ! ELSE -OPTIMIZE = -Od $(RUNTIME)d -Z7 -D_DEBUG -DDEBUGGING +OPTIMIZE = -Od -TP $(RUNTIME)d -Z7 -D_DEBUG -DDEBUGGING ! ENDIF LINK_DBG = -debug -pdb:none !ELSE ! IF "$(CCTYPE)" == "MSVC20" OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG ! ELSE -OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG +OPTIMIZE = -O1 -TP $(RUNTIME) -DNDEBUG ! ENDIF LINK_DBG = -release !ENDIF @@ -132,15 +130,20 @@ LIBFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \ oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ version.lib odbc32.lib odbccp32.lib -CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) $(PCHFLAGS) $(OPTIMIZE) +CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(OBJECTDEF) $(LOCDEFS) $(PCHFLAGS) $(OPTIMIZE) + !IF "$(OBJECT)" == "-DPERL_OBJECT" -COBJFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(OBJECTFLAGS) $(LOCDEFS) $(PCHFLAGS) $(OPTIMIZE) DMYMALLOC = undef !ELSE -COBJFLAGS = $(CFLAGS) DMYMALLOC = define !ENDIF + +!IF "$(OBJECTDEF)" == "-DPERL_OBJECT" +MINI_SRC = +!ELSE +MINI_SRC = ..\perlio.c ..\malloc.c +!ENDIF LINK_FLAGS = -nologo $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE) OBJOUT_FLAG = -Fo EXEOUT_FLAG = -Fe @@ -185,7 +188,10 @@ PERLDLL=..\perlcore.dll PERLIMPLIB=..\perl.lib PERLDLL=..\perl.dll !ENDIF +!IF "$(OBJECTDEF)" != "-DPERL_OBJECT" MINIPERL=..\miniperl.exe +!ENDIF +MINIPERLEXE=..\miniperl.exe PERLEXE=..\perl.exe GLOBEXE=..\perlglob.exe CONFIGPM=..\lib\Config.pm @@ -208,10 +214,14 @@ NULL= CRYPT_OBJ=$(CRYPT_SRC:.c=.obj) !ENDIF +!IF "$(MINI_SRC)" != "" +MINI_OBJ=..\perlio$(o) ..\malloc$(o) +!ENDIF + # # filenames given to xsubpp must have forward slashes (since it puts # full pathnames in #line strings) -XSUBPP=..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp -C++ -prototypes +XSUBPP=..\$(MINIPERLEXE) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp -C++ -prototypes CORE_C= ..\av.c \ ..\deb.c \ @@ -224,7 +234,6 @@ CORE_C= ..\av.c \ ..\mg.c \ ..\op.c \ ..\perl.c \ - ..\perlio.c \ ..\perly.c \ ..\pp.c \ ..\pp_ctl.c \ @@ -239,7 +248,7 @@ CORE_C= ..\av.c \ ..\toke.c \ ..\universal.c \ ..\util.c \ - ..\malloc.c \ + $(MINI_SRC) \ $(CRYPT_SRC) CORE_OBJ= ..\av$(o) \ @@ -253,7 +262,6 @@ CORE_OBJ= ..\av$(o) \ ..\mg$(o) \ ..\op$(o) \ ..\perl$(o) \ - ..\perlio$(o) \ ..\perly$(o) \ ..\pp$(o) \ ..\pp_ctl$(o) \ @@ -268,7 +276,7 @@ CORE_OBJ= ..\av$(o) \ ..\toke$(o) \ ..\universal$(o)\ ..\util$(o) \ - ..\malloc$(o) \ + $(MINI_OBJ) \ $(CRYPT_OBJ) WIN32_C = perllib.c \ @@ -276,16 +284,25 @@ WIN32_C = perllib.c \ win32sck.c \ win32thread.c +!IF "$(USE_THREADS)" == "" && "$(OBJECT)" == "-DPERL_OBJECT" +WIN32_OBJ = win32$(o) \ + win32sck$(o) \ +!ELSE WIN32_OBJ = win32$(o) \ win32sck$(o) \ win32thread$(o) +!ENDIF PERL95_OBJ = perl95$(o) \ win32mt$(o) \ - win32sckmt$(o) \ - $(CRYPT_OBJ) + win32sckmt$(o) + +!IF "$(OBJECT)" == "-DPERL_OBJECT" +DLL_OBJ = $(DYNALOADER)$(o) +!ELSE DLL_OBJ = perllib$(o) $(DYNALOADER)$(o) +!ENDIF X2P_OBJ = ..\x2p\a2p$(o) \ ..\x2p\hash$(o) \ @@ -372,8 +389,9 @@ POD2TEXT=$(PODDIR)\pod2text # Top targets # -all: $(PERLEXE) $(PERL95EXE) $(GLOBEXE) $(DYNALOADMODULES) $(MINIMOD) \ - $(X2P) +all: $(GLOBEXE) $(X2P) $(MINIMOD) $(CONFIGPM) + +pass2 : $(PERLEXE) $(PERL95EXE) $(DYNALOADMODULES) $(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c @@ -395,12 +413,12 @@ config.w32 : $(CFGSH_TMPL) copy $(CFGH_TMPL) config.h ..\config.sh : config.w32 $(MINIPERL) config_sh.PL - $(MINIPERL) -I..\lib config_sh.PL \ + $(MINIPERLEXE) -I..\lib config_sh.PL \ "INST_DRV=$(INST_DRV)" \ "INST_TOP=$(INST_TOP)" \ "archname=$(ARCHNAME)" \ "cc=$(CC)" \ - "ccflags=$(OPTIMIZE) $(DEFINES) $(OBJECTFLAGS)"\ + "ccflags=$(OPTIMIZE) $(DEFINES) $(OBJECT)"\ "cf_email=$(EMAIL)" \ "d_crypt=$(D_CRYPT)" \ "libs=$(LIBFILES)" \ @@ -421,14 +439,17 @@ $(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl $(XCOPY) ..\*.h $(COREDIR)\*.* $(XCOPY) *.h $(COREDIR)\*.* $(RCOPY) include $(COREDIR)\*.* - $(MINIPERL) -I..\lib config_h.PL || $(MAKE) CCTYPE=$(CCTYPE) \ - RUNTIME=$(RUNTIME) CFG=$(CFG) $(CONFIGPM) - + $(MINIPERLEXE) -I..\lib config_h.PL || $(MAKE) CCTYPE=$(CCTYPE) \ + RUNTIME=$(RUNTIME) CFG=$(CFG) OBJECTDEF=$(OBJECT) pass2 + +!IF "$(OBJECTDEF)" != "-DPERL_OBJECT" $(MINIPERL) : ..\miniperlmain$(o) $(CORE_OBJ) $(WIN32_OBJ) $(LINK32) -subsystem:console -out:$@ @<< $(LINK_FLAGS) $(LIBFILES) ..\miniperlmain$(o) $(CORE_OBJ) $(WIN32_OBJ) << +!ENDIF + $(WIN32_OBJ) : $(CORE_H) $(CORE_OBJ) : $(CORE_H) $(DLL_OBJ) : $(CORE_H) @@ -437,25 +458,29 @@ $(X2P_OBJ) : $(CORE_H) !IF "$(OBJECT)" == "-DPERL_OBJECT" -perldll.def : makefile +perldll.def : $(CONFIGPM) echo LIBRARY PerlCore >perldll.def echo DESCRIPTION 'Perl interpreter' >>perldll.def echo EXPORTS >>perldll.def echo perl_alloc >>perldll.def + +$(PERLDLL): perldll.def $(CORE_OBJ) + $(LINK32) -dll -def:perldll.def -out:$@ @<< + $(LINK_FLAGS) $(LIBFILES) $(CORE_OBJ) +<< + $(XCOPY) $(PERLIMPLIB) $(COREDIR) !ELSE -perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym makedef.pl +perldll.def : $(CONFIGPM) ..\global.sym makedef.pl $(MINIPERL) -w makedef.pl $(OPTIMIZE) $(DEFINES) \ CCTYPE=$(CCTYPE) > perldll.def -!ENDIF - - $(PERLDLL): perldll.def $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ) $(LINK32) -dll -def:perldll.def -out:$@ @<< $(LINK_FLAGS) $(LIBFILES) $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ) << $(XCOPY) $(PERLIMPLIB) $(COREDIR) +!ENDIF perl.def : $(MINIPERL) makeperldef.pl $(MINIPERL) -I..\lib makeperldef.pl $(NULL) > perl.def @@ -489,14 +514,6 @@ perlmain.c : runperl.c perlmain$(o) : perlmain.c $(CC) $(CFLAGS) -UPERLDLL -c perlmain.c -$(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain$(o) - $(LINK32) -subsystem:console -out:perl.exe $(LINK_FLAGS) $(LIBFILES) \ - perlmain$(o) $(WINIOMAYBE) $(PERLIMPLIB) - copy perl.exe $@ - del perl.exe - copy splittree.pl .. - $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" - perl95.c : runperl.c copy runperl.c perl95.c @@ -509,13 +526,41 @@ win32sckmt$(o) : win32sck.c win32mt$(o) : win32.c $(CC) $(CFLAGS) -MT -UPERLDLL -DWIN95FIX -c $(OBJOUT_FLAG)win32mt$(o) win32.c + +!IF "$(OBJECT)" == "-DPERL_OBJECT" +$(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain$(o) $(DLL_OBJ) $(WIN32_OBJ) + $(LINK32) -subsystem:console -out:perl.exe $(LINK_FLAGS) $(LIBFILES) \ + perlmain$(o) $(DLL_OBJ) $(WIN32_OBJ) $(WINIOMAYBE) $(PERLIMPLIB) + copy perl.exe $@ + del perl.exe + copy splittree.pl .. + $(MINIPERLEXE) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" + +$(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ) $(DLL_OBJ) + $(LINK32) -subsystem:console -out:perl95.exe $(LINK_FLAGS) $(LIBFILES) \ + $(DLL_OBJ) $(PERL95_OBJ) $(PERLIMPLIB) + copy perl95.exe $@ + del perl95.exe + +!ELSE + +$(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain$(o) + $(LINK32) -subsystem:console -out:perl.exe $(LINK_FLAGS) $(LIBFILES) \ + perlmain$(o) $(WINIOMAYBE) $(PERLIMPLIB) + copy perl.exe $@ + del perl.exe + copy splittree.pl .. + $(MINIPERLEXE) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" + $(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ) $(LINK32) -subsystem:console -out:perl95.exe $(LINK_FLAGS) $(LIBFILES) \ $(PERL95_OBJ) $(PERLIMPLIB) copy perl95.exe $@ del perl95.exe -$(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) +!ENDIF + +$(DYNALOADER).c: $(CONFIGPM) $(EXTDIR)\DynaLoader\dl_win32.xs if not exist ..\lib\auto mkdir ..\lib\auto $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) cd $(EXTDIR)\$(*B) @@ -652,7 +697,6 @@ test-notty : test-prep cd ..\win32 clean : - -@erase miniperlmain$(o) -@erase $(MINIPERL) -@erase perlglob$(o) -@erase perlmain$(o) diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs index 077fb22715..a8d10e1aa7 100644 --- a/win32/dl_win32.xs +++ b/win32/dl_win32.xs @@ -41,9 +41,6 @@ dl_private_init(CPERLarg) (void)dl_generic_private_init(THIS); } -#ifdef PERL_OBJECT -#define dl_static_linked(x) 0 -#else static int dl_static_linked(char *filename) { @@ -53,7 +50,6 @@ dl_static_linked(char *filename) }; return 0; } -#endif MODULE = DynaLoader PACKAGE = DynaLoader diff --git a/win32/ipdir.c b/win32/ipdir.c deleted file mode 100644 index 29702c8f26..0000000000 --- a/win32/ipdir.c +++ /dev/null @@ -1,186 +0,0 @@ -/* - - ipdir.c - Interface for perl directory functions - -*/ - -#include <ipdir.h> - -class CPerlDir : public IPerlDir -{ -public: - CPerlDir() { pPerl = NULL; }; - virtual int MKdir(const char *dirname, int mode, int &err); - virtual int Chdir(const char *dirname, int &err); - virtual int Rmdir(const char *dirname, int &err); - virtual int Close(DIR *dirp, int &err); - virtual DIR *Open(char *filename, int &err); - virtual struct direct *Read(DIR *dirp, int &err); - virtual void Rewind(DIR *dirp, int &err); - virtual void Seek(DIR *dirp, long loc, int &err); - virtual long Tell(DIR *dirp, int &err); - - inline void SetPerlObj(CPerlObj *p) { pPerl = p; }; -protected: - CPerlObj *pPerl; -}; - -int CPerlDir::MKdir(const char *dirname, int mode, int &err) -{ - return mkdir(dirname); /* just ignore mode */ -} - -int CPerlDir::Chdir(const char *dirname, int &err) -{ - return chdir(dirname); -} - -int CPerlDir::Rmdir(const char *dirname, int &err) -{ - return rmdir(dirname); -} - -#define PATHLEN 1024 -// The idea here is to read all the directory names into a string table -// (separated by nulls) and when one of the other dir functions is called -// return the pointer to the current file name. -DIR *CPerlDir::Open(char *filename, int &err) -{ - DIR *p; - long len; - long idx; - char scannamespc[PATHLEN]; - char *scanname = scannamespc; - struct stat sbuf; - WIN32_FIND_DATA FindData; - HANDLE fh; - - // Create the search pattern - strcpy(scanname, filename); - - len = strlen(scanname); - if(len > 1 && ((scanname[len-1] == '/') || (scanname[len-1] == '\\'))) - { - // allow directory names of 'x:\' to pass - if(!(len == 3 && scanname[1] == ':')) - scanname[len-1] = '\0'; - } - - // check to see if filename is a directory - if(stat(scanname, &sbuf) < 0 || sbuf.st_mode & _S_IFDIR == 0) - { - DWORD dTemp = GetFileAttributes(scanname); - if(dTemp == 0xffffffff || !(dTemp & FILE_ATTRIBUTE_DIRECTORY)) - { - return NULL; - } - } - - if((scanname[len-1] == '/') || (scanname[len-1] == '\\')) - scanname[len-1] = '\0'; - - strcat(scanname, "/*"); - - // Get a DIR structure - Newz(1501, p, 1, DIR); - if(p == NULL) - return NULL; - - // do the FindFirstFile call - fh = FindFirstFile(scanname, &FindData); - if(fh == INVALID_HANDLE_VALUE) - { - Safefree(p); - return NULL; - } - - // now allocate the first part of the string table for the filenames that we find. - idx = strlen(FindData.cFileName)+1; - New(1502, p->start, idx, char); - if(p->start == NULL) - { - FindClose(fh); - croak("opendir: malloc failed!\n"); - } - strcpy(p->start, FindData.cFileName); - p->nfiles++; - - // loop finding all the files that match the wildcard - // (which should be all of them in this directory!). - // the variable idx should point one past the null terminator - // of the previous string found. - // - while(FindNextFile(fh, &FindData)) - { - len = strlen(FindData.cFileName); - // bump the string table size by enough for the - // new name and it's null terminator - Renew(p->start, idx+len+1, char); - if(p->start == NULL) - { - FindClose(fh); - croak("opendir: malloc failed!\n"); - } - strcpy(&p->start[idx], FindData.cFileName); - p->nfiles++; - idx += len+1; - } - FindClose(fh); - p->size = idx; - p->curr = p->start; - return p; -} - -int CPerlDir::Close(DIR *dirp, int &err) -{ - Safefree(dirp->start); - Safefree(dirp); - return 1; -} - -// Readdir just returns the current string pointer and bumps the -// string pointer to the next entry. -struct direct *CPerlDir::Read(DIR *dirp, int &err) -{ - int len; - static int dummy = 0; - - if(dirp->curr) - { // first set up the structure to return - len = strlen(dirp->curr); - strcpy(dirp->dirstr.d_name, dirp->curr); - dirp->dirstr.d_namlen = len; - - // Fake an inode - dirp->dirstr.d_ino = dummy++; - - // Now set up for the next call to readdir - dirp->curr += len + 1; - if(dirp->curr >= (dirp->start + dirp->size)) - { - dirp->curr = NULL; - } - - return &(dirp->dirstr); - } - else - return NULL; -} - -void CPerlDir::Rewind(DIR *dirp, int &err) -{ - dirp->curr = dirp->start; -} - -void CPerlDir::Seek(DIR *dirp, long loc, int &err) -{ - dirp->curr = (char *)loc; -} - -long CPerlDir::Tell(DIR *dirp, int &err) -{ - return (long) dirp->curr; -} - - diff --git a/win32/ipenv.c b/win32/ipenv.c deleted file mode 100644 index 5939c11d20..0000000000 --- a/win32/ipenv.c +++ /dev/null @@ -1,116 +0,0 @@ -/* - - ipenv.c - Interface for perl environment functions - -*/ - -#include <ipenv.h> -#include <stdlib.h> - -class CPerlEnv : public IPerlEnv -{ -public: - CPerlEnv() { w32_perldll_handle = INVALID_HANDLE_VALUE; pPerl = NULL; }; - virtual char *Getenv(const char *varname, int &err); - virtual int Putenv(const char *envstring, int &err); - virtual char* LibPath(char *sfx, ...); - - inline void SetPerlObj(CPerlObj *p) { pPerl = p; }; -protected: - char w32_perllib_root[MAX_PATH+1]; - HANDLE w32_perldll_handle; - CPerlObj *pPerl; -}; - - -BOOL GetRegStr(HKEY hkey, const char *lpszValueName, char *lpszDefault, char *lpszData, unsigned long *lpdwDataLen) -{ // Retrieve a REG_SZ or REG_EXPAND_SZ from the registry - HKEY handle; - DWORD type, dwDataLen = *lpdwDataLen; - const char *subkey = "Software\\Perl"; - char szBuffer[MAX_PATH+1]; - long retval; - - retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle); - if(retval == ERROR_SUCCESS) - { - retval = RegQueryValueEx(handle, lpszValueName, 0, &type, (LPBYTE)lpszData, &dwDataLen); - RegCloseKey(handle); - if(retval == ERROR_SUCCESS && (type == REG_SZ || type == REG_EXPAND_SZ)) - { - if(type != REG_EXPAND_SZ) - { - *lpdwDataLen = dwDataLen; - return TRUE; - } - strcpy(szBuffer, lpszData); - dwDataLen = ExpandEnvironmentStrings(szBuffer, lpszData, *lpdwDataLen); - if(dwDataLen < *lpdwDataLen) - { - *lpdwDataLen = dwDataLen; - return TRUE; - } - } - } - - strcpy(lpszData, lpszDefault); - return FALSE; -} - -char* GetRegStr(const char *lpszValueName, char *lpszDefault, char *lpszData, unsigned long *lpdwDataLen) -{ - if(!GetRegStr(HKEY_CURRENT_USER, lpszValueName, lpszDefault, lpszData, lpdwDataLen)) - { - GetRegStr(HKEY_LOCAL_MACHINE, lpszValueName, lpszDefault, lpszData, lpdwDataLen); - } - if(*lpszData == '\0') - lpszData = NULL; - return lpszData; -} - - -char *CPerlEnv::Getenv(const char *varname, int &err) -{ - char* ptr = getenv(varname); - if(ptr == NULL) - { - unsigned long dwDataLen = sizeof(w32_perllib_root); - if(strcmp("PERL5DB", varname) == 0) - ptr = GetRegStr(varname, "", w32_perllib_root, &dwDataLen); - } - return ptr; -} - -int CPerlEnv::Putenv(const char *envstring, int &err) -{ - return _putenv(envstring); -} - -char* CPerlEnv::LibPath(char *sfx, ...) -{ - va_list ap; - char *end; - va_start(ap,sfx); - GetModuleFileName((w32_perldll_handle == INVALID_HANDLE_VALUE) - ? GetModuleHandle(NULL) - : (HINSTANCE)w32_perldll_handle, - w32_perllib_root, - sizeof(w32_perllib_root)); - *(end = strrchr(w32_perllib_root, '\\')) = '\0'; - if (stricmp(end-4,"\\bin") == 0) - end -= 4; - strcpy(end,"\\lib"); - while (sfx) - { - strcat(end,"\\"); - strcat(end,sfx); - sfx = va_arg(ap,char *); - } - va_end(ap); - return (w32_perllib_root); -} - - - - diff --git a/win32/iplio.c b/win32/iplio.c deleted file mode 100644 index 2969126fd3..0000000000 --- a/win32/iplio.c +++ /dev/null @@ -1,357 +0,0 @@ -/* - - iplio.c - Interface for perl Low IO functions - -*/ - -#include <iplio.h> -#include <sys/utime.h> - - -class CPerlLIO : public IPerlLIO -{ -public: - CPerlLIO() { w32_platform = (-1); pPerl = NULL; pSock = NULL; pStdIO = NULL; }; - - virtual int Access(const char *path, int mode, int &err); - virtual int Chmod(const char *filename, int pmode, int &err); - virtual int Chsize(int handle, long size, int &err); - virtual int Close(int handle, int &err); - virtual int Dup(int handle, int &err); - virtual int Dup2(int handle1, int handle2, int &err); - virtual int Flock(int fd, int oper, int &err); - virtual int FStat(int handle, struct stat *buffer, int &err); - virtual int IOCtl(int i, unsigned int u, char *data, int &err); - virtual int Isatty(int handle, int &err); - virtual long Lseek(int handle, long offset, int origin, int &err); - virtual int Lstat(const char *path, struct stat *buffer, int &err); - virtual char *Mktemp(char *Template, int &err); - virtual int Open(const char *filename, int oflag, int &err); - virtual int Open(const char *filename, int oflag, int pmode, int &err); - virtual int Read(int handle, void *buffer, unsigned int count, int &err); - virtual int Rename(const char *oldname, const char *newname, int &err); - virtual int Setmode(int handle, int mode, int &err); - virtual int STat(const char *path, struct stat *buffer, int &err); - virtual char *Tmpnam(char *string, int &err); - virtual int Umask(int pmode, int &err); - virtual int Unlink(const char *filename, int &err); - virtual int Utime(char *filename, struct utimbuf *times, int &err); - virtual int Write(int handle, const void *buffer, unsigned int count, int &err); - - inline void SetPerlObj(CPerlObj *p) { pPerl = p; }; - inline void SetSockCtl(CPerlSock *p) { pSock = p; }; - inline void SetStdObj(IPerlStdIOWin *p) { pStdIO = p; }; -protected: - inline int IsWin95(void) - { - return (os_id() == VER_PLATFORM_WIN32_WINDOWS); - }; - inline int IsWinNT(void) - { - return (os_id() == VER_PLATFORM_WIN32_NT); - }; - int GetOSfhandle(int filenum) - { - return pStdIO->GetOSfhandle(filenum); - }; - DWORD os_id(void) - { - if((-1) == w32_platform) - { - OSVERSIONINFO osver; - - memset(&osver, 0, sizeof(OSVERSIONINFO)); - osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - GetVersionEx(&osver); - w32_platform = osver.dwPlatformId; - } - return (w32_platform); - } - - DWORD w32_platform; - CPerlObj *pPerl; - CPerlSock *pSock; - IPerlStdIOWin *pStdIO; -}; - -#define CALLFUNCRET(x)\ - int ret = x;\ - if(ret)\ - err = errno;\ - return ret; - -#define CALLFUNCERR(x)\ - int ret = x;\ - if(errno)\ - err = errno;\ - return ret; - -#define LCALLFUNCERR(x)\ - long ret = x;\ - if(errno)\ - err = errno;\ - return ret; - -int CPerlLIO::Access(const char *path, int mode, int &err) -{ - CALLFUNCRET(access(path, mode)) -} - -int CPerlLIO::Chmod(const char *filename, int pmode, int &err) -{ - CALLFUNCRET(chmod(filename, pmode)) -} - -int CPerlLIO::Chsize(int handle, long size, int &err) -{ - CALLFUNCRET(chsize(handle, size)) -} - -int CPerlLIO::Close(int fd, int &err) -{ - CALLFUNCRET(close(fd)) -} - -int CPerlLIO::Dup(int fd, int &err) -{ - CALLFUNCERR(dup(fd)) -} - -int CPerlLIO::Dup2(int handle1, int handle2, int &err) -{ - CALLFUNCERR(dup2(handle1, handle2)) -} - - -#define LK_ERR(f,i) ((f) ? (i = 0) : (err = GetLastError())) -#define LK_LEN 0xffff0000 -#define LOCK_SH 1 -#define LOCK_EX 2 -#define LOCK_NB 4 -#define LOCK_UN 8 - -int CPerlLIO::Flock(int fd, int oper, int &err) -{ - OVERLAPPED o; - int i = -1; - HANDLE fh; - - if (!IsWinNT()) { - croak("flock() unimplemented on this platform"); - return -1; - } - fh = (HANDLE)GetOSfhandle(fd); - memset(&o, 0, sizeof(o)); - - switch(oper) { - case LOCK_SH: /* shared lock */ - LK_ERR(LockFileEx(fh, 0, 0, LK_LEN, 0, &o),i); - break; - case LOCK_EX: /* exclusive lock */ - LK_ERR(LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK, 0, LK_LEN, 0, &o),i); - break; - case LOCK_SH|LOCK_NB: /* non-blocking shared lock */ - LK_ERR(LockFileEx(fh, LOCKFILE_FAIL_IMMEDIATELY, 0, LK_LEN, 0, &o),i); - break; - case LOCK_EX|LOCK_NB: /* non-blocking exclusive lock */ - LK_ERR(LockFileEx(fh, - LOCKFILE_EXCLUSIVE_LOCK|LOCKFILE_FAIL_IMMEDIATELY, - 0, LK_LEN, 0, &o),i); - break; - case LOCK_UN: /* unlock lock */ - LK_ERR(UnlockFileEx(fh, 0, LK_LEN, 0, &o),i); - break; - default: /* unknown */ - err = EINVAL; - break; - } - return i; -} - -int CPerlLIO::FStat(int fd, struct stat *sbufptr, int &err) -{ - CALLFUNCERR(fstat(fd, sbufptr)) -} - -int CPerlLIO::IOCtl(int i, unsigned int u, char *data, int &err) -{ - return pSock->IoctlSocket((SOCKET)i, (long)u, (u_long*)data, err); -} - -int CPerlLIO::Isatty(int fd, int &err) -{ - return isatty(fd); -} - -long CPerlLIO::Lseek(int fd, long offset, int origin, int &err) -{ - LCALLFUNCERR(lseek(fd, offset, origin)) -} - -int CPerlLIO::Lstat(const char *path, struct stat *sbufptr, int &err) -{ - return STat(path, sbufptr, err); -} - -char *CPerlLIO::Mktemp(char *Template, int &err) -{ - return mktemp(Template); -} - -int CPerlLIO::Open(const char *filename, int oflag, int &err) -{ - int ret; - if(stricmp(filename, "/dev/null") == 0) - ret = open("NUL", oflag); - else - ret = open(filename, oflag); - - if(errno) - err = errno; - return ret; -} - -int CPerlLIO::Open(const char *filename, int oflag, int pmode, int &err) -{ - int ret; - if(stricmp(filename, "/dev/null") == 0) - ret = open("NUL", oflag, pmode); - else - ret = open(filename, oflag, pmode); - - if(errno) - err = errno; - return ret; -} - -int CPerlLIO::Read(int fd, void *buffer, unsigned int cnt, int &err) -{ - CALLFUNCERR(read(fd, buffer, cnt)) -} - -int CPerlLIO::Rename(const char *OldFileName, const char *newname, int &err) -{ - char szNewWorkName[MAX_PATH+1]; - WIN32_FIND_DATA fdOldFile, fdNewFile; - HANDLE handle; - char *ptr; - - if((strchr(OldFileName, '\\') || strchr(OldFileName, '/')) - && strchr(newname, '\\') == NULL - && strchr(newname, '/') == NULL) - { - strcpy(szNewWorkName, OldFileName); - if((ptr = strrchr(szNewWorkName, '\\')) == NULL) - ptr = strrchr(szNewWorkName, '/'); - strcpy(++ptr, newname); - } - else - strcpy(szNewWorkName, newname); - - if(stricmp(OldFileName, szNewWorkName) != 0) - { // check that we're not being fooled by relative paths - // and only delete the new file - // 1) if it exists - // 2) it is not the same file as the old file - // 3) old file exist - // GetFullPathName does not return the long file name on some systems - handle = FindFirstFile(OldFileName, &fdOldFile); - if(handle != INVALID_HANDLE_VALUE) - { - FindClose(handle); - - handle = FindFirstFile(szNewWorkName, &fdNewFile); - - if(handle != INVALID_HANDLE_VALUE) - FindClose(handle); - else - fdNewFile.cFileName[0] = '\0'; - - if(strcmp(fdOldFile.cAlternateFileName, fdNewFile.cAlternateFileName) != 0 - && strcmp(fdOldFile.cFileName, fdNewFile.cFileName) != 0) - { // file exists and not same file - DeleteFile(szNewWorkName); - } - } - } - int ret = rename(OldFileName, szNewWorkName); - if(ret) - err = errno; - - return ret; -} - -int CPerlLIO::Setmode(int fd, int mode, int &err) -{ - CALLFUNCRET(setmode(fd, mode)) -} - -int CPerlLIO::STat(const char *path, struct stat *sbufptr, int &err) -{ - char t[MAX_PATH]; - const char *p = path; - int l = strlen(path); - int res; - - if (l > 1) { - switch(path[l - 1]) { - case '\\': - case '/': - if (path[l - 2] != ':') { - strncpy(t, path, l - 1); - t[l - 1] = 0; - p = t; - }; - } - } - res = stat(path, sbufptr); -#ifdef __BORLANDC__ - if (res == 0) { - if (S_ISDIR(buffer->st_mode)) - buffer->st_mode |= S_IWRITE | S_IEXEC; - else if (S_ISREG(buffer->st_mode)) { - if (l >= 4 && path[l-4] == '.') { - const char *e = path + l - 3; - if (strnicmp(e,"exe",3) - && strnicmp(e,"bat",3) - && strnicmp(e,"com",3) - && (IsWin95() || strnicmp(e,"cmd",3))) - buffer->st_mode &= ~S_IEXEC; - else - buffer->st_mode |= S_IEXEC; - } - else - buffer->st_mode &= ~S_IEXEC; - } - } -#endif - return res; -} - -char *CPerlLIO::Tmpnam(char *string, int &err) -{ - return tmpnam(string); -} - -int CPerlLIO::Umask(int pmode, int &err) -{ - return umask(pmode); -} - -int CPerlLIO::Unlink(const char *filename, int &err) -{ - chmod(filename, _S_IREAD | _S_IWRITE); - CALLFUNCRET(unlink(filename)) -} - -int CPerlLIO::Utime(char *filename, struct utimbuf *times, int &err) -{ - CALLFUNCRET(utime(filename, times)) -} - -int CPerlLIO::Write(int fd, const void *buffer, unsigned int cnt, int &err) -{ - CALLFUNCERR(write(fd, buffer, cnt)) -} - diff --git a/win32/ipmem.c b/win32/ipmem.c deleted file mode 100644 index 62e72ab8db..0000000000 --- a/win32/ipmem.c +++ /dev/null @@ -1,39 +0,0 @@ -/* - - ipmem.c - Interface for perl memory allocation - -*/ - -#include <ipmem.h> - -class CPerlMem : public IPerlMem -{ -public: - CPerlMem() { pPerl = NULL; }; - virtual void* Malloc(size_t); - virtual void* Realloc(void*, size_t); - virtual void Free(void*); - - inline void SetPerlObj(CPerlObj *p) { pPerl = p; }; -protected: - CPerlObj *pPerl; -}; - -void* CPerlMem::Malloc(size_t size) -{ - return malloc(size); -} - -void* CPerlMem::Realloc(void* ptr, size_t size) -{ - return realloc(ptr, size); -} - -void CPerlMem::Free(void* ptr) -{ - free(ptr); -} - - - diff --git a/win32/ipproc.c b/win32/ipproc.c deleted file mode 100644 index f6445291d1..0000000000 --- a/win32/ipproc.c +++ /dev/null @@ -1,620 +0,0 @@ -/* - - ipproc.c - Interface for perl process functions - -*/ - -#include <ipproc.h> -#include <stdlib.h> -#include <fcntl.h> - -#define EXECF_EXEC 1 -#define EXECF_SPAWN 2 -#define EXECF_SPAWN_NOWAIT 3 - -class CPerlProc : public IPerlProc -{ -public: - CPerlProc() - { - pPerl = NULL; - w32_perlshell_tokens = NULL; - w32_perlshell_items = -1; - w32_platform = -1; -#ifndef __BORLANDC__ - w32_num_children = 0; -#endif - }; - virtual void Abort(void); - virtual void Exit(int status); - virtual void _Exit(int status); - virtual int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3); - virtual int Execv(const char *cmdname, const char *const *argv); - virtual int Execvp(const char *cmdname, const char *const *argv); - virtual uid_t Getuid(void); - virtual uid_t Geteuid(void); - virtual gid_t Getgid(void); - virtual gid_t Getegid(void); - virtual char *Getlogin(void); - virtual int Kill(int pid, int sig); - virtual int Killpg(int pid, int sig); - virtual int PauseProc(void); - virtual PerlIO* Popen(const char *command, const char *mode); - virtual int Pclose(PerlIO *stream); - virtual int Pipe(int *phandles); - virtual int Setuid(uid_t u); - virtual int Setgid(gid_t g); - virtual int Sleep(unsigned int); - virtual int Times(struct tms *timebuf); - virtual int Wait(int *status); - virtual Sighandler_t Signal(int sig, Sighandler_t subcode); - virtual void GetSysMsg(char*& msg, DWORD& dwLen, DWORD dwErr); - virtual void FreeBuf(char* msg); - virtual BOOL DoCmd(char *cmd); - virtual int Spawn(char*cmds); - virtual int Spawnvp(int mode, const char *cmdname, const char *const *argv); - virtual int ASpawn(void *vreally, void **vmark, void **vsp); - - inline void SetPerlObj(CPerlObj *p) { pPerl = p; }; -protected: - int Spawn(char *cmd, int exectype); - void GetShell(void); - long Tokenize(char *str, char **dest, char ***destv); - - inline int IsWin95(void) - { - return (os_id() == VER_PLATFORM_WIN32_WINDOWS); - }; - inline int IsWinNT(void) - { - return (os_id() == VER_PLATFORM_WIN32_NT); - }; - - inline long filetime_to_clock(PFILETIME ft) - { - __int64 qw = ft->dwHighDateTime; - qw <<= 32; - qw |= ft->dwLowDateTime; - qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */ - return (long) qw; - }; - - DWORD os_id(void) - { - if((-1) == w32_platform) - { - OSVERSIONINFO osver; - - memset(&osver, 0, sizeof(OSVERSIONINFO)); - osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - GetVersionEx(&osver); - w32_platform = osver.dwPlatformId; - } - return (w32_platform); - }; - - DWORD w32_platform; - char szLoginNameStr[128]; - char *w32_perlshell_tokens; - long w32_perlshell_items; - char **w32_perlshell_vec; -#ifndef __BORLANDC__ - long w32_num_children; - HANDLE w32_child_pids[MAXIMUM_WAIT_OBJECTS]; -#endif - CPerlObj *pPerl; -}; - - -static BOOL -has_redirection(char *ptr) -{ - int inquote = 0; - char quote = '\0'; - - /* - * Scan string looking for redirection (< or >) or pipe - * characters (|) that are not in a quoted string - */ - while(*ptr) { - switch(*ptr) { - case '\'': - case '\"': - if(inquote) { - if(quote == *ptr) { - inquote = 0; - quote = '\0'; - } - } - else { - quote = *ptr; - inquote++; - } - break; - case '>': - case '<': - case '|': - if(!inquote) - return TRUE; - default: - break; - } - ++ptr; - } - return FALSE; -} - -/* Tokenize a string. Words are null-separated, and the list - * ends with a doubled null. Any character (except null and - * including backslash) may be escaped by preceding it with a - * backslash (the backslash will be stripped). - * Returns number of words in result buffer. - */ -long -CPerlProc::Tokenize(char *str, char **dest, char ***destv) -{ - char *retstart = Nullch; - char **retvstart = 0; - int items = -1; - if (str) { - int slen = strlen(str); - register char *ret; - register char **retv; - New(1307, ret, slen+2, char); - New(1308, retv, (slen+3)/2, char*); - - retstart = ret; - retvstart = retv; - *retv = ret; - items = 0; - while (*str) { - *ret = *str++; - if (*ret == '\\' && *str) - *ret = *str++; - else if (*ret == ' ') { - while (*str == ' ') - str++; - if (ret == retstart) - ret--; - else { - *ret = '\0'; - ++items; - if (*str) - *++retv = ret+1; - } - } - else if (!*str) - ++items; - ret++; - } - retvstart[items] = Nullch; - *ret++ = '\0'; - *ret = '\0'; - } - *dest = retstart; - *destv = retvstart; - return items; -} - - -void -CPerlProc::GetShell(void) -{ - if (!w32_perlshell_tokens) { - /* we don't use COMSPEC here for two reasons: - * 1. the same reason perl on UNIX doesn't use SHELL--rampant and - * uncontrolled unportability of the ensuing scripts. - * 2. PERL5SHELL could be set to a shell that may not be fit for - * interactive use (which is what most programs look in COMSPEC - * for). - */ - char* defaultshell = (IsWinNT() ? "cmd.exe /x/c" : "command.com /c"); - char* usershell = getenv("PERL5SHELL"); - w32_perlshell_items = Tokenize(usershell ? usershell : defaultshell, - &w32_perlshell_tokens, - &w32_perlshell_vec); - } -} - -int -CPerlProc::ASpawn(void *vreally, void **vmark, void **vsp) -{ - SV *really = (SV*)vreally; - SV **mark = (SV**)vmark; - SV **sp = (SV**)vsp; - char **argv; - char *str; - int status; - int flag = P_WAIT; - int index = 0; - - if (sp <= mark) - return -1; - - GetShell(); - New(1306, argv, (sp - mark) + w32_perlshell_items + 2, char*); - - if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) { - ++mark; - flag = SvIVx(*mark); - } - - while(++mark <= sp) { - if (*mark && (str = SvPV(*mark, na))) - argv[index++] = str; - else - argv[index++] = ""; - } - argv[index++] = 0; - - status = Spawnvp(flag, - (really ? SvPV(really,na) : argv[0]), - (const char* const*)argv); - - if (status < 0 && errno == ENOEXEC) { - /* possible shell-builtin, invoke with shell */ - int sh_items; - sh_items = w32_perlshell_items; - while (--index >= 0) - argv[index+sh_items] = argv[index]; - while (--sh_items >= 0) - argv[sh_items] = w32_perlshell_vec[sh_items]; - - status = Spawnvp(flag, - (really ? SvPV(really,na) : argv[0]), - (const char* const*)argv); - } - - if (status < 0) { - if (pPerl->Perl_dowarn) - warn("Can't spawn \"%s\": %s", argv[0], strerror(errno)); - status = 255 * 256; - } - else if (flag != P_NOWAIT) - status *= 256; - Safefree(argv); - return (pPerl->Perl_statusvalue = status); -} - - -int -CPerlProc::Spawn(char *cmd, int exectype) -{ - char **a; - char *s; - char **argv; - int status = -1; - BOOL needToTry = TRUE; - char *cmd2; - - /* Save an extra exec if possible. See if there are shell - * metacharacters in it */ - if(!has_redirection(cmd)) { - New(1301,argv, strlen(cmd) / 2 + 2, char*); - New(1302,cmd2, strlen(cmd) + 1, char); - strcpy(cmd2, cmd); - a = argv; - for (s = cmd2; *s;) { - while (*s && isspace(*s)) - s++; - if (*s) - *(a++) = s; - while(*s && !isspace(*s)) - s++; - if(*s) - *s++ = '\0'; - } - *a = Nullch; - if (argv[0]) { - switch (exectype) { - case EXECF_SPAWN: - status = Spawnvp(P_WAIT, argv[0], - (const char* const*)argv); - break; - case EXECF_SPAWN_NOWAIT: - status = Spawnvp(P_NOWAIT, argv[0], - (const char* const*)argv); - break; - case EXECF_EXEC: - status = Execvp(argv[0], (const char* const*)argv); - break; - } - if (status != -1 || errno == 0) - needToTry = FALSE; - } - Safefree(argv); - Safefree(cmd2); - } - if (needToTry) { - char **argv; - int i = -1; - GetShell(); - New(1306, argv, w32_perlshell_items + 2, char*); - while (++i < w32_perlshell_items) - argv[i] = w32_perlshell_vec[i]; - argv[i++] = cmd; - argv[i] = Nullch; - switch (exectype) { - case EXECF_SPAWN: - status = Spawnvp(P_WAIT, argv[0], - (const char* const*)argv); - break; - case EXECF_SPAWN_NOWAIT: - status = Spawnvp(P_NOWAIT, argv[0], - (const char* const*)argv); - break; - case EXECF_EXEC: - status = Execvp(argv[0], (const char* const*)argv); - break; - } - cmd = argv[0]; - Safefree(argv); - } - if (status < 0) { - if (pPerl->Perl_dowarn) - warn("Can't %s \"%s\": %s", - (exectype == EXECF_EXEC ? "exec" : "spawn"), - cmd, strerror(errno)); - status = 255 * 256; - } - else if (exectype != EXECF_SPAWN_NOWAIT) - status *= 256; - return (pPerl->Perl_statusvalue = status); -} - - -void CPerlProc::Abort(void) -{ - abort(); -} - -void CPerlProc::Exit(int status) -{ - exit(status); -} - -void CPerlProc::_Exit(int status) -{ - _exit(status); -} - -int CPerlProc::Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3) -{ - return execl(cmdname, arg0, arg1, arg2, arg3); -} - -int CPerlProc::Execv(const char *cmdname, const char *const *argv) -{ - return execv(cmdname, argv); -} - -int CPerlProc::Execvp(const char *cmdname, const char *const *argv) -{ - return execvp(cmdname, argv); -} - -#define ROOT_UID ((uid_t)0) -#define ROOT_GID ((gid_t)0) - -uid_t CPerlProc::Getuid(void) -{ - return ROOT_UID; -} - -uid_t CPerlProc::Geteuid(void) -{ - return ROOT_UID; -} - -gid_t CPerlProc::Getgid(void) -{ - return ROOT_GID; -} - -gid_t CPerlProc::Getegid(void) -{ - return ROOT_GID; -} - - -char *CPerlProc::Getlogin(void) -{ - char unknown[] = "<Unknown>"; - unsigned long len; - - len = sizeof(szLoginNameStr); - if(!GetUserName(szLoginNameStr, &len)) - { - strcpy(szLoginNameStr, unknown); - } - return szLoginNameStr; -} - -int CPerlProc::Kill(int pid, int sig) -{ - HANDLE hProcess; - - hProcess = OpenProcess(PROCESS_ALL_ACCESS, FALSE, (DWORD)pid); - if(hProcess == NULL) - croak("kill process failed!\n"); - - if(TerminateProcess(hProcess, 0) == FALSE) - croak("kill process failed!\n"); - - CloseHandle(hProcess); - return 0; -} - -int CPerlProc::Killpg(int pid, int sig) -{ - croak("killpg not implemented!\n"); - return 0; -} - -int CPerlProc::PauseProc(void) -{ - Sleep((unsigned int)((32767L << 16) + 32767)); - return 0; -} - -PerlIO* CPerlProc::Popen(const char *command, const char *mode) -{ - return (PerlIO*)_popen(command, mode); -} - -int CPerlProc::Pclose(PerlIO *pf) -{ - return _pclose((FILE*)pf); -} - -int CPerlProc::Pipe(int *phandles) -{ - return _pipe(phandles, 512, O_BINARY); -} - -int CPerlProc::Sleep(unsigned int s) -{ - ::Sleep(s*1000); - return 0; -} - -int CPerlProc::Times(struct tms *timebuf) -{ - FILETIME user; - FILETIME kernel; - FILETIME dummy; - if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy, - &kernel,&user)) { - timebuf->tms_utime = filetime_to_clock(&user); - timebuf->tms_stime = filetime_to_clock(&kernel); - timebuf->tms_cutime = 0; - timebuf->tms_cstime = 0; - - } else { - /* That failed - e.g. Win95 fallback to clock() */ - clock_t t = clock(); - timebuf->tms_utime = t; - timebuf->tms_stime = 0; - timebuf->tms_cutime = 0; - timebuf->tms_cstime = 0; - } - return 0; -} - -int CPerlProc::Wait(int *status) -{ -#ifdef __BORLANDC__ - return wait(status); -#else - /* XXX this wait emulation only knows about processes - * spawned via win32_spawnvp(P_NOWAIT, ...). - */ - int i, retval; - DWORD exitcode, waitcode; - - if (!w32_num_children) { - errno = ECHILD; - return -1; - } - - /* if a child exists, wait for it to die */ - waitcode = WaitForMultipleObjects(w32_num_children, - w32_child_pids, - FALSE, - INFINITE); - if (waitcode != WAIT_FAILED) { - if (waitcode >= WAIT_ABANDONED_0 - && waitcode < WAIT_ABANDONED_0 + w32_num_children) - i = waitcode - WAIT_ABANDONED_0; - else - i = waitcode - WAIT_OBJECT_0; - if (GetExitCodeProcess(w32_child_pids[i], &exitcode) ) { - CloseHandle(w32_child_pids[i]); - *status = (int)((exitcode & 0xff) << 8); - retval = (int)w32_child_pids[i]; - Copy(&w32_child_pids[i+1], &w32_child_pids[i], - (w32_num_children-i-1), HANDLE); - w32_num_children--; - return retval; - } - } - -FAILED: - errno = GetLastError(); - return -1; - -#endif -} - -int CPerlProc::Setuid(uid_t u) -{ - return (u == ROOT_UID ? 0 : -1); -} - -int CPerlProc::Setgid(gid_t g) -{ - return (g == ROOT_GID ? 0 : -1); -} - -Sighandler_t CPerlProc::Signal(int sig, Sighandler_t subcode) -{ - return 0; -} - -void CPerlProc::GetSysMsg(char*& sMsg, DWORD& dwLen, DWORD dwErr) -{ - dwLen = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER - |FORMAT_MESSAGE_IGNORE_INSERTS - |FORMAT_MESSAGE_FROM_SYSTEM, NULL, - dwErr, 0, (char *)&sMsg, 1, NULL); - if (0 < dwLen) { - while (0 < dwLen && isspace(sMsg[--dwLen])) - ; - if ('.' != sMsg[dwLen]) - dwLen++; - sMsg[dwLen]= '\0'; - } - if (0 == dwLen) { - sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/); - dwLen = sprintf(sMsg, - "Unknown error #0x%lX (lookup 0x%lX)", - dwErr, GetLastError()); - } -} - -void CPerlProc::FreeBuf(char* sMsg) -{ - LocalFree(sMsg); -} - -BOOL CPerlProc::DoCmd(char *cmd) -{ - Spawn(cmd, EXECF_EXEC); - return FALSE; -} - -int CPerlProc::Spawn(char* cmd) -{ - return Spawn(cmd, EXECF_SPAWN); -} - -int CPerlProc::Spawnvp(int mode, const char *cmdname, const char *const *argv) -{ - int status; - - status = spawnvp(mode, cmdname, (char * const *)argv); -#ifndef __BORLANDC__ - /* XXX For the P_NOWAIT case, Borland RTL returns pinfo.dwProcessId - * while VC RTL returns pinfo.hProcess. For purposes of the custom - * implementation of win32_wait(), we assume the latter. - */ - if (mode == P_NOWAIT && status >= 0) - w32_child_pids[w32_num_children++] = (HANDLE)status; -#endif - return status; -} - - - - diff --git a/win32/ipsock.c b/win32/ipsock.c deleted file mode 100644 index a6510b9d83..0000000000 --- a/win32/ipsock.c +++ /dev/null @@ -1,681 +0,0 @@ -/* - - ipsock.c - Interface for perl socket functions - -*/ - -#include <ipsock.h> -#include <fcntl.h> - -#define USE_SOCKETS_AS_HANDLES - -class CPerlSock : public IPerlSock -{ -public: - CPerlSock(); - ~CPerlSock(); - virtual u_long Htonl(u_long hostlong); - virtual u_short Htons(u_short hostshort); - virtual u_long Ntohl(u_long netlong); - virtual u_short Ntohs(u_short netshort); - virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err); - virtual int Bind(SOCKET s, const struct sockaddr* name, int namelen, int &err); - virtual int Connect(SOCKET s, const struct sockaddr* name, int namelen, int &err); - virtual void Endhostent(int &err); - virtual void Endnetent(int &err); - virtual void Endprotoent(int &err); - virtual void Endservent(int &err); - virtual struct hostent* Gethostbyaddr(const char* addr, int len, int type, int &err); - virtual struct hostent* Gethostbyname(const char* name, int &err); - virtual struct hostent* Gethostent(int &err); - virtual int Gethostname(char* name, int namelen, int &err); - virtual struct netent *Getnetbyaddr(long net, int type, int &err); - virtual struct netent *Getnetbyname(const char *, int &err); - virtual struct netent *Getnetent(int &err); - virtual int Getpeername(SOCKET s, struct sockaddr* name, int* namelen, int &err); - virtual struct protoent* Getprotobyname(const char* name, int &err); - virtual struct protoent* Getprotobynumber(int number, int &err); - virtual struct protoent* Getprotoent(int &err); - virtual struct servent* Getservbyname(const char* name, const char* proto, int &err); - virtual struct servent* Getservbyport(int port, const char* proto, int &err); - virtual struct servent* Getservent(int &err); - virtual int Getsockname(SOCKET s, struct sockaddr* name, int* namelen, int &err); - virtual int Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err); - virtual unsigned long InetAddr(const char* cp, int &err); - virtual char* InetNtoa(struct in_addr in, int &err); - virtual int IoctlSocket(SOCKET s, long cmd, u_long *argp, int& err); - virtual int Listen(SOCKET s, int backlog, int &err); - virtual int Recvfrom(SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen, int &err); - virtual int Select(int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout, int &err); - virtual int Send(SOCKET s, const char* buffer, int len, int flags, int &err); - virtual int Sendto(SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen, int &err); - virtual void Sethostent(int stayopen, int &err); - virtual void Setnetent(int stayopen, int &err); - virtual void Setprotoent(int stayopen, int &err); - virtual void Setservent(int stayopen, int &err); - virtual int Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err); - virtual int Shutdown(SOCKET s, int how, int &err); - virtual SOCKET Socket(int af, int type, int protocol, int &err); - virtual int Socketpair(int domain, int type, int protocol, int* fds, int &err); - - void CloseSocket(int fh, int& err); - void* GetAddress(HINSTANCE hInstance, char *lpFunctionName); - void LoadWinSock(void); - - inline void SetPerlObj(CPerlObj *p) { pPerl = p; }; - inline void SetStdObj(IPerlStdIOWin *p) { pStdIO = p; }; -protected: - void Start(void); - - inline int OpenOSfhandle(long osfhandle) - { - return pStdIO->OpenOSfhandle(osfhandle, O_RDWR|O_BINARY); - }; - int GetOSfhandle(int filenum) - { - return pStdIO->GetOSfhandle(filenum); - }; - - inline void StartSockets(void) - { - if(!bStarted) - Start(); - }; - - BOOL bStarted; - CPerlObj *pPerl; - IPerlStdIOWin *pStdIO; -}; - - -#define SOCKETAPI PASCAL - -typedef SOCKET (SOCKETAPI *LPSOCKACCEPT)(SOCKET, struct sockaddr *, int *); -typedef int (SOCKETAPI *LPSOCKBIND)(SOCKET, const struct sockaddr *, int); -typedef int (SOCKETAPI *LPSOCKCLOSESOCKET)(SOCKET); -typedef int (SOCKETAPI *LPSOCKCONNECT)(SOCKET, const struct sockaddr *, int); -typedef unsigned long (SOCKETAPI *LPINETADDR)(const char *); -typedef char* (SOCKETAPI *LPINETNTOA)(struct in_addr); -typedef int (SOCKETAPI *LPSOCKIOCTLSOCKET)(SOCKET, long, u_long *); -typedef int (SOCKETAPI *LPSOCKGETPEERNAME)(SOCKET, struct sockaddr *, int *); -typedef int (SOCKETAPI *LPSOCKGETSOCKNAME)(SOCKET, struct sockaddr *, int *); -typedef int (SOCKETAPI *LPSOCKGETSOCKOPT)(SOCKET, int, int, char *, int *); -typedef u_long (SOCKETAPI *LPSOCKHTONL)(u_long); -typedef u_short (SOCKETAPI *LPSOCKHTONS)(u_short); -typedef int (SOCKETAPI *LPSOCKLISTEN)(SOCKET, int); -typedef u_long (SOCKETAPI *LPSOCKNTOHL)(u_long); -typedef u_short (SOCKETAPI *LPSOCKNTOHS)(u_short); -typedef int (SOCKETAPI *LPSOCKRECV)(SOCKET, char *, int, int); -typedef int (SOCKETAPI *LPSOCKRECVFROM)(SOCKET, char *, int, int, struct sockaddr *, int *); -typedef int (SOCKETAPI *LPSOCKSELECT)(int, fd_set *, fd_set *, fd_set *, const struct timeval *); -typedef int (SOCKETAPI *LPSOCKSEND)(SOCKET, const char *, int, int); -typedef int (SOCKETAPI *LPSOCKSENDTO)(SOCKET, const char *, int, int, const struct sockaddr *, int); -typedef int (SOCKETAPI *LPSOCKSETSOCKOPT)(SOCKET, int, int, const char *, int); -typedef int (SOCKETAPI *LPSOCKSHUTDOWN)(SOCKET, int); -typedef SOCKET (SOCKETAPI *LPSOCKSOCKET)(int, int, int); - -/* Database function prototypes */ -typedef struct hostent *(SOCKETAPI *LPSOCKGETHOSTBYADDR)(const char *, int, int); -typedef struct hostent *(SOCKETAPI *LPSOCKGETHOSTBYNAME)(const char *); -typedef int (SOCKETAPI *LPSOCKGETHOSTNAME)(char *, int); -typedef struct servent *(SOCKETAPI *LPSOCKGETSERVBYPORT)(int, const char *); -typedef struct servent *(SOCKETAPI *LPSOCKGETSERVBYNAME)(const char *, const char *); -typedef struct protoent *(SOCKETAPI *LPSOCKGETPROTOBYNUMBER)(int); -typedef struct protoent *(SOCKETAPI *LPSOCKGETPROTOBYNAME)(const char *); - -/* Microsoft Windows Extension function prototypes */ -typedef int (SOCKETAPI *LPSOCKWSASTARTUP)(unsigned short, LPWSADATA); -typedef int (SOCKETAPI *LPSOCKWSACLEANUP)(void); -typedef int (SOCKETAPI *LPSOCKWSAGETLASTERROR)(void); -typedef int (SOCKETAPI *LPWSAFDIsSet)(SOCKET, fd_set *); - -static HINSTANCE hWinSockDll = 0; - -static LPSOCKACCEPT paccept = 0; -static LPSOCKBIND pbind = 0; -static LPSOCKCLOSESOCKET pclosesocket = 0; -static LPSOCKCONNECT pconnect = 0; -static LPINETADDR pinet_addr = 0; -static LPINETNTOA pinet_ntoa = 0; -static LPSOCKIOCTLSOCKET pioctlsocket = 0; -static LPSOCKGETPEERNAME pgetpeername = 0; -static LPSOCKGETSOCKNAME pgetsockname = 0; -static LPSOCKGETSOCKOPT pgetsockopt = 0; -static LPSOCKHTONL phtonl = 0; -static LPSOCKHTONS phtons = 0; -static LPSOCKLISTEN plisten = 0; -static LPSOCKNTOHL pntohl = 0; -static LPSOCKNTOHS pntohs = 0; -static LPSOCKRECV precv = 0; -static LPSOCKRECVFROM precvfrom = 0; -static LPSOCKSELECT pselect = 0; -static LPSOCKSEND psend = 0; -static LPSOCKSENDTO psendto = 0; -static LPSOCKSETSOCKOPT psetsockopt = 0; -static LPSOCKSHUTDOWN pshutdown = 0; -static LPSOCKSOCKET psocket = 0; -static LPSOCKGETHOSTBYADDR pgethostbyaddr = 0; -static LPSOCKGETHOSTBYNAME pgethostbyname = 0; -static LPSOCKGETHOSTNAME pgethostname = 0; -static LPSOCKGETSERVBYPORT pgetservbyport = 0; -static LPSOCKGETSERVBYNAME pgetservbyname = 0; -static LPSOCKGETPROTOBYNUMBER pgetprotobynumber = 0; -static LPSOCKGETPROTOBYNAME pgetprotobyname = 0; -static LPSOCKWSASTARTUP pWSAStartup = 0; -static LPSOCKWSACLEANUP pWSACleanup = 0; -static LPSOCKWSAGETLASTERROR pWSAGetLastError = 0; -static LPWSAFDIsSet pWSAFDIsSet = 0; - -void* CPerlSock::GetAddress(HINSTANCE hInstance, char *lpFunctionName) -{ - char buffer[512]; - FARPROC proc = GetProcAddress(hInstance, lpFunctionName); - if(proc == 0) - { - sprintf(buffer, "Unable to get address of %s in WSock32.dll", lpFunctionName); - croak(buffer); - } - return proc; -} - -void CPerlSock::LoadWinSock(void) -{ - if(hWinSockDll == NULL) - { - HINSTANCE hLib = LoadLibrary("WSock32.DLL"); - if(hLib == NULL) - croak("Could not load WSock32.dll\n"); - - paccept = (LPSOCKACCEPT)GetAddress(hLib, "accept"); - pbind = (LPSOCKBIND)GetAddress(hLib, "bind"); - pclosesocket = (LPSOCKCLOSESOCKET)GetAddress(hLib, "closesocket"); - pconnect = (LPSOCKCONNECT)GetAddress(hLib, "connect"); - pinet_addr = (LPINETADDR)GetAddress(hLib, "inet_addr"); - pinet_ntoa = (LPINETNTOA)GetAddress(hLib, "inet_ntoa"); - pioctlsocket = (LPSOCKIOCTLSOCKET)GetAddress(hLib, "ioctlsocket"); - pgetpeername = (LPSOCKGETPEERNAME)GetAddress(hLib, "getpeername"); - pgetsockname = (LPSOCKGETSOCKNAME)GetAddress(hLib, "getsockname"); - pgetsockopt = (LPSOCKGETSOCKOPT)GetAddress(hLib, "getsockopt"); - phtonl = (LPSOCKHTONL)GetAddress(hLib, "htonl"); - phtons = (LPSOCKHTONS)GetAddress(hLib, "htons"); - plisten = (LPSOCKLISTEN)GetAddress(hLib, "listen"); - pntohl = (LPSOCKNTOHL)GetAddress(hLib, "ntohl"); - pntohs = (LPSOCKNTOHS)GetAddress(hLib, "ntohs"); - precv = (LPSOCKRECV)GetAddress(hLib, "recv"); - precvfrom = (LPSOCKRECVFROM)GetAddress(hLib, "recvfrom"); - pselect = (LPSOCKSELECT)GetAddress(hLib, "select"); - psend = (LPSOCKSEND)GetAddress(hLib, "send"); - psendto = (LPSOCKSENDTO)GetAddress(hLib, "sendto"); - psetsockopt = (LPSOCKSETSOCKOPT)GetAddress(hLib, "setsockopt"); - pshutdown = (LPSOCKSHUTDOWN)GetAddress(hLib, "shutdown"); - psocket = (LPSOCKSOCKET)GetAddress(hLib, "socket"); - pgethostbyaddr = (LPSOCKGETHOSTBYADDR)GetAddress(hLib, "gethostbyaddr"); - pgethostbyname = (LPSOCKGETHOSTBYNAME)GetAddress(hLib, "gethostbyname"); - pgethostname = (LPSOCKGETHOSTNAME)GetAddress(hLib, "gethostname"); - pgetservbyport = (LPSOCKGETSERVBYPORT)GetAddress(hLib, "getservbyport"); - pgetservbyname = (LPSOCKGETSERVBYNAME)GetAddress(hLib, "getservbyname"); - pgetprotobynumber = (LPSOCKGETPROTOBYNUMBER)GetAddress(hLib, "getprotobynumber"); - pgetprotobyname = (LPSOCKGETPROTOBYNAME)GetAddress(hLib, "getprotobyname"); - pWSAStartup = (LPSOCKWSASTARTUP)GetAddress(hLib, "WSAStartup"); - pWSACleanup = (LPSOCKWSACLEANUP)GetAddress(hLib, "WSACleanup"); - pWSAGetLastError = (LPSOCKWSAGETLASTERROR)GetAddress(hLib, "WSAGetLastError"); - pWSAFDIsSet = (LPWSAFDIsSet)GetAddress(hLib, "__WSAFDIsSet"); - hWinSockDll = hLib; - } -} - - -CPerlSock::CPerlSock() -{ - bStarted = FALSE; - pPerl = NULL; - pStdIO = NULL; -} - -CPerlSock::~CPerlSock() -{ - if(bStarted) - pWSACleanup(); -} - -void -CPerlSock::Start(void) -{ - unsigned short version; - WSADATA retdata; - int ret; - int iSockOpt = SO_SYNCHRONOUS_NONALERT; - - LoadWinSock(); - /* - * initalize the winsock interface and insure that it is - * cleaned up at exit. - */ - version = 0x101; - if(ret = pWSAStartup(version, &retdata)) - croak("Unable to locate winsock library!\n"); - if(retdata.wVersion != version) - croak("Could not find version 1.1 of winsock dll\n"); - - /* atexit((void (*)(void)) EndSockets); */ - -#ifdef USE_SOCKETS_AS_HANDLES - /* - * Enable the use of sockets as filehandles - */ - psetsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, - (char *)&iSockOpt, sizeof(iSockOpt)); -#endif /* USE_SOCKETS_AS_HANDLES */ - bStarted = TRUE; -} - - -u_long -CPerlSock::Htonl(u_long hostlong) -{ - StartSockets(); - return phtonl(hostlong); -} - -u_short -CPerlSock::Htons(u_short hostshort) -{ - StartSockets(); - return phtons(hostshort); -} - -u_long -CPerlSock::Ntohl(u_long netlong) -{ - StartSockets(); - return pntohl(netlong); -} - -u_short -CPerlSock::Ntohs(u_short netshort) -{ - StartSockets(); - return pntohs(netshort); -} - - -/* thanks to Beverly Brown (beverly@datacube.com) */ -#ifdef USE_SOCKETS_AS_HANDLES -# define OPEN_SOCKET(x) OpenOSfhandle(x) -# define TO_SOCKET(x) GetOSfhandle(x) -#else -# define OPEN_SOCKET(x) (x) -# define TO_SOCKET(x) (x) -#endif /* USE_SOCKETS_AS_HANDLES */ - -#define SOCKET_TEST(x, y) \ - STMT_START { \ - StartSockets(); \ - if((x) == (y)) \ - err = pWSAGetLastError(); \ - } STMT_END - -#define SOCKET_TEST_ERROR(x) SOCKET_TEST(x, SOCKET_ERROR) - -SOCKET -CPerlSock::Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err) -{ - SOCKET r; - - SOCKET_TEST((r = paccept(TO_SOCKET(s), addr, addrlen)), INVALID_SOCKET); - return OPEN_SOCKET(r); -} - -int -CPerlSock::Bind(SOCKET s, const struct sockaddr* addr, int addrlen, int &err) -{ - int r; - - SOCKET_TEST_ERROR(r = pbind(TO_SOCKET(s), addr, addrlen)); - return r; -} - -void -CPerlSock::CloseSocket(int fh, int& err) -{ - SOCKET_TEST_ERROR(pclosesocket(TO_SOCKET(fh))); -} - -int -CPerlSock::Connect(SOCKET s, const struct sockaddr* addr, int addrlen, int &err) -{ - int r; - - SOCKET_TEST_ERROR(r = pconnect(TO_SOCKET(s), addr, addrlen)); - return r; -} - -void CPerlSock::Endhostent(int &err) -{ - croak("endhostent not implemented!\n"); -} - -void CPerlSock::Endnetent(int &err) -{ - croak("endnetent not implemented!\n"); -} - -void CPerlSock::Endprotoent(int &err) -{ - croak("endprotoent not implemented!\n"); -} - -void CPerlSock::Endservent(int &err) -{ - croak("endservent not implemented!\n"); -} - -struct hostent* -CPerlSock::Gethostbyaddr(const char* addr, int len, int type, int &err) -{ - struct hostent *r; - - SOCKET_TEST(r = pgethostbyaddr(addr, len, type), NULL); - return r; -} - -struct hostent* -CPerlSock::Gethostbyname(const char* name, int &err) -{ - struct hostent *r; - - SOCKET_TEST(r = pgethostbyname(name), NULL); - return r; -} - -struct hostent* CPerlSock::Gethostent(int &err) -{ - croak("gethostent not implemented!\n"); - return NULL; -} - -int -CPerlSock::Gethostname(char* name, int len, int &err) -{ - int r; - - SOCKET_TEST_ERROR(r = pgethostname(name, len)); - return r; -} - -struct netent *CPerlSock::Getnetbyaddr(long net, int type, int &err) -{ - croak("getnetbyaddr not implemented!\n"); - return NULL; -} - -struct netent *CPerlSock::Getnetbyname(const char *, int &err) -{ - croak("getnetbyname not implemented!\n"); - return NULL; -} - -struct netent *CPerlSock::Getnetent(int &err) -{ - croak("getnetent not implemented!\n"); - return NULL; -} - -int -CPerlSock::Getpeername(SOCKET s, struct sockaddr* addr, int* addrlen, int &err) -{ - int r; - - SOCKET_TEST_ERROR(r = pgetpeername(TO_SOCKET(s), addr, addrlen)); - return r; -} - -struct protoent* -CPerlSock::Getprotobyname(const char* name, int &err) -{ - struct protoent *r; - - SOCKET_TEST(r = pgetprotobyname(name), NULL); - return r; -} - -struct protoent* -CPerlSock::Getprotobynumber(int number, int &err) -{ - struct protoent *r; - - SOCKET_TEST(r = pgetprotobynumber(number), NULL); - return r; -} - -struct protoent* CPerlSock::Getprotoent(int &err) -{ - croak("getprotoent not implemented!\n"); - return NULL; -} - -struct servent* -CPerlSock::Getservbyname(const char* name, const char* proto, int &err) -{ - struct servent *r; - dTHR; - - SOCKET_TEST(r = pgetservbyname(name, proto), NULL); -// if (r) { -// r = win32_savecopyservent(&myservent, r, proto); -// } - return r; -} - -struct servent* -CPerlSock::Getservbyport(int port, const char* proto, int &err) -{ - struct servent *r; - dTHR; - - SOCKET_TEST(r = pgetservbyport(port, proto), NULL); -// if (r) { -// r = win32_savecopyservent(&myservent, r, proto); -// } - return r; -} - -struct servent* CPerlSock::Getservent(int &err) -{ - croak("getservent not implemented!\n"); - return NULL; -} - -int -CPerlSock::Getsockname(SOCKET s, struct sockaddr* addr, int* addrlen, int &err) -{ - int r; - - SOCKET_TEST_ERROR(r = pgetsockname(TO_SOCKET(s), addr, addrlen)); - return r; -} - -int -CPerlSock::Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err) -{ - int r; - - SOCKET_TEST_ERROR(r = pgetsockopt(TO_SOCKET(s), level, optname, optval, optlen)); - return r; -} - -unsigned long -CPerlSock::InetAddr(const char* cp, int &err) -{ - unsigned long r; - - SOCKET_TEST(r = pinet_addr(cp), INADDR_NONE); - return r; -} - -char* -CPerlSock::InetNtoa(struct in_addr in, int &err) -{ - char* r; - - SOCKET_TEST(r = pinet_ntoa(in), NULL); - return r; -} - -int -CPerlSock::IoctlSocket(SOCKET s, long cmd, u_long *argp, int& err) -{ - int r; - - SOCKET_TEST_ERROR(r = pioctlsocket(TO_SOCKET(s), cmd, argp)); - return r; -} - -int -CPerlSock::Listen(SOCKET s, int backlog, int &err) -{ - int r; - - SOCKET_TEST_ERROR(r = plisten(TO_SOCKET(s), backlog)); - return r; -} - -int -CPerlSock::Recvfrom(SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen, int &err) -{ - int r; - - SOCKET_TEST_ERROR(r = precvfrom(TO_SOCKET(s), buffer, len, flags, from, fromlen)); - return r; -} - -int -CPerlSock::Select(int nfds, char* rd, char* wr, char* ex, const struct timeval* timeout, int &err) -{ - long r; - int i, fd, bit, offset; - FD_SET nrd, nwr, nex; - - FD_ZERO(&nrd); - FD_ZERO(&nwr); - FD_ZERO(&nex); - for (i = 0; i < nfds; i++) - { - fd = TO_SOCKET(i); - bit = 1L<<(i % (sizeof(char)*8)); - offset = i / (sizeof(char)*8); - if(rd != NULL && (rd[offset] & bit)) - FD_SET(fd, &nrd); - if(wr != NULL && (wr[offset] & bit)) - FD_SET(fd, &nwr); - if(ex != NULL && (ex[offset] & bit)) - FD_SET(fd, &nex); - } - SOCKET_TEST_ERROR(r = pselect(nfds, &nrd, &nwr, &nex, timeout)); - - for(i = 0; i < nfds; i++) - { - fd = TO_SOCKET(i); - bit = 1L<<(i % (sizeof(char)*8)); - offset = i / (sizeof(char)*8); - if(rd != NULL && (rd[offset] & bit)) - { - if(!pWSAFDIsSet(fd, &nrd)) - rd[offset] &= ~bit; - } - if(wr != NULL && (wr[offset] & bit)) - { - if(!pWSAFDIsSet(fd, &nwr)) - wr[offset] &= ~bit; - } - if(ex != NULL && (ex[offset] & bit)) - { - if(!pWSAFDIsSet(fd, &nex)) - ex[offset] &= ~bit; - } - } - return r; -} - -int -CPerlSock::Send(SOCKET s, const char* buffer, int len, int flags, int &err) -{ - int r; - - SOCKET_TEST_ERROR(r = psend(TO_SOCKET(s), buffer, len, flags)); - return r; -} - -int -CPerlSock::Sendto(SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen, int &err) -{ - int r; - - SOCKET_TEST_ERROR(r = psendto(TO_SOCKET(s), buffer, len, flags, to, tolen)); - return r; -} - -void CPerlSock::Sethostent(int stayopen, int &err) -{ - croak("sethostent not implemented!\n"); -} - -void CPerlSock::Setnetent(int stayopen, int &err) -{ - croak("setnetent not implemented!\n"); -} - -void CPerlSock::Setprotoent(int stayopen, int &err) -{ - croak("setprotoent not implemented!\n"); -} - -void CPerlSock::Setservent(int stayopen, int &err) -{ - croak("setservent not implemented!\n"); -} - -int -CPerlSock::Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err) -{ - int r; - - SOCKET_TEST_ERROR(r = psetsockopt(TO_SOCKET(s), level, optname, optval, optlen)); - return r; -} - -int -CPerlSock::Shutdown(SOCKET s, int how, int &err) -{ - int r; - - SOCKET_TEST_ERROR(r = pshutdown(TO_SOCKET(s), how)); - return r; -} - -SOCKET -CPerlSock::Socket(int af, int type, int protocol, int &err) -{ - SOCKET s; - -#ifdef USE_SOCKETS_AS_HANDLES - StartSockets(); - if((s = psocket(af, type, protocol)) == INVALID_SOCKET) - err = pWSAGetLastError(); - else - s = OPEN_SOCKET(s); -#else - SOCKET_TEST(s = psocket(af, type, protocol), INVALID_SOCKET); -#endif /* USE_SOCKETS_AS_HANDLES */ - - return s; -} - -int CPerlSock::Socketpair(int domain, int type, int protocol, int* fds, int &err) -{ - croak("socketpair not implemented!\n"); - return 0; -} - - diff --git a/win32/ipstdio.c b/win32/ipstdio.c deleted file mode 100644 index 795b901db8..0000000000 --- a/win32/ipstdio.c +++ /dev/null @@ -1,756 +0,0 @@ -/* - - ipstdio.c - Interface for perl stdio functions - -*/ - -#include "ipstdiowin.h" -#include <stdio.h> - -class CPerlStdIO : public IPerlStdIOWin -{ -public: - CPerlStdIO() - { - pPerl = NULL; - pSock = NULL; - w32_platform = -1; - ZeroMemory(bSocketTable, sizeof(bSocketTable)); - }; - virtual PerlIO* Stdin(void); - virtual PerlIO* Stdout(void); - virtual PerlIO* Stderr(void); - virtual PerlIO* Open(const char *, const char *, int &err); - virtual int Close(PerlIO*, int &err); - virtual int Eof(PerlIO*, int &err); - virtual int Error(PerlIO*, int &err); - virtual void Clearerr(PerlIO*, int &err); - virtual int Getc(PerlIO*, int &err); - virtual char* GetBase(PerlIO *, int &err); - virtual int GetBufsiz(PerlIO *, int &err); - virtual int GetCnt(PerlIO *, int &err); - virtual char* GetPtr(PerlIO *, int &err); - virtual int Putc(PerlIO*, int, int &err); - virtual int Puts(PerlIO*, const char *, int &err); - virtual int Flush(PerlIO*, int &err); - virtual int Ungetc(PerlIO*,int, int &err); - virtual int Fileno(PerlIO*, int &err); - virtual PerlIO* Fdopen(int, const char *, int &err); - virtual PerlIO* Reopen(const char*, const char*, PerlIO*, int &err); - virtual SSize_t Read(PerlIO*,void *,Size_t, int &err); - virtual SSize_t Write(PerlIO*,const void *,Size_t, int &err); - virtual void SetBuf(PerlIO *, char*, int &err); - virtual int SetVBuf(PerlIO *, char*, int, Size_t, int &err); - virtual void SetCnt(PerlIO *, int, int &err); - virtual void SetPtrCnt(PerlIO *, char *, int, int& err); - virtual void Setlinebuf(PerlIO*, int &err); - virtual int Printf(PerlIO*, int &err, const char *,...); - virtual int Vprintf(PerlIO*, int &err, const char *, va_list); - virtual long Tell(PerlIO*, int &err); - virtual int Seek(PerlIO*, off_t, int, int &err); - virtual void Rewind(PerlIO*, int &err); - virtual PerlIO* Tmpfile(int &err); - virtual int Getpos(PerlIO*, Fpos_t *, int &err); - virtual int Setpos(PerlIO*, const Fpos_t *, int &err); - virtual void Init(int &err); - virtual void InitOSExtras(void* p); - virtual int OpenOSfhandle(long osfhandle, int flags); - virtual int GetOSfhandle(int filenum); - - void ShutDown(void); - - inline void SetPerlObj(CPerlObj *p) { pPerl = p; }; - inline void SetSockCtl(CPerlSock *p) { pSock = p; }; -protected: - inline int IsWin95(void) - { - return (os_id() == VER_PLATFORM_WIN32_WINDOWS); - }; - inline int IsWinNT(void) - { - return (os_id() == VER_PLATFORM_WIN32_NT); - }; - inline void AddToSocketTable(int fh) - { - if(fh < _NSTREAM_) - bSocketTable[fh] = TRUE; - }; - inline BOOL InSocketTable(int fh) - { - if(fh < _NSTREAM_) - return bSocketTable[fh]; - return FALSE; - }; - inline void RemoveFromSocketTable(int fh) - { - if(fh < _NSTREAM_) - bSocketTable[fh] = FALSE; - }; - DWORD os_id(void) - { - if((-1) == w32_platform) - { - OSVERSIONINFO osver; - - memset(&osver, 0, sizeof(OSVERSIONINFO)); - osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - GetVersionEx(&osver); - w32_platform = osver.dwPlatformId; - } - return (w32_platform); - }; - - - CPerlObj *pPerl; - CPerlSock *pSock; - DWORD w32_platform; - BOOL bSocketTable[_NSTREAM_]; -}; - -void CPerlStdIO::ShutDown(void) -{ - int i, err; - for(i = 0; i < _NSTREAM_; ++i) - { - if(InSocketTable(i)) - pSock->CloseSocket(i, err); - } -}; - -#ifdef _X86_ -extern "C" int __cdecl _alloc_osfhnd(void); -extern "C" int __cdecl _set_osfhnd(int fh, long value); -extern "C" void __cdecl _unlock(int); - -#if (_MSC_VER >= 1000) -typedef struct -{ - long osfhnd; /* underlying OS file HANDLE */ - char osfile; /* attributes of file (e.g., open in text mode?) */ - char pipech; /* one char buffer for handles opened on pipes */ -} ioinfo; -extern "C" ioinfo * __pioinfo[]; -#define IOINFO_L2E 5 -#define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E) -#define _pioinfo(i) (__pioinfo[i >> IOINFO_L2E] + (i & (IOINFO_ARRAY_ELTS - 1))) -#define _osfile(i) (_pioinfo(i)->osfile) -#else -extern "C" extern char _osfile[]; -#endif // (_MSC_VER >= 1000) - -#define FOPEN 0x01 // file handle open -#define FAPPEND 0x20 // file handle opened O_APPEND -#define FDEV 0x40 // file handle refers to device -#define FTEXT 0x80 // file handle is in text mode - -#define _STREAM_LOCKS 26 // Table of stream locks -#define _LAST_STREAM_LOCK (_STREAM_LOCKS+_NSTREAM_-1) // Last stream lock -#define _FH_LOCKS (_LAST_STREAM_LOCK+1) // Table of fh locks -#endif // _X86_ - -int CPerlStdIO::OpenOSfhandle(long osfhandle, int flags) -{ - int fh; - -#ifdef _X86_ - if(IsWin95()) - { - // all this is here to handle Win95's GetFileType bug. - char fileflags; // _osfile flags - - // copy relevant flags from second parameter - fileflags = FDEV; - - if(flags & _O_APPEND) - fileflags |= FAPPEND; - - if(flags & _O_TEXT) - fileflags |= FTEXT; - - // attempt to allocate a C Runtime file handle - if((fh = _alloc_osfhnd()) == -1) - { - errno = EMFILE; // too many open files - _doserrno = 0L; // not an OS error - return -1; // return error to caller - } - - // the file is open. now, set the info in _osfhnd array - _set_osfhnd(fh, osfhandle); - - fileflags |= FOPEN; // mark as open - -#if (_MSC_VER >= 1000) - _osfile(fh) = fileflags; // set osfile entry -#else - _osfile[fh] = fileflags; // set osfile entry -#endif - } - else -#endif // _X86_ - fh = _open_osfhandle(osfhandle, flags); - - if(fh >= 0) - AddToSocketTable(fh); - - return fh; // return handle -} - -int CPerlStdIO::GetOSfhandle(int filenum) -{ - return _get_osfhandle(filenum); -} - -PerlIO* CPerlStdIO::Stdin(void) -{ - return (PerlIO*)(&_iob[0]); -} - -PerlIO* CPerlStdIO::Stdout(void) -{ - return (PerlIO*)(&_iob[1]); -} - -PerlIO* CPerlStdIO::Stderr(void) -{ - return (PerlIO*)(&_iob[2]); -} - -PerlIO* CPerlStdIO::Open(const char *path, const char *mode, int &err) -{ - PerlIO* ret = NULL; - if(*path != '\0') - { - if(stricmp(path, "/dev/null") == 0) - ret = (PerlIO*)fopen("NUL", mode); - else - ret = (PerlIO*)fopen(path, mode); - - if(errno) - err = errno; - } - else - err = EINVAL; - return ret; -} - -extern "C" int _free_osfhnd(int fh); -int CPerlStdIO::Close(PerlIO* pf, int &err) -{ - int ret = 0, fileNo = fileno((FILE*)pf); - if(InSocketTable(fileNo)) - { - RemoveFromSocketTable(fileNo); - pSock->CloseSocket(fileNo, err); - _free_osfhnd(fileNo); - fclose((FILE*)pf); - } - else - ret = fclose((FILE*)pf); - - if(errno) - err = errno; - return ret; -} - -int CPerlStdIO::Eof(PerlIO* pf, int &err) -{ - int ret = feof((FILE*)pf); - if(errno) - err = errno; - return ret; -} - -int CPerlStdIO::Error(PerlIO* pf, int &err) -{ - int ret = ferror((FILE*)pf); - if(errno) - err = errno; - return ret; -} - -void CPerlStdIO::Clearerr(PerlIO* pf, int &err) -{ - clearerr((FILE*)pf); - err = 0; -} - -int CPerlStdIO::Getc(PerlIO* pf, int &err) -{ - int ret = fgetc((FILE*)pf); - if(errno) - err = errno; - return ret; -} - -int CPerlStdIO::Putc(PerlIO* pf, int c, int &err) -{ - int ret = fputc(c, (FILE*)pf); - if(errno) - err = errno; - return ret; -} - -int CPerlStdIO::Puts(PerlIO* pf, const char *s, int &err) -{ - int ret = fputs(s, (FILE*)pf); - if(errno) - err = errno; - return ret; -} - -int CPerlStdIO::Flush(PerlIO* pf, int &err) -{ - int ret = fflush((FILE*)pf); - if(errno) - err = errno; - return ret; -} - -int CPerlStdIO::Ungetc(PerlIO* pf,int c, int &err) -{ - int ret = ungetc(c, (FILE*)pf); - if(errno) - err = errno; - return ret; -} - -int CPerlStdIO::Fileno(PerlIO* pf, int &err) -{ - int ret = fileno((FILE*)pf); - if(errno) - err = errno; - return ret; -} - -PerlIO* CPerlStdIO::Fdopen(int fh, const char *mode, int &err) -{ - PerlIO* ret = (PerlIO*)fdopen(fh, mode); - if(errno) - err = errno; - return ret; -} - -PerlIO* CPerlStdIO::Reopen(const char* filename, const char* mode, PerlIO* pf, int &err) -{ - PerlIO* ret = (PerlIO*)freopen(filename, mode, (FILE*)pf); - if(errno) - err = errno; - return ret; -} - -SSize_t CPerlStdIO::Read(PerlIO* pf, void * buffer, Size_t count, int &err) -{ - size_t ret = fread(buffer, 1, count, (FILE*)pf); - if(errno) - err = errno; - return ret; -} - -SSize_t CPerlStdIO::Write(PerlIO* pf, const void * buffer, Size_t count, int &err) -{ - size_t ret = fwrite(buffer, 1, count, (FILE*)pf); - if(errno) - err = errno; - return ret; -} - -void CPerlStdIO::Setlinebuf(PerlIO*pf, int &err) -{ - setvbuf((FILE*)pf, NULL, _IOLBF, 0); -} - -int CPerlStdIO::Printf(PerlIO* pf, int &err, const char *format, ...) -{ - va_list(arglist); - va_start(arglist, format); - int ret = Vprintf(pf, err, format, arglist); - if(errno) - err = errno; - return ret; -} - -int CPerlStdIO::Vprintf(PerlIO* pf, int &err, const char * format, va_list arg) -{ - int ret = vfprintf((FILE*)pf, format, arg); - if(errno) - err = errno; - return ret; -} - -long CPerlStdIO::Tell(PerlIO* pf, int &err) -{ - long ret = ftell((FILE*)pf); - if(errno) - err = errno; - return ret; -} - -int CPerlStdIO::Seek(PerlIO* pf, off_t offset, int origin, int &err) -{ - int ret = fseek((FILE*)pf, offset, origin); - if(errno) - err = errno; - return ret; -} - -void CPerlStdIO::Rewind(PerlIO* pf, int &err) -{ - rewind((FILE*)pf); -} - -PerlIO* CPerlStdIO::Tmpfile(int &err) -{ - return (PerlIO*)tmpfile(); -} - -int CPerlStdIO::Getpos(PerlIO* pf, Fpos_t *p, int &err) -{ - int ret = fgetpos((FILE*)pf, (fpos_t*)p); - if(errno) - err = errno; - return ret; -} - -int CPerlStdIO::Setpos(PerlIO* pf, const Fpos_t *p, int &err) -{ - int ret = fsetpos((FILE*)pf, (fpos_t*)p); - if(errno) - err = errno; - return ret; -} - -char* CPerlStdIO::GetBase(PerlIO *pf, int &err) -{ - return ((FILE*)pf)->_base; -} - -int CPerlStdIO::GetBufsiz(PerlIO *pf, int &err) -{ - return ((FILE*)pf)->_bufsiz; -} - -int CPerlStdIO::GetCnt(PerlIO *pf, int &err) -{ - return ((FILE*)pf)->_cnt; -} - -char* CPerlStdIO::GetPtr(PerlIO *pf, int &err) -{ - return ((FILE*)pf)->_ptr; -} - -void CPerlStdIO::SetBuf(PerlIO *pf, char* buffer, int &err) -{ - setbuf((FILE*)pf, buffer); -} - -int CPerlStdIO::SetVBuf(PerlIO *pf, char* buffer, int type, Size_t size, int &err) -{ - return setvbuf((FILE*)pf, buffer, type, size); -} - -void CPerlStdIO::SetCnt(PerlIO *pf, int n, int &err) -{ - ((FILE*)pf)->_cnt = n; -} - -void CPerlStdIO::SetPtrCnt(PerlIO *pf, char *ptr, int n, int& err) -{ - ((FILE*)pf)->_ptr = ptr; - ((FILE*)pf)->_cnt = n; -} - -void CPerlStdIO::Init(int &err) -{ -} - - -static -XS(w32_GetCwd) -{ - dXSARGS; - SV *sv = sv_newmortal(); - /* Make one call with zero size - return value is required size */ - DWORD len = GetCurrentDirectory((DWORD)0,NULL); - SvUPGRADE(sv,SVt_PV); - SvGROW(sv,len); - SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv)); - /* - * If result != 0 - * then it worked, set PV valid, - * else leave it 'undef' - */ - if (SvCUR(sv)) - SvPOK_on(sv); - EXTEND(sp,1); - ST(0) = sv; - XSRETURN(1); -} - -static -XS(w32_SetCwd) -{ - dXSARGS; - if (items != 1) - croak("usage: Win32::SetCurrentDirectory($cwd)"); - if (SetCurrentDirectory(SvPV(ST(0),na))) - XSRETURN_YES; - - XSRETURN_NO; -} - -static -XS(w32_GetNextAvailDrive) -{ - dXSARGS; - char ix = 'C'; - char root[] = "_:\\"; - while (ix <= 'Z') { - root[0] = ix++; - if (GetDriveType(root) == 1) { - root[2] = '\0'; - XSRETURN_PV(root); - } - } - XSRETURN_UNDEF; -} - -static -XS(w32_GetLastError) -{ - dXSARGS; - XSRETURN_IV(GetLastError()); -} - -static -XS(w32_LoginName) -{ - dXSARGS; - char szBuffer[128]; - DWORD size = sizeof(szBuffer); - if (GetUserName(szBuffer, &size)) { - /* size includes NULL */ - ST(0) = sv_2mortal(newSVpv(szBuffer,size-1)); - XSRETURN(1); - } - XSRETURN_UNDEF; -} - -static -XS(w32_NodeName) -{ - dXSARGS; - char name[MAX_COMPUTERNAME_LENGTH+1]; - DWORD size = sizeof(name); - if (GetComputerName(name,&size)) { - /* size does NOT include NULL :-( */ - ST(0) = sv_2mortal(newSVpv(name,size)); - XSRETURN(1); - } - XSRETURN_UNDEF; -} - - -static -XS(w32_DomainName) -{ - dXSARGS; - char name[256]; - DWORD size = sizeof(name); - if (GetUserName(name,&size)) { - char sid[1024]; - DWORD sidlen = sizeof(sid); - char dname[256]; - DWORD dnamelen = sizeof(dname); - SID_NAME_USE snu; - if (LookupAccountName(NULL, name, &sid, &sidlen, - dname, &dnamelen, &snu)) { - XSRETURN_PV(dname); /* all that for this */ - } - } - XSRETURN_UNDEF; -} - -static -XS(w32_FsType) -{ - dXSARGS; - char fsname[256]; - DWORD flags, filecomplen; - if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen, - &flags, fsname, sizeof(fsname))) { - if (GIMME == G_ARRAY) { - XPUSHs(sv_2mortal(newSVpv(fsname,0))); - XPUSHs(sv_2mortal(newSViv(flags))); - XPUSHs(sv_2mortal(newSViv(filecomplen))); - PUTBACK; - return; - } - XSRETURN_PV(fsname); - } - XSRETURN_UNDEF; -} - -static -XS(w32_GetOSVersion) -{ - dXSARGS; - OSVERSIONINFO osver; - - osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - if (GetVersionEx(&osver)) { - XPUSHs(newSVpv(osver.szCSDVersion, 0)); - XPUSHs(newSViv(osver.dwMajorVersion)); - XPUSHs(newSViv(osver.dwMinorVersion)); - XPUSHs(newSViv(osver.dwBuildNumber)); - XPUSHs(newSViv(osver.dwPlatformId)); - PUTBACK; - return; - } - XSRETURN_UNDEF; -} - -static -XS(w32_IsWinNT) -{ - dXSARGS; - OSVERSIONINFO osver; - memset(&osver, 0, sizeof(OSVERSIONINFO)); - osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - GetVersionEx(&osver); - XSRETURN_IV(VER_PLATFORM_WIN32_NT == osver.dwPlatformId); -} - -static -XS(w32_IsWin95) -{ - dXSARGS; - OSVERSIONINFO osver; - memset(&osver, 0, sizeof(OSVERSIONINFO)); - osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - GetVersionEx(&osver); - XSRETURN_IV(VER_PLATFORM_WIN32_WINDOWS == osver.dwPlatformId); -} - -static -XS(w32_FormatMessage) -{ - dXSARGS; - DWORD source = 0; - char msgbuf[1024]; - - if (items != 1) - croak("usage: Win32::FormatMessage($errno)"); - - if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, - &source, SvIV(ST(0)), 0, - msgbuf, sizeof(msgbuf)-1, NULL)) - XSRETURN_PV(msgbuf); - - XSRETURN_UNDEF; -} - -static -XS(w32_Spawn) -{ - dXSARGS; - char *cmd, *args; - PROCESS_INFORMATION stProcInfo; - STARTUPINFO stStartInfo; - BOOL bSuccess = FALSE; - - if(items != 3) - croak("usage: Win32::Spawn($cmdName, $args, $PID)"); - - cmd = SvPV(ST(0),na); - args = SvPV(ST(1), na); - - memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */ - stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */ - stStartInfo.dwFlags = STARTF_USESHOWWINDOW; /* Enable wShowWindow control */ - stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE; /* Start min (normal) */ - - if(CreateProcess( - cmd, /* Image path */ - args, /* Arguments for command line */ - NULL, /* Default process security */ - NULL, /* Default thread security */ - FALSE, /* Must be TRUE to use std handles */ - NORMAL_PRIORITY_CLASS, /* No special scheduling */ - NULL, /* Inherit our environment block */ - NULL, /* Inherit our currrent directory */ - &stStartInfo, /* -> Startup info */ - &stProcInfo)) /* <- Process info (if OK) */ - { - CloseHandle(stProcInfo.hThread);/* library source code does this. */ - sv_setiv(ST(2), stProcInfo.dwProcessId); - bSuccess = TRUE; - } - XSRETURN_IV(bSuccess); -} - -static -XS(w32_GetTickCount) -{ - dXSARGS; - XSRETURN_IV(GetTickCount()); -} - -static -XS(w32_GetShortPathName) -{ - dXSARGS; - SV *shortpath; - DWORD len; - - if(items != 1) - croak("usage: Win32::GetShortPathName($longPathName)"); - - shortpath = sv_mortalcopy(ST(0)); - SvUPGRADE(shortpath, SVt_PV); - /* src == target is allowed */ - do { - len = GetShortPathName(SvPVX(shortpath), - SvPVX(shortpath), - SvLEN(shortpath)); - } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1)); - if (len) { - SvCUR_set(shortpath,len); - ST(0) = shortpath; - } - else - ST(0) = &sv_undef; - XSRETURN(1); -} - - -void CPerlStdIO::InitOSExtras(void* p) -{ - char *file = __FILE__; - dXSUB_SYS; - - /* XXX should be removed after checking with Nick */ - newXS("Win32::GetCurrentDirectory", w32_GetCwd, file); - - /* these names are Activeware compatible */ - newXS("Win32::GetCwd", w32_GetCwd, file); - newXS("Win32::SetCwd", w32_SetCwd, file); - newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file); - newXS("Win32::GetLastError", w32_GetLastError, file); - newXS("Win32::LoginName", w32_LoginName, file); - newXS("Win32::NodeName", w32_NodeName, file); - newXS("Win32::DomainName", w32_DomainName, file); - newXS("Win32::FsType", w32_FsType, file); - newXS("Win32::GetOSVersion", w32_GetOSVersion, file); - newXS("Win32::IsWinNT", w32_IsWinNT, file); - newXS("Win32::IsWin95", w32_IsWin95, file); - newXS("Win32::FormatMessage", w32_FormatMessage, file); - newXS("Win32::Spawn", w32_Spawn, file); - newXS("Win32::GetTickCount", w32_GetTickCount, file); - newXS("Win32::GetShortPathName", w32_GetShortPathName, file); - -} - - diff --git a/win32/ipstdiowin.h b/win32/ipstdiowin.h deleted file mode 100644 index e4895272c0..0000000000 --- a/win32/ipstdiowin.h +++ /dev/null @@ -1,22 +0,0 @@ -/* - - ipstdiowin.h - Interface for perl stdio functions - -*/ - -#ifndef __Inc__IPerlStdIOWin___ -#define __Inc__IPerlStdIOWin___ - -#include <ipstdio.h> - - -class IPerlStdIOWin : public IPerlStdIO -{ -public: - virtual int OpenOSfhandle(long osfhandle, int flags) = 0; - virtual int GetOSfhandle(int filenum) = 0; -}; - -#endif /* __Inc__IPerlStdIOWin___ */ - diff --git a/win32/perlobj.def b/win32/perlobj.def deleted file mode 100644 index 28816cde11..0000000000 --- a/win32/perlobj.def +++ /dev/null @@ -1,4 +0,0 @@ -LIBRARY PerlCore -DESCRIPTION 'Perl interpreter' -EXPORTS - perl_alloc diff --git a/win32/runperl.c b/win32/runperl.c index b7f61a243e..ec65e2cc07 100644 --- a/win32/runperl.c +++ b/win32/runperl.c @@ -6,6 +6,8 @@ #define NO_XSLOCKS #include "XSUB.H" +#include "Win32iop.h" + #undef errno #if defined(_MT) _CRTIMP int * __cdecl _errno(void); @@ -14,21 +16,860 @@ _CRTIMP int * __cdecl _errno(void); _CRTIMP extern int errno; #endif +CPerlObj *pPerl; + +#include <fcntl.h> #include <ipdir.h> #include <ipenv.h> #include <ipsock.h> #include <iplio.h> #include <ipmem.h> #include <ipproc.h> +#include <ipstdio.h> + +class IPerlStdIOWin : public IPerlStdIO +{ +public: + virtual int OpenOSfhandle(long osfhandle, int flags) = 0; + virtual int GetOSfhandle(int filenum) = 0; +}; + +extern int g_closedir(DIR *dirp); +extern DIR *g_opendir(char *filename); +extern struct direct *g_readdir(DIR *dirp); +extern void g_rewinddir(DIR *dirp); +extern void g_seekdir(DIR *dirp, long loc); +extern long g_telldir(DIR *dirp); +class CPerlDir : public IPerlDir +{ +public: + CPerlDir() {}; + virtual int Makedir(const char *dirname, int mode, int &err) + { + return win32_mkdir(dirname, mode); + }; + virtual int Chdir(const char *dirname, int &err) + { + return win32_chdir(dirname); + }; + virtual int Rmdir(const char *dirname, int &err) + { + return win32_rmdir(dirname); + }; + virtual int Close(DIR *dirp, int &err) + { + return g_closedir(dirp); + }; + virtual DIR *Open(char *filename, int &err) + { + return g_opendir(filename); + }; + virtual struct direct *Read(DIR *dirp, int &err) + { + return g_readdir(dirp); + }; + virtual void Rewind(DIR *dirp, int &err) + { + g_rewinddir(dirp); + }; + virtual void Seek(DIR *dirp, long loc, int &err) + { + g_seekdir(dirp, loc); + }; + virtual long Tell(DIR *dirp, int &err) + { + return g_telldir(dirp); + }; +}; + + +extern char * g_win32_perllib_path(char *sfx,...); +class CPerlEnv : public IPerlEnv +{ +public: + CPerlEnv() {}; + virtual char *Getenv(const char *varname, int &err) + { + return win32_getenv(varname); + }; + virtual int Putenv(const char *envstring, int &err) + { + return _putenv(envstring); + }; + virtual char* LibPath(char *sfx, ...) + { + LPSTR ptr1, ptr2, ptr3, ptr4, ptr5; + va_list ap; + va_start(ap,sfx); + ptr1 = va_arg(ap,char *); + ptr2 = va_arg(ap,char *); + ptr3 = va_arg(ap,char *); + ptr4 = va_arg(ap,char *); + ptr5 = va_arg(ap,char *); + return g_win32_perllib_path(sfx, ptr1, ptr2, ptr3, ptr4, ptr5); + }; +}; + +#define PROCESS_AND_RETURN \ + if(errno) \ + err = errno; \ + return r + +class CPerlSock : public IPerlSock +{ +public: + CPerlSock() {}; + virtual u_long Htonl(u_long hostlong) + { + return win32_htonl(hostlong); + }; + virtual u_short Htons(u_short hostshort) + { + return win32_htons(hostshort); + }; + virtual u_long Ntohl(u_long netlong) + { + return win32_ntohl(netlong); + }; + virtual u_short Ntohs(u_short netshort) + { + return win32_ntohs(netshort); + } + + virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err) + { + SOCKET r = win32_accept(s, addr, addrlen); + PROCESS_AND_RETURN; + }; + virtual int Bind(SOCKET s, const struct sockaddr* name, int namelen, int &err) + { + int r = win32_bind(s, name, namelen); + PROCESS_AND_RETURN; + }; + virtual int Connect(SOCKET s, const struct sockaddr* name, int namelen, int &err) + { + int r = win32_connect(s, name, namelen); + PROCESS_AND_RETURN; + }; + virtual void Endhostent(int &err) + { + win32_endhostent(); + }; + virtual void Endnetent(int &err) + { + win32_endnetent(); + }; + virtual void Endprotoent(int &err) + { + win32_endprotoent(); + }; + virtual void Endservent(int &err) + { + win32_endservent(); + }; + virtual struct hostent* Gethostbyaddr(const char* addr, int len, int type, int &err) + { + struct hostent *r = win32_gethostbyaddr(addr, len, type); + PROCESS_AND_RETURN; + }; + virtual struct hostent* Gethostbyname(const char* name, int &err) + { + struct hostent *r = win32_gethostbyname(name); + PROCESS_AND_RETURN; + }; + virtual struct hostent* Gethostent(int &err) + { + croak("gethostent not implemented!\n"); + return NULL; + }; + virtual int Gethostname(char* name, int namelen, int &err) + { + int r = win32_gethostname(name, namelen); + PROCESS_AND_RETURN; + }; + virtual struct netent *Getnetbyaddr(long net, int type, int &err) + { + struct netent *r = win32_getnetbyaddr(net, type); + PROCESS_AND_RETURN; + }; + virtual struct netent *Getnetbyname(const char *name, int &err) + { + struct netent *r = win32_getnetbyname((char*)name); + PROCESS_AND_RETURN; + }; + virtual struct netent *Getnetent(int &err) + { + struct netent *r = win32_getnetent(); + PROCESS_AND_RETURN; + }; + virtual int Getpeername(SOCKET s, struct sockaddr* name, int* namelen, int &err) + { + int r = win32_getpeername(s, name, namelen); + PROCESS_AND_RETURN; + }; + virtual struct protoent* Getprotobyname(const char* name, int &err) + { + struct protoent *r = win32_getprotobyname(name); + PROCESS_AND_RETURN; + }; + virtual struct protoent* Getprotobynumber(int number, int &err) + { + struct protoent *r = win32_getprotobynumber(number); + PROCESS_AND_RETURN; + }; + virtual struct protoent* Getprotoent(int &err) + { + struct protoent *r = win32_getprotoent(); + PROCESS_AND_RETURN; + }; + virtual struct servent* Getservbyname(const char* name, const char* proto, int &err) + { + struct servent *r = win32_getservbyname(name, proto); + PROCESS_AND_RETURN; + }; + virtual struct servent* Getservbyport(int port, const char* proto, int &err) + { + struct servent *r = win32_getservbyport(port, proto); + PROCESS_AND_RETURN; + }; + virtual struct servent* Getservent(int &err) + { + struct servent *r = win32_getservent(); + PROCESS_AND_RETURN; + }; + virtual int Getsockname(SOCKET s, struct sockaddr* name, int* namelen, int &err) + { + int r = win32_getsockname(s, name, namelen); + PROCESS_AND_RETURN; + }; + virtual int Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err) + { + int r = win32_getsockopt(s, level, optname, optval, optlen); + PROCESS_AND_RETURN; + }; + virtual unsigned long InetAddr(const char* cp, int &err) + { + unsigned long r = win32_inet_addr(cp); + PROCESS_AND_RETURN; + }; + virtual char* InetNtoa(struct in_addr in, int &err) + { + char *r = win32_inet_ntoa(in); + PROCESS_AND_RETURN; + }; + virtual int IoctlSocket(SOCKET s, long cmd, u_long *argp, int& err) + { + int r = win32_ioctlsocket(s, cmd, argp); + PROCESS_AND_RETURN; + }; + virtual int Listen(SOCKET s, int backlog, int &err) + { + int r = win32_listen(s, backlog); + PROCESS_AND_RETURN; + }; + virtual int Recvfrom(SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen, int &err) + { + int r = win32_recvfrom(s, buffer, len, flags, from, fromlen); + PROCESS_AND_RETURN; + }; + virtual int Select(int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout, int &err) + { + int r = win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout); + PROCESS_AND_RETURN; + }; + virtual int Send(SOCKET s, const char* buffer, int len, int flags, int &err) + { + int r = win32_send(s, buffer, len, flags); + PROCESS_AND_RETURN; + }; + virtual int Sendto(SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen, int &err) + { + int r = win32_sendto(s, buffer, len, flags, to, tolen); + PROCESS_AND_RETURN; + }; + virtual void Sethostent(int stayopen, int &err) + { + win32_sethostent(stayopen); + }; + virtual void Setnetent(int stayopen, int &err) + { + win32_setnetent(stayopen); + }; + virtual void Setprotoent(int stayopen, int &err) + { + win32_setprotoent(stayopen); + }; + virtual void Setservent(int stayopen, int &err) + { + win32_setservent(stayopen); + }; + virtual int Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err) + { + int r = win32_setsockopt(s, level, optname, optval, optlen); + PROCESS_AND_RETURN; + }; + virtual int Shutdown(SOCKET s, int how, int &err) + { + int r = win32_shutdown(s, how); + PROCESS_AND_RETURN; + }; + virtual SOCKET Socket(int af, int type, int protocol, int &err) + { + SOCKET r = win32_socket(af, type, protocol); + PROCESS_AND_RETURN; + }; + virtual int Socketpair(int domain, int type, int protocol, int* fds, int &err) + { + croak("socketpair not implemented!\n"); + return 0; + }; +}; + + +#define CALLFUNCRET(x)\ + int ret = x;\ + if(ret)\ + err = errno;\ + return ret; + +#define CALLFUNCERR(x)\ + int ret = x;\ + if(errno)\ + err = errno;\ + return ret; + +#define LCALLFUNCERR(x)\ + long ret = x;\ + if(errno)\ + err = errno;\ + return ret; + +class CPerlLIO : public IPerlLIO +{ +public: + CPerlLIO() {}; + virtual int Access(const char *path, int mode, int &err) + { + CALLFUNCRET(access(path, mode)) + }; + virtual int Chmod(const char *filename, int pmode, int &err) + { + CALLFUNCRET(chmod(filename, pmode)) + }; + virtual int Chsize(int handle, long size, int &err) + { + CALLFUNCRET(chsize(handle, size)) + }; + virtual int Close(int handle, int &err) + { + CALLFUNCRET(win32_close(handle)) + }; + virtual int Dup(int handle, int &err) + { + CALLFUNCERR(win32_dup(handle)) + }; + virtual int Dup2(int handle1, int handle2, int &err) + { + CALLFUNCERR(win32_dup2(handle1, handle2)) + }; + virtual int Flock(int fd, int oper, int &err) + { + CALLFUNCERR(win32_flock(fd, oper)) + }; + virtual int FileStat(int handle, struct stat *buffer, int &err) + { + CALLFUNCERR(fstat(handle, buffer)) + }; + virtual int IOCtl(int i, unsigned int u, char *data, int &err) + { + CALLFUNCERR(win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data)) + }; + virtual int Isatty(int fd, int &err) + { + return isatty(fd); + }; + virtual long Lseek(int handle, long offset, int origin, int &err) + { + LCALLFUNCERR(win32_lseek(handle, offset, origin)) + }; + virtual int Lstat(const char *path, struct stat *buffer, int &err) + { + return NameStat(path, buffer, err); + }; + virtual char *Mktemp(char *Template, int &err) + { + return mktemp(Template); + }; + virtual int Open(const char *filename, int oflag, int &err) + { + CALLFUNCERR(win32_open(filename, oflag)) + }; + virtual int Open(const char *filename, int oflag, int pmode, int &err) + { + int ret; + if(stricmp(filename, "/dev/null") == 0) + ret = open("NUL", oflag, pmode); + else + ret = open(filename, oflag, pmode); + + if(errno) + err = errno; + return ret; + }; + virtual int Read(int handle, void *buffer, unsigned int count, int &err) + { + CALLFUNCERR(win32_read(handle, buffer, count)) + }; + virtual int Rename(const char *OldFileName, const char *newname, int &err) + { + char szNewWorkName[MAX_PATH+1]; + WIN32_FIND_DATA fdOldFile, fdNewFile; + HANDLE handle; + char *ptr; + + if((strchr(OldFileName, '\\') || strchr(OldFileName, '/')) + && strchr(newname, '\\') == NULL + && strchr(newname, '/') == NULL) + { + strcpy(szNewWorkName, OldFileName); + if((ptr = strrchr(szNewWorkName, '\\')) == NULL) + ptr = strrchr(szNewWorkName, '/'); + strcpy(++ptr, newname); + } + else + strcpy(szNewWorkName, newname); + + if(stricmp(OldFileName, szNewWorkName) != 0) + { // check that we're not being fooled by relative paths + // and only delete the new file + // 1) if it exists + // 2) it is not the same file as the old file + // 3) old file exist + // GetFullPathName does not return the long file name on some systems + handle = FindFirstFile(OldFileName, &fdOldFile); + if(handle != INVALID_HANDLE_VALUE) + { + FindClose(handle); + + handle = FindFirstFile(szNewWorkName, &fdNewFile); + + if(handle != INVALID_HANDLE_VALUE) + FindClose(handle); + else + fdNewFile.cFileName[0] = '\0'; + + if(strcmp(fdOldFile.cAlternateFileName, fdNewFile.cAlternateFileName) != 0 + && strcmp(fdOldFile.cFileName, fdNewFile.cFileName) != 0) + { // file exists and not same file + DeleteFile(szNewWorkName); + } + } + } + int ret = rename(OldFileName, szNewWorkName); + if(ret) + err = errno; + + return ret; + }; + virtual int Setmode(int handle, int mode, int &err) + { + CALLFUNCRET(win32_setmode(handle, mode)) + }; + virtual int NameStat(const char *path, struct stat *buffer, int &err) + { + return win32_stat(path, buffer); + }; + virtual char *Tmpnam(char *string, int &err) + { + return tmpnam(string); + }; + virtual int Umask(int pmode, int &err) + { + return umask(pmode); + }; + virtual int Unlink(const char *filename, int &err) + { + chmod(filename, _S_IREAD | _S_IWRITE); + CALLFUNCRET(unlink(filename)) + }; + virtual int Utime(char *filename, struct utimbuf *times, int &err) + { + CALLFUNCRET(win32_utime(filename, times)) + }; + virtual int Write(int handle, const void *buffer, unsigned int count, int &err) + { + CALLFUNCERR(win32_write(handle, buffer, count)) + }; +}; + +class CPerlMem : public IPerlMem +{ +public: + CPerlMem() {}; + virtual void* Malloc(size_t size) + { + return win32_malloc(size); + }; + virtual void* Realloc(void* ptr, size_t size) + { + return win32_realloc(ptr, size); + }; + virtual void Free(void* ptr) + { + win32_free(ptr); + }; +}; + +#define EXECF_EXEC 1 +#define EXECF_SPAWN 2 + +extern char *g_getlogin(void); +extern int do_spawn2(char *cmd, int exectype); +extern int g_do_aspawn(void *vreally, void **vmark, void **vsp); +class CPerlProc : public IPerlProc +{ +public: + CPerlProc() {}; + virtual void Abort(void) + { + win32_abort(); + }; + virtual void Exit(int status) + { + exit(status); + }; + virtual void _Exit(int status) + { + _exit(status); + }; + virtual int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3) + { + return execl(cmdname, arg0, arg1, arg2, arg3); + }; + virtual int Execv(const char *cmdname, const char *const *argv) + { + return win32_execvp(cmdname, argv); + }; + virtual int Execvp(const char *cmdname, const char *const *argv) + { + return win32_execvp(cmdname, argv); + }; + virtual uid_t Getuid(void) + { + return getuid(); + }; + virtual uid_t Geteuid(void) + { + return geteuid(); + }; + virtual gid_t Getgid(void) + { + return getgid(); + }; + virtual gid_t Getegid(void) + { + return getegid(); + }; + virtual char *Getlogin(void) + { + return g_getlogin(); + }; + virtual int Kill(int pid, int sig) + { + return kill(pid, sig); + }; + virtual int Killpg(int pid, int sig) + { + croak("killpg not implemented!\n"); + return 0; + }; + virtual int PauseProc(void) + { + return win32_sleep((32767L << 16) + 32767); + }; + virtual PerlIO* Popen(const char *command, const char *mode) + { + return (PerlIO*)win32_popen(command, mode); + }; + virtual int Pclose(PerlIO *stream) + { + return win32_pclose((FILE*)stream); + }; + virtual int Pipe(int *phandles) + { + return win32_pipe(phandles, 512, _O_BINARY); + }; + virtual int Setuid(uid_t u) + { + return setuid(u); + }; + virtual int Setgid(gid_t g) + { + return setgid(g); + }; + virtual int Sleep(unsigned int s) + { + return win32_sleep(s); + }; + virtual int Times(struct tms *timebuf) + { + return win32_times(timebuf); + }; + virtual int Wait(int *status) + { + return win32_wait(status); + }; + virtual Sighandler_t Signal(int sig, Sighandler_t subcode) + { + return 0; + }; + virtual void GetSysMsg(char*& sMsg, DWORD& dwLen, DWORD dwErr) + { + dwLen = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER + |FORMAT_MESSAGE_IGNORE_INSERTS + |FORMAT_MESSAGE_FROM_SYSTEM, NULL, + dwErr, 0, (char *)&sMsg, 1, NULL); + if (0 < dwLen) { + while (0 < dwLen && isspace(sMsg[--dwLen])) + ; + if ('.' != sMsg[dwLen]) + dwLen++; + sMsg[dwLen]= '\0'; + } + if (0 == dwLen) { + sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/); + dwLen = sprintf(sMsg, + "Unknown error #0x%lX (lookup 0x%lX)", + dwErr, GetLastError()); + } + }; + virtual void FreeBuf(char* sMsg) + { + LocalFree(sMsg); + }; + virtual BOOL DoCmd(char *cmd) + { + do_spawn2(cmd, EXECF_EXEC); + return FALSE; + }; + virtual int Spawn(char* cmds) + { + return do_spawn2(cmds, EXECF_SPAWN); + }; + virtual int Spawnvp(int mode, const char *cmdname, const char *const *argv) + { + return win32_spawnvp(mode, cmdname, argv); + }; + virtual int ASpawn(void *vreally, void **vmark, void **vsp) + { + return g_do_aspawn(vreally, vmark, vsp); + }; +}; + + +class CPerlStdIO : public IPerlStdIOWin +{ +public: + CPerlStdIO() {}; + virtual PerlIO* Stdin(void) + { + return (PerlIO*)win32_stdin(); + }; + virtual PerlIO* Stdout(void) + { + return (PerlIO*)win32_stdout(); + }; + virtual PerlIO* Stderr(void) + { + return (PerlIO*)win32_stderr(); + }; + virtual PerlIO* Open(const char *path, const char *mode, int &err) + { + PerlIO*pf = (PerlIO*)win32_fopen(path, mode); + if(errno) + err = errno; + return pf; + }; + virtual int Close(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_fclose(((FILE*)pf))) + }; + virtual int Eof(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_feof((FILE*)pf)) + }; + virtual int Error(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_ferror((FILE*)pf)) + }; + virtual void Clearerr(PerlIO* pf, int &err) + { + win32_clearerr((FILE*)pf); + }; + virtual int Getc(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_getc((FILE*)pf)) + }; + virtual char* GetBase(PerlIO* pf, int &err) + { + return ((FILE*)pf)->_base; + }; + virtual int GetBufsiz(PerlIO* pf, int &err) + { + return ((FILE*)pf)->_bufsiz; + }; + virtual int GetCnt(PerlIO* pf, int &err) + { + return ((FILE*)pf)->_cnt; + }; + virtual char* GetPtr(PerlIO* pf, int &err) + { + return ((FILE*)pf)->_ptr; + }; + virtual int Putc(PerlIO* pf, int c, int &err) + { + CALLFUNCERR(win32_fputc(c, (FILE*)pf)) + }; + virtual int Puts(PerlIO* pf, const char *s, int &err) + { + CALLFUNCERR(win32_fputs(s, (FILE*)pf)) + }; + virtual int Flush(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_fflush((FILE*)pf)) + }; + virtual int Ungetc(PerlIO* pf,int c, int &err) + { + CALLFUNCERR(win32_ungetc(c, (FILE*)pf)) + }; + virtual int Fileno(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_fileno((FILE*)pf)) + }; + virtual PerlIO* Fdopen(int fd, const char *mode, int &err) + { + PerlIO* pf = (PerlIO*)win32_fdopen(fd, mode); + if(errno) + err = errno; + return pf; + }; + virtual PerlIO* Reopen(const char*path, const char*mode, PerlIO* pf, int &err) + { + PerlIO* newPf = (PerlIO*)win32_freopen(path, mode, (FILE*)pf); + if(errno) + err = errno; + return newPf; + }; + virtual SSize_t Read(PerlIO* pf, void *buffer, Size_t size, int &err) + { + SSize_t i = win32_fread(buffer, size, 1, (FILE*)pf); + if(errno) + err = errno; + return i; + }; + virtual SSize_t Write(PerlIO* pf, const void *buffer, Size_t size, int &err) + { + SSize_t i = win32_fwrite(buffer, size, 1, (FILE*)pf); + if(errno) + err = errno; + return i; + }; + virtual void SetBuf(PerlIO* pf, char* buffer, int &err) + { + win32_setbuf((FILE*)pf, buffer); + }; + virtual int SetVBuf(PerlIO* pf, char* buffer, int type, Size_t size, int &err) + { + int i = win32_setvbuf((FILE*)pf, buffer, type, size); + if(errno) + err = errno; + return i; + }; + virtual void SetCnt(PerlIO* pf, int n, int &err) + { + ((FILE*)pf)->_cnt = n; + }; + virtual void SetPtrCnt(PerlIO* pf, char * ptr, int n, int& err) + { + ((FILE*)pf)->_ptr = ptr; + ((FILE*)pf)->_cnt = n; + }; + virtual void Setlinebuf(PerlIO* pf, int &err) + { + win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0); + }; + virtual int Printf(PerlIO* pf, int &err, const char *format,...) + { + va_list(arglist); + va_start(arglist, format); + int i = win32_vfprintf((FILE*)pf, format, arglist); + if(errno) + err = errno; + return i; + }; + virtual int Vprintf(PerlIO* pf, int &err, const char *format, va_list arglist) + { + int i = win32_vfprintf((FILE*)pf, format, arglist); + if(errno) + err = errno; + return i; + }; + virtual long Tell(PerlIO* pf, int &err) + { + long l = win32_ftell((FILE*)pf); + if(errno) + err = errno; + return l; + }; + virtual int Seek(PerlIO* pf, off_t offset, int origin, int &err) + { + int i = win32_fseek((FILE*)pf, offset, origin); + if(errno) + err = errno; + return i; + }; + virtual void Rewind(PerlIO* pf, int &err) + { + win32_rewind((FILE*)pf); + }; + virtual PerlIO* Tmpfile(int &err) + { + PerlIO* pf = (PerlIO*)win32_tmpfile(); + if(errno) + err = errno; + return pf; + }; + virtual int Getpos(PerlIO* pf, Fpos_t *p, int &err) + { + int i = win32_fgetpos((FILE*)pf, p); + if(errno) + err = errno; + return i; + }; + virtual int Setpos(PerlIO* pf, const Fpos_t *p, int &err) + { + int i = win32_fsetpos((FILE*)pf, p); + if(errno) + err = errno; + return i; + }; + virtual void Init(int &err) + { + }; + virtual void InitOSExtras(void* p) + { + Perl_init_os_extras(); + }; + virtual int OpenOSfhandle(long osfhandle, int flags) + { + return win32_open_osfhandle(osfhandle, flags); + } + virtual int GetOSfhandle(int filenum) + { + return win32_get_osfhandle(filenum); + } +}; -#include "ipstdiowin.h" -#include "ipdir.c" -#include "ipenv.c" -#include "ipsock.c" -#include "iplio.c" -#include "ipmem.c" -#include "ipproc.c" -#include "ipstdio.c" static void xs_init _((CPERLarg)); #define stderr (&_iob[2]) @@ -38,110 +879,92 @@ static void xs_init _((CPERLarg)); class CPerlHost { public: - CPerlHost() { pPerl = NULL; }; - inline BOOL PerlCreate(void) + CPerlHost() { pPerl = NULL; }; + inline BOOL PerlCreate(void) + { + try { + pPerl = perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO, &perlDir, &perlSock, &perlProc); + if(pPerl != NULL) + { try { - pPerl = perl_alloc(&perlMem, - &perlEnv, - &perlStdIO, - &perlLIO, - &perlDir, - &perlSock, - &perlProc); - if(pPerl != NULL) - { - perlDir.SetPerlObj(pPerl); - perlEnv.SetPerlObj(pPerl); - perlLIO.SetPerlObj(pPerl); - perlLIO.SetSockCtl(&perlSock); - perlLIO.SetStdObj(&perlStdIO); - perlMem.SetPerlObj(pPerl); - perlProc.SetPerlObj(pPerl); - perlSock.SetPerlObj(pPerl); - perlSock.SetStdObj(&perlStdIO); - perlStdIO.SetPerlObj(pPerl); - perlStdIO.SetSockCtl(&perlSock); - try - { - pPerl->perl_construct(); - } - catch(...) - { - fprintf(stderr, "%s\n", "Error: Unable to construct data structures"); - pPerl->perl_free(); - pPerl = NULL; - } - } + pPerl->perl_construct(); } catch(...) { - fprintf(stderr, "%s\n", "Error: Unable to allocate memory"); - pPerl = NULL; + fprintf(stderr, "%s\n", "Error: Unable to construct data structures"); + pPerl->perl_free(); + pPerl = NULL; } - return (pPerl != NULL); - }; - inline int PerlParse(int argc, char** argv, char** env) + } + } + catch(...) { - char* environ = NULL; - int retVal; - try - { - retVal = pPerl->perl_parse(xs_init, argc, argv, (env == NULL || *env == NULL ? &environ : env)); - } - catch(int x) - { - // this is where exit() should arrive - retVal = x; - } - catch(...) - { - fprintf(stderr, "Error: Parse exception\n"); - retVal = -1; - } - return retVal; - }; - inline int PerlRun(void) + fprintf(stderr, "%s\n", "Error: Unable to allocate memory"); + pPerl = NULL; + } + return (pPerl != NULL); + }; + inline int PerlParse(int argc, char** argv, char** env) + { + char* environ = NULL; + int retVal; + try { - int retVal; - try - { - retVal = pPerl->perl_run(); - } - catch(int x) - { - // this is where exit() should arrive - retVal = x; - } - catch(...) - { - fprintf(stderr, "Error: Runtime exception\n"); - retVal = -1; - } - return retVal; - }; - inline void PerlDestroy(void) + retVal = pPerl->perl_parse(xs_init, argc, argv, (env == NULL || *env == NULL ? &environ : env)); + } + catch(int x) { - try - { - pPerl->perl_destruct(); - pPerl->perl_free(); - } - catch(...) - { - } - }; + // this is where exit() should arrive + retVal = x; + } + catch(...) + { + fprintf(stderr, "Error: Parse exception\n"); + retVal = -1; + } + return retVal; + }; + inline int PerlRun(void) + { + int retVal; + try + { + retVal = pPerl->perl_run(); + } + catch(int x) + { + // this is where exit() should arrive + retVal = x; + } + catch(...) + { + fprintf(stderr, "Error: Runtime exception\n"); + retVal = -1; + } + return retVal; + }; + inline void PerlDestroy(void) + { + try + { + pPerl->perl_destruct(); + pPerl->perl_free(); + } + catch(...) + { + } + }; protected: - CPerlObj *pPerl; - CPerlDir perlDir; - CPerlEnv perlEnv; - CPerlLIO perlLIO; - CPerlMem perlMem; - CPerlProc perlProc; - CPerlSock perlSock; - CPerlStdIO perlStdIO; + CPerlDir perlDir; + CPerlEnv perlEnv; + CPerlLIO perlLIO; + CPerlMem perlMem; + CPerlProc perlProc; + CPerlSock perlSock; + CPerlStdIO perlStdIO; }; #undef PERL_SYS_INIT @@ -150,32 +973,38 @@ protected: int main(int argc, char **argv, char **env) { - CPerlHost host; - int exitstatus = 1; + CPerlHost host; + int exitstatus = 1; - if(!host.PerlCreate()) - exit(exitstatus); + if(!host.PerlCreate()) + exit(exitstatus); - exitstatus = host.PerlParse(argc, argv, env); + exitstatus = host.PerlParse(argc, argv, env); - if (!exitstatus) - { - exitstatus = host.PerlRun(); + if (!exitstatus) + { + exitstatus = host.PerlRun(); } - host.PerlDestroy(); + host.PerlDestroy(); return exitstatus; } +char *staticlinkmodules[] = { + "DynaLoader", + NULL, +}; -static void xs_init(CPERLarg) -{ -} +EXTERN_C void boot_DynaLoader _((CPERLarg_ CV* cv)); -EXTERN_C void boot_DynaLoader _((CPERLarg_ CV* cv)) +static void +xs_init(CPERLarg) { + char *file = __FILE__; + dXSUB_SYS; + newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); } #else /* PERL_OBJECT */ diff --git a/win32/win32.c b/win32/win32.c index 9d819b518f..fe38c1e2ae 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -25,7 +25,14 @@ #include "EXTERN.h" #include "perl.h" + +#define NO_XSLOCKS +#ifdef PERL_OBJECT +extern CPerlObj* pPerl; +#endif #include "XSUB.h" + +#include "Win32iop.h" #include <fcntl.h> #include <sys/stat.h> #ifndef __GNUC__ @@ -53,14 +60,40 @@ int _CRT_glob = 0; #define EXECF_SPAWN 2 #define EXECF_SPAWN_NOWAIT 3 +#if defined(PERL_OBJECT) +#undef win32_perllib_path +#define win32_perllib_path g_win32_perllib_path +#undef do_aspawn +#define do_aspawn g_do_aspawn +#undef do_spawn +#define do_spawn g_do_spawn +#undef do_exec +#define do_exec g_do_exec +#undef opendir +#define opendir g_opendir +#undef readdir +#define readdir g_readdir +#undef telldir +#define telldir g_telldir +#undef seekdir +#define seekdir g_seekdir +#undef rewinddir +#define rewinddir g_rewinddir +#undef closedir +#define closedir g_closedir +#undef getlogin +#define getlogin g_getlogin +#endif + static DWORD os_id(void); static void get_shell(void); static long tokenize(char *str, char **dest, char ***destv); -static int do_spawn2(char *cmd, int exectype); + int do_spawn2(char *cmd, int exectype); static BOOL has_redirection(char *ptr); static long filetime_to_clock(PFILETIME ft); static BOOL filetime_from_time(PFILETIME ft, time_t t); + char * w32_perlshell_tokens = Nullch; char ** w32_perlshell_vec; long w32_perlshell_items = -1; @@ -166,6 +199,7 @@ has_redirection(char *ptr) return FALSE; } +#if !defined(PERL_OBJECT) /* since the current process environment is being updated in util.c * the library functions will get the correct environment */ @@ -200,6 +234,7 @@ my_pclose(PerlIO *fp) { return win32_pclose(fp); } +#endif static DWORD os_id(void) @@ -318,7 +353,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) argv[index++] = 0; status = win32_spawnvp(flag, - (really ? SvPV(really,na) : argv[0]), + (const char*)(really ? SvPV(really,na) : argv[0]), (const char* const*)argv); if (status < 0 && errno == ENOEXEC) { @@ -331,7 +366,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) argv[sh_items] = w32_perlshell_vec[sh_items]; status = win32_spawnvp(flag, - (really ? SvPV(really,na) : argv[0]), + (const char*)(really ? SvPV(really,na) : argv[0]), (const char* const*)argv); } @@ -346,7 +381,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) return (statusvalue = status); } -static int +int do_spawn2(char *cmd, int exectype) { char **a; @@ -756,6 +791,51 @@ win32_stat(const char *path, struct stat *buffer) #ifndef USE_WIN32_RTL_ENV +BOOL GetRegStr(HKEY hkey, const char *lpszValueName, char *lpszDefault, char *lpszData, unsigned long *lpdwDataLen) +{ // Retrieve a REG_SZ or REG_EXPAND_SZ from the registry + HKEY handle; + DWORD type, dwDataLen = *lpdwDataLen; + const char *subkey = "Software\\Perl"; + char szBuffer[MAX_PATH+1]; + long retval; + + retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle); + if(retval == ERROR_SUCCESS) + { + retval = RegQueryValueEx(handle, lpszValueName, 0, &type, (LPBYTE)lpszData, &dwDataLen); + RegCloseKey(handle); + if(retval == ERROR_SUCCESS && (type == REG_SZ || type == REG_EXPAND_SZ)) + { + if(type != REG_EXPAND_SZ) + { + *lpdwDataLen = dwDataLen; + return TRUE; + } + strcpy(szBuffer, lpszData); + dwDataLen = ExpandEnvironmentStrings(szBuffer, lpszData, *lpdwDataLen); + if(dwDataLen < *lpdwDataLen) + { + *lpdwDataLen = dwDataLen; + return TRUE; + } + } + } + + strcpy(lpszData, lpszDefault); + return FALSE; +} + +char* GetRegStr(const char *lpszValueName, char *lpszDefault, char *lpszData, unsigned long *lpdwDataLen) +{ + if(!GetRegStr(HKEY_CURRENT_USER, lpszValueName, lpszDefault, lpszData, lpdwDataLen)) + { + GetRegStr(HKEY_LOCAL_MACHINE, lpszValueName, lpszDefault, lpszData, lpdwDataLen); + } + if(*lpszData == '\0') + lpszData = NULL; + return lpszData; +} + DllExport char * win32_getenv(const char *name) { @@ -771,6 +851,12 @@ win32_getenv(const char *name) curlen = needlen; needlen = GetEnvironmentVariable(name,curitem,curlen); } + if(curitem == NULL) + { + unsigned long dwDataLen = curlen; + if(strcmp("PERL5DB", name) == 0) + curitem = GetRegStr(name, "", curitem, &dwDataLen); + } return curitem; } @@ -1209,7 +1295,7 @@ win32_str_os_error(void *sv, DWORD dwErr) sMsg[dwLen]= '\0'; } if (0 == dwLen) { - sMsg = LocalAlloc(0, 64/**sizeof(TCHAR)*/); + sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/); dwLen = sprintf(sMsg, "Unknown error #0x%lX (lookup 0x%lX)", dwErr, GetLastError()); @@ -1967,6 +2053,713 @@ XS(w32_Sleep) XSRETURN_YES; } +#define TMPBUFSZ 1024 +#define MAX_LENGTH 2048 +#define SUCCESSRETURNED(x) (x == ERROR_SUCCESS) +#define REGRETURN(x) XSRETURN_IV(SUCCESSRETURNED(x)) +#define SvHKEY(index) (HKEY)((unsigned long)SvIV(index)) +#define SETIV(index,value) sv_setiv(ST(index), value) +#define SETNV(index,value) sv_setnv(ST(index), value) +#define SETPV(index,string) sv_setpv(ST(index), string) +#define SETPVN(index, buffer, length) sv_setpvn(ST(index), (char*)buffer, length) +#define SETHKEY(index, hkey) SETIV(index,(long)hkey) + +static time_t ft2timet(FILETIME *ft) +{ + SYSTEMTIME st; + struct tm tm; + + FileTimeToSystemTime(ft, &st); + tm.tm_sec = st.wSecond; + tm.tm_min = st.wMinute; + tm.tm_hour = st.wHour; + tm.tm_mday = st.wDay; + tm.tm_mon = st.wMonth - 1; + tm.tm_year = st.wYear - 1900; + tm.tm_wday = st.wDayOfWeek; + tm.tm_yday = -1; + tm.tm_isdst = -1; + return mktime (&tm); +} + +static +XS(w32_RegCloseKey) +{ + dXSARGS; + + if(items != 1) + { + croak("usage: Win32::RegCloseKey($hkey);\n"); + } + + REGRETURN(RegCloseKey(SvHKEY(ST(0)))); +} + +static +XS(w32_RegConnectRegistry) +{ + dXSARGS; + HKEY handle; + + if(items != 3) + { + croak("usage: Win32::RegConnectRegistry($machine, $hkey, $handle);\n"); + } + + if(SUCCESSRETURNED(RegConnectRegistry((char *)SvPV(ST(0), na), SvHKEY(ST(1)), &handle))) + { + SETHKEY(2,handle); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegCreateKey) +{ + dXSARGS; + HKEY handle; + DWORD disposition; + long retval; + + if(items != 3) + { + croak("usage: Win32::RegCreateKey($hkey, $subkey, $handle);\n"); + } + + retval = RegCreateKeyEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, NULL, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, + NULL, &handle, &disposition); + + if(SUCCESSRETURNED(retval)) + { + SETHKEY(2,handle); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegCreateKeyEx) +{ + dXSARGS; + + unsigned int length; + long retval; + HKEY hkey, handle; + char *subkey; + char *keyclass; + DWORD options, disposition; + REGSAM sam; + SECURITY_ATTRIBUTES sa, *psa; + + if(items != 9) + { + croak("usage: Win32::RegCreateKeyEx($hkey, $subkey, $reserved, $class, $options, $sam, " + "$security, $handle, $disposition);\n"); + } + + hkey = SvHKEY(ST(0)); + subkey = (char *)SvPV(ST(1), na); + keyclass = (char *)SvPV(ST(3), na); + options = (DWORD) ((unsigned long)SvIV(ST(4))); + sam = (REGSAM) ((unsigned long)SvIV(ST(5))); + psa = (SECURITY_ATTRIBUTES*)SvPV(ST(6), length); + if(length != sizeof(SECURITY_ATTRIBUTES)) + { + psa = &sa; + memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES)); + sa.nLength = sizeof(SECURITY_ATTRIBUTES); + } + + retval = RegCreateKeyEx(hkey, subkey, 0, keyclass, options, sam, + psa, &handle, &disposition); + + if(SUCCESSRETURNED(retval)) + { + if(psa == &sa) + SETPVN(6, &sa, sizeof(sa)); + + SETHKEY(7,handle); + SETIV(8,disposition); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegDeleteKey) +{ + dXSARGS; + + if(items != 2) + { + croak("usage: Win32::RegDeleteKey($hkey, $subkey);\n"); + } + + REGRETURN(RegDeleteKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na))); +} + +static +XS(w32_RegDeleteValue) +{ + dXSARGS; + + if(items != 2) + { + croak("usage: Win32::RegDeleteValue($hkey, $valname);\n"); + } + + REGRETURN(RegDeleteValue(SvHKEY(ST(0)), (char *)SvPV(ST(1), na))); +} + +static +XS(w32_RegEnumKey) +{ + dXSARGS; + + char keybuffer[TMPBUFSZ]; + + if(items != 3) + { + croak("usage: Win32::RegEnumKey($hkey, $idx, $subkeyname);\n"); + } + + if(SUCCESSRETURNED(RegEnumKey(SvHKEY(ST(0)), SvIV(ST(1)), keybuffer, sizeof(keybuffer)))) + { + SETPV(2, keybuffer); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegEnumKeyEx) +{ + dXSARGS; + int length; + + DWORD keysz, classsz; + char keybuffer[TMPBUFSZ]; + char classbuffer[TMPBUFSZ]; + long retval; + FILETIME filetime; + + if(items != 6) + { + croak("usage: Win32::RegEnumKeyEx($hkey, $idx, $subkeyname, $reserved, $class, $time);\n"); + } + + keysz = sizeof(keybuffer); + classsz = sizeof(classbuffer); + retval = RegEnumKeyEx(SvHKEY(ST(0)), SvIV(ST(1)), keybuffer, &keysz, 0, + classbuffer, &classsz, &filetime); + if(SUCCESSRETURNED(retval)) + { + SETPV(2, keybuffer); + SETPV(4, classbuffer); + SETIV(5, ft2timet(&filetime)); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegEnumValue) +{ + dXSARGS; + HKEY hkey; + DWORD type, namesz, valsz; + long retval; + static HKEY last_hkey; + char myvalbuf[MAX_LENGTH]; + char mynambuf[MAX_LENGTH]; + + if(items != 6) + { + croak("usage: Win32::RegEnumValue($hkey, $i, $name, $reserved, $type, $value);\n"); + } + + hkey = SvHKEY(ST(0)); + + // If this is a new key, find out how big the maximum name and value sizes are and + // allocate space for them. Free any old storage and set the old key value to the + // current key. + + if(hkey != (HKEY)last_hkey) + { + char keyclass[TMPBUFSZ]; + DWORD classsz, subkeys, maxsubkey, maxclass, values, salen, maxnamesz, maxvalsz; + FILETIME ft; + classsz = sizeof(keyclass); + retval = RegQueryInfoKey(hkey, keyclass, &classsz, 0, &subkeys, &maxsubkey, &maxclass, + &values, &maxnamesz, &maxvalsz, &salen, &ft); + + if(!SUCCESSRETURNED(retval)) + { + XSRETURN_NO; + } + memset(myvalbuf, 0, MAX_LENGTH); + memset(mynambuf, 0, MAX_LENGTH); + last_hkey = hkey; + } + + namesz = MAX_LENGTH; + valsz = MAX_LENGTH; + retval = RegEnumValue(hkey, SvIV(ST(1)), mynambuf, &namesz, 0, &type, (LPBYTE) myvalbuf, &valsz); + if(!SUCCESSRETURNED(retval)) + { + XSRETURN_NO; + } + else + { + SETPV(2, mynambuf); + SETIV(4, type); + + // return includes the null terminator so delete it if REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ + switch(type) + { + case REG_SZ: + case REG_MULTI_SZ: + case REG_EXPAND_SZ: + if(valsz) + --valsz; + case REG_BINARY: + SETPVN(5, myvalbuf, valsz); + break; + + case REG_DWORD_BIG_ENDIAN: + { + BYTE tmp = myvalbuf[0]; + myvalbuf[0] = myvalbuf[3]; + myvalbuf[3] = tmp; + tmp = myvalbuf[1]; + myvalbuf[1] = myvalbuf[2]; + myvalbuf[2] = tmp; + } + case REG_DWORD_LITTLE_ENDIAN: // same as REG_DWORD + SETNV(5, (double)*((DWORD*)myvalbuf)); + break; + + default: + break; + } + + XSRETURN_YES; + } +} + +static +XS(w32_RegFlushKey) +{ + dXSARGS; + + if(items != 1) + { + croak("usage: Win32::RegFlushKey($hkey);\n"); + } + + REGRETURN(RegFlushKey(SvHKEY(ST(0)))); +} + +static +XS(w32_RegGetKeySecurity) +{ + dXSARGS; + SECURITY_DESCRIPTOR sd; + DWORD sdsz; + + if(items != 3) + { + croak("usage: Win32::RegGetKeySecurity($hkey, $security_info, $security_descriptor);\n"); + } + + if(SUCCESSRETURNED(RegGetKeySecurity(SvHKEY(ST(0)), SvIV(ST(1)), &sd, &sdsz))) + { + SETPVN(2, &sd, sdsz); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegLoadKey) +{ + dXSARGS; + + if(items != 3) + { + croak("usage: Win32::RegLoadKey($hkey, $subkey, $filename);\n"); + } + + REGRETURN(RegLoadKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), (char *)SvPV(ST(2), na))); +} + +static +XS(w32_RegNotifyChangeKeyValue) +{ + croak("Win32::RegNotifyChangeKeyValue not yet implemented!\n"); +} + +static +XS(w32_RegOpenKey) +{ + dXSARGS; + HKEY handle; + + if(items != 3) + { + croak("usage: Win32::RegOpenKey($hkey, $subkey, $handle);\n"); + } + + if(SUCCESSRETURNED(RegOpenKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), &handle))) + { + SETHKEY(2,handle); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegOpenKeyEx) +{ + dXSARGS; + HKEY handle; + + if(items != 5) + { + croak("usage: Win32::RegOpenKeyEx($hkey, $subkey, $reserved, $sam, $handle);\n"); + } + + if(SUCCESSRETURNED(RegOpenKeyEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), + 0, (REGSAM) ((unsigned long)SvIV(ST(3))), &handle))) + { + SETHKEY(4,handle); + XSRETURN_YES; + } + XSRETURN_NO; +} + +#pragma optimize("", off) +static +XS(w32_RegQueryInfoKey) +{ + dXSARGS; + int length; + + char keyclass[TMPBUFSZ]; + DWORD subkeys, maxsubkey, maxclass, values, maxvalname, maxvaldata; + DWORD seclen, classsz; + FILETIME ft; + long retval; + + if(items != 10) + { + croak("usage: Win32::RegQueryInfoKey($hkey, $class, $numsubkeys, $maxsubkey," + "$maxclass, $values, $maxvalname, $maxvaldata, $secdesclen," + "$lastwritetime);\n"); + } + + classsz = sizeof(keyclass); + retval = RegQueryInfoKey(SvHKEY(ST(0)), keyclass, &classsz, 0, &subkeys, &maxsubkey, + &maxclass, &values, &maxvalname, &maxvaldata, + &seclen, &ft); + if(SUCCESSRETURNED(retval)) + { + SETPV(1, keyclass); + SETIV(2, subkeys); + SETIV(3, maxsubkey); + SETIV(4, maxclass); + SETIV(5, values); + SETIV(6, maxvalname); + SETIV(7, maxvaldata); + SETIV(8, seclen); + SETIV(9, ft2timet(&ft)); + XSRETURN_YES; + } + XSRETURN_NO; +} +#pragma optimize("", on) + +static +XS(w32_RegQueryValue) +{ + dXSARGS; + + unsigned char databuffer[TMPBUFSZ*2]; + long datasz = sizeof(databuffer); + + if(items != 3) + { + croak("usage: Win32::RegQueryValue($hkey, $valuename, $data);\n"); + } + + if(SUCCESSRETURNED(RegQueryValue(SvHKEY(ST(0)), SvPV(ST(1), na), (char*)databuffer, &datasz))) + { + // return includes the null terminator so delete it + SETPVN(2, databuffer, --datasz); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegQueryValueEx) +{ + dXSARGS; + + unsigned char databuffer[TMPBUFSZ*2]; + DWORD datasz = sizeof(databuffer); + DWORD type; + LONG result; + LPBYTE ptr = databuffer; + + if(items != 5) + { + croak("usage: Win32::RegQueryValueEx($hkey, $valuename, $reserved, $type, $data);\n"); + } + + result = RegQueryValueEx(SvHKEY(ST(0)), SvPV(ST(1), na), 0, &type, ptr, &datasz); + if(result == ERROR_MORE_DATA) + { + New(0, ptr, datasz+1, BYTE); + result = RegQueryValueEx(SvHKEY(ST(0)), SvPV(ST(1), na), 0, &type, ptr, &datasz); + } + if(SUCCESSRETURNED(result)) + { + SETIV(3, type); + + // return includes the null terminator so delete it if REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ + switch(type) + { + case REG_SZ: + case REG_MULTI_SZ: + case REG_EXPAND_SZ: + --datasz; + case REG_BINARY: + SETPVN(4, ptr, datasz); + break; + + case REG_DWORD_BIG_ENDIAN: + { + BYTE tmp = ptr[0]; + ptr[0] = ptr[3]; + ptr[3] = tmp; + tmp = ptr[1]; + ptr[1] = ptr[2]; + ptr[2] = tmp; + } + case REG_DWORD_LITTLE_ENDIAN: // same as REG_DWORD + SETNV(4, (double)*((DWORD*)ptr)); + break; + + default: + break; + } + + if(ptr != databuffer) + safefree(ptr); + + XSRETURN_YES; + } + if(ptr != databuffer) + safefree(ptr); + + XSRETURN_NO; +} + +static +XS(w32_RegReplaceKey) +{ + dXSARGS; + + if(items != 4) + { + croak("usage: Win32::RegReplaceKey($hkey, $subkey, $newfile, $oldfile);\n"); + } + + REGRETURN(RegReplaceKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), (char *)SvPV(ST(2), na), (char *)SvPV(ST(3), na))); +} + +static +XS(w32_RegRestoreKey) +{ + dXSARGS; + + if(items < 2 || items > 3) + { + croak("usage: Win32::RegRestoreKey($hkey, $filename [, $flags]);\n"); + } + + REGRETURN(RegRestoreKey(SvHKEY(ST(0)), (char*)SvPV(ST(1), na), (DWORD)((items == 3) ? SvIV(ST(2)) : 0))); +} + +static +XS(w32_RegSaveKey) +{ + dXSARGS; + + if(items != 2) + { + croak("usage: Win32::RegSaveKey($hkey, $filename);\n"); + } + + REGRETURN(RegSaveKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), NULL)); +} + +static +XS(w32_RegSetKeySecurity) +{ + dXSARGS; + + if(items != 3) + { + croak("usage: Win32::RegSetKeySecurity($hkey, $security_info, $security_descriptor);\n"); + } + + REGRETURN(RegSetKeySecurity(SvHKEY(ST(0)), SvIV(ST(1)), (SECURITY_DESCRIPTOR*)SvPV(ST(2), na))); +} + +static +XS(w32_RegSetValue) +{ + dXSARGS; + + unsigned int size; + char *buffer; + + if(items != 4) + { + croak("usage: Win32::RegSetValue($hkey, $subKey, $type, $data);\n"); + } + + DWORD type = SvIV(ST(2)); + if(type != REG_SZ && type != REG_EXPAND_SZ) + { + croak("Win32::RegSetValue: Type was not REG_SZ or REG_EXPAND_SZ, cannot set %s\n", (char *)SvPV(ST(1), na)); + } + + buffer = (char *)SvPV(ST(3), size); + REGRETURN(RegSetValue(SvHKEY(ST(0)), SvPV(ST(1), na), REG_SZ, buffer, size)); +} + +static +XS(w32_RegSetValueEx) +{ + dXSARGS; + + DWORD type; + DWORD val; + unsigned int size; + char *buffer; + + if(items != 5) + { + croak("usage: Win32::RegSetValueEx($hkey, $valname, $reserved, $type, $data);\n"); + } + + type = (DWORD)SvIV(ST(3)); + switch(type) + { + case REG_SZ: + case REG_BINARY: + case REG_MULTI_SZ: + case REG_EXPAND_SZ: + buffer = (char *)SvPV(ST(4), size); + if(type != REG_BINARY) + size++; // include null terminator in size + + REGRETURN(RegSetValueEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, type, (PBYTE) buffer, size)); + break; + + case REG_DWORD_BIG_ENDIAN: + case REG_DWORD_LITTLE_ENDIAN: // Same as REG_DWORD + val = (DWORD)SvIV(ST(4)); + REGRETURN(RegSetValueEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, type, (PBYTE) &val, sizeof(DWORD))); + break; + + default: + croak("Win32::RegSetValueEx: Type not specified, cannot set %s\n", (char *)SvPV(ST(1), na)); + } +} + +static +XS(w32_RegUnloadKey) +{ + dXSARGS; + + if(items != 2) + { + croak("usage: Win32::RegUnLoadKey($hkey, $subkey);\n"); + } + + REGRETURN(RegUnLoadKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na))); +} + +static +XS(w32_RegisterServer) +{ + dXSARGS; + BOOL bSuccess = FALSE; + HINSTANCE hInstance; + unsigned int length; + FARPROC sFunc; + + if(items != 1) + { + croak("usage: Win32::RegisterServer($LibraryName)\n"); + } + + hInstance = LoadLibrary((char *)SvPV(ST(0), length)); + if(hInstance != NULL) + { + sFunc = GetProcAddress(hInstance, "DllRegisterServer"); + if(sFunc != NULL) + { + bSuccess = (sFunc() == 0); + } + FreeLibrary(hInstance); + } + + if(bSuccess) + { + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_UnregisterServer) +{ + dXSARGS; + BOOL bSuccess = FALSE; + HINSTANCE hInstance; + unsigned int length; + FARPROC sFunc; + + if(items != 1) + { + croak("usage: Win32::UnregisterServer($LibraryName)\n"); + } + + hInstance = LoadLibrary((char *)SvPV(ST(0), length)); + if(hInstance != NULL) + { + sFunc = GetProcAddress(hInstance, "DllUnregisterServer"); + if(sFunc != NULL) + { + bSuccess = (sFunc() == 0); + } + FreeLibrary(hInstance); + } + + if(bSuccess) + { + XSRETURN_YES; + } + XSRETURN_NO; +} + + void Perl_init_os_extras() { @@ -1991,6 +2784,40 @@ Perl_init_os_extras() newXS("Win32::GetShortPathName", w32_GetShortPathName, file); newXS("Win32::Sleep", w32_Sleep, file); + /* the following extensions are used interally and may be changed at any time */ + /* therefore no documentation is provided */ + newXS("Win32::RegCloseKey", w32_RegCloseKey, file); + newXS("Win32::RegConnectRegistry", w32_RegConnectRegistry, file); + newXS("Win32::RegCreateKey", w32_RegCreateKey, file); + newXS("Win32::RegCreateKeyEx", w32_RegCreateKeyEx, file); + newXS("Win32::RegDeleteKey", w32_RegDeleteKey, file); + newXS("Win32::RegDeleteValue", w32_RegDeleteValue, file); + + newXS("Win32::RegEnumKey", w32_RegEnumKey, file); + newXS("Win32::RegEnumKeyEx", w32_RegEnumKeyEx, file); + newXS("Win32::RegEnumValue", w32_RegEnumValue, file); + + newXS("Win32::RegFlushKey", w32_RegFlushKey, file); + newXS("Win32::RegGetKeySecurity", w32_RegGetKeySecurity, file); + + newXS("Win32::RegLoadKey", w32_RegLoadKey, file); + newXS("Win32::RegOpenKey", w32_RegOpenKey, file); + newXS("Win32::RegOpenKeyEx", w32_RegOpenKeyEx, file); + newXS("Win32::RegQueryInfoKey", w32_RegQueryInfoKey, file); + newXS("Win32::RegQueryValue", w32_RegQueryValue, file); + newXS("Win32::RegQueryValueEx", w32_RegQueryValueEx, file); + + newXS("Win32::RegReplaceKey", w32_RegReplaceKey, file); + newXS("Win32::RegRestoreKey", w32_RegRestoreKey, file); + newXS("Win32::RegSaveKey", w32_RegSaveKey, file); + newXS("Win32::RegSetKeySecurity", w32_RegSetKeySecurity, file); + newXS("Win32::RegSetValue", w32_RegSetValue, file); + newXS("Win32::RegSetValueEx", w32_RegSetValueEx, file); + newXS("Win32::RegUnloadKey", w32_RegUnloadKey, file); + + newXS("Win32::RegisterServer", w32_RegisterServer, file); + newXS("Win32::UnregisterServer", w32_UnregisterServer, file); + /* XXX Bloat Alert! The following Activeware preloads really * ought to be part of Win32::Sys::*, so they're not included * here. diff --git a/win32/win32.h b/win32/win32.h index 8b9be40130..35eeaba612 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -39,11 +39,15 @@ typedef long long __int64; * otherwise import it. */ +#if defined(PERL_OBJECT) +#define DllExport +#else #if defined(PERLDLL) || defined(WIN95FIX) #define DllExport __declspec(dllexport) #else #define DllExport __declspec(dllimport) #endif +#endif #define WIN32_LEAN_AND_MEAN #include <windows.h> diff --git a/win32/win32sck.c b/win32/win32sck.c index 14d2e6a45f..5c2b73f95a 100644 --- a/win32/win32sck.c +++ b/win32/win32sck.c @@ -17,6 +17,13 @@ #include <windows.h> #include "EXTERN.h" #include "perl.h" + +#if defined(PERL_OBJECT) +#define NO_XSLOCKS +extern CPerlObj* pPerl; +#include "XSUB.h" +#endif + #include <sys/socket.h> #include <fcntl.h> #include <sys/stat.h> @@ -613,7 +620,7 @@ win32_savecopyservent(struct servent*d, struct servent*s, const char *proto) d->s_proto = s->s_proto; else #endif - if (proto && strlen(proto)) + if (proto && strlen(proto)) d->s_proto = (char *)proto; else d->s_proto = "tcp"; diff --git a/win32/win32thread.c b/win32/win32thread.c index 44f32e27fd..e91830d38d 100644 --- a/win32/win32thread.c +++ b/win32/win32thread.c @@ -1,6 +1,12 @@ #include "EXTERN.h" #include "perl.h" +#if defined(PERL_OBJECT) +#define NO_XSLOCKS +extern CPerlObj* pPerl; +#include "XSUB.h" +#endif + #ifdef USE_DECLSPEC_THREAD __declspec(thread) struct perl_thread *Perl_current_thread = NULL; #endif |