diff options
| -rw-r--r-- | EXTERN.h | 2 | ||||
| -rw-r--r-- | ObjXSub.h | 1100 | ||||
| -rw-r--r-- | XSUB.h | 8 | ||||
| -rw-r--r-- | cv.h | 2 | ||||
| -rw-r--r-- | doio.c | 4 | ||||
| -rw-r--r-- | dosish.h | 4 | ||||
| -rw-r--r-- | dump.c | 4 | ||||
| -rw-r--r-- | embedvar.h | 6 | ||||
| -rw-r--r-- | globals.c | 1500 | ||||
| -rw-r--r-- | gv.c | 16 | ||||
| -rw-r--r-- | hv.c | 16 | ||||
| -rw-r--r-- | intrpvar.h | 10 | ||||
| -rw-r--r-- | ipdir.h | 26 | ||||
| -rw-r--r-- | ipenv.h | 20 | ||||
| -rw-r--r-- | iplio.h | 40 | ||||
| -rw-r--r-- | ipmem.h | 20 | ||||
| -rw-r--r-- | ipproc.h | 55 | ||||
| -rw-r--r-- | ipsock.h | 59 | ||||
| -rw-r--r-- | ipstdio.h | 55 | ||||
| -rw-r--r-- | malloc.c | 2 | ||||
| -rw-r--r-- | mg.c | 134 | ||||
| -rw-r--r-- | mg.h | 14 | ||||
| -rw-r--r-- | objpp.h | 1391 | ||||
| -rw-r--r-- | op.c | 44 | ||||
| -rw-r--r-- | op.h | 2 | ||||
| -rw-r--r-- | opcode.h | 16 | ||||
| -rw-r--r-- | perl.c | 180 | ||||
| -rw-r--r-- | perl.h | 98 | ||||
| -rw-r--r-- | perldir.h | 12 | ||||
| -rw-r--r-- | perlenv.h | 10 | ||||
| -rw-r--r-- | perlio.h | 48 | ||||
| -rw-r--r-- | perllio.h | 29 | ||||
| -rw-r--r-- | perlmem.h | 6 | ||||
| -rw-r--r-- | perlproc.h | 47 | ||||
| -rw-r--r-- | perlsock.h | 111 | ||||
| -rw-r--r-- | perlvars.h | 11 | ||||
| -rw-r--r-- | perly.c | 21 | ||||
| -rw-r--r-- | pp.c | 44 | ||||
| -rw-r--r-- | pp.h | 13 | ||||
| -rw-r--r-- | pp_ctl.c | 84 | ||||
| -rw-r--r-- | pp_hot.c | 26 | ||||
| -rw-r--r-- | pp_sys.c | 52 | ||||
| -rw-r--r-- | proto.h | 1567 | ||||
| -rw-r--r-- | regcomp.c | 42 | ||||
| -rw-r--r-- | regcomp.h | 2 | ||||
| -rw-r--r-- | regexec.c | 102 | ||||
| -rw-r--r-- | run.c | 13 | ||||
| -rw-r--r-- | scope.c | 8 | ||||
| -rw-r--r-- | scope.h | 5 | ||||
| -rw-r--r-- | sv.c | 138 | ||||
| -rw-r--r-- | sv.h | 2 | ||||
| -rw-r--r-- | thread.h | 4 | ||||
| -rw-r--r-- | toke.c | 98 | ||||
| -rw-r--r-- | universal.c | 10 | ||||
| -rw-r--r-- | util.c | 34 | ||||
| -rw-r--r-- | vms/vms.c | 2 | ||||
| -rw-r--r-- | win32/Makefile | 10 | ||||
| -rw-r--r-- | win32/config_H.bc | 2 | ||||
| -rw-r--r-- | win32/config_H.vc | 40 | ||||
| -rw-r--r-- | win32/dl_win32.xs | 10 | ||||
| -rw-r--r-- | win32/include/sys/socket.h | 2 | ||||
| -rw-r--r-- | win32/ipdir.c | 186 | ||||
| -rw-r--r-- | win32/ipenv.c | 62 | ||||
| -rw-r--r-- | win32/iplio.c | 307 | ||||
| -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 | 447 | ||||
| -rw-r--r-- | win32/ipstdiowin.h | 22 | ||||
| -rw-r--r-- | win32/makedef.pl | 2 | ||||
| -rw-r--r-- | win32/perlobj.def | 4 | ||||
| -rw-r--r-- | win32/runperl.c | 172 | ||||
| -rw-r--r-- | win32/win32iop.h | 9 |
73 files changed, 9008 insertions, 976 deletions
@@ -23,7 +23,7 @@ # define EXTCONST globalref # define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly #else -# if defined(WIN32) && !defined(__GNUC__) +# if defined(WIN32) && !defined(__GNUC__) && !defined(PERL_OBJECT) # ifdef PERLDLL # define EXT extern __declspec(dllexport) # define dEXT diff --git a/ObjXSub.h b/ObjXSub.h new file mode 100644 index 0000000000..7f2acf37e8 --- /dev/null +++ b/ObjXSub.h @@ -0,0 +1,1100 @@ +#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 an +#define an pPerl->Perl_an +#undef cop_seqmax +#define cop_seqmax pPerl->Perl_cop_seqmax +#undef evalseq +#define evalseq pPerl->Perl_evalseq +#undef sub_generation +#define sub_generation pPerl->Perl_sub_generation +#undef origenviron +#define origenviron pPerl->Perl_origenviron +#undef environ +#define environ pPerl->Perl_environ +#undef origalen +#define origalen pPerl->Perl_origalen +#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 +#undef 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 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 curpad +#define curpad pPerl->Perl_curpad +#undef Sv +#define Sv pPerl->Perl_Sv +#undef Xpv +#define Xpv pPerl->Perl_Xpv +#undef buf +#define buf pPerl->Perl_buf +#undef tokenbuf +#define tokenbuf pPerl->Perl_tokenbuf +#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 +#undef sv_no +#define sv_no pPerl->Perl_sv_no +#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 +#undef last_hkey +#define last_hkey pPerl->Perl_last_hkey +#undef valbuf +#define valbuf pPerl->Perl_valbuf +#undef namebuf +#define namebuf pPerl->Perl_namebuf +#undef maxvalsz +#define maxvalsz pPerl->Perl_maxvalsz +#undef maxnamesz +#define maxnamesz pPerl->Perl_maxnamesz + +// functions + +#undef amagic_call +#define amagic_call pPerl->Perl_amagic_call +#undef Gv_AMupdate +#define Gv_AMupdate pPerl->Gv_AMupdate +#undef append_elem +#define append_elem pPerl->Perl_append_elem +#undef append_list +#define append_list pPerl->Perl_append_list +#undef apply +#define apply pPerl->Perl_apply +#undef assertref +#define assertref pPerl->Perl_assertref +#undef av_clear +#define av_clear pPerl->Perl_av_clear +#undef av_extend +#define av_extend pPerl->Perl_av_extend +#undef av_fake +#define av_fake pPerl->Perl_av_fake +#undef av_fetch +#define av_fetch pPerl->Perl_av_fetch +#undef av_fill +#define av_fill pPerl->Perl_av_fill +#undef av_len +#define av_len pPerl->Perl_av_len +#undef av_make +#define av_make pPerl->Perl_av_make +#undef av_pop +#define av_pop pPerl->Perl_av_pop +#undef av_push +#define av_push pPerl->Perl_av_push +#undef av_shift +#define av_shift pPerl->Perl_av_shift +#undef av_store +#define av_store pPerl->Perl_av_store +#undef av_undef +#define av_undef pPerl->Perl_av_undef +#undef av_unshift +#define av_unshift pPerl->Perl_av_unshift +#undef bad_type +#define bad_type pPerl->bad_type +#undef bind_match +#define bind_match pPerl->Perl_bind_match +#undef block_end +#define block_end pPerl->Perl_block_end +#undef block_start +#define block_start pPerl->Perl_block_start +#undef call_list +#define call_list pPerl->Perl_call_list +#undef cando +#define cando pPerl->Perl_cando +#undef cast_ulong +#define cast_ulong pPerl->cast_ulong +#undef checkcomma +#define checkcomma pPerl->Perl_checkcomma +#undef check_uni +#define check_uni pPerl->Perl_check_uni +#undef ck_concat +#define ck_concat pPerl->Perl_ck_concat +#undef ck_delete +#define ck_delete pPerl->Perl_ck_delete +#undef ck_eof +#define ck_eof pPerl->Perl_ck_eof +#undef ck_eval +#define ck_eval pPerl->Perl_ck_eval +#undef ck_exec +#define ck_exec pPerl->Perl_ck_exec +#undef ck_formline +#define ck_formline pPerl->Perl_ck_formline +#undef ck_ftst +#define ck_ftst pPerl->Perl_ck_ftst +#undef ck_fun +#define ck_fun pPerl->Perl_ck_fun +#undef ck_glob +#define ck_glob pPerl->Perl_ck_glob +#undef ck_grep +#define ck_grep pPerl->Perl_ck_grep +#undef ck_gvconst +#define ck_gvconst pPerl->Perl_ck_gvconst +#undef ck_index +#define ck_index pPerl->Perl_ck_index +#undef ck_lengthconst +#define ck_lengthconst pPerl->Perl_ck_lengthconst +#undef ck_lfun +#define ck_lfun pPerl->Perl_ck_lfun +#undef ck_listiob +#define ck_listiob pPerl->Perl_ck_listiob +#undef ck_match +#define ck_match pPerl->Perl_ck_match +#undef ck_null +#define ck_null pPerl->Perl_ck_null +#undef ck_repeat +#define ck_repeat pPerl->Perl_ck_repeat +#undef ck_require +#define ck_require pPerl->Perl_ck_require +#undef ck_retarget +#define ck_retarget pPerl->Perl_ck_retarget +#undef ck_rfun +#define ck_rfun pPerl->Perl_ck_rfun +#undef ck_rvconst +#define ck_rvconst pPerl->Perl_ck_rvconst +#undef ck_select +#define ck_select pPerl->Perl_ck_select +#undef ck_shift +#define ck_shift pPerl->Perl_ck_shift +#undef ck_sort +#define ck_sort pPerl->Perl_ck_sort +#undef ck_spair +#define ck_spair pPerl->Perl_ck_spair +#undef ck_split +#define ck_split pPerl->Perl_ck_split +#undef ck_subr +#define ck_subr pPerl->Perl_ck_subr +#undef ck_svconst +#define ck_svconst pPerl->Perl_ck_svconst +#undef ck_trunc +#define ck_trunc pPerl->Perl_ck_trunc +#undef closedir +#define closedir pPerl->closedir +#undef convert +#define convert pPerl->Perl_convert +#undef cpytill +#define cpytill pPerl->Perl_cpytill +#undef croak +#define croak pPerl->Perl_croak +#undef cv_clone +#define cv_clone pPerl->Perl_cv_clone +#undef cv_undef +#define cv_undef pPerl->Perl_cv_undef +#undef cxinc +#define cxinc pPerl->Perl_cxinc +#undef del_xiv +#define del_xiv pPerl->del_xiv +#undef del_xnv +#define del_xnv pPerl->del_xnv +#undef del_xpv +#define del_xpv pPerl->del_xpv +#undef del_xrv +#define del_xrv pPerl->del_xrv +#undef deprecate +#define deprecate pPerl->Perl_deprecate +#undef die +#define die pPerl->Perl_die +#undef die_where +#define die_where pPerl->Perl_die_where +#undef doencodes +#define doencodes pPerl->doencodes +#undef doform +#define doform pPerl->doform +#undef doparseform +#define doparseform pPerl->doparseform +#undef dopoptoeval +#define dopoptoeval pPerl->Perl_dopoptoeval +#undef dopoptolabel +#define dopoptolabel pPerl->dopoptolabel +#undef dopoptoloop +#define dopoptoloop pPerl->dopoptoloop +#undef dopoptosub +#define dopoptosub pPerl->dopoptosub +#undef dounwind +#define dounwind pPerl->Perl_dounwind +#undef do_aexec +#define do_aexec pPerl->Perl_do_aexec +#undef do_chop +#define do_chop pPerl->Perl_do_chop +#undef do_close +#define do_close pPerl->Perl_do_close +#undef do_eof +#define do_eof pPerl->Perl_do_eof +#undef do_exec +#define do_exec pPerl->Perl_do_exec +#undef do_execfree +#define do_execfree pPerl->Perl_do_execfree +#undef do_open +#define do_open pPerl->Perl_do_open +#undef dowantarray +#define dowantarray pPerl->Perl_dowantarray +#undef fbm_compile +#define fbm_compile pPerl->Perl_fbm_compile +#undef fbm_instr +#define fbm_instr pPerl->Perl_fbm_instr +#undef filter_add +#define filter_add pPerl->Perl_filter_add +#undef filter_del +#define filter_del pPerl->Perl_filter_del +#undef filter_gets +#define filter_gets pPerl->filter_gets +#undef filter_read +#define filter_read pPerl->Perl_filter_read +#undef find_beginning +#define find_beginning pPerl->find_beginning +#undef force_ident +#define force_ident pPerl->Perl_force_ident +#undef force_list +#define force_list pPerl->Perl_force_list +#undef force_next +#define force_next pPerl->Perl_force_next +#undef force_word +#define force_word pPerl->Perl_force_word +#undef fold_constants +#define fold_constants pPerl->Perl_fold_constants +#undef fprintf +#define fprintf pPerl->fprintf +#undef free_tmps +#define free_tmps pPerl->Perl_free_tmps +#undef gen_constant_list +#define gen_constant_list pPerl->Perl_gen_constant_list +#undef getlogin +#define getlogin pPerl->getlogin +#undef gp_free +#define gp_free pPerl->Perl_gp_free +#undef gp_ref +#define gp_ref pPerl->Perl_gp_ref +#undef gv_AVadd +#define gv_AVadd pPerl->Perl_gv_AVadd +#undef gv_HVadd +#define gv_HVadd pPerl->Perl_gv_HVadd +#undef gv_IOadd +#define gv_IOadd pPerl->Perl_gv_IOadd +#undef gv_check +#define gv_check pPerl->Perl_gv_check +#undef gv_efullname +#define gv_efullname pPerl->Perl_gv_efullname +#undef gv_efullname3 +#define gv_efullname3 pPerl->Perl_gv_efullname3 +#undef gv_fetchfile +#define gv_fetchfile pPerl->Perl_gv_fetchfile +#undef gv_fetchmeth +#define gv_fetchmeth pPerl->Perl_gv_fetchmeth +#undef gv_fetchmethod +#define gv_fetchmethod pPerl->Perl_gv_fetchmethod +#undef gv_fetchmethod_autoload +#define gv_fetchmethod_autoload pPerl->Perl_gv_fetchmethod_autoload +#undef gv_fetchpv +#define gv_fetchpv pPerl->Perl_gv_fetchpv +#undef gv_fullname +#define gv_fullname pPerl->Perl_gv_fullname +#undef gv_fullname3 +#define gv_fullname3 pPerl->Perl_gv_fullname3 +#undef gv_init +#define gv_init pPerl->Perl_gv_init +#undef gv_init_sv +#define gv_init_sv pPerl->gv_init_sv +#undef gv_stashpv +#define gv_stashpv pPerl->Perl_gv_stashpv +#undef gv_stashpvn +#define gv_stashpvn pPerl->Perl_gv_stashpvn +#undef gv_stashsv +#define gv_stashsv pPerl->Perl_gv_stashsv +#undef he_delayfree +#define he_delayfree pPerl->Perl_he_delayfree +#undef he_free +#define he_free pPerl->Perl_he_free +#undef hfreeentries +#define hfreeentries pPerl->hfreeentries +#undef hoistmust +#define hoistmust pPerl->Perl_hoistmust +#undef hsplit +#define hsplit pPerl->hsplit +#undef hv_clear +#define hv_clear pPerl->Perl_hv_clear +#undef hv_delete +#define hv_delete pPerl->Perl_hv_delete +#undef hv_delete_ent +#define hv_delete_ent pPerl->Perl_hv_delete_ent +#undef hv_exists +#define hv_exists pPerl->Perl_hv_exists +#undef hv_exists_ent +#define hv_exists_ent pPerl->Perl_hv_exists_ent +#undef hv_fetch +#define hv_fetch pPerl->Perl_hv_fetch +#undef hv_fetch_ent +#define hv_fetch_ent pPerl->Perl_hv_fetch_ent +#undef hv_iterinit +#define hv_iterinit pPerl->Perl_hv_iterinit +#undef hv_iterkey +#define hv_iterkey pPerl->Perl_hv_iterkey +#undef hv_iterkeysv +#define hv_iterkeysv pPerl->Perl_hv_iterkeysv +#undef hv_iternext +#define hv_iternext pPerl->Perl_hv_iternext +#undef hv_iternextsv +#define hv_iternextsv pPerl->Perl_hv_iternextsv +#undef hv_iterval +#define hv_iterval pPerl->Perl_hv_iterval +#undef hv_ksplit +#define hv_ksplit pPerl->Perl_hv_ksplit +#undef hv_magic +#define hv_magic pPerl->Perl_hv_magic +#undef hv_store +#define hv_store pPerl->Perl_hv_store +#undef hv_store_ent +#define hv_store_ent pPerl->Perl_hv_store_ent +#undef hv_undef +#define hv_undef pPerl->Perl_hv_undef +#undef ibcmp +#define ibcmp pPerl->Perl_ibcmp +#undef incpush +#define incpush pPerl->incpush +#undef incline +#define incline pPerl->incline +#undef incl_perldb +#define incl_perldb pPerl->incl_perldb +#undef ingroup +#define ingroup pPerl->Perl_ingroup +#undef instr +#define instr pPerl->Perl_instr +#undef intuit_method +#define intuit_method pPerl->intuit_method +#undef intuit_more +#define intuit_more pPerl->Perl_intuit_more +#undef invert +#define invert pPerl->Perl_invert +#undef ioctl +#define ioctl pPerl->ioctl +#undef jmaybe +#define jmaybe pPerl->Perl_jmaybe +#undef keyword +#define keyword pPerl->Perl_keyword +#undef leave_scope +#define leave_scope pPerl->Perl_leave_scope +#undef lex_end +#define lex_end pPerl->Perl_lex_end +#undef lex_start +#define lex_start pPerl->Perl_lex_start +#undef linklist +#define linklist pPerl->Perl_linklist +#undef list +#define list pPerl->Perl_list +#undef listkids +#define listkids pPerl->Perl_listkids +#undef lop +#define lop pPerl->lop +#undef localize +#define localize pPerl->Perl_localize +#undef looks_like_number +#define looks_like_number pPerl->Perl_looks_like_number +#undef magic_clearenv +#define magic_clearenv pPerl->Perl_magic_clearenv +#undef magic_clearpack +#define magic_clearpack pPerl->Perl_magic_clearpack +#undef magic_clearsig +#define magic_clearsig pPerl->Perl_magic_clearsig +#undef magic_existspack +#define magic_existspack pPerl->Perl_magic_existspack +#undef magic_get +#define magic_get pPerl->Perl_magic_get +#undef magic_getarylen +#define magic_getarylen pPerl->Perl_magic_getarylen +#undef magic_getpack +#define magic_getpack pPerl->Perl_magic_getpack +#undef magic_getglob +#define magic_getglob pPerl->Perl_magic_getglob +#undef magic_getpos +#define magic_getpos pPerl->Perl_magic_getpos +#undef magic_getsig +#define magic_getsig pPerl->Perl_magic_getsig +#undef magic_gettaint +#define magic_gettaint pPerl->Perl_magic_gettaint +#undef magic_getuvar +#define magic_getuvar pPerl->Perl_magic_getuvar +#undef magic_len +#define magic_len pPerl->Perl_magic_len +#undef magic_methpack +#define magic_methpack pPerl->magic_methpack +#undef magic_nextpack +#define magic_nextpack pPerl->Perl_magic_nextpack +#undef magic_set +#define magic_set pPerl->Perl_magic_set +#undef magic_setamagic +#define magic_setamagic pPerl->Perl_magic_setamagic +#undef magic_setarylen +#define magic_setarylen pPerl->Perl_magic_setarylen +#undef magic_setbm +#define magic_setbm pPerl->Perl_magic_setbm +#undef magic_setdbline +#define magic_setdbline pPerl->Perl_magic_setdbline +#undef magic_setenv +#define magic_setenv pPerl->Perl_magic_setenv +#undef magic_setisa +#define magic_setisa pPerl->Perl_magic_setisa +#undef magic_setglob +#define magic_setglob pPerl->Perl_magic_setglob +#undef magic_setmglob +#define magic_setmglob pPerl->Perl_magic_setmglob +#undef magic_setnkeys +#define magic_setnkeys pPerl->Perl_magic_setnkeys +#undef magic_setpack +#define magic_setpack pPerl->Perl_magic_setpack +#undef magic_setpos +#define magic_setpos pPerl->Perl_magic_setpos +#undef magic_setsig +#define magic_setsig pPerl->Perl_magic_setsig +#undef magic_setsubstr +#define magic_setsubstr pPerl->Perl_magic_setsubstr +#undef magic_settaint +#define magic_settaint pPerl->Perl_magic_settaint +#undef magic_setuvar +#define magic_setuvar pPerl->Perl_magic_setuvar +#undef magic_setvec +#define magic_setvec pPerl->Perl_magic_setvec +#undef magic_wipepack +#define magic_wipepack pPerl->Perl_magic_wipepack +#undef magicname +#define magicname pPerl->Perl_magicname +#undef markstack_grow +#define markstack_grow pPerl->Perl_markstack_grow +#undef mess +#define mess pPerl->Perl_mess +#undef mg_clear +#define mg_clear pPerl->Perl_mg_clear +#undef mg_copy +#define mg_copy pPerl->Perl_mg_copy +#undef mg_find +#define mg_find pPerl->Perl_mg_find +#undef mg_free +#define mg_free pPerl->Perl_mg_free +#undef mg_get +#define mg_get pPerl->Perl_mg_get +#undef mg_Len +#define mg_Len pPerl->mg_Len +#undef mg_magical +#define mg_magical pPerl->Perl_mg_magical +#undef mg_set +#define mg_set pPerl->Perl_mg_set +#undef missingterm +#define missingterm pPerl->missingterm +#undef mod +#define mod pPerl->Perl_mod +#undef modkids +#define modkids pPerl->Perl_modkids +#undef moreswitches +#define moreswitches pPerl->Perl_moreswitches +#undef more_sv +#define more_sv pPerl->more_sv +#undef more_xiv +#define more_xiv pPerl->more_xiv +#undef more_xnv +#define more_xnv pPerl->more_xnv +#undef more_xpv +#define more_xpv pPerl->more_xpv +#undef more_xrv +#define more_xrv pPerl->more_xrv +#undef my +#define my pPerl->Perl_my +#undef my_bcopy +#define my_bcopy pPerl->Perl_my_bcopy +#undef my_bzero +#define my_bzero pPerl->Perl_my_bzero +#undef my_exit +#define my_exit pPerl->Perl_my_exit +#undef my_lstat +#define my_lstat pPerl->Perl_my_lstat +#undef my_memcmp +#define my_memcmp pPerl->my_memcmp +#undef my_pclose +#define my_pclose pPerl->Perl_my_pclose +#undef my_popen +#define my_popen pPerl->Perl_my_popen +#undef my_setenv +#define my_setenv pPerl->Perl_my_setenv +#undef my_stat +#define my_stat pPerl->Perl_my_stat +#undef my_unexec +#define my_unexec pPerl->Perl_my_unexec +#undef newANONLIST +#define newANONLIST pPerl->Perl_newANONLIST +#undef newANONHASH +#define newANONHASH pPerl->Perl_newANONHASH +#undef newANONSUB +#define newANONSUB pPerl->Perl_newANONSUB +#undef newASSIGNOP +#define newASSIGNOP pPerl->Perl_newASSIGNOP +#undef newCONDOP +#define newCONDOP pPerl->Perl_newCONDOP +#undef newFORM +#define newFORM pPerl->Perl_newFORM +#undef newFOROP +#define newFOROP pPerl->Perl_newFOROP +#undef newLOGOP +#define newLOGOP pPerl->Perl_newLOGOP +#undef newLOOPEX +#define newLOOPEX pPerl->Perl_newLOOPEX +#undef newLOOPOP +#define newLOOPOP pPerl->Perl_newLOOPOP +#undef newMETHOD +#define newMETHOD pPerl->Perl_newMETHOD +#undef newNULLLIST +#define newNULLLIST pPerl->Perl_newNULLLIST +#undef newOP +#define newOP pPerl->Perl_newOP +#undef newPROG +#define newPROG pPerl->Perl_newPROG +#undef newRANGE +#define newRANGE pPerl->Perl_newRANGE +#undef newSLICEOP +#define newSLICEOP pPerl->Perl_newSLICEOP +#undef newSTATEOP +#define newSTATEOP pPerl->Perl_newSTATEOP +#undef newSUB +#define newSUB pPerl->Perl_newSUB +#undef newXS +#define newXS pPerl->Perl_newXS +#undef newAV +#define newAV pPerl->Perl_newAV +#undef newAVREF +#define newAVREF pPerl->Perl_newAVREF +#undef newBINOP +#define newBINOP pPerl->Perl_newBINOP +#undef newCVREF +#define newCVREF pPerl->Perl_newCVREF +#undef newCVOP +#define newCVOP pPerl->Perl_newCVOP +#undef newGVOP +#define newGVOP pPerl->Perl_newGVOP +#undef newGVgen +#define newGVgen pPerl->Perl_newGVgen +#undef newGVREF +#define newGVREF pPerl->Perl_newGVREF +#undef newHVREF +#define newHVREF pPerl->Perl_newHVREF +#undef newHV +#define newHV pPerl->Perl_newHV +#undef newIO +#define newIO pPerl->Perl_newIO +#undef newLISTOP +#define newLISTOP pPerl->Perl_newLISTOP +#undef newPMOP +#define newPMOP pPerl->Perl_newPMOP +#undef newPVOP +#define newPVOP pPerl->Perl_newPVOP +#undef newRV +#define newRV pPerl->Perl_newRV +#undef newSV +#define newSV pPerl->Perl_newSV +#undef newSV +#define newSV pPerl->Perl_newSV +#undef newSVREF +#define newSVREF pPerl->Perl_newSVREF +#undef newSVOP +#define newSVOP pPerl->Perl_newSVOP +#undef newSViv +#define newSViv pPerl->Perl_newSViv +#undef newSVnv +#define newSVnv pPerl->Perl_newSVnv +#undef newSVpv +#define newSVpv pPerl->Perl_newSVpv +#undef newSVrv +#define newSVrv pPerl->Perl_newSVrv +#undef newSVsv +#define newSVsv pPerl->Perl_newSVsv +#undef newUNOP +#define newUNOP pPerl->Perl_newUNOP +#undef newWHILEOP +#define newWHILEOP pPerl->Perl_newWHILEOP +#undef new_sv +#define new_sv pPerl->new_sv +#undef new_xiv +#define new_xiv pPerl->new_xiv +#undef new_xnv +#define new_xnv pPerl->new_xnv +#undef new_xpv +#define new_xpv pPerl->new_xpv +#undef new_xrv +#define new_xrv pPerl->new_xrv +#undef nextargv +#define nextargv pPerl->Perl_nextargv +#undef nextchar +#define nextchar pPerl->nextchar +#undef ninstr +#define ninstr pPerl->Perl_ninstr +#undef not_a_number +#define not_a_number pPerl->not_a_number +#undef no_fh_allowed +#define no_fh_allowed pPerl->Perl_no_fh_allowed +#undef no_op +#define no_op pPerl->Perl_no_op +#undef null +#define null pPerl->null +#undef package +#define package pPerl->Perl_package +#undef pad_allocmy +#define pad_allocmy pPerl->Perl_pad_allocmy +#undef pad_findmy +#define pad_findmy pPerl->Perl_pad_findmy +#undef op_free +#define op_free pPerl->Perl_op_free +#undef oopsCV +#define oopsCV pPerl->Perl_oopsCV +#undef oopsAV +#define oopsAV pPerl->Perl_oopsAV +#undef oopsHV +#define oopsHV pPerl->Perl_oopsHV +#undef opendir +#define opendir pPerl->opendir +#undef open_script +#define open_script pPerl->open_script +#undef pad_leavemy +#define pad_leavemy pPerl->Perl_pad_leavemy +#undef pad_sv +#define pad_sv pPerl->Perl_pad_sv +#undef pad_findlex +#define pad_findlex pPerl->pad_findlex +#undef pad_free +#define pad_free pPerl->Perl_pad_free +#undef pad_reset +#define pad_reset pPerl->Perl_pad_reset +#undef pad_swipe +#define pad_swipe pPerl->Perl_pad_swipe +#undef peep +#define peep pPerl->Perl_peep +#undef perl_call_argv +#define perl_call_argv pPerl->perl_call_argv +#undef perl_call_method +#define perl_call_method pPerl->perl_call_method +#undef perl_call_pv +#define perl_call_pv pPerl->perl_call_pv +#undef perl_call_sv +#define perl_call_sv pPerl->perl_call_sv +#undef perl_callargv +#define perl_callargv pPerl->perl_callargv +#undef perl_callpv +#define perl_callpv pPerl->perl_callpv +#undef perl_callsv +#define perl_callsv pPerl->perl_callsv +#undef perl_eval_sv +#define perl_eval_sv pPerl->perl_eval_sv +#undef perl_get_sv +#define perl_get_sv pPerl->perl_get_sv +#undef perl_get_av +#define perl_get_av pPerl->perl_get_av +#undef perl_get_hv +#define perl_get_hv pPerl->perl_get_hv +#undef perl_get_cv +#define perl_get_cv pPerl->perl_get_cv +#undef perl_require_pv +#define perl_require_pv pPerl->perl_require_pv +#undef pidgone +#define pidgone pPerl->Perl_pidgone +#undef pmflag +#define pmflag pPerl->Perl_pmflag +#undef pmruntime +#define pmruntime pPerl->Perl_pmruntime +#undef pmtrans +#define pmtrans pPerl->Perl_pmtrans +#undef pop_return +#define pop_return pPerl->Perl_pop_return +#undef pop_scope +#define pop_scope pPerl->Perl_pop_scope +#undef prepend_elem +#define prepend_elem pPerl->Perl_prepend_elem +#undef push_return +#define push_return pPerl->Perl_push_return +#undef push_scope +#define push_scope pPerl->Perl_push_scope +#undef pregcomp +#define pregcomp pPerl->Perl_pregcomp +#undef ref +#define ref pPerl->Perl_ref +#undef refkids +#define refkids pPerl->Perl_refkids +#undef pregexec +#define pregexec pPerl->Perl_pregexec +#undef pregfree +#define pregfree pPerl->Perl_pregfree +#undef reganode +#define reganode pPerl->reganode +#undef regatom +#define regatom pPerl->regatom +#undef regbranch +#define regbranch pPerl->regbranch +#undef regc +#define regc pPerl->regc +#undef regclass +#define regclass pPerl->regclass +#undef regcppush +#define regcppush pPerl->regcppush +#undef regcppop +#define regcppop pPerl->regcppop +#undef reginsert +#define reginsert pPerl->reginsert +#undef regmatch +#define regmatch pPerl->regmatch +#undef regnext +#define regnext pPerl->Perl_regnext +#undef regoptail +#define regoptail pPerl->regoptail +#undef regpiece +#define regpiece pPerl->regpiece +#undef regrepeat +#define regrepeat pPerl->regrepeat +#undef regset +#define regset pPerl->regset +#undef regtail +#define regtail pPerl->regtail +#undef regtry +#define regtry pPerl->regtry +#undef repeatcpy +#define repeatcpy pPerl->Perl_repeatcpy +#undef rninstr +#define rninstr pPerl->Perl_rninstr +#undef run +#define run pPerl->Perl_run +#undef safefree +#define safefree pPerl->Perl_safefree +#undef safecalloc +#define safecalloc pPerl->Perl_safecalloc +#undef safemalloc +#define safemalloc pPerl->Perl_safemalloc +#undef saferealloc +#define saferealloc pPerl->Perl_saferealloc +#undef same_dirent +#define same_dirent pPerl->same_dirent +#undef savepv +#define savepv pPerl->Perl_savepv +#undef savepvn +#define savepvn pPerl->Perl_savepvn +#undef savestack_grow +#define savestack_grow pPerl->Perl_savestack_grow +#undef save_aptr +#define save_aptr pPerl->Perl_save_aptr +#undef save_ary +#define save_ary pPerl->Perl_save_ary +#undef save_clearsv +#define save_clearsv pPerl->Perl_save_clearsv +#undef save_delete +#define save_delete pPerl->Perl_save_delete +#undef save_freesv +#define save_freesv pPerl->Perl_save_freesv +#undef save_freeop +#define save_freeop pPerl->Perl_save_freeop +#undef save_freepv +#define save_freepv pPerl->Perl_save_freepv +#undef save_hash +#define save_hash pPerl->Perl_save_hash +#undef save_hptr +#define save_hptr pPerl->Perl_save_hptr +#undef save_I32 +#define save_I32 pPerl->Perl_save_I32 +#undef save_int +#define save_int pPerl->Perl_save_int +#undef save_item +#define save_item pPerl->Perl_save_item +#undef save_iv +#define save_iv pPerl->save_iv +#undef save_lines +#define save_lines pPerl->save_lines +#undef save_list +#define save_list pPerl->Perl_save_list +#undef save_long +#define save_long pPerl->Perl_save_long +#undef save_nogv +#define save_nogv pPerl->Perl_save_nogv +#undef save_scalar +#define save_scalar pPerl->Perl_save_scalar +#undef save_pptr +#define save_pptr pPerl->Perl_save_pptr +#undef save_sptr +#define save_sptr pPerl->Perl_save_sptr +#undef save_svref +#define save_svref pPerl->Perl_save_svref +#undef sawparens +#define sawparens pPerl->Perl_sawparens +#undef scalar +#define scalar pPerl->Perl_scalar +#undef scalarboolean +#define scalarboolean pPerl->scalarboolean +#undef scalarkids +#define scalarkids pPerl->Perl_scalarkids +#undef scalarseq +#define scalarseq pPerl->Perl_scalarseq +#undef scalarvoid +#define scalarvoid pPerl->Perl_scalarvoid +#undef scan_const +#define scan_const pPerl->Perl_scan_const +#undef scan_formline +#define scan_formline pPerl->Perl_scan_formline +#undef scan_ident +#define scan_ident pPerl->Perl_scan_ident +#undef scan_inputsymbol +#define scan_inputsymbol pPerl->Perl_scan_inputsymbol +#undef scan_heredoc +#define scan_heredoc pPerl->Perl_scan_heredoc +#undef scan_hex +#define scan_hex pPerl->Perl_scan_hex +#undef scan_num +#define scan_num pPerl->Perl_scan_num +#undef scan_oct +#define scan_oct pPerl->Perl_scan_oct +#undef scan_pat +#define scan_pat pPerl->Perl_scan_pat +#undef scan_str +#define scan_str pPerl->Perl_scan_str +#undef scan_subst +#define scan_subst pPerl->Perl_scan_subst +#undef scan_trans +#define scan_trans pPerl->Perl_scan_trans +#undef scope +#define scope pPerl->Perl_scope +#undef screaminstr +#define screaminstr pPerl->Perl_screaminstr +#undef sighandler +#define sighandler pPerl->Perl_sighandler +#undef skipspace +#define skipspace pPerl->Perl_skipspace +#undef sortcv +#define sortcv pPerl->sortcv +#undef sortcmp +#define sortcmp pPerl->sortcmp +#undef stack_grow +#define stack_grow pPerl->Perl_stack_grow +#undef start_subparse +#define start_subparse pPerl->Perl_start_subparse +#undef sublex_done +#define sublex_done pPerl->Perl_sublex_done +#undef sublex_start +#define sublex_start pPerl->Perl_sublex_start +#undef sv_2bool +#define sv_2bool pPerl->Perl_sv_2bool +#undef sv_2cv +#define sv_2cv pPerl->Perl_sv_2cv +#undef sv_2io +#define sv_2io pPerl->Perl_sv_2io +#undef sv_2iv +#define sv_2iv pPerl->Perl_sv_2iv +#undef sv_2mortal +#define sv_2mortal pPerl->Perl_sv_2mortal +#undef sv_2nv +#define sv_2nv pPerl->Perl_sv_2nv +#undef sv_2pv +#define sv_2pv pPerl->Perl_sv_2pv +#undef sv_add_arena +#define sv_add_arena pPerl->Perl_sv_add_arena +#undef sv_backoff +#define sv_backoff pPerl->Perl_sv_backoff +#undef sv_bless +#define sv_bless pPerl->Perl_sv_bless +#undef sv_catpv +#define sv_catpv pPerl->Perl_sv_catpv +#undef sv_catpvn +#define sv_catpvn pPerl->Perl_sv_catpvn +#undef sv_catsv +#define sv_catsv pPerl->Perl_sv_catsv +#undef sv_chop +#define sv_chop pPerl->Perl_sv_chop +#undef 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 +#undef sv_clear +#define sv_clear pPerl->Perl_sv_clear +#undef sv_cmp +#define sv_cmp pPerl->Perl_sv_cmp +#undef sv_dec +#define sv_dec pPerl->Perl_sv_dec +#undef sv_derived_from +#define sv_derived_from pPerl->Perl_sv_derived_from +#undef sv_dump +#define sv_dump pPerl->Perl_sv_dump +#undef sv_eq +#define sv_eq pPerl->Perl_sv_eq +#undef sv_free +#define sv_free pPerl->Perl_sv_free +#undef sv_free_arenas +#define sv_free_arenas pPerl->Perl_sv_free_arenas +#undef sv_gets +#define sv_gets pPerl->Perl_sv_gets +#undef sv_grow +#define sv_grow pPerl->Perl_sv_grow +#undef sv_inc +#define sv_inc pPerl->Perl_sv_inc +#undef sv_insert +#define sv_insert pPerl->Perl_sv_insert +#undef sv_isa +#define sv_isa pPerl->Perl_sv_isa +#undef sv_isobject +#define sv_isobject pPerl->Perl_sv_isobject +#undef sv_len +#define sv_len pPerl->Perl_sv_len +#undef 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 +#undef sv_newmortal +#define sv_newmortal pPerl->Perl_sv_newmortal +#undef sv_newref +#define sv_newref pPerl->Perl_sv_newref +#undef sv_pvn +#define sv_pvn pPerl->Perl_sv_pvn +#undef sv_pvn_force +#define sv_pvn_force pPerl->Perl_sv_pvn_force +#undef sv_reftype +#define sv_reftype pPerl->Perl_sv_reftype +#undef sv_replace +#define sv_replace pPerl->Perl_sv_replace +#undef sv_report_used +#define sv_report_used pPerl->Perl_sv_report_used +#undef sv_reset +#define sv_reset pPerl->Perl_sv_reset +#undef sv_setiv +#define sv_setiv pPerl->Perl_sv_setiv +#undef sv_setnv +#define sv_setnv pPerl->Perl_sv_setnv +#undef 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 +#undef 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_setpvn +#define sv_setpvn pPerl->Perl_sv_setpvn +#undef sv_setsv +#define sv_setsv pPerl->Perl_sv_setsv +#undef sv_unglob +#define sv_unglob pPerl->sv_unglob +#undef sv_unmagic +#define sv_unmagic pPerl->Perl_sv_unmagic +#undef sv_unref +#define sv_unref pPerl->Perl_sv_unref +#undef sv_upgrade +#define sv_upgrade pPerl->Perl_sv_upgrade +#undef sv_usepvn +#define sv_usepvn pPerl->Perl_sv_usepvn +#undef taint_env +#define taint_env pPerl->Perl_taint_env +#undef taint_not +#define taint_not pPerl->Perl_taint_not +#undef taint_proper +#define taint_proper pPerl->Perl_taint_proper +#undef too_few_arguments +#define too_few_arguments pPerl->Perl_too_few_arguments +#undef too_many_arguments +#define too_many_arguments pPerl->Perl_too_many_arguments +#undef warn +#define warn pPerl->Perl_warn + + +#undef SAVETMPS +#define SAVETMPS pPerl->SaveTmps() +#undef FREETMPS +#define FREETMPS pPerl->FreeTmps() + +#ifdef WIN32 +#undef errno +#define errno pPerl->ErrorNo() +#undef pVtbl +#define pVtbl (pPerl->GetpVtbl()) +#undef g_lpObj +#define g_lpObj pPerl->Perl_g_lpObj +#undef LastOLEError +#define LastOLEError pPerl->Perl_LastOLEError +#undef bOleInit +#define bOleInit pPerl->Perl_bOleInit +#undef CreatePerlOLEObject +#define CreatePerlOLEObject pPerl->CreatePerlOLEObject +#undef NtCrypt +#define NtCrypt pPerl->NtCrypt +#undef NtGetLib +#define NtGetLib pPerl->NtGetLib +#undef NtGetArchLib +#define NtGetArchLib pPerl->NtGetArchLib +#undef NtGetSiteLib +#define NtGetSiteLib pPerl->NtGetSiteLib +#undef NtGetBin +#define NtGetBin pPerl->NtGetBin +#undef NtGetDebugScriptStr +#define NtGetDebugScriptStr pPerl->NtGetDebugScriptStr +#endif /* WIN32 */ + +#endif /* __ObjXSub_h__ */ + @@ -1,7 +1,11 @@ #define ST(off) stack_base[ax + (off)] #ifdef CAN_PROTOTYPE +#ifdef PERL_OBJECT +#define XS(name) void name(CPerlObj* pPerl, CV* cv) +#else #define XS(name) void name(CV* cv) +#endif #else #define XS(name) void name(cv) CV* cv; #endif @@ -69,3 +73,7 @@ #else # define XS_VERSION_BOOTCHECK #endif + +#ifdef PERL_OBJECT +#include "ObjXSub.h" +#endif
\ No newline at end of file @@ -21,7 +21,7 @@ struct xpvcv { HV * xcv_stash; OP * xcv_start; OP * xcv_root; - void (*xcv_xsub) _((CV*)); + void (*xcv_xsub) _((CPERLproto_ CV*)); ANY xcv_xsubany; GV * xcv_gv; GV * xcv_filegv; @@ -76,7 +76,7 @@ #endif bool -do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawperm, FILE *supplied_fp) +do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp) { register IO *io = GvIOn(gv); PerlIO *saveifp = Nullfp; @@ -760,7 +760,7 @@ Off_t length; /* length to set file to */ #endif /* F_FREESP */ bool -do_print(register SV *sv, FILE *fp) +do_print(register SV *sv, PerlIO *fp) { register char *tmps; STRLEN len; @@ -127,6 +127,8 @@ * get to use the same RTL functions as the core. */ # ifndef HASATTRIBUTE -# include <win32iop.h> +# ifndef PERL_OBJECT +# include <win32iop.h> +# endif # endif #endif /* WIN32 */ @@ -22,11 +22,13 @@ dump_all(void) } #else /* Rest of file is for DEBUGGING */ +#ifndef PERL_OBJECT #ifdef I_STDARG static void dump(char *pat, ...); #else static void dump(); #endif +#endif /* PERL_OBJECT */ void dump_all(void) @@ -408,7 +410,7 @@ long arg2, arg3, arg4, arg5; #else #ifdef I_STDARG -static void +STATIC void dump(char *pat,...) #else /*VARARGS0*/ diff --git a/embedvar.h b/embedvar.h index f2f7f690c7..5d3e1d19c7 100644 --- a/embedvar.h +++ b/embedvar.h @@ -636,6 +636,7 @@ #define do_undump (Perl_Vars.Gdo_undump) #define egid (Perl_Vars.Gegid) #define error_count (Perl_Vars.Gerror_count) +#define error_no (Perl_Vars.Gerror_no) #define euid (Perl_Vars.Geuid) #define eval_cond (Perl_Vars.Geval_cond) #define eval_mutex (Perl_Vars.Geval_mutex) @@ -706,6 +707,7 @@ #define scrgv (Perl_Vars.Gscrgv) #define sh_path (Perl_Vars.Gsh_path) #define sighandlerp (Perl_Vars.Gsighandlerp) +#define sort_mutex (Perl_Vars.Gsort_mutex) #define sub_generation (Perl_Vars.Gsub_generation) #define subline (Perl_Vars.Gsubline) #define subname (Perl_Vars.Gsubname) @@ -754,6 +756,7 @@ #define Gdo_undump do_undump #define Gegid egid #define Gerror_count error_count +#define Gerror_no error_no #define Geuid euid #define Geval_cond eval_cond #define Geval_mutex eval_mutex @@ -824,6 +827,7 @@ #define Gscrgv scrgv #define Gsh_path sh_path #define Gsighandlerp sighandlerp +#define Gsort_mutex sort_mutex #define Gsub_generation sub_generation #define Gsubline subline #define Gsubname subname @@ -872,6 +876,7 @@ #define do_undump Perl_do_undump #define egid Perl_egid #define error_count Perl_error_count +#define error_no Perl_error_no #define euid Perl_euid #define eval_cond Perl_eval_cond #define eval_mutex Perl_eval_mutex @@ -942,6 +947,7 @@ #define scrgv Perl_scrgv #define sh_path Perl_sh_path #define sighandlerp Perl_sighandlerp +#define sort_mutex Perl_sort_mutex #define sub_generation Perl_sub_generation #define subline Perl_subline #define subname Perl_subname @@ -1,2 +1,1502 @@ #include "INTERN.h" #include "perl.h" + +#ifdef PERL_OBJECT +#undef pp_null +#define pp_null CPerlObj::Perl_pp_null +#undef pp_stub +#define pp_stub CPerlObj::Perl_pp_stub +#undef pp_scalar +#define pp_scalar CPerlObj::Perl_pp_scalar +#undef pp_pushmark +#define pp_pushmark CPerlObj::Perl_pp_pushmark +#undef pp_wantarray +#define pp_wantarray CPerlObj::Perl_pp_wantarray +#undef pp_const +#define pp_const CPerlObj::Perl_pp_const +#undef pp_gvsv +#define pp_gvsv CPerlObj::Perl_pp_gvsv +#undef pp_gv +#define pp_gv CPerlObj::Perl_pp_gv +#undef pp_gelem +#define pp_gelem CPerlObj::Perl_pp_gelem +#undef pp_padsv +#define pp_padsv CPerlObj::Perl_pp_padsv +#undef pp_padav +#define pp_padav CPerlObj::Perl_pp_padav +#undef pp_padhv +#define pp_padhv CPerlObj::Perl_pp_padhv +#undef pp_padany +#define pp_padany CPerlObj::Perl_pp_padany +#undef pp_pushre +#define pp_pushre CPerlObj::Perl_pp_pushre +#undef pp_rv2gv +#define pp_rv2gv CPerlObj::Perl_pp_rv2gv +#undef pp_rv2sv +#define pp_rv2sv CPerlObj::Perl_pp_rv2sv +#undef pp_av2arylen +#define pp_av2arylen CPerlObj::Perl_pp_av2arylen +#undef pp_rv2cv +#define pp_rv2cv CPerlObj::Perl_pp_rv2cv +#undef pp_anoncode +#define pp_anoncode CPerlObj::Perl_pp_anoncode +#undef pp_prototype +#define pp_prototype CPerlObj::Perl_pp_prototype +#undef pp_refgen +#define pp_refgen CPerlObj::Perl_pp_refgen +#undef pp_srefgen +#define pp_srefgen CPerlObj::Perl_pp_srefgen +#undef pp_ref +#define pp_ref CPerlObj::Perl_pp_ref +#undef pp_bless +#define pp_bless CPerlObj::Perl_pp_bless +#undef pp_backtick +#define pp_backtick CPerlObj::Perl_pp_backtick +#undef pp_glob +#define pp_glob CPerlObj::Perl_pp_glob +#undef pp_readline +#define pp_readline CPerlObj::Perl_pp_readline +#undef pp_rcatline +#define pp_rcatline CPerlObj::Perl_pp_rcatline +#undef pp_regcmaybe +#define pp_regcmaybe CPerlObj::Perl_pp_regcmaybe +#undef pp_regcomp +#define pp_regcomp CPerlObj::Perl_pp_regcomp +#undef pp_match +#define pp_match CPerlObj::Perl_pp_match +#undef pp_subst +#define pp_subst CPerlObj::Perl_pp_subst +#undef pp_substcont +#define pp_substcont CPerlObj::Perl_pp_substcont +#undef pp_trans +#define pp_trans CPerlObj::Perl_pp_trans +#undef pp_sassign +#define pp_sassign CPerlObj::Perl_pp_sassign +#undef pp_aassign +#define pp_aassign CPerlObj::Perl_pp_aassign +#undef pp_chop +#define pp_chop CPerlObj::Perl_pp_chop +#undef pp_schop +#define pp_schop CPerlObj::Perl_pp_schop +#undef pp_chomp +#define pp_chomp CPerlObj::Perl_pp_chomp +#undef pp_schomp +#define pp_schomp CPerlObj::Perl_pp_schomp +#undef pp_defined +#define pp_defined CPerlObj::Perl_pp_defined +#undef pp_undef +#define pp_undef CPerlObj::Perl_pp_undef +#undef pp_study +#define pp_study CPerlObj::Perl_pp_study +#undef pp_pos +#define pp_pos CPerlObj::Perl_pp_pos +#undef pp_preinc +#define pp_preinc CPerlObj::Perl_pp_preinc +#undef pp_i_preinc +#define pp_i_preinc CPerlObj::Perl_pp_preinc +#undef pp_predec +#define pp_predec CPerlObj::Perl_pp_predec +#undef pp_i_predec +#define pp_i_predec CPerlObj::Perl_pp_predec +#undef pp_postinc +#define pp_postinc CPerlObj::Perl_pp_postinc +#undef pp_i_postinc +#define pp_i_postinc CPerlObj::Perl_pp_postinc +#undef pp_postdec +#define pp_postdec CPerlObj::Perl_pp_postdec +#undef pp_i_postdec +#define pp_i_postdec CPerlObj::Perl_pp_postdec +#undef pp_pow +#define pp_pow CPerlObj::Perl_pp_pow +#undef pp_multiply +#define pp_multiply CPerlObj::Perl_pp_multiply +#undef pp_i_multiply +#define pp_i_multiply CPerlObj::Perl_pp_i_multiply +#undef pp_divide +#define pp_divide CPerlObj::Perl_pp_divide +#undef pp_i_divide +#define pp_i_divide CPerlObj::Perl_pp_i_divide +#undef pp_modulo +#define pp_modulo CPerlObj::Perl_pp_modulo +#undef pp_i_modulo +#define pp_i_modulo CPerlObj::Perl_pp_i_modulo +#undef pp_repeat +#define pp_repeat CPerlObj::Perl_pp_repeat +#undef pp_add +#define pp_add CPerlObj::Perl_pp_add +#undef pp_i_add +#define pp_i_add CPerlObj::Perl_pp_i_add +#undef pp_subtract +#define pp_subtract CPerlObj::Perl_pp_subtract +#undef pp_i_subtract +#define pp_i_subtract CPerlObj::Perl_pp_i_subtract +#undef pp_concat +#define pp_concat CPerlObj::Perl_pp_concat +#undef pp_stringify +#define pp_stringify CPerlObj::Perl_pp_stringify +#undef pp_left_shift +#define pp_left_shift CPerlObj::Perl_pp_left_shift +#undef pp_right_shift +#define pp_right_shift CPerlObj::Perl_pp_right_shift +#undef pp_lt +#define pp_lt CPerlObj::Perl_pp_lt +#undef pp_i_lt +#define pp_i_lt CPerlObj::Perl_pp_i_lt +#undef pp_gt +#define pp_gt CPerlObj::Perl_pp_gt +#undef pp_i_gt +#define pp_i_gt CPerlObj::Perl_pp_i_gt +#undef pp_le +#define pp_le CPerlObj::Perl_pp_le +#undef pp_i_le +#define pp_i_le CPerlObj::Perl_pp_i_le +#undef pp_ge +#define pp_ge CPerlObj::Perl_pp_ge +#undef pp_i_ge +#define pp_i_ge CPerlObj::Perl_pp_i_ge +#undef pp_eq +#define pp_eq CPerlObj::Perl_pp_eq +#undef pp_i_eq +#define pp_i_eq CPerlObj::Perl_pp_i_eq +#undef pp_ne +#define pp_ne CPerlObj::Perl_pp_ne +#undef pp_i_ne +#define pp_i_ne CPerlObj::Perl_pp_i_ne +#undef pp_ncmp +#define pp_ncmp CPerlObj::Perl_pp_ncmp +#undef pp_i_ncmp +#define pp_i_ncmp CPerlObj::Perl_pp_i_ncmp +#undef pp_slt +#define pp_slt CPerlObj::Perl_pp_slt +#undef pp_sgt +#define pp_sgt CPerlObj::Perl_pp_sgt +#undef pp_sle +#define pp_sle CPerlObj::Perl_pp_sle +#undef pp_sge +#define pp_sge CPerlObj::Perl_pp_sge +#undef pp_seq +#define pp_seq CPerlObj::Perl_pp_seq +#undef pp_sne +#define pp_sne CPerlObj::Perl_pp_sne +#undef pp_scmp +#define pp_scmp CPerlObj::Perl_pp_scmp +#undef pp_bit_and +#define pp_bit_and CPerlObj::Perl_pp_bit_and +#undef pp_bit_xor +#define pp_bit_xor CPerlObj::Perl_pp_bit_xor +#undef pp_bit_or +#define pp_bit_or CPerlObj::Perl_pp_bit_or +#undef pp_negate +#define pp_negate CPerlObj::Perl_pp_negate +#undef pp_i_negate +#define pp_i_negate CPerlObj::Perl_pp_i_negate +#undef pp_not +#define pp_not CPerlObj::Perl_pp_not +#undef pp_complement +#define pp_complement CPerlObj::Perl_pp_complement +#undef pp_atan2 +#define pp_atan2 CPerlObj::Perl_pp_atan2 +#undef pp_sin +#define pp_sin CPerlObj::Perl_pp_sin +#undef pp_cos +#define pp_cos CPerlObj::Perl_pp_cos +#undef pp_rand +#define pp_rand CPerlObj::Perl_pp_rand +#undef pp_srand +#define pp_srand CPerlObj::Perl_pp_srand +#undef pp_exp +#define pp_exp CPerlObj::Perl_pp_exp +#undef pp_log +#define pp_log CPerlObj::Perl_pp_log +#undef pp_sqrt +#define pp_sqrt CPerlObj::Perl_pp_sqrt +#undef pp_int +#define pp_int CPerlObj::Perl_pp_int +#undef pp_hex +#define pp_hex CPerlObj::Perl_pp_hex +#undef pp_oct +#define pp_oct CPerlObj::Perl_pp_oct +#undef pp_abs +#define pp_abs CPerlObj::Perl_pp_abs +#undef pp_length +#define pp_length CPerlObj::Perl_pp_length +#undef pp_substr +#define pp_substr CPerlObj::Perl_pp_substr +#undef pp_vec +#define pp_vec CPerlObj::Perl_pp_vec +#undef pp_index +#define pp_index CPerlObj::Perl_pp_index +#undef pp_rindex +#define pp_rindex CPerlObj::Perl_pp_rindex +#undef pp_sprintf +#define pp_sprintf CPerlObj::Perl_pp_sprintf +#undef pp_formline +#define pp_formline CPerlObj::Perl_pp_formline +#undef pp_ord +#define pp_ord CPerlObj::Perl_pp_ord +#undef pp_chr +#define pp_chr CPerlObj::Perl_pp_chr +#undef pp_crypt +#define pp_crypt CPerlObj::Perl_pp_crypt +#undef pp_ucfirst +#define pp_ucfirst CPerlObj::Perl_pp_ucfirst +#undef pp_lcfirst +#define pp_lcfirst CPerlObj::Perl_pp_lcfirst +#undef pp_uc +#define pp_uc CPerlObj::Perl_pp_uc +#undef pp_lc +#define pp_lc CPerlObj::Perl_pp_lc +#undef pp_quotemeta +#define pp_quotemeta CPerlObj::Perl_pp_quotemeta +#undef pp_rv2av +#define pp_rv2av CPerlObj::Perl_pp_rv2av +#undef pp_aelemfast +#define pp_aelemfast CPerlObj::Perl_pp_aelemfast +#undef pp_aelem +#define pp_aelem CPerlObj::Perl_pp_aelem +#undef pp_aslice +#define pp_aslice CPerlObj::Perl_pp_aslice +#undef pp_each +#define pp_each CPerlObj::Perl_pp_each +#undef pp_values +#define pp_values CPerlObj::Perl_pp_values +#undef pp_keys +#define pp_keys CPerlObj::Perl_pp_keys +#undef pp_delete +#define pp_delete CPerlObj::Perl_pp_delete +#undef pp_exists +#define pp_exists CPerlObj::Perl_pp_exists +#undef pp_rv2hv +#define pp_rv2hv CPerlObj::Perl_pp_rv2hv +#undef pp_helem +#define pp_helem CPerlObj::Perl_pp_helem +#undef pp_hslice +#define pp_hslice CPerlObj::Perl_pp_hslice +#undef pp_unpack +#define pp_unpack CPerlObj::Perl_pp_unpack +#undef pp_pack +#define pp_pack CPerlObj::Perl_pp_pack +#undef pp_split +#define pp_split CPerlObj::Perl_pp_split +#undef pp_join +#define pp_join CPerlObj::Perl_pp_join +#undef pp_list +#define pp_list CPerlObj::Perl_pp_list +#undef pp_lslice +#define pp_lslice CPerlObj::Perl_pp_lslice +#undef pp_anonlist +#define pp_anonlist CPerlObj::Perl_pp_anonlist +#undef pp_anonhash +#define pp_anonhash CPerlObj::Perl_pp_anonhash +#undef pp_splice +#define pp_splice CPerlObj::Perl_pp_splice +#undef pp_push +#define pp_push CPerlObj::Perl_pp_push +#undef pp_pop +#define pp_pop CPerlObj::Perl_pp_pop +#undef pp_shift +#define pp_shift CPerlObj::Perl_pp_shift +#undef pp_unshift +#define pp_unshift CPerlObj::Perl_pp_unshift +#undef pp_sort +#define pp_sort CPerlObj::Perl_pp_sort +#undef pp_reverse +#define pp_reverse CPerlObj::Perl_pp_reverse +#undef pp_grepstart +#define pp_grepstart CPerlObj::Perl_pp_grepstart +#undef pp_grepwhile +#define pp_grepwhile CPerlObj::Perl_pp_grepwhile +#undef pp_mapstart +#define pp_mapstart CPerlObj::Perl_pp_mapstart +#undef pp_mapwhile +#define pp_mapwhile CPerlObj::Perl_pp_mapwhile +#undef pp_range +#define pp_range CPerlObj::Perl_pp_range +#undef pp_flip +#define pp_flip CPerlObj::Perl_pp_flip +#undef pp_flop +#define pp_flop CPerlObj::Perl_pp_flop +#undef pp_and +#define pp_and CPerlObj::Perl_pp_and +#undef pp_or +#define pp_or CPerlObj::Perl_pp_or +#undef pp_xor +#define pp_xor CPerlObj::Perl_pp_xor +#undef pp_cond_expr +#define pp_cond_expr CPerlObj::Perl_pp_cond_expr +#undef pp_andassign +#define pp_andassign CPerlObj::Perl_pp_andassign +#undef pp_orassign +#define pp_orassign CPerlObj::Perl_pp_orassign +#undef pp_method +#define pp_method CPerlObj::Perl_pp_method +#undef pp_entersub +#define pp_entersub CPerlObj::Perl_pp_entersub +#undef pp_leavesub +#define pp_leavesub CPerlObj::Perl_pp_leavesub +#undef pp_caller +#define pp_caller CPerlObj::Perl_pp_caller +#undef pp_warn +#define pp_warn CPerlObj::Perl_pp_warn +#undef pp_die +#define pp_die CPerlObj::Perl_pp_die +#undef pp_reset +#define pp_reset CPerlObj::Perl_pp_reset +#undef pp_lineseq +#define pp_lineseq CPerlObj::Perl_pp_lineseq +#undef pp_nextstate +#define pp_nextstate CPerlObj::Perl_pp_nextstate +#undef pp_dbstate +#define pp_dbstate CPerlObj::Perl_pp_dbstate +#undef pp_unstack +#define pp_unstack CPerlObj::Perl_pp_unstack +#undef pp_enter +#define pp_enter CPerlObj::Perl_pp_enter +#undef pp_leave +#define pp_leave CPerlObj::Perl_pp_leave +#undef pp_scope +#define pp_scope CPerlObj::Perl_pp_scope +#undef pp_enteriter +#define pp_enteriter CPerlObj::Perl_pp_enteriter +#undef pp_iter +#define pp_iter CPerlObj::Perl_pp_iter +#undef pp_enterloop +#define pp_enterloop CPerlObj::Perl_pp_enterloop +#undef pp_leaveloop +#define pp_leaveloop CPerlObj::Perl_pp_leaveloop +#undef pp_return +#define pp_return CPerlObj::Perl_pp_return +#undef pp_last +#define pp_last CPerlObj::Perl_pp_last +#undef pp_next +#define pp_next CPerlObj::Perl_pp_next +#undef pp_redo +#define pp_redo CPerlObj::Perl_pp_redo +#undef pp_dump +#define pp_dump CPerlObj::Perl_pp_dump +#undef pp_goto +#define pp_goto CPerlObj::Perl_pp_goto +#undef pp_exit +#define pp_exit CPerlObj::Perl_pp_exit +#undef pp_open +#define pp_open CPerlObj::Perl_pp_open +#undef pp_close +#define pp_close CPerlObj::Perl_pp_close +#undef pp_pipe_op +#define pp_pipe_op CPerlObj::Perl_pp_pipe_op +#undef pp_fileno +#define pp_fileno CPerlObj::Perl_pp_fileno +#undef pp_umask +#define pp_umask CPerlObj::Perl_pp_umask +#undef pp_binmode +#define pp_binmode CPerlObj::Perl_pp_binmode +#undef pp_tie +#define pp_tie CPerlObj::Perl_pp_tie +#undef pp_untie +#define pp_untie CPerlObj::Perl_pp_untie +#undef pp_tied +#define pp_tied CPerlObj::Perl_pp_tied +#undef pp_dbmopen +#define pp_dbmopen CPerlObj::Perl_pp_dbmopen +#undef pp_dbmclose +#define pp_dbmclose CPerlObj::Perl_pp_dbmclose +#undef pp_sselect +#define pp_sselect CPerlObj::Perl_pp_sselect +#undef pp_select +#define pp_select CPerlObj::Perl_pp_select +#undef pp_getc +#define pp_getc CPerlObj::Perl_pp_getc +#undef pp_read +#define pp_read CPerlObj::Perl_pp_read +#undef pp_enterwrite +#define pp_enterwrite CPerlObj::Perl_pp_enterwrite +#undef pp_leavewrite +#define pp_leavewrite CPerlObj::Perl_pp_leavewrite +#undef pp_prtf +#define pp_prtf CPerlObj::Perl_pp_prtf +#undef pp_print +#define pp_print CPerlObj::Perl_pp_print +#undef pp_sysopen +#define pp_sysopen CPerlObj::Perl_pp_sysopen +#undef pp_sysseek +#define pp_sysseek CPerlObj::Perl_pp_sysseek +#undef pp_sysread +#define pp_sysread CPerlObj::Perl_pp_sysread +#undef pp_syswrite +#define pp_syswrite CPerlObj::Perl_pp_syswrite +#undef pp_send +#define pp_send CPerlObj::Perl_pp_send +#undef pp_recv +#define pp_recv CPerlObj::Perl_pp_recv +#undef pp_eof +#define pp_eof CPerlObj::Perl_pp_eof +#undef pp_tell +#define pp_tell CPerlObj::Perl_pp_tell +#undef pp_seek +#define pp_seek CPerlObj::Perl_pp_seek +#undef pp_truncate +#define pp_truncate CPerlObj::Perl_pp_truncate +#undef pp_fcntl +#define pp_fcntl CPerlObj::Perl_pp_fcntl +#undef pp_ioctl +#define pp_ioctl CPerlObj::Perl_pp_ioctl +#undef pp_flock +#define pp_flock CPerlObj::Perl_pp_flock +#undef pp_socket +#define pp_socket CPerlObj::Perl_pp_socket +#undef pp_sockpair +#define pp_sockpair CPerlObj::Perl_pp_sockpair +#undef pp_bind +#define pp_bind CPerlObj::Perl_pp_bind +#undef pp_connect +#define pp_connect CPerlObj::Perl_pp_connect +#undef pp_listen +#define pp_listen CPerlObj::Perl_pp_listen +#undef pp_accept +#define pp_accept CPerlObj::Perl_pp_accept +#undef pp_shutdown +#define pp_shutdown CPerlObj::Perl_pp_shutdown +#undef pp_gsockopt +#define pp_gsockopt CPerlObj::Perl_pp_gsockopt +#undef pp_ssockopt +#define pp_ssockopt CPerlObj::Perl_pp_ssockopt +#undef pp_getsockname +#define pp_getsockname CPerlObj::Perl_pp_getsockname +#undef pp_getpeername +#define pp_getpeername CPerlObj::Perl_pp_getpeername +#undef pp_lstat +#define pp_lstat CPerlObj::Perl_pp_lstat +#undef pp_stat +#define pp_stat CPerlObj::Perl_pp_stat +#undef pp_ftrread +#define pp_ftrread CPerlObj::Perl_pp_ftrread +#undef pp_ftrwrite +#define pp_ftrwrite CPerlObj::Perl_pp_ftrwrite +#undef pp_ftrexec +#define pp_ftrexec CPerlObj::Perl_pp_ftrexec +#undef pp_fteread +#define pp_fteread CPerlObj::Perl_pp_fteread +#undef pp_ftewrite +#define pp_ftewrite CPerlObj::Perl_pp_ftewrite +#undef pp_fteexec +#define pp_fteexec CPerlObj::Perl_pp_fteexec +#undef pp_ftis +#define pp_ftis CPerlObj::Perl_pp_ftis +#undef pp_fteowned +#define pp_fteowned CPerlObj::Perl_pp_fteowned +#undef pp_ftrowned +#define pp_ftrowned CPerlObj::Perl_pp_ftrowned +#undef pp_ftzero +#define pp_ftzero CPerlObj::Perl_pp_ftzero +#undef pp_ftsize +#define pp_ftsize CPerlObj::Perl_pp_ftsize +#undef pp_ftmtime +#define pp_ftmtime CPerlObj::Perl_pp_ftmtime +#undef pp_ftatime +#define pp_ftatime CPerlObj::Perl_pp_ftatime +#undef pp_ftctime +#define pp_ftctime CPerlObj::Perl_pp_ftctime +#undef pp_ftsock +#define pp_ftsock CPerlObj::Perl_pp_ftsock +#undef pp_ftchr +#define pp_ftchr CPerlObj::Perl_pp_ftchr +#undef pp_ftblk +#define pp_ftblk CPerlObj::Perl_pp_ftblk +#undef pp_ftfile +#define pp_ftfile CPerlObj::Perl_pp_ftfile +#undef pp_ftdir +#define pp_ftdir CPerlObj::Perl_pp_ftdir +#undef pp_ftpipe +#define pp_ftpipe CPerlObj::Perl_pp_ftpipe +#undef pp_ftlink +#define pp_ftlink CPerlObj::Perl_pp_ftlink +#undef pp_ftsuid +#define pp_ftsuid CPerlObj::Perl_pp_ftsuid +#undef pp_ftsgid +#define pp_ftsgid CPerlObj::Perl_pp_ftsgid +#undef pp_ftsvtx +#define pp_ftsvtx CPerlObj::Perl_pp_ftsvtx +#undef pp_fttty +#define pp_fttty CPerlObj::Perl_pp_fttty +#undef pp_fttext +#define pp_fttext CPerlObj::Perl_pp_fttext +#undef pp_ftbinary +#define pp_ftbinary CPerlObj::Perl_pp_ftbinary +#undef pp_chdir +#define pp_chdir CPerlObj::Perl_pp_chdir +#undef pp_chown +#define pp_chown CPerlObj::Perl_pp_chown +#undef pp_chroot +#define pp_chroot CPerlObj::Perl_pp_chroot +#undef pp_unlink +#define pp_unlink CPerlObj::Perl_pp_unlink +#undef pp_chmod +#define pp_chmod CPerlObj::Perl_pp_chmod +#undef pp_utime +#define pp_utime CPerlObj::Perl_pp_utime +#undef pp_rename +#define pp_rename CPerlObj::Perl_pp_rename +#undef pp_link +#define pp_link CPerlObj::Perl_pp_link +#undef pp_symlink +#define pp_symlink CPerlObj::Perl_pp_symlink +#undef pp_readlink +#define pp_readlink CPerlObj::Perl_pp_readlink +#undef pp_mkdir +#define pp_mkdir CPerlObj::Perl_pp_mkdir +#undef pp_rmdir +#define pp_rmdir CPerlObj::Perl_pp_rmdir +#undef pp_open_dir +#define pp_open_dir CPerlObj::Perl_pp_open_dir +#undef pp_readdir +#define pp_readdir CPerlObj::Perl_pp_readdir +#undef pp_telldir +#define pp_telldir CPerlObj::Perl_pp_telldir +#undef pp_seekdir +#define pp_seekdir CPerlObj::Perl_pp_seekdir +#undef pp_rewinddir +#define pp_rewinddir CPerlObj::Perl_pp_rewinddir +#undef pp_closedir +#define pp_closedir CPerlObj::Perl_pp_closedir +#undef pp_fork +#define pp_fork CPerlObj::Perl_pp_fork +#undef pp_wait +#define pp_wait CPerlObj::Perl_pp_wait +#undef pp_waitpid +#define pp_waitpid CPerlObj::Perl_pp_waitpid +#undef pp_system +#define pp_system CPerlObj::Perl_pp_system +#undef pp_exec +#define pp_exec CPerlObj::Perl_pp_exec +#undef pp_kill +#define pp_kill CPerlObj::Perl_pp_kill +#undef pp_getppid +#define pp_getppid CPerlObj::Perl_pp_getppid +#undef pp_getpgrp +#define pp_getpgrp CPerlObj::Perl_pp_getpgrp +#undef pp_setpgrp +#define pp_setpgrp CPerlObj::Perl_pp_setpgrp +#undef pp_getpriority +#define pp_getpriority CPerlObj::Perl_pp_getpriority +#undef pp_setpriority +#define pp_setpriority CPerlObj::Perl_pp_setpriority +#undef pp_time +#define pp_time CPerlObj::Perl_pp_time +#undef pp_tms +#define pp_tms CPerlObj::Perl_pp_tms +#undef pp_localtime +#define pp_localtime CPerlObj::Perl_pp_localtime +#undef pp_gmtime +#define pp_gmtime CPerlObj::Perl_pp_gmtime +#undef pp_alarm +#define pp_alarm CPerlObj::Perl_pp_alarm +#undef pp_sleep +#define pp_sleep CPerlObj::Perl_pp_sleep +#undef pp_shmget +#define pp_shmget CPerlObj::Perl_pp_shmget +#undef pp_shmctl +#define pp_shmctl CPerlObj::Perl_pp_shmctl +#undef pp_shmread +#define pp_shmread CPerlObj::Perl_pp_shmread +#undef pp_shmwrite +#define pp_shmwrite CPerlObj::Perl_pp_shmwrite +#undef pp_msgget +#define pp_msgget CPerlObj::Perl_pp_msgget +#undef pp_msgctl +#define pp_msgctl CPerlObj::Perl_pp_msgctl +#undef pp_msgsnd +#define pp_msgsnd CPerlObj::Perl_pp_msgsnd +#undef pp_msgrcv +#define pp_msgrcv CPerlObj::Perl_pp_msgrcv +#undef pp_semget +#define pp_semget CPerlObj::Perl_pp_semget +#undef pp_semctl +#define pp_semctl CPerlObj::Perl_pp_semctl +#undef pp_semop +#define pp_semop CPerlObj::Perl_pp_semop +#undef pp_require +#define pp_require CPerlObj::Perl_pp_require +#undef pp_dofile +#define pp_dofile CPerlObj::Perl_pp_dofile +#undef pp_entereval +#define pp_entereval CPerlObj::Perl_pp_entereval +#undef pp_leaveeval +#define pp_leaveeval CPerlObj::Perl_pp_leaveeval +#undef pp_entertry +#define pp_entertry CPerlObj::Perl_pp_entertry +#undef pp_leavetry +#define pp_leavetry CPerlObj::Perl_pp_leavetry +#undef pp_ghbyname +#define pp_ghbyname CPerlObj::Perl_pp_ghbyname +#undef pp_ghbyaddr +#define pp_ghbyaddr CPerlObj::Perl_pp_ghbyaddr +#undef pp_ghostent +#define pp_ghostent CPerlObj::Perl_pp_ghostent +#undef pp_gnbyname +#define pp_gnbyname CPerlObj::Perl_pp_gnbyname +#undef pp_gnbyaddr +#define pp_gnbyaddr CPerlObj::Perl_pp_gnbyaddr +#undef pp_gnetent +#define pp_gnetent CPerlObj::Perl_pp_gnetent +#undef pp_gpbyname +#define pp_gpbyname CPerlObj::Perl_pp_gpbyname +#undef pp_gpbynumber +#define pp_gpbynumber CPerlObj::Perl_pp_gpbynumber +#undef pp_gprotoent +#define pp_gprotoent CPerlObj::Perl_pp_gprotoent +#undef pp_gsbyname +#define pp_gsbyname CPerlObj::Perl_pp_gsbyname +#undef pp_gsbyport +#define pp_gsbyport CPerlObj::Perl_pp_gsbyport +#undef pp_gservent +#define pp_gservent CPerlObj::Perl_pp_gservent +#undef pp_shostent +#define pp_shostent CPerlObj::Perl_pp_shostent +#undef pp_snetent +#define pp_snetent CPerlObj::Perl_pp_snetent +#undef pp_sprotoent +#define pp_sprotoent CPerlObj::Perl_pp_sprotoent +#undef pp_sservent +#define pp_sservent CPerlObj::Perl_pp_sservent +#undef pp_ehostent +#define pp_ehostent CPerlObj::Perl_pp_ehostent +#undef pp_enetent +#define pp_enetent CPerlObj::Perl_pp_enetent +#undef pp_eprotoent +#define pp_eprotoent CPerlObj::Perl_pp_eprotoent +#undef pp_eservent +#define pp_eservent CPerlObj::Perl_pp_eservent +#undef pp_gpwnam +#define pp_gpwnam CPerlObj::Perl_pp_gpwnam +#undef pp_gpwuid +#define pp_gpwuid CPerlObj::Perl_pp_gpwuid +#undef pp_gpwent +#define pp_gpwent CPerlObj::Perl_pp_gpwent +#undef pp_spwent +#define pp_spwent CPerlObj::Perl_pp_spwent +#undef pp_epwent +#define pp_epwent CPerlObj::Perl_pp_epwent +#undef pp_ggrnam +#define pp_ggrnam CPerlObj::Perl_pp_ggrnam +#undef pp_ggrgid +#define pp_ggrgid CPerlObj::Perl_pp_ggrgid +#undef pp_ggrent +#define pp_ggrent CPerlObj::Perl_pp_ggrent +#undef pp_sgrent +#define pp_sgrent CPerlObj::Perl_pp_sgrent +#undef pp_egrent +#define pp_egrent CPerlObj::Perl_pp_egrent +#undef pp_getlogin +#define pp_getlogin CPerlObj::Perl_pp_getlogin +#undef pp_syscall +#define pp_syscall CPerlObj::Perl_pp_syscall +#undef pp_lock +#define pp_lock CPerlObj::Perl_pp_lock +#undef pp_threadsv +#define pp_threadsv CPerlObj::Perl_pp_threadsv + +OP * (CPERLscope(*check)[]) _((OP *op)) = { + ck_null, /* null */ + ck_null, /* stub */ + ck_fun, /* scalar */ + ck_null, /* pushmark */ + ck_null, /* wantarray */ + ck_svconst, /* const */ + ck_null, /* gvsv */ + ck_null, /* gv */ + ck_null, /* gelem */ + ck_null, /* padsv */ + ck_null, /* padav */ + ck_null, /* padhv */ + ck_null, /* padany */ + ck_null, /* pushre */ + ck_rvconst, /* rv2gv */ + ck_rvconst, /* rv2sv */ + ck_null, /* av2arylen */ + ck_rvconst, /* rv2cv */ + ck_anoncode, /* anoncode */ + ck_null, /* prototype */ + ck_spair, /* refgen */ + ck_null, /* srefgen */ + ck_fun, /* ref */ + ck_fun, /* bless */ + ck_null, /* backtick */ + ck_glob, /* glob */ + ck_null, /* readline */ + ck_null, /* rcatline */ + ck_fun, /* regcmaybe */ + ck_null, /* regcomp */ + ck_match, /* match */ + ck_null, /* subst */ + ck_null, /* substcont */ + ck_null, /* trans */ + ck_null, /* sassign */ + ck_null, /* aassign */ + ck_spair, /* chop */ + ck_null, /* schop */ + ck_spair, /* chomp */ + ck_null, /* schomp */ + ck_rfun, /* defined */ + ck_lfun, /* undef */ + ck_fun, /* study */ + ck_lfun, /* pos */ + ck_lfun, /* preinc */ + ck_lfun, /* i_preinc */ + ck_lfun, /* predec */ + ck_lfun, /* i_predec */ + ck_lfun, /* postinc */ + ck_lfun, /* i_postinc */ + ck_lfun, /* postdec */ + ck_lfun, /* i_postdec */ + ck_null, /* pow */ + ck_null, /* multiply */ + ck_null, /* i_multiply */ + ck_null, /* divide */ + ck_null, /* i_divide */ + ck_null, /* modulo */ + ck_null, /* i_modulo */ + ck_repeat, /* repeat */ + ck_null, /* add */ + ck_null, /* i_add */ + ck_null, /* subtract */ + ck_null, /* i_subtract */ + ck_concat, /* concat */ + ck_fun, /* stringify */ + ck_bitop, /* left_shift */ + ck_bitop, /* right_shift */ + ck_null, /* lt */ + ck_null, /* i_lt */ + ck_null, /* gt */ + ck_null, /* i_gt */ + ck_null, /* le */ + ck_null, /* i_le */ + ck_null, /* ge */ + ck_null, /* i_ge */ + ck_null, /* eq */ + ck_null, /* i_eq */ + ck_null, /* ne */ + ck_null, /* i_ne */ + ck_null, /* ncmp */ + ck_null, /* i_ncmp */ + ck_scmp, /* slt */ + ck_scmp, /* sgt */ + ck_scmp, /* sle */ + ck_scmp, /* sge */ + ck_null, /* seq */ + ck_null, /* sne */ + ck_scmp, /* scmp */ + ck_bitop, /* bit_and */ + ck_bitop, /* bit_xor */ + ck_bitop, /* bit_or */ + ck_null, /* negate */ + ck_null, /* i_negate */ + ck_null, /* not */ + ck_bitop, /* complement */ + ck_fun, /* atan2 */ + ck_fun, /* sin */ + ck_fun, /* cos */ + ck_fun, /* rand */ + ck_fun, /* srand */ + ck_fun, /* exp */ + ck_fun, /* log */ + ck_fun, /* sqrt */ + ck_fun, /* int */ + ck_fun, /* hex */ + ck_fun, /* oct */ + ck_fun, /* abs */ + ck_lengthconst, /* length */ + ck_fun, /* substr */ + ck_fun, /* vec */ + ck_index, /* index */ + ck_index, /* rindex */ + ck_fun_locale, /* sprintf */ + ck_fun, /* formline */ + ck_fun, /* ord */ + ck_fun, /* chr */ + ck_fun, /* crypt */ + ck_fun_locale, /* ucfirst */ + ck_fun_locale, /* lcfirst */ + ck_fun_locale, /* uc */ + ck_fun_locale, /* lc */ + ck_fun, /* quotemeta */ + ck_rvconst, /* rv2av */ + ck_null, /* aelemfast */ + ck_null, /* aelem */ + ck_null, /* aslice */ + ck_fun, /* each */ + ck_fun, /* values */ + ck_fun, /* keys */ + ck_delete, /* delete */ + ck_exists, /* exists */ + ck_rvconst, /* rv2hv */ + ck_null, /* helem */ + ck_null, /* hslice */ + ck_fun, /* unpack */ + ck_fun, /* pack */ + ck_split, /* split */ + ck_fun, /* join */ + ck_null, /* list */ + ck_null, /* lslice */ + ck_fun, /* anonlist */ + ck_fun, /* anonhash */ + ck_fun, /* splice */ + ck_fun, /* push */ + ck_shift, /* pop */ + ck_shift, /* shift */ + ck_fun, /* unshift */ + ck_sort, /* sort */ + ck_fun, /* reverse */ + ck_grep, /* grepstart */ + ck_null, /* grepwhile */ + ck_grep, /* mapstart */ + ck_null, /* mapwhile */ + ck_null, /* range */ + ck_null, /* flip */ + ck_null, /* flop */ + ck_null, /* and */ + ck_null, /* or */ + ck_null, /* xor */ + ck_null, /* cond_expr */ + ck_null, /* andassign */ + ck_null, /* orassign */ + ck_null, /* method */ + ck_subr, /* entersub */ + ck_null, /* leavesub */ + ck_fun, /* caller */ + ck_fun, /* warn */ + ck_fun, /* die */ + ck_fun, /* reset */ + ck_null, /* lineseq */ + ck_null, /* nextstate */ + ck_null, /* dbstate */ + ck_null, /* unstack */ + ck_null, /* enter */ + ck_null, /* leave */ + ck_null, /* scope */ + ck_null, /* enteriter */ + ck_null, /* iter */ + ck_null, /* enterloop */ + ck_null, /* leaveloop */ + ck_null, /* return */ + ck_null, /* last */ + ck_null, /* next */ + ck_null, /* redo */ + ck_null, /* dump */ + ck_null, /* goto */ + ck_fun, /* exit */ + ck_fun, /* open */ + ck_fun, /* close */ + ck_fun, /* pipe_op */ + ck_fun, /* fileno */ + ck_fun, /* umask */ + ck_fun, /* binmode */ + ck_fun, /* tie */ + ck_fun, /* untie */ + ck_fun, /* tied */ + ck_fun, /* dbmopen */ + ck_fun, /* dbmclose */ + ck_select, /* sselect */ + ck_select, /* select */ + ck_eof, /* getc */ + ck_fun, /* read */ + ck_fun, /* enterwrite */ + ck_null, /* leavewrite */ + ck_listiob, /* prtf */ + ck_listiob, /* print */ + ck_fun, /* sysopen */ + ck_fun, /* sysseek */ + ck_fun, /* sysread */ + ck_fun, /* syswrite */ + ck_fun, /* send */ + ck_fun, /* recv */ + ck_eof, /* eof */ + ck_fun, /* tell */ + ck_fun, /* seek */ + ck_trunc, /* truncate */ + ck_fun, /* fcntl */ + ck_fun, /* ioctl */ + ck_fun, /* flock */ + ck_fun, /* socket */ + ck_fun, /* sockpair */ + ck_fun, /* bind */ + ck_fun, /* connect */ + ck_fun, /* listen */ + ck_fun, /* accept */ + ck_fun, /* shutdown */ + ck_fun, /* gsockopt */ + ck_fun, /* ssockopt */ + ck_fun, /* getsockname */ + ck_fun, /* getpeername */ + ck_ftst, /* lstat */ + ck_ftst, /* stat */ + ck_ftst, /* ftrread */ + ck_ftst, /* ftrwrite */ + ck_ftst, /* ftrexec */ + ck_ftst, /* fteread */ + ck_ftst, /* ftewrite */ + ck_ftst, /* fteexec */ + ck_ftst, /* ftis */ + ck_ftst, /* fteowned */ + ck_ftst, /* ftrowned */ + ck_ftst, /* ftzero */ + ck_ftst, /* ftsize */ + ck_ftst, /* ftmtime */ + ck_ftst, /* ftatime */ + ck_ftst, /* ftctime */ + ck_ftst, /* ftsock */ + ck_ftst, /* ftchr */ + ck_ftst, /* ftblk */ + ck_ftst, /* ftfile */ + ck_ftst, /* ftdir */ + ck_ftst, /* ftpipe */ + ck_ftst, /* ftlink */ + ck_ftst, /* ftsuid */ + ck_ftst, /* ftsgid */ + ck_ftst, /* ftsvtx */ + ck_ftst, /* fttty */ + ck_ftst, /* fttext */ + ck_ftst, /* ftbinary */ + ck_fun, /* chdir */ + ck_fun, /* chown */ + ck_fun, /* chroot */ + ck_fun, /* unlink */ + ck_fun, /* chmod */ + ck_fun, /* utime */ + ck_fun, /* rename */ + ck_fun, /* link */ + ck_fun, /* symlink */ + ck_fun, /* readlink */ + ck_fun, /* mkdir */ + ck_fun, /* rmdir */ + ck_fun, /* open_dir */ + ck_fun, /* readdir */ + ck_fun, /* telldir */ + ck_fun, /* seekdir */ + ck_fun, /* rewinddir */ + ck_fun, /* closedir */ + ck_null, /* fork */ + ck_null, /* wait */ + ck_fun, /* waitpid */ + ck_exec, /* system */ + ck_exec, /* exec */ + ck_fun, /* kill */ + ck_null, /* getppid */ + ck_fun, /* getpgrp */ + ck_fun, /* setpgrp */ + ck_fun, /* getpriority */ + ck_fun, /* setpriority */ + ck_null, /* time */ + ck_null, /* tms */ + ck_fun, /* localtime */ + ck_fun, /* gmtime */ + ck_fun, /* alarm */ + ck_fun, /* sleep */ + ck_fun, /* shmget */ + ck_fun, /* shmctl */ + ck_fun, /* shmread */ + ck_fun, /* shmwrite */ + ck_fun, /* msgget */ + ck_fun, /* msgctl */ + ck_fun, /* msgsnd */ + ck_fun, /* msgrcv */ + ck_fun, /* semget */ + ck_fun, /* semctl */ + ck_fun, /* semop */ + ck_require, /* require */ + ck_fun, /* dofile */ + ck_eval, /* entereval */ + ck_null, /* leaveeval */ + ck_null, /* entertry */ + ck_null, /* leavetry */ + ck_fun, /* ghbyname */ + ck_fun, /* ghbyaddr */ + ck_null, /* ghostent */ + ck_fun, /* gnbyname */ + ck_fun, /* gnbyaddr */ + ck_null, /* gnetent */ + ck_fun, /* gpbyname */ + ck_fun, /* gpbynumber */ + ck_null, /* gprotoent */ + ck_fun, /* gsbyname */ + ck_fun, /* gsbyport */ + ck_null, /* gservent */ + ck_fun, /* shostent */ + ck_fun, /* snetent */ + ck_fun, /* sprotoent */ + ck_fun, /* sservent */ + ck_null, /* ehostent */ + ck_null, /* enetent */ + ck_null, /* eprotoent */ + ck_null, /* eservent */ + ck_fun, /* gpwnam */ + ck_fun, /* gpwuid */ + ck_null, /* gpwent */ + ck_null, /* spwent */ + ck_null, /* epwent */ + ck_fun, /* ggrnam */ + ck_fun, /* ggrgid */ + ck_null, /* ggrent */ + ck_null, /* sgrent */ + ck_null, /* egrent */ + ck_null, /* getlogin */ + ck_fun, /* syscall */ + ck_rfun, /* lock */ + ck_null, /* threadsv */ +}; + +OP * (CPERLscope(*ppaddr)[])(ARGSproto) = { + pp_null, + pp_stub, + pp_scalar, + pp_pushmark, + pp_wantarray, + pp_const, + pp_gvsv, + pp_gv, + pp_gelem, + pp_padsv, + pp_padav, + pp_padhv, + pp_padany, + pp_pushre, + pp_rv2gv, + pp_rv2sv, + pp_av2arylen, + pp_rv2cv, + pp_anoncode, + pp_prototype, + pp_refgen, + pp_srefgen, + pp_ref, + pp_bless, + pp_backtick, + pp_glob, + pp_readline, + pp_rcatline, + pp_regcmaybe, + pp_regcomp, + pp_match, + pp_subst, + pp_substcont, + pp_trans, + pp_sassign, + pp_aassign, + pp_chop, + pp_schop, + pp_chomp, + pp_schomp, + pp_defined, + pp_undef, + pp_study, + pp_pos, + pp_preinc, + pp_i_preinc, + pp_predec, + pp_i_predec, + pp_postinc, + pp_i_postinc, + pp_postdec, + pp_i_postdec, + pp_pow, + pp_multiply, + pp_i_multiply, + pp_divide, + pp_i_divide, + pp_modulo, + pp_i_modulo, + pp_repeat, + pp_add, + pp_i_add, + pp_subtract, + pp_i_subtract, + pp_concat, + pp_stringify, + pp_left_shift, + pp_right_shift, + pp_lt, + pp_i_lt, + pp_gt, + pp_i_gt, + pp_le, + pp_i_le, + pp_ge, + pp_i_ge, + pp_eq, + pp_i_eq, + pp_ne, + pp_i_ne, + pp_ncmp, + pp_i_ncmp, + pp_slt, + pp_sgt, + pp_sle, + pp_sge, + pp_seq, + pp_sne, + pp_scmp, + pp_bit_and, + pp_bit_xor, + pp_bit_or, + pp_negate, + pp_i_negate, + pp_not, + pp_complement, + pp_atan2, + pp_sin, + pp_cos, + pp_rand, + pp_srand, + pp_exp, + pp_log, + pp_sqrt, + pp_int, + pp_hex, + pp_oct, + pp_abs, + pp_length, + pp_substr, + pp_vec, + pp_index, + pp_rindex, + pp_sprintf, + pp_formline, + pp_ord, + pp_chr, + pp_crypt, + pp_ucfirst, + pp_lcfirst, + pp_uc, + pp_lc, + pp_quotemeta, + pp_rv2av, + pp_aelemfast, + pp_aelem, + pp_aslice, + pp_each, + pp_values, + pp_keys, + pp_delete, + pp_exists, + pp_rv2hv, + pp_helem, + pp_hslice, + pp_unpack, + pp_pack, + pp_split, + pp_join, + pp_list, + pp_lslice, + pp_anonlist, + pp_anonhash, + pp_splice, + pp_push, + pp_pop, + pp_shift, + pp_unshift, + pp_sort, + pp_reverse, + pp_grepstart, + pp_grepwhile, + pp_mapstart, + pp_mapwhile, + pp_range, + pp_flip, + pp_flop, + pp_and, + pp_or, + pp_xor, + pp_cond_expr, + pp_andassign, + pp_orassign, + pp_method, + pp_entersub, + pp_leavesub, + pp_caller, + pp_warn, + pp_die, + pp_reset, + pp_lineseq, + pp_nextstate, + pp_dbstate, + pp_unstack, + pp_enter, + pp_leave, + pp_scope, + pp_enteriter, + pp_iter, + pp_enterloop, + pp_leaveloop, + pp_return, + pp_last, + pp_next, + pp_redo, + pp_dump, + pp_goto, + pp_exit, + pp_open, + pp_close, + pp_pipe_op, + pp_fileno, + pp_umask, + pp_binmode, + pp_tie, + pp_untie, + pp_tied, + pp_dbmopen, + pp_dbmclose, + pp_sselect, + pp_select, + pp_getc, + pp_read, + pp_enterwrite, + pp_leavewrite, + pp_prtf, + pp_print, + pp_sysopen, + pp_sysseek, + pp_sysread, + pp_syswrite, + pp_send, + pp_recv, + pp_eof, + pp_tell, + pp_seek, + pp_truncate, + pp_fcntl, + pp_ioctl, + pp_flock, + pp_socket, + pp_sockpair, + pp_bind, + pp_connect, + pp_listen, + pp_accept, + pp_shutdown, + pp_gsockopt, + pp_ssockopt, + pp_getsockname, + pp_getpeername, + pp_lstat, + pp_stat, + pp_ftrread, + pp_ftrwrite, + pp_ftrexec, + pp_fteread, + pp_ftewrite, + pp_fteexec, + pp_ftis, + pp_fteowned, + pp_ftrowned, + pp_ftzero, + pp_ftsize, + pp_ftmtime, + pp_ftatime, + pp_ftctime, + pp_ftsock, + pp_ftchr, + pp_ftblk, + pp_ftfile, + pp_ftdir, + pp_ftpipe, + pp_ftlink, + pp_ftsuid, + pp_ftsgid, + pp_ftsvtx, + pp_fttty, + pp_fttext, + pp_ftbinary, + pp_chdir, + pp_chown, + pp_chroot, + pp_unlink, + pp_chmod, + pp_utime, + pp_rename, + pp_link, + pp_symlink, + pp_readlink, + pp_mkdir, + pp_rmdir, + pp_open_dir, + pp_readdir, + pp_telldir, + pp_seekdir, + pp_rewinddir, + pp_closedir, + pp_fork, + pp_wait, + pp_waitpid, + pp_system, + pp_exec, + pp_kill, + pp_getppid, + pp_getpgrp, + pp_setpgrp, + pp_getpriority, + pp_setpriority, + pp_time, + pp_tms, + pp_localtime, + pp_gmtime, + pp_alarm, + pp_sleep, + pp_shmget, + pp_shmctl, + pp_shmread, + pp_shmwrite, + pp_msgget, + pp_msgctl, + pp_msgsnd, + pp_msgrcv, + pp_semget, + pp_semctl, + pp_semop, + pp_require, + pp_dofile, + pp_entereval, + pp_leaveeval, + pp_entertry, + pp_leavetry, + pp_ghbyname, + pp_ghbyaddr, + pp_ghostent, + pp_gnbyname, + pp_gnbyaddr, + pp_gnetent, + pp_gpbyname, + pp_gpbynumber, + pp_gprotoent, + pp_gsbyname, + pp_gsbyport, + pp_gservent, + pp_shostent, + pp_snetent, + pp_sprotoent, + pp_sservent, + pp_ehostent, + pp_enetent, + pp_eprotoent, + pp_eservent, + pp_gpwnam, + pp_gpwuid, + pp_gpwent, + pp_spwent, + pp_epwent, + pp_ggrnam, + pp_ggrgid, + pp_ggrent, + pp_sgrent, + pp_egrent, + pp_getlogin, + pp_syscall, + pp_lock, + pp_threadsv, +}; + +int +fprintf(PerlIO *stream, const char *format, ...) +{ + va_list(arglist); + va_start(arglist, format); + return PerlIO_vprintf(stream, format, arglist); +} + +CPerlObj::CPerlObj(IPerlMem* ipM, IPerlEnv* ipE, IPerlStdIO* ipStd, + IPerlLIO* ipLIO, IPerlDir* ipD, IPerlSock* ipS, IPerlProc* ipP) +{ + memset(((char*)this)+sizeof(void*), 0, sizeof(CPerlObj)-sizeof(void*)); + piMem = ipM; + piENV = ipE; + piStdIO = ipStd; + piLIO = ipLIO; + piDir = ipD; + piSock = ipS; + piProc = ipP; +} + +void* +CPerlObj::operator new(size_t nSize, IPerlMem *pvtbl) +{ + if(pvtbl != NULL) + return pvtbl->Malloc(nSize); + + return NULL; +} + +int& +CPerlObj::ErrorNo(void) +{ + return error_no; +} + +void +CPerlObj::Init(void) +{ + curcop = &compiling; + cxstack_ix = -1; + cxstack_max = 128; +#ifdef USE_THREADS + threadsv_names = THREADSV_NAMES; + chopset = " \n-"; + tmps_ix = -1; + tmps_floor = -1; + curcop = &compiling; + cxstack_ix = -1; + cxstack_max = 128; +#endif + maxo = MAXO; + sh_path = SH_PATH; + runops = RUNOPS_DEFAULT; +#ifdef CSH + cshname = CSH; +#endif + rsfp = Nullfp; + expect = XSTATE; +#ifdef USE_LOCALE_COLLATE + collation_standard = TRUE; + collxfrm_mult = 2; +#endif +#ifdef USE_LOCALE_NUMERIC + 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; + +#ifdef WIN32 + New(2904, environ, 1, char*); + *environ = NULL; +#endif +} + +#ifdef WIN32 +bool +do_exec(char *cmd) +{ + return PerlProc_Cmd(cmd); +} + +int +do_aspawn(void *vreally, void **vmark, void **vsp) +{ + return PerlProc_aspawn(vreally, vmark, vsp); +} + +#endif /* WIN32 */ + +#endif /* PERL_OBJECT */ @@ -104,7 +104,7 @@ gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi) GvMULTI_on(gv); } -static void +STATIC void gv_init_sv(GV *gv, I32 sv_type) { switch (sv_type) { @@ -1137,15 +1137,19 @@ amagic_call(SV *left, SV *right, int method, int flags) break; case copy_amg: { - SV* ref=SvRV(left); - if (!SvROK(ref) && SvTYPE(ref) <= SVt_PVMG) { + /* + * SV* ref causes confusion with the interpreter variable of + * the same name + */ + SV* tmpRef=SvRV(left); + if (!SvROK(tmpRef) && SvTYPE(tmpRef) <= SVt_PVMG) { /* * Just to be extra cautious. Maybe in some * additional cases sv_setsv is safe, too. */ - SV* newref = newSVsv(ref); + SV* newref = newSVsv(tmpRef); SvOBJECT_on(newref); - SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(ref)); + SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(tmpRef)); return newref; } } @@ -1314,7 +1318,7 @@ amagic_call(SV *left, SV *right, int method, int flags) PUTBACK; if (op = pp_entersub(ARGS)) - runops(); + CALLRUNOPS(); LEAVE; SPAGAIN; @@ -14,12 +14,14 @@ #include "EXTERN.h" #include "perl.h" +static void hv_magic_check _((HV *hv, bool *needs_copy, bool *needs_store)); +#ifndef PERL_OBJECT static void hsplit _((HV *hv)); static void hfreeentries _((HV *hv)); -static void hv_magic_check _((HV *hv, bool *needs_copy, bool *needs_store)); static HE* more_he _((void)); +#endif -static HE* +STATIC HE* new_he(void) { HE* he; @@ -31,14 +33,14 @@ new_he(void) return more_he(); } -static void +STATIC void del_he(HE *p) { HeNEXT(p) = (HE*)he_root; he_root = p; } -static HE* +STATIC HE* more_he(void) { register HE* he; @@ -54,7 +56,7 @@ more_he(void) return new_he(); } -static HEK * +STATIC HEK * save_hek(char *str, I32 len, U32 hash) { char *k; @@ -643,7 +645,7 @@ hv_exists_ent(HV *hv, SV *keysv, U32 hash) return FALSE; } -static void +STATIC void hsplit(HV *hv) { register XPVHV* xhv = (XPVHV*)SvANY(hv); @@ -859,7 +861,7 @@ hv_clear(HV *hv) mg_clear((SV*)hv); } -static void +STATIC void hfreeentries(HV *hv) { register HE **array; diff --git a/intrpvar.h b/intrpvar.h index f3014cbb14..447753e45e 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -157,3 +157,13 @@ PERLVAR(Iofmt, char *) /* $# */ #ifdef USE_THREADS PERLVAR(Ithrsv, SV *) /* holds struct perl_thread for main thread */ #endif /* USE_THREADS */ + +#ifdef PERL_OBJECT +PERLVARI(piMem, IPerlMem*, NULL) +PERLVARI(piENV, IPerlEnv*, NULL) +PERLVARI(piStdIO, IPerlStdIO*, NULL) +PERLVARI(piLIO, IPerlLIO*, NULL) +PERLVARI(piDir, IPerlDir*, NULL) +PERLVARI(piSock, IPerlSock*, NULL) +PERLVARI(piProc, IPerlProc*, NULL) +#endif diff --git a/ipdir.h b/ipdir.h new file mode 100644 index 0000000000..fb6f1eba0a --- /dev/null +++ b/ipdir.h @@ -0,0 +1,26 @@ +/* + + ipdir.h + Interface for perl directory functions + +*/ + +#ifndef __Inc__IPerlDir___ +#define __Inc__IPerlDir___ + +class IPerlDir +{ +public: + virtual int MKdir(const char *dirname, int mode, int &err) = 0; + virtual int Chdir(const char *dirname, int &err) = 0; + virtual int Rmdir(const char *dirname, int &err) = 0; + virtual int Close(DIR *dirp, int &err) = 0; + virtual DIR *Open(char *filename, int &err) = 0; + virtual struct direct *Read(DIR *dirp, int &err) = 0; + virtual void Rewind(DIR *dirp, int &err) = 0; + virtual void Seek(DIR *dirp, long loc, int &err) = 0; + virtual long Tell(DIR *dirp, int &err) = 0; +}; + +#endif /* __Inc__IPerlDir___ */ + diff --git a/ipenv.h b/ipenv.h new file mode 100644 index 0000000000..0ec5f9ffd3 --- /dev/null +++ b/ipenv.h @@ -0,0 +1,20 @@ +/* + + ipenv.h + Interface for perl environment functions + +*/ + +#ifndef __Inc__IPerlEnv___ +#define __Inc__IPerlEnv___ + +class IPerlEnv +{ +public: + virtual char* Getenv(const char *varname, int &err) = 0; + virtual int Putenv(const char *envstring, int &err) = 0; + virtual char* LibPath(char *sfx, ...) =0; +}; + +#endif /* __Inc__IPerlEnv___ */ + diff --git a/iplio.h b/iplio.h new file mode 100644 index 0000000000..d4bcb276d6 --- /dev/null +++ b/iplio.h @@ -0,0 +1,40 @@ +/* + + iplio.h + Interface for perl Low IO functions + +*/ + +#ifndef __Inc__IPerlLIO___ +#define __Inc__IPerlLIO___ + +class IPerlLIO +{ +public: + virtual int Access(const char *path, int mode, int &err) = 0; + virtual int Chmod(const char *filename, int pmode, int &err) = 0; + virtual int Chsize(int handle, long size, int &err) = 0; + virtual int Close(int handle, int &err) = 0; + virtual int Dup(int handle, int &err) = 0; + virtual int Dup2(int handle1, int handle2, int &err) = 0; + virtual int Flock(int fd, int oper, int &err) = 0; + virtual int FStat(int handle, struct stat *buffer, int &err) = 0; + virtual int IOCtl(int i, unsigned int u, char *data, int &err) = 0; + virtual int Isatty(int handle, int &err) = 0; + virtual long Lseek(int handle, long offset, int origin, int &err) = 0; + virtual int Lstat(const char *path, struct stat *buffer, int &err) = 0; + virtual char *Mktemp(char *Template, int &err) = 0; + virtual int Open(const char *filename, int oflag, int &err) = 0; + virtual int Open(const char *filename, int oflag, int pmode, int &err) = 0; + virtual int Read(int handle, void *buffer, unsigned int count, int &err) = 0; + virtual int Rename(const char *oldname, const char *newname, int &err) = 0; + virtual int Setmode(int handle, int mode, int &err) = 0; + virtual int STat(const char *path, struct stat *buffer, int &err) = 0; + virtual char *Tmpnam(char *string, int &err) = 0; + virtual int Umask(int pmode, int &err) = 0; + virtual int Unlink(const char *filename, int &err) = 0; + virtual int Utime(char *filename, struct utimbuf *times, int &err) = 0; + virtual int Write(int handle, const void *buffer, unsigned int count, int &err) = 0; +}; + +#endif /* __Inc__IPerlLIO___ */ diff --git a/ipmem.h b/ipmem.h new file mode 100644 index 0000000000..8e87be707f --- /dev/null +++ b/ipmem.h @@ -0,0 +1,20 @@ +/* + + ipmem.h + Interface for perl memory allocation + +*/ + +#ifndef __Inc__IPerlMem___ +#define __Inc__IPerlMem___ + +class IPerlMem +{ +public: + virtual void* Malloc(size_t) = 0; + virtual void* Realloc(void*, size_t) = 0; + virtual void Free(void*) = 0; +}; + +#endif /* __Inc__IPerlMem___ */ + diff --git a/ipproc.h b/ipproc.h new file mode 100644 index 0000000000..fd049136b3 --- /dev/null +++ b/ipproc.h @@ -0,0 +1,55 @@ +/* + + ipproc.h + Interface for perl process functions + +*/ + +#ifndef __Inc__IPerlProc___ +#define __Inc__IPerlProc___ + +#ifndef Sighandler_t +typedef Signal_t (*Sighandler_t) _((int)); +#endif +#ifndef jmp_buf +#include <setjmp.h> +#endif + +class IPerlProc +{ +public: + virtual void Abort(void) = 0; + virtual void Exit(int status) = 0; + virtual void _Exit(int status) = 0; + virtual int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3) = 0; + virtual int Execv(const char *cmdname, const char *const *argv) = 0; + virtual int Execvp(const char *cmdname, const char *const *argv) = 0; + virtual uid_t Getuid(void) = 0; + virtual uid_t Geteuid(void) = 0; + virtual gid_t Getgid(void) = 0; + virtual gid_t Getegid(void) = 0; + virtual char *Getlogin(void) = 0; + virtual int Kill(int pid, int sig) = 0; + virtual int Killpg(int pid, int sig) = 0; + virtual int PauseProc(void) = 0; + virtual PerlIO* Popen(const char *command, const char *mode) = 0; + virtual int Pclose(PerlIO *stream) = 0; + virtual int Pipe(int *phandles) = 0; + virtual int Setuid(uid_t uid) = 0; + virtual int Setgid(gid_t gid) = 0; + virtual int Sleep(unsigned int) = 0; + virtual int Times(struct tms *timebuf) = 0; + virtual int Wait(int *status) = 0; + virtual Sighandler_t Signal(int sig, Sighandler_t subcode) = 0; +#ifdef WIN32 + virtual void GetSysMsg(char*& msg, DWORD& dwLen, DWORD dwErr) = 0; + virtual void FreeBuf(char* msg) = 0; + virtual BOOL DoCmd(char *cmd) = 0; + virtual int Spawn(char*cmds) = 0; + virtual int Spawnvp(int mode, const char *cmdname, const char *const *argv) = 0; + virtual int ASpawn(void *vreally, void **vmark, void **vsp) = 0; +#endif +}; + +#endif /* __Inc__IPerlProc___ */ + diff --git a/ipsock.h b/ipsock.h new file mode 100644 index 0000000000..5dd9de9fed --- /dev/null +++ b/ipsock.h @@ -0,0 +1,59 @@ +/* + + ipsock.h + Interface for perl socket functions + +*/ + +#ifndef __Inc__IPerlSock___ +#define __Inc__IPerlSock___ + +class IPerlSock +{ +public: + virtual u_long Htonl(u_long hostlong) = 0; + virtual u_short Htons(u_short hostshort) = 0; + virtual u_long Ntohl(u_long netlong) = 0; + virtual u_short Ntohs(u_short netshort) = 0; + virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err) = 0; + virtual int Bind(SOCKET s, const struct sockaddr* name, int namelen, int &err) = 0; + virtual int Connect(SOCKET s, const struct sockaddr* name, int namelen, int &err) = 0; + virtual void Endhostent(int &err) = 0; + virtual void Endnetent(int &err) = 0; + virtual void Endprotoent(int &err) = 0; + virtual void Endservent(int &err) = 0; + virtual struct hostent* Gethostbyaddr(const char* addr, int len, int type, int &err) = 0; + virtual struct hostent* Gethostbyname(const char* name, int &err) = 0; + virtual struct hostent* Gethostent(int &err) = 0; + virtual int Gethostname(char* name, int namelen, int &err) = 0; + virtual struct netent *Getnetbyaddr(long net, int type, int &err) = 0; + virtual struct netent *Getnetbyname(const char *, int &err) = 0; + virtual struct netent *Getnetent(int &err) = 0; + virtual int Getpeername(SOCKET s, struct sockaddr* name, int* namelen, int &err) = 0; + virtual struct protoent* Getprotobyname(const char* name, int &err) = 0; + virtual struct protoent* Getprotobynumber(int number, int &err) = 0; + virtual struct protoent* Getprotoent(int &err) = 0; + virtual struct servent* Getservbyname(const char* name, const char* proto, int &err) = 0; + virtual struct servent* Getservbyport(int port, const char* proto, int &err) = 0; + virtual struct servent* Getservent(int &err) = 0; + virtual int Getsockname(SOCKET s, struct sockaddr* name, int* namelen, int &err) = 0; + virtual int Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err) = 0; + virtual unsigned long InetAddr(const char* cp, int &err) = 0; + virtual char* InetNtoa(struct in_addr in, int &err) = 0; + virtual int Listen(SOCKET s, int backlog, int &err) = 0; + virtual int Recvfrom(SOCKET s, char* buf, int len, int flags, struct sockaddr* from, int* fromlen, int &err) = 0; + virtual int Select(int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout, int &err) = 0; + virtual int Send(SOCKET s, const char* buf, int len, int flags, int &err) = 0; + virtual int Sendto(SOCKET s, const char* buf, int len, int flags, const struct sockaddr* to, int tolen, int &err) = 0; + virtual void Sethostent(int stayopen, int &err) = 0; + virtual void Setnetent(int stayopen, int &err) = 0; + virtual void Setprotoent(int stayopen, int &err) = 0; + virtual void Setservent(int stayopen, int &err) = 0; + virtual int Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err) = 0; + virtual int Shutdown(SOCKET s, int how, int &err) = 0; + virtual SOCKET Socket(int af, int type, int protocol, int &err) = 0; + virtual int Socketpair(int domain, int type, int protocol, int* fds, int &err) = 0; +}; + +#endif /* __Inc__IPerlSock___ */ + diff --git a/ipstdio.h b/ipstdio.h new file mode 100644 index 0000000000..bb6c14fd53 --- /dev/null +++ b/ipstdio.h @@ -0,0 +1,55 @@ +/* + + ipstdio.h + Interface for perl stdio functions + +*/ + +#ifndef __Inc__IPerlStdIO___ +#define __Inc__IPerlStdIO___ + +#ifndef PerlIO +typedef struct _PerlIO PerlIO; +#endif + +class IPerlStdIO +{ +public: + virtual PerlIO* Stdin(void) = 0; + virtual PerlIO* Stdout(void) = 0; + virtual PerlIO* Stderr(void) = 0; + virtual PerlIO* Open(const char *, const char *, int &err) = 0; + virtual int Close(PerlIO*, int &err) = 0; + virtual int Eof(PerlIO*, int &err) = 0; + virtual int Error(PerlIO*, int &err) = 0; + virtual void Clearerr(PerlIO*, int &err) = 0; + virtual int Getc(PerlIO*, int &err) = 0; + virtual char* GetBase(PerlIO *, int &err) = 0; + virtual int GetBufsiz(PerlIO *, int &err) = 0; + virtual int GetCnt(PerlIO *, int &err) = 0; + virtual char* GetPtr(PerlIO *, int &err) = 0; + virtual int Putc(PerlIO*, int, int &err) = 0; + virtual int Puts(PerlIO*, const char *, int &err) = 0; + virtual int Flush(PerlIO*, int &err) = 0; + virtual int Ungetc(PerlIO*,int, int &err) = 0; + virtual int Fileno(PerlIO*, int &err) = 0; + virtual PerlIO* Fdopen(int, const char *, int &err) = 0; + virtual SSize_t Read(PerlIO*,void *,Size_t, int &err) = 0; + virtual SSize_t Write(PerlIO*,const void *,Size_t, int &err) = 0; + virtual void SetCnt(PerlIO *, int, int &err) = 0; + virtual void SetPtrCnt(PerlIO *, char *, int, int& err) = 0; + virtual void Setlinebuf(PerlIO*, int &err) = 0; + virtual int Printf(PerlIO*, int &err, const char *,...) = 0; + virtual int Vprintf(PerlIO*, int &err, const char *, va_list) = 0; + virtual long Tell(PerlIO*, int &err) = 0; + virtual int Seek(PerlIO*, off_t, int, int &err) = 0; + virtual void Rewind(PerlIO*, int &err) = 0; + virtual PerlIO* Tmpfile(int &err) = 0; + virtual int Getpos(PerlIO*, Fpos_t *, int &err) = 0; + virtual int Setpos(PerlIO*, const Fpos_t *, int &err) = 0; + virtual void Init(int &err) = 0; + virtual void InitOSExtras(void* p) = 0; +}; + +#endif /* __Inc__IPerlStdIO___ */ + @@ -508,7 +508,7 @@ free(void *mp) if (OV_MAGIC(ovp, bucket) != MAGIC) { static int bad_free_warn = -1; if (bad_free_warn == -1) { - char *pbf = PerlENV_getenv("PERL_BADFREE"); + char *pbf = PerlEnv_getenv("PERL_BADFREE"); bad_free_warn = (pbf) ? atoi(pbf) : 1; } if (!bad_free_warn) @@ -30,6 +30,21 @@ * Use the "DESTRUCTOR" scope cleanup to reinstate magic. */ +#ifdef PERL_OBJECT +static void UnwindHandler(void *pPerl, void *ptr) +{ + ((CPerlObj*)pPerl)->unwind_handler_stack(ptr); +} + +static void RestoreMagic(void *pPerl, void *ptr) +{ + ((CPerlObj*)pPerl)->restore_magic(ptr); +} +#define UNWINDHANDLER UnwindHandler +#define RESTOREMAGIC RestoreMagic +#define VTBL this->*vtbl + +#else struct magic_state { SV* mgs_sv; U32 mgs_flags; @@ -37,22 +52,27 @@ struct magic_state { typedef struct magic_state MGS; static void restore_magic _((void *p)); +#define UNWINDHANDLER unwind_handler_stack +#define RESTOREMAGIC restore_magic +#define VTBL *vtbl -static void +#endif + +STATIC void save_magic(MGS *mgs, SV *sv) { assert(SvMAGICAL(sv)); mgs->mgs_sv = sv; mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv); - SAVEDESTRUCTOR(restore_magic, mgs); + SAVEDESTRUCTOR(RESTOREMAGIC, mgs); SvMAGICAL_off(sv); SvREADONLY_off(sv); SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; } -static void +STATIC void restore_magic(void *p) { MGS* mgs = (MGS*)p; @@ -76,11 +96,11 @@ mg_magical(SV *sv) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; if (vtbl) { - if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP)) + if ((vtbl->svt_get != NULL) && !(mg->mg_flags & MGf_GSKIP)) SvGMAGICAL_on(sv); if (vtbl->svt_set) SvSMAGICAL_on(sv); - if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear) + if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || (vtbl->svt_clear != NULL)) SvRMAGICAL_on(sv); } } @@ -100,8 +120,8 @@ mg_get(SV *sv) mgp = &SvMAGIC(sv); while ((mg = *mgp) != 0) { MGVTBL* vtbl = mg->mg_virtual; - if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) { - (*vtbl->svt_get)(sv, mg); + if (!(mg->mg_flags & MGf_GSKIP) && vtbl && (vtbl->svt_get != NULL)) { + (VTBL->svt_get)(sv, mg); /* Ignore this magic if it's been deleted */ if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) && (mg->mg_flags & MGf_GSKIP)) @@ -137,8 +157,8 @@ mg_set(SV *sv) mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */ mgs.mgs_flags = 0; } - if (vtbl && vtbl->svt_set) - (*vtbl->svt_set)(sv, mg); + if (vtbl && (vtbl->svt_set != NULL)) + (VTBL->svt_set)(sv, mg); } LEAVE; @@ -154,13 +174,13 @@ mg_len(SV *sv) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; - if (vtbl && vtbl->svt_len) { + if (vtbl && (vtbl->svt_len != NULL)) { MGS mgs; ENTER; save_magic(&mgs, sv); /* omit MGf_GSKIP -- not changed here */ - len = (*vtbl->svt_len)(sv, mg); + len = (VTBL->svt_len)(sv, mg); LEAVE; return len; } @@ -183,8 +203,8 @@ mg_clear(SV *sv) MGVTBL* vtbl = mg->mg_virtual; /* omit GSKIP -- never set here */ - if (vtbl && vtbl->svt_clear) - (*vtbl->svt_clear)(sv, mg); + if (vtbl && (vtbl->svt_clear != NULL)) + (VTBL->svt_clear)(sv, mg); } LEAVE; @@ -224,12 +244,12 @@ mg_free(SV *sv) for (mg = SvMAGIC(sv); mg; mg = moremagic) { MGVTBL* vtbl = mg->mg_virtual; moremagic = mg->mg_moremagic; - if (vtbl && vtbl->svt_free) - (*vtbl->svt_free)(sv, mg); + if (vtbl && (vtbl->svt_free != NULL)) + (VTBL->svt_free)(sv, mg); if (mg->mg_ptr && mg->mg_type != 'g') - if (mg->mg_len >= 0) + if (mg->mg_length >= 0) Safefree(mg->mg_ptr); - else if (mg->mg_len == HEf_SVKEY) + else if (mg->mg_length == HEf_SVKEY) SvREFCNT_dec((SV*)mg->mg_ptr); if (mg->mg_flags & MGf_REFCOUNTED) SvREFCNT_dec(mg->mg_obj); @@ -354,7 +374,17 @@ magic_get(SV *sv, MAGIC *mg) DWORD dwErr = GetLastError(); sv_setnv(sv, (double)dwErr); if (dwErr) + { +#ifdef PERL_OBJECT + char *sMsg; + DWORD dwLen; + PerlProc_GetSysMsg(sMsg, dwLen, dwErr); + sv_setpvn(sv, sMsg, dwLen); + PerlProc_FreeBuf(sMsg); +#else win32_str_os_error(sv, dwErr); +#endif + } else sv_setpv(sv, ""); SetLastError(dwErr); @@ -922,7 +952,7 @@ magic_setnkeys(SV *sv, MAGIC *mg) return 0; } -static int +STATIC int magic_methpack(SV *sv, MAGIC *mg, char *meth) { dSP; @@ -933,13 +963,13 @@ magic_methpack(SV *sv, MAGIC *mg, char *meth) EXTEND(sp, 2); PUSHs(mg->mg_obj); if (mg->mg_ptr) { - if (mg->mg_len >= 0) - PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len))); - else if (mg->mg_len == HEf_SVKEY) + if (mg->mg_length >= 0) + PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_length))); + else if (mg->mg_length == HEf_SVKEY) PUSHs((SV*)mg->mg_ptr); } else if (mg->mg_type == 'p') - PUSHs(sv_2mortal(newSViv(mg->mg_len))); + PUSHs(sv_2mortal(newSViv(mg->mg_length))); PUTBACK; if (perl_call_method(meth, G_SCALAR)) @@ -968,13 +998,13 @@ magic_setpack(SV *sv, MAGIC *mg) EXTEND(sp, 3); PUSHs(mg->mg_obj); if (mg->mg_ptr) { - if (mg->mg_len >= 0) - PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len))); - else if (mg->mg_len == HEf_SVKEY) + if (mg->mg_length >= 0) + PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_length))); + else if (mg->mg_length == HEf_SVKEY) PUSHs((SV*)mg->mg_ptr); } else if (mg->mg_type == 'p') - PUSHs(sv_2mortal(newSViv(mg->mg_len))); + PUSHs(sv_2mortal(newSViv(mg->mg_length))); PUSHs(sv); PUTBACK; @@ -1074,9 +1104,9 @@ magic_getpos(SV *sv, MAGIC *mg) if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) { mg = mg_find(lsv, 'g'); - if (mg && mg->mg_len >= 0) { + if (mg && mg->mg_length >= 0) { dTHR; - sv_setiv(sv, mg->mg_len + curcop->cop_arybase); + sv_setiv(sv, mg->mg_length + curcop->cop_arybase); return 0; } } @@ -1102,7 +1132,7 @@ magic_setpos(SV *sv, MAGIC *mg) mg = mg_find(lsv, 'g'); } else if (!SvOK(sv)) { - mg->mg_len = -1; + mg->mg_length = -1; return 0; } len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv); @@ -1115,7 +1145,7 @@ magic_setpos(SV *sv, MAGIC *mg) } else if (pos > len) pos = len; - mg->mg_len = pos; + mg->mg_length = pos; mg->mg_flags &= ~MGf_MINMATCH; return 0; @@ -1167,8 +1197,8 @@ int magic_gettaint(SV *sv, MAGIC *mg) { dTHR; - TAINT_IF((mg->mg_len & 1) || - (mg->mg_len & 2) && mg->mg_obj == sv); /* kludge */ + TAINT_IF((mg->mg_length & 1) || + (mg->mg_length & 2) && mg->mg_obj == sv); /* kludge */ return 0; } @@ -1178,14 +1208,14 @@ magic_settaint(SV *sv, MAGIC *mg) dTHR; if (localizing) { if (localizing == 1) - mg->mg_len <<= 1; + mg->mg_length <<= 1; else - mg->mg_len >>= 1; + mg->mg_length >>= 1; } else if (tainted) - mg->mg_len |= 1; + mg->mg_length |= 1; else - mg->mg_len &= ~1; + mg->mg_length &= ~1; return 0; } @@ -1285,7 +1315,7 @@ vivify_defelem(SV *sv) int magic_setmglob(SV *sv, MAGIC *mg) { - mg->mg_len = -1; + mg->mg_length = -1; SvSCREAM_off(sv); return 0; } @@ -1335,7 +1365,7 @@ magic_setcollxfrm(SV *sv, MAGIC *mg) if (mg->mg_ptr) { Safefree(mg->mg_ptr); mg->mg_ptr = NULL; - mg->mg_len = -1; + mg->mg_length = -1; } return 0; } @@ -1515,15 +1545,15 @@ magic_set(SV *sv, MAGIC *mg) (void)setresuid((Uid_t)uid, (Uid_t)-1, (Uid_t)-1); #else if (uid == euid) /* special case $< = $> */ - (void)setuid(uid); + (void)PerlProc_setuid(uid); else { - uid = (I32)getuid(); + uid = (I32)PerlProc_getuid(); croak("setruid() not implemented"); } #endif #endif #endif - uid = (I32)getuid(); + uid = (I32)PerlProc_getuid(); tainting |= (uid && (euid != uid || egid != gid)); break; case '>': @@ -1542,15 +1572,15 @@ magic_set(SV *sv, MAGIC *mg) (void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1); #else if (euid == uid) /* special case $> = $< */ - setuid(euid); + PerlProc_setuid(euid); else { - euid = (I32)geteuid(); + euid = (I32)PerlProc_geteuid(); croak("seteuid() not implemented"); } #endif #endif #endif - euid = (I32)geteuid(); + euid = (I32)PerlProc_geteuid(); tainting |= (uid && (euid != uid || egid != gid)); break; case '(': @@ -1569,15 +1599,15 @@ magic_set(SV *sv, MAGIC *mg) (void)setresgid((Gid_t)gid, (Gid_t)-1, (Gid_t) 1); #else if (gid == egid) /* special case $( = $) */ - (void)setgid(gid); + (void)PerlProc_setgid(gid); else { - gid = (I32)getgid(); + gid = (I32)PerlProc_getgid(); croak("setrgid() not implemented"); } #endif #endif #endif - gid = (I32)getgid(); + gid = (I32)PerlProc_getgid(); tainting |= (uid && (euid != uid || egid != gid)); break; case ')': @@ -1619,15 +1649,15 @@ magic_set(SV *sv, MAGIC *mg) (void)setresgid((Gid_t)-1, (Gid_t)egid, (Gid_t)-1); #else if (egid == gid) /* special case $) = $( */ - (void)setgid(egid); + (void)PerlProc_setgid(egid); else { - egid = (I32)getegid(); + egid = (I32)PerlProc_getegid(); croak("setegid() not implemented"); } #endif #endif #endif - egid = (I32)getegid(); + egid = (I32)PerlProc_getegid(); tainting |= (uid && (euid != uid || egid != gid)); break; case ':': @@ -1731,7 +1761,7 @@ whichsig(char *sig) static SV* sig_sv; -static void +STATIC void unwind_handler_stack(void *p) { dTHR; @@ -1785,7 +1815,7 @@ sighandler(int sig) if (flags & 1) { savestack_ix += 5; /* Protect save in progress. */ o_save_i = savestack_ix; - SAVEDESTRUCTOR(unwind_handler_stack, (void*)&flags); + SAVEDESTRUCTOR(UNWINDHANDLER, (void*)&flags); } if (flags & 4) markstack_ptr++; /* Protect mark. */ @@ -8,11 +8,11 @@ */ struct mgvtbl { - int (*svt_get) _((SV *sv, MAGIC* mg)); - int (*svt_set) _((SV *sv, MAGIC* mg)); - U32 (*svt_len) _((SV *sv, MAGIC* mg)); - int (*svt_clear) _((SV *sv, MAGIC* mg)); - int (*svt_free) _((SV *sv, MAGIC* mg)); + int (CPERLscope(*svt_get)) _((SV *sv, MAGIC* mg)); + int (CPERLscope(*svt_set)) _((SV *sv, MAGIC* mg)); + U32 (CPERLscope(*svt_len)) _((SV *sv, MAGIC* mg)); + int (CPERLscope(*svt_clear)) _((SV *sv, MAGIC* mg)); + int (CPERLscope(*svt_free)) _((SV *sv, MAGIC* mg)); }; struct magic { @@ -23,7 +23,7 @@ struct magic { U8 mg_flags; SV* mg_obj; char* mg_ptr; - I32 mg_len; + I32 mg_length; }; #define MGf_TAINTEDDIR 1 @@ -36,6 +36,6 @@ struct magic { #define MgTAINTEDDIR_on(mg) (mg->mg_flags |= MGf_TAINTEDDIR) #define MgTAINTEDDIR_off(mg) (mg->mg_flags &= ~MGf_TAINTEDDIR) -#define MgPV(mg,lp) (((lp = (mg)->mg_len) == HEf_SVKEY) ? \ +#define MgPV(mg,lp) (((lp = (mg)->mg_length) == HEf_SVKEY) ? \ SvPV((SV*)((mg)->mg_ptr),lp) : \ (mg)->mg_ptr) diff --git a/objpp.h b/objpp.h new file mode 100644 index 0000000000..7a9cd2da61 --- /dev/null +++ b/objpp.h @@ -0,0 +1,1391 @@ +#ifndef __Objpp_h__ +#define __Objpp_h__ + +#undef amagic_call +#define amagic_call CPerlObj::Perl_amagic_call +#undef Gv_AMupdate +#define Gv_AMupdate CPerlObj::Perl_Gv_AMupdate +#undef add_data +#define add_data CPerlObj::add_data +#undef ao +#define ao CPerlObj::ao +#undef append_elem +#define append_elem CPerlObj::Perl_append_elem +#undef append_list +#define append_list CPerlObj::Perl_append_list +#undef apply +#define apply CPerlObj::Perl_apply +#undef asIV +#define asIV CPerlObj::asIV +#undef asUV +#define asUV CPerlObj::asUV +#undef assertref +#define assertref CPerlObj::Perl_assertref +#undef av_clear +#define av_clear CPerlObj::Perl_av_clear +#undef av_extend +#define av_extend CPerlObj::Perl_av_extend +#undef av_fake +#define av_fake CPerlObj::Perl_av_fake +#undef av_fetch +#define av_fetch CPerlObj::Perl_av_fetch +#undef av_fill +#define av_fill CPerlObj::Perl_av_fill +#undef av_len +#define av_len CPerlObj::Perl_av_len +#undef av_make +#define av_make CPerlObj::Perl_av_make +#undef av_pop +#define av_pop CPerlObj::Perl_av_pop +#undef av_push +#define av_push CPerlObj::Perl_av_push +#undef av_shift +#define av_shift CPerlObj::Perl_av_shift +#undef av_reify +#define av_reify CPerlObj::Perl_av_reify +#undef av_store +#define av_store CPerlObj::Perl_av_store +#undef av_undef +#define av_undef CPerlObj::Perl_av_undef +#undef av_unshift +#define av_unshift CPerlObj::Perl_av_unshift +#undef avhv_keys +#define avhv_keys CPerlObj::Perl_avhv_keys +#undef avhv_fetch +#define avhv_fetch CPerlObj::Perl_avhv_fetch +#undef avhv_fetch_ent +#define avhv_fetch_ent CPerlObj::Perl_avhv_fetch_ent +#undef avhv_store +#define avhv_store CPerlObj::Perl_avhv_store +#undef avhv_store_ent +#define avhv_store_ent CPerlObj::Perl_avhv_store_ent +#undef avhv_exists_ent +#define avhv_exists_ent CPerlObj::Perl_avhv_exists_ent +#undef avhv_exists +#define avhv_exists CPerlObj::Perl_avhv_exists +#undef avhv_delete +#define avhv_delete CPerlObj::Perl_avhv_delete +#undef avhv_delete_ent +#define avhv_delete_ent CPerlObj::Perl_avhv_delete_ent +#undef avhv_iterinit +#define avhv_iterinit CPerlObj::Perl_avhv_iterinit +#undef avhv_iternext +#define avhv_iternext CPerlObj::Perl_avhv_iternext +#undef avhv_iterval +#define avhv_iterval CPerlObj::Perl_avhv_iterval +#undef avhv_iternextsv +#define avhv_iternextsv CPerlObj::Perl_avhv_iternextsv +#undef bad_type +#define bad_type CPerlObj::bad_type +#undef bind_match +#define bind_match CPerlObj::Perl_bind_match +#undef block_end +#define block_end CPerlObj::Perl_block_end +#undef block_gimme +#define block_gimme CPerlObj::Perl_block_gimme +#undef block_start +#define block_start CPerlObj::Perl_block_start +#undef call_list +#define call_list CPerlObj::Perl_call_list +#undef cando +#define cando CPerlObj::Perl_cando +#undef cast_ulong +#define cast_ulong CPerlObj::cast_ulong +#undef checkcomma +#define checkcomma CPerlObj::Perl_checkcomma +#undef check_uni +#define check_uni CPerlObj::Perl_check_uni +#undef ck_anoncode +#define ck_anoncode CPerlObj::Perl_ck_anoncode +#undef ck_bitop +#define ck_bitop CPerlObj::Perl_ck_bitop +#undef ck_concat +#define ck_concat CPerlObj::Perl_ck_concat +#undef ck_delete +#define ck_delete CPerlObj::Perl_ck_delete +#undef ck_eof +#define ck_eof CPerlObj::Perl_ck_eof +#undef ck_eval +#define ck_eval CPerlObj::Perl_ck_eval +#undef ck_exec +#define ck_exec CPerlObj::Perl_ck_exec +#undef ck_exists +#define ck_exists CPerlObj::Perl_ck_exists +#undef ck_formline +#define ck_formline CPerlObj::Perl_ck_formline +#undef ck_ftst +#define ck_ftst CPerlObj::Perl_ck_ftst +#undef ck_fun +#define ck_fun CPerlObj::Perl_ck_fun +#undef ck_fun_locale +#define ck_fun_locale CPerlObj::Perl_ck_fun_locale +#undef ck_glob +#define ck_glob CPerlObj::Perl_ck_glob +#undef ck_grep +#define ck_grep CPerlObj::Perl_ck_grep +#undef ck_gvconst +#define ck_gvconst CPerlObj::Perl_ck_gvconst +#undef ck_index +#define ck_index CPerlObj::Perl_ck_index +#undef ck_lengthconst +#define ck_lengthconst CPerlObj::Perl_ck_lengthconst +#undef ck_lfun +#define ck_lfun CPerlObj::Perl_ck_lfun +#undef ck_listiob +#define ck_listiob CPerlObj::Perl_ck_listiob +#undef ck_match +#define ck_match CPerlObj::Perl_ck_match +#undef ck_null +#define ck_null CPerlObj::Perl_ck_null +#undef ck_repeat +#define ck_repeat CPerlObj::Perl_ck_repeat +#undef ck_require +#define ck_require CPerlObj::Perl_ck_require +#undef ck_retarget +#define ck_retarget CPerlObj::Perl_ck_retarget +#undef ck_rfun +#define ck_rfun CPerlObj::Perl_ck_rfun +#undef ck_rvconst +#define ck_rvconst CPerlObj::Perl_ck_rvconst +#undef ck_scmp +#define ck_scmp CPerlObj::Perl_ck_scmp +#undef ck_select +#define ck_select CPerlObj::Perl_ck_select +#undef ck_shift +#define ck_shift CPerlObj::Perl_ck_shift +#undef ck_sort +#define ck_sort CPerlObj::Perl_ck_sort +#undef ck_spair +#define ck_spair CPerlObj::Perl_ck_spair +#undef ck_split +#define ck_split CPerlObj::Perl_ck_split +#undef ck_subr +#define ck_subr CPerlObj::Perl_ck_subr +#undef ck_svconst +#define ck_svconst CPerlObj::Perl_ck_svconst +#undef ck_trunc +#define ck_trunc CPerlObj::Perl_ck_trunc +#undef convert +#define convert CPerlObj::Perl_convert +#undef cpytill +#define cpytill CPerlObj::Perl_cpytill +#undef croak +#define croak CPerlObj::Perl_croak +#undef cv_ckproto +#define cv_ckproto CPerlObj::Perl_cv_ckproto +#undef cv_clone +#define cv_clone CPerlObj::Perl_cv_clone +#undef cv_clone2 +#define cv_clone2 CPerlObj::cv_clone2 +#undef cv_const_sv +#define cv_const_sv CPerlObj::Perl_cv_const_sv +#undef cv_undef +#define cv_undef CPerlObj::Perl_cv_undef +#undef cx_dump +#define cx_dump CPerlObj::Perl_cx_dump +#undef cxinc +#define cxinc CPerlObj::Perl_cxinc +#undef deb +#define deb CPerlObj::Perl_deb +#undef deb_growlevel +#define deb_growlevel CPerlObj::Perl_deb_growlevel +#undef debop +#define debop CPerlObj::Perl_debop +#undef debstackptrs +#define debstackptrs CPerlObj::Perl_debstackptrs +#undef debprof +#define debprof CPerlObj::debprof +#undef debprofdump +#define debprofdump CPerlObj::Perl_debprofdump +#undef debstack +#define debstack CPerlObj::Perl_debstack +#undef del_sv +#define del_sv CPerlObj::del_sv +#undef del_xiv +#define del_xiv CPerlObj::del_xiv +#undef del_xnv +#define del_xnv CPerlObj::del_xnv +#undef del_xpv +#define del_xpv CPerlObj::del_xpv +#undef del_xrv +#define del_xrv CPerlObj::del_xrv +#undef delimcpy +#define delimcpy CPerlObj::Perl_delimcpy +#undef depcom +#define depcom CPerlObj::depcom +#undef deprecate +#define deprecate CPerlObj::Perl_deprecate +#undef die +#define die CPerlObj::Perl_die +#undef die_where +#define die_where CPerlObj::Perl_die_where +#undef div128 +#define div128 CPerlObj::div128 +#undef doencodes +#define doencodes CPerlObj::doencodes +#undef doeval +#define doeval CPerlObj::doeval +#undef doform +#define doform CPerlObj::doform +#undef dofindlabel +#define dofindlabel CPerlObj::Perl_dofindlabel +#undef doparseform +#define doparseform CPerlObj::doparseform +#undef dopoptoeval +#define dopoptoeval CPerlObj::Perl_dopoptoeval +#undef dopoptolabel +#define dopoptolabel CPerlObj::dopoptolabel +#undef dopoptoloop +#define dopoptoloop CPerlObj::dopoptoloop +#undef dopoptosub +#define dopoptosub CPerlObj::dopoptosub +#undef dounwind +#define dounwind CPerlObj::Perl_dounwind +#undef do_aexec +#define do_aexec CPerlObj::Perl_do_aexec +#undef do_aspawn +#define do_aspawn CPerlObj::do_aspawn +#undef do_chop +#define do_chop CPerlObj::Perl_do_chop +#undef do_close +#define do_close CPerlObj::Perl_do_close +#undef do_eof +#define do_eof CPerlObj::Perl_do_eof +#undef do_exec +#define do_exec CPerlObj::Perl_do_exec +#undef do_execfree +#define do_execfree CPerlObj::Perl_do_execfree +#undef do_ipcctl +#define do_ipcctl CPerlObj::Perl_do_ipcctl +#undef do_ipcget +#define do_ipcget CPerlObj::Perl_do_ipcget +#undef do_join +#define do_join CPerlObj::Perl_do_join +#undef do_kv +#define do_kv CPerlObj::Perl_do_kv +#undef do_msgrcv +#define do_msgrcv CPerlObj::Perl_do_msgrcv +#undef do_msgsnd +#define do_msgsnd CPerlObj::Perl_do_msgsnd +#undef do_open +#define do_open CPerlObj::Perl_do_open +#undef do_pipe +#define do_pipe CPerlObj::Perl_do_pipe +#undef do_print +#define do_print CPerlObj::Perl_do_print +#undef do_readline +#define do_readline CPerlObj::Perl_do_readline +#undef do_chomp +#define do_chomp CPerlObj::Perl_do_chomp +#undef do_seek +#define do_seek CPerlObj::Perl_do_seek +#undef do_semop +#define do_semop CPerlObj::Perl_do_semop +#undef do_shmio +#define do_shmio CPerlObj::Perl_do_shmio +#undef do_sprintf +#define do_sprintf CPerlObj::Perl_do_sprintf +#undef do_sysseek +#define do_sysseek CPerlObj::Perl_do_sysseek +#undef do_tell +#define do_tell CPerlObj::Perl_do_tell +#undef do_trans +#define do_trans CPerlObj::Perl_do_trans +#undef do_vecset +#define do_vecset CPerlObj::Perl_do_vecset +#undef do_vop +#define do_vop CPerlObj::Perl_do_vop +#undef do_clean_all +#define do_clean_all CPerlObj::do_clean_all +#undef do_clean_named_objs +#define do_clean_named_objs CPerlObj::do_clean_named_objs +#undef do_clean_objs +#define do_clean_objs CPerlObj::do_clean_objs +#undef do_report_used +#define do_report_used CPerlObj::do_report_used +#undef docatch +#define docatch CPerlObj::docatch +#undef dowantarray +#define dowantarray CPerlObj::Perl_dowantarray +#undef dump +#define dump CPerlObj::dump +#undef dump_all +#define dump_all CPerlObj::Perl_dump_all +#undef dump_eval +#define dump_eval CPerlObj::Perl_dump_eval +#undef dump_fds +#define dump_fds CPerlObj::Perl_dump_fds +#undef dump_form +#define dump_form CPerlObj::Perl_dump_form +#undef dump_gv +#define dump_gv CPerlObj::Perl_dump_gv +#undef dump_op +#define dump_op CPerlObj::Perl_dump_op +#undef dump_pm +#define dump_pm CPerlObj::Perl_dump_pm +#undef dump_packsubs +#define dump_packsubs CPerlObj::Perl_dump_packsubs +#undef dump_sub +#define dump_sub CPerlObj::Perl_dump_sub +#undef dumpuntil +#define dumpuntil CPerlObj::dumpuntil +#undef fbm_compile +#define fbm_compile CPerlObj::Perl_fbm_compile +#undef fbm_instr +#define fbm_instr CPerlObj::Perl_fbm_instr +#undef filter_add +#define filter_add CPerlObj::Perl_filter_add +#undef filter_del +#define filter_del CPerlObj::Perl_filter_del +#undef filter_gets +#define filter_gets CPerlObj::filter_gets +#undef filter_read +#define filter_read CPerlObj::Perl_filter_read +#undef find_beginning +#define find_beginning CPerlObj::find_beginning +#undef forbid_setid +#define forbid_setid CPerlObj::forbid_setid +#undef force_ident +#define force_ident CPerlObj::Perl_force_ident +#undef force_list +#define force_list CPerlObj::Perl_force_list +#undef force_next +#define force_next CPerlObj::Perl_force_next +#undef force_word +#define force_word CPerlObj::Perl_force_word +#undef force_version +#define force_version CPerlObj::force_version +#undef form +#define form CPerlObj::Perl_form +#undef fold_constants +#define fold_constants CPerlObj::Perl_fold_constants +#undef fprintf +#define fprintf CPerlObj::fprintf +#undef free_tmps +#define free_tmps CPerlObj::Perl_free_tmps +#undef gen_constant_list +#define gen_constant_list CPerlObj::Perl_gen_constant_list +#undef get_db_sub +#define get_db_sub CPerlObj::get_db_sub +#undef get_op_descs +#define get_op_descs CPerlObj::Perl_get_op_descs +#undef get_op_names +#define get_op_names CPerlObj::Perl_get_op_names +#undef getlogin +#define getlogin CPerlObj::getlogin +#undef gp_free +#define gp_free CPerlObj::Perl_gp_free +#undef gp_ref +#define gp_ref CPerlObj::Perl_gp_ref +#undef gv_autoload4 +#define gv_autoload4 CPerlObj::Perl_gv_autoload4 +#undef gv_AVadd +#define gv_AVadd CPerlObj::Perl_gv_AVadd +#undef gv_HVadd +#define gv_HVadd CPerlObj::Perl_gv_HVadd +#undef gv_IOadd +#define gv_IOadd CPerlObj::Perl_gv_IOadd +#undef gv_check +#define gv_check CPerlObj::Perl_gv_check +#undef gv_efullname +#define gv_efullname CPerlObj::Perl_gv_efullname +#undef gv_efullname3 +#define gv_efullname3 CPerlObj::Perl_gv_efullname3 +#undef gv_ename +#define gv_ename CPerlObj::gv_ename +#undef gv_fetchfile +#define gv_fetchfile CPerlObj::Perl_gv_fetchfile +#undef gv_fetchmeth +#define gv_fetchmeth CPerlObj::Perl_gv_fetchmeth +#undef gv_fetchmethod +#define gv_fetchmethod CPerlObj::Perl_gv_fetchmethod +#undef gv_fetchmethod_autoload +#define gv_fetchmethod_autoload CPerlObj::Perl_gv_fetchmethod_autoload +#undef gv_fetchpv +#define gv_fetchpv CPerlObj::Perl_gv_fetchpv +#undef gv_fullname +#define gv_fullname CPerlObj::Perl_gv_fullname +#undef gv_fullname3 +#define gv_fullname3 CPerlObj::Perl_gv_fullname3 +#undef gv_init +#define gv_init CPerlObj::Perl_gv_init +#undef gv_init_sv +#define gv_init_sv CPerlObj::gv_init_sv +#undef gv_stashpv +#define gv_stashpv CPerlObj::Perl_gv_stashpv +#undef gv_stashpvn +#define gv_stashpvn CPerlObj::Perl_gv_stashpvn +#undef gv_stashsv +#define gv_stashsv CPerlObj::Perl_gv_stashsv +#undef he_delayfree +#define he_delayfree CPerlObj::Perl_he_delayfree +#undef he_free +#define he_free CPerlObj::Perl_he_free +#undef hfreeentries +#define hfreeentries CPerlObj::hfreeentries +#undef hoistmust +#define hoistmust CPerlObj::Perl_hoistmust +#undef hsplit +#define hsplit CPerlObj::hsplit +#undef hv_clear +#define hv_clear CPerlObj::Perl_hv_clear +#undef hv_delayfree_ent +#define hv_delayfree_ent CPerlObj::Perl_hv_delayfree_ent +#undef hv_delete +#define hv_delete CPerlObj::Perl_hv_delete +#undef hv_delete_ent +#define hv_delete_ent CPerlObj::Perl_hv_delete_ent +#undef hv_exists +#define hv_exists CPerlObj::Perl_hv_exists +#undef hv_exists_ent +#define hv_exists_ent CPerlObj::Perl_hv_exists_ent +#undef hv_free_ent +#define hv_free_ent CPerlObj::Perl_hv_free_ent +#undef hv_fetch +#define hv_fetch CPerlObj::Perl_hv_fetch +#undef hv_fetch_ent +#define hv_fetch_ent CPerlObj::Perl_hv_fetch_ent +#undef hv_iterinit +#define hv_iterinit CPerlObj::Perl_hv_iterinit +#undef hv_iterkey +#define hv_iterkey CPerlObj::Perl_hv_iterkey +#undef hv_iterkeysv +#define hv_iterkeysv CPerlObj::Perl_hv_iterkeysv +#undef hv_iternext +#define hv_iternext CPerlObj::Perl_hv_iternext +#undef hv_iternextsv +#define hv_iternextsv CPerlObj::Perl_hv_iternextsv +#undef hv_iterval +#define hv_iterval CPerlObj::Perl_hv_iterval +#undef hv_ksplit +#define hv_ksplit CPerlObj::Perl_hv_ksplit +#undef hv_magic +#define hv_magic CPerlObj::Perl_hv_magic +#undef hv_store +#define hv_store CPerlObj::Perl_hv_store +#undef hv_store_ent +#define hv_store_ent CPerlObj::Perl_hv_store_ent +#undef hv_undef +#define hv_undef CPerlObj::Perl_hv_undef +#undef ibcmp +#define ibcmp CPerlObj::Perl_ibcmp +#undef ibcmp_locale +#define ibcmp_locale CPerlObj::Perl_ibcmp_locale +#undef incpush +#define incpush CPerlObj::incpush +#undef incline +#define incline CPerlObj::incline +#undef incl_perldb +#define incl_perldb CPerlObj::incl_perldb +#undef ingroup +#define ingroup CPerlObj::Perl_ingroup +#undef init_debugger +#define init_debugger CPerlObj::init_debugger +#undef init_ids +#define init_ids CPerlObj::init_ids +#undef init_main_thread +#define init_main_thread CPerlObj::init_main_thread +#undef init_main_stash +#define init_main_stash CPerlObj::init_main_stash +#undef init_lexer +#define init_lexer CPerlObj::init_lexer +#undef init_perllib +#define init_perllib CPerlObj::init_perllib +#undef init_predump_symbols +#define init_predump_symbols CPerlObj::init_predump_symbols +#undef init_postdump_symbols +#define init_postdump_symbols CPerlObj::init_postdump_symbols +#undef init_stacks +#define init_stacks CPerlObj::Perl_init_stacks +#undef intro_my +#define intro_my CPerlObj::Perl_intro_my +#undef nuke_stacks +#define nuke_stacks CPerlObj::nuke_stacks +#undef instr +#define instr CPerlObj::Perl_instr +#undef intuit_method +#define intuit_method CPerlObj::intuit_method +#undef intuit_more +#define intuit_more CPerlObj::Perl_intuit_more +#undef invert +#define invert CPerlObj::Perl_invert +#undef io_close +#define io_close CPerlObj::Perl_io_close +#undef is_an_int +#define is_an_int CPerlObj::is_an_int +#undef isa_lookup +#define isa_lookup CPerlObj::isa_lookup +#undef jmaybe +#define jmaybe CPerlObj::Perl_jmaybe +#undef keyword +#define keyword CPerlObj::Perl_keyword +#undef leave_scope +#define leave_scope CPerlObj::Perl_leave_scope +#undef lex_end +#define lex_end CPerlObj::Perl_lex_end +#undef lex_start +#define lex_start CPerlObj::Perl_lex_start +#undef linklist +#define linklist CPerlObj::Perl_linklist +#undef list +#define list CPerlObj::Perl_list +#undef list_assignment +#define list_assignment CPerlObj::list_assignment +#undef listkids +#define listkids CPerlObj::Perl_listkids +#undef lop +#define lop CPerlObj::lop +#undef localize +#define localize CPerlObj::Perl_localize +#undef looks_like_number +#define looks_like_number CPerlObj::Perl_looks_like_number +#undef magic_clearenv +#define magic_clearenv CPerlObj::Perl_magic_clearenv +#undef magic_clear_all_env +#define magic_clear_all_env CPerlObj::Perl_magic_clear_all_env +#undef magic_clearpack +#define magic_clearpack CPerlObj::Perl_magic_clearpack +#undef magic_clearsig +#define magic_clearsig CPerlObj::Perl_magic_clearsig +#undef magic_existspack +#define magic_existspack CPerlObj::Perl_magic_existspack +#undef magic_freedefelem +#define magic_freedefelem CPerlObj::Perl_magic_freedefelem +#undef magic_freeregexp +#define magic_freeregexp CPerlObj::Perl_magic_freeregexp +#undef magic_get +#define magic_get CPerlObj::Perl_magic_get +#undef magic_getarylen +#define magic_getarylen CPerlObj::Perl_magic_getarylen +#undef magic_getdefelem +#define magic_getdefelem CPerlObj::Perl_magic_getdefelem +#undef magic_getpack +#define magic_getpack CPerlObj::Perl_magic_getpack +#undef magic_getglob +#define magic_getglob CPerlObj::Perl_magic_getglob +#undef magic_getpos +#define magic_getpos CPerlObj::Perl_magic_getpos +#undef magic_getsig +#define magic_getsig CPerlObj::Perl_magic_getsig +#undef magic_gettaint +#define magic_gettaint CPerlObj::Perl_magic_gettaint +#undef magic_getuvar +#define magic_getuvar CPerlObj::Perl_magic_getuvar +#undef magic_len +#define magic_len CPerlObj::Perl_magic_len +#undef magic_methpack +#define magic_methpack CPerlObj::magic_methpack +#undef magic_nextpack +#define magic_nextpack CPerlObj::Perl_magic_nextpack +#undef magic_set +#define magic_set CPerlObj::Perl_magic_set +#undef magic_set_all_env +#define magic_set_all_env CPerlObj::Perl_magic_set_all_env +#undef magic_setamagic +#define magic_setamagic CPerlObj::Perl_magic_setamagic +#undef magic_setarylen +#define magic_setarylen CPerlObj::Perl_magic_setarylen +#undef magic_setbm +#define magic_setbm CPerlObj::Perl_magic_setbm +#undef magic_setcollxfrm +#define magic_setcollxfrm CPerlObj::Perl_magic_setcollxfrm +#undef magic_setdbline +#define magic_setdbline CPerlObj::Perl_magic_setdbline +#undef magic_setdefelem +#define magic_setdefelem CPerlObj::Perl_magic_setdefelem +#undef magic_setenv +#define magic_setenv CPerlObj::Perl_magic_setenv +#undef magic_setfm +#define magic_setfm CPerlObj::Perl_magic_setfm +#undef magic_setisa +#define magic_setisa CPerlObj::Perl_magic_setisa +#undef magic_setglob +#define magic_setglob CPerlObj::Perl_magic_setglob +#undef magic_setmglob +#define magic_setmglob CPerlObj::Perl_magic_setmglob +#undef magic_setnkeys +#define magic_setnkeys CPerlObj::Perl_magic_setnkeys +#undef magic_setpack +#define magic_setpack CPerlObj::Perl_magic_setpack +#undef magic_setpos +#define magic_setpos CPerlObj::Perl_magic_setpos +#undef magic_setsig +#define magic_setsig CPerlObj::Perl_magic_setsig +#undef magic_setsubstr +#define magic_setsubstr CPerlObj::Perl_magic_setsubstr +#undef magic_settaint +#define magic_settaint CPerlObj::Perl_magic_settaint +#undef magic_setuvar +#define magic_setuvar CPerlObj::Perl_magic_setuvar +#undef magic_setvec +#define magic_setvec CPerlObj::Perl_magic_setvec +#undef magic_wipepack +#define magic_wipepack CPerlObj::Perl_magic_wipepack +#undef magicname +#define magicname CPerlObj::Perl_magicname +#undef markstack_grow +#define markstack_grow CPerlObj::Perl_markstack_grow +#undef markstack_ptr +#define markstack_ptr CPerlObj::Perl_markstack_ptr +#undef mess +#define mess CPerlObj::Perl_mess +#undef mess_alloc +#define mess_alloc CPerlObj::mess_alloc +#undef mem_collxfrm +#define mem_collxfrm CPerlObj::Perl_mem_collxfrm +#undef mg_clear +#define mg_clear CPerlObj::Perl_mg_clear +#undef mg_copy +#define mg_copy CPerlObj::Perl_mg_copy +#undef mg_find +#define mg_find CPerlObj::Perl_mg_find +#undef mg_free +#define mg_free CPerlObj::Perl_mg_free +#undef mg_get +#define mg_get CPerlObj::Perl_mg_get +#undef mg_len +#define mg_len CPerlObj::Perl_mg_len +#undef mg_magical +#define mg_magical CPerlObj::Perl_mg_magical +#undef mg_set +#define mg_set CPerlObj::Perl_mg_set +#undef missingterm +#define missingterm CPerlObj::missingterm +#undef mod +#define mod CPerlObj::Perl_mod +#undef modkids +#define modkids CPerlObj::Perl_modkids +#undef moreswitches +#define moreswitches CPerlObj::Perl_moreswitches +#undef more_sv +#define more_sv CPerlObj::more_sv +#undef more_xiv +#define more_xiv CPerlObj::more_xiv +#undef more_xnv +#define more_xnv CPerlObj::more_xnv +#undef more_xpv +#define more_xpv CPerlObj::more_xpv +#undef more_xrv +#define more_xrv CPerlObj::more_xrv +#undef mstats +#define mstats CPerlObj::mstats +#undef mul128 +#define mul128 CPerlObj::mul128 +#undef my +#define my CPerlObj::Perl_my +#undef my_bcopy +#define my_bcopy CPerlObj::Perl_my_bcopy +#undef my_bzero +#define my_bzero CPerlObj::Perl_my_bzero +#undef my_exit +#define my_exit CPerlObj::Perl_my_exit +#undef my_exit_jump +#define my_exit_jump CPerlObj::my_exit_jump +#undef my_failure_exit +#define my_failure_exit CPerlObj::Perl_my_failure_exit +#undef my_lstat +#define my_lstat CPerlObj::Perl_my_lstat +#undef my_memcmp +#define my_memcmp CPerlObj::my_memcmp +#undef my_pclose +#define my_pclose CPerlObj::Perl_my_pclose +#undef my_popen +#define my_popen CPerlObj::Perl_my_popen +#undef my_setenv +#define my_setenv CPerlObj::Perl_my_setenv +#undef my_stat +#define my_stat CPerlObj::Perl_my_stat +#undef my_swap +#define my_swap CPerlObj::my_swap +#undef my_htonl +#define my_htonl CPerlObj::my_htonl +#undef my_ntohl +#define my_ntohl CPerlObj::my_ntohl +#undef my_unexec +#define my_unexec CPerlObj::Perl_my_unexec +#undef newANONLIST +#define newANONLIST CPerlObj::Perl_newANONLIST +#undef newANONHASH +#define newANONHASH CPerlObj::Perl_newANONHASH +#undef newANONSUB +#define newANONSUB CPerlObj::Perl_newANONSUB +#undef newASSIGNOP +#define newASSIGNOP CPerlObj::Perl_newASSIGNOP +#undef newCONDOP +#define newCONDOP CPerlObj::Perl_newCONDOP +#undef newDEFSVOP +#define newDEFSVOP CPerlObj::newDEFSVOP +#undef newFORM +#define newFORM CPerlObj::Perl_newFORM +#undef newFOROP +#define newFOROP CPerlObj::Perl_newFOROP +#undef newLOGOP +#define newLOGOP CPerlObj::Perl_newLOGOP +#undef newLOOPEX +#define newLOOPEX CPerlObj::Perl_newLOOPEX +#undef newLOOPOP +#define newLOOPOP CPerlObj::Perl_newLOOPOP +#undef newMETHOD +#define newMETHOD CPerlObj::Perl_newMETHOD +#undef newNULLLIST +#define newNULLLIST CPerlObj::Perl_newNULLLIST +#undef newOP +#define newOP CPerlObj::Perl_newOP +#undef newPROG +#define newPROG CPerlObj::Perl_newPROG +#undef newRANGE +#define newRANGE CPerlObj::Perl_newRANGE +#undef newSLICEOP +#define newSLICEOP CPerlObj::Perl_newSLICEOP +#undef newSTATEOP +#define newSTATEOP CPerlObj::Perl_newSTATEOP +#undef newSUB +#define newSUB CPerlObj::Perl_newSUB +#undef newXS +#define newXS CPerlObj::Perl_newXS +#undef newXSUB +#define newXSUB CPerlObj::Perl_newXSUB +#undef newAV +#define newAV CPerlObj::Perl_newAV +#undef newAVREF +#define newAVREF CPerlObj::Perl_newAVREF +#undef newBINOP +#define newBINOP CPerlObj::Perl_newBINOP +#undef newCVREF +#define newCVREF CPerlObj::Perl_newCVREF +#undef newCVOP +#define newCVOP CPerlObj::Perl_newCVOP +#undef newGVOP +#define newGVOP CPerlObj::Perl_newGVOP +#undef newGVgen +#define newGVgen CPerlObj::Perl_newGVgen +#undef newGVREF +#define newGVREF CPerlObj::Perl_newGVREF +#undef newHVREF +#define newHVREF CPerlObj::Perl_newHVREF +#undef newHV +#define newHV CPerlObj::Perl_newHV +#undef newIO +#define newIO CPerlObj::Perl_newIO +#undef newLISTOP +#define newLISTOP CPerlObj::Perl_newLISTOP +#undef newPMOP +#define newPMOP CPerlObj::Perl_newPMOP +#undef newPVOP +#define newPVOP CPerlObj::Perl_newPVOP +#undef newRV +#define newRV CPerlObj::Perl_newRV +#undef Perl_newRV_noinc +#define Perl_newRV_noinc CPerlObj::Perl_newRV_noinc +#undef newSV +#define newSV CPerlObj::Perl_newSV +#undef newSV +#define newSV CPerlObj::Perl_newSV +#undef newSVREF +#define newSVREF CPerlObj::Perl_newSVREF +#undef newSVOP +#define newSVOP CPerlObj::Perl_newSVOP +#undef newSViv +#define newSViv CPerlObj::Perl_newSViv +#undef newSVnv +#define newSVnv CPerlObj::Perl_newSVnv +#undef newSVpv +#define newSVpv CPerlObj::Perl_newSVpv +#undef newSVrv +#define newSVrv CPerlObj::Perl_newSVrv +#undef newSVsv +#define newSVsv CPerlObj::Perl_newSVsv +#undef newSVpvf +#define newSVpvf CPerlObj::Perl_newSVpvf +#undef newUNOP +#define newUNOP CPerlObj::Perl_newUNOP +#undef newWHILEOP +#define newWHILEOP CPerlObj::Perl_newWHILEOP +#undef new_sv +#define new_sv CPerlObj::new_sv +#undef new_xiv +#define new_xiv CPerlObj::new_xiv +#undef new_xnv +#define new_xnv CPerlObj::new_xnv +#undef new_xpv +#define new_xpv CPerlObj::new_xpv +#undef new_xrv +#define new_xrv CPerlObj::new_xrv +#undef nextargv +#define nextargv CPerlObj::Perl_nextargv +#undef nextchar +#define nextchar CPerlObj::nextchar +#undef ninstr +#define ninstr CPerlObj::Perl_ninstr +#undef not_a_number +#define not_a_number CPerlObj::not_a_number +#undef no_fh_allowed +#define no_fh_allowed CPerlObj::Perl_no_fh_allowed +#undef no_op +#define no_op CPerlObj::Perl_no_op +#undef null +#define null CPerlObj::null +#undef profiledata +#define profiledata CPerlObj::Perl_profiledata +#undef package +#define package CPerlObj::Perl_package +#undef pad_alloc +#define pad_alloc CPerlObj::Perl_pad_alloc +#undef pad_allocmy +#define pad_allocmy CPerlObj::Perl_pad_allocmy +#undef pad_findmy +#define pad_findmy CPerlObj::Perl_pad_findmy +#undef op_free +#define op_free CPerlObj::Perl_op_free +#undef oopsCV +#define oopsCV CPerlObj::Perl_oopsCV +#undef oopsAV +#define oopsAV CPerlObj::Perl_oopsAV +#undef oopsHV +#define oopsHV CPerlObj::Perl_oopsHV +#undef open_script +#define open_script CPerlObj::open_script +#undef pad_leavemy +#define pad_leavemy CPerlObj::Perl_pad_leavemy +#undef pad_sv +#define pad_sv CPerlObj::Perl_pad_sv +#undef pad_findlex +#define pad_findlex CPerlObj::pad_findlex +#undef pad_free +#define pad_free CPerlObj::Perl_pad_free +#undef pad_reset +#define pad_reset CPerlObj::Perl_pad_reset +#undef pad_swipe +#define pad_swipe CPerlObj::Perl_pad_swipe +#undef peep +#define peep CPerlObj::Perl_peep +#undef perl_call_argv +#define perl_call_argv CPerlObj::perl_call_argv +#undef perl_call_method +#define perl_call_method CPerlObj::perl_call_method +#undef perl_call_pv +#define perl_call_pv CPerlObj::perl_call_pv +#undef perl_call_sv +#define perl_call_sv CPerlObj::perl_call_sv +#undef perl_callargv +#define perl_callargv CPerlObj::perl_callargv +#undef perl_callpv +#define perl_callpv CPerlObj::perl_callpv +#undef perl_callsv +#define perl_callsv CPerlObj::perl_callsv +#undef perl_eval_pv +#define perl_eval_pv CPerlObj::perl_eval_pv +#undef perl_eval_sv +#define perl_eval_sv CPerlObj::perl_eval_sv +#undef perl_get_sv +#define perl_get_sv CPerlObj::perl_get_sv +#undef perl_get_av +#define perl_get_av CPerlObj::perl_get_av +#undef perl_get_hv +#define perl_get_hv CPerlObj::perl_get_hv +#undef perl_get_cv +#define perl_get_cv CPerlObj::perl_get_cv +#undef Perl_GetVars +#define Perl_GetVars CPerlObj::Perl_GetVars +#undef perl_init_fold +#define perl_init_fold CPerlObj::perl_init_fold +#undef perl_init_i18nl10n +#define perl_init_i18nl10n CPerlObj::perl_init_i18nl10n +#undef perl_init_i18nl14n +#define perl_init_i18nl14n CPerlObj::perl_init_i18nl14n +#undef perl_new_collate +#define perl_new_collate CPerlObj::perl_new_collate +#undef perl_new_ctype +#define perl_new_ctype CPerlObj::perl_new_ctype +#undef perl_new_numeric +#define perl_new_numeric CPerlObj::perl_new_numeric +#undef perl_set_numeric_standard +#define perl_set_numeric_standard CPerlObj::perl_set_numeric_standard +#undef perl_set_numeric_local +#define perl_set_numeric_local CPerlObj::perl_set_numeric_local +#undef perl_require_pv +#define perl_require_pv CPerlObj::perl_require_pv +#undef perl_thread +#define perl_thread CPerlObj::perl_thread +#undef pidgone +#define pidgone CPerlObj::Perl_pidgone +#undef pmflag +#define pmflag CPerlObj::Perl_pmflag +#undef pmruntime +#define pmruntime CPerlObj::Perl_pmruntime +#undef pmtrans +#define pmtrans CPerlObj::Perl_pmtrans +#undef pop_return +#define pop_return CPerlObj::Perl_pop_return +#undef pop_scope +#define pop_scope CPerlObj::Perl_pop_scope +#undef prepend_elem +#define prepend_elem CPerlObj::Perl_prepend_elem +#undef provide_ref +#define provide_ref CPerlObj::Perl_provide_ref +#undef push_return +#define push_return CPerlObj::Perl_push_return +#undef push_scope +#define push_scope CPerlObj::Perl_push_scope +#undef pregcomp +#define pregcomp CPerlObj::Perl_pregcomp +#undef ref +#define ref CPerlObj::Perl_ref +#undef refkids +#define refkids CPerlObj::Perl_refkids +#undef regdump +#define regdump CPerlObj::Perl_regdump +#undef rsignal +#define rsignal CPerlObj::Perl_rsignal +#undef rsignal_restore +#define rsignal_restore CPerlObj::Perl_rsignal_restore +#undef rsignal_save +#define rsignal_save CPerlObj::Perl_rsignal_save +#undef rsignal_state +#define rsignal_state CPerlObj::Perl_rsignal_state +#undef pregexec +#define pregexec CPerlObj::Perl_pregexec +#undef pregfree +#define pregfree CPerlObj::Perl_pregfree +#undef re_croak2 +#define re_croak2 CPerlObj::re_croak2 +#undef refto +#define refto CPerlObj::refto +#undef reg +#define reg CPerlObj::reg +#undef reg_node +#define reg_node CPerlObj::reg_node +#undef reganode +#define reganode CPerlObj::reganode +#undef regatom +#define regatom CPerlObj::regatom +#undef regbranch +#define regbranch CPerlObj::regbranch +#undef regc +#define regc CPerlObj::regc +#undef regcurly +#define regcurly CPerlObj::regcurly +#undef regcppush +#define regcppush CPerlObj::regcppush +#undef regcppop +#define regcppop CPerlObj::regcppop +#undef regclass +#define regclass CPerlObj::regclass +#undef regexec_flags +#define regexec_flags CPerlObj::Perl_regexec_flags +#undef reginclass +#define reginclass CPerlObj::reginclass +#undef reginsert +#define reginsert CPerlObj::reginsert +#undef regmatch +#define regmatch CPerlObj::regmatch +#undef regnext +#define regnext CPerlObj::Perl_regnext +#undef regoptail +#define regoptail CPerlObj::regoptail +#undef regpiece +#define regpiece CPerlObj::regpiece +#undef regprop +#define regprop CPerlObj::Perl_regprop +#undef regrepeat +#define regrepeat CPerlObj::regrepeat +#undef regrepeat_hard +#define regrepeat_hard CPerlObj::regrepeat_hard +#undef regset +#define regset CPerlObj::regset +#undef regtail +#define regtail CPerlObj::regtail +#undef regtry +#define regtry CPerlObj::regtry +#undef repeatcpy +#define repeatcpy CPerlObj::Perl_repeatcpy +#undef restore_magic +#define restore_magic CPerlObj::restore_magic +#undef restore_rsfp +#define restore_rsfp CPerlObj::restore_rsfp +#undef rninstr +#define rninstr CPerlObj::Perl_rninstr +#undef runops_standard +#define runops_standard CPerlObj::Perl_runops_standard +#undef runops_debug +#define runops_debug CPerlObj::Perl_runops_debug +#undef rxres_free +#define rxres_free CPerlObj::Perl_rxres_free +#undef rxres_restore +#define rxres_restore CPerlObj::Perl_rxres_restore +#undef rxres_save +#define rxres_save CPerlObj::Perl_rxres_save +#ifndef MYMALLOC +#undef safefree +#define safefree CPerlObj::Perl_safefree +#undef safecalloc +#define safecalloc CPerlObj::Perl_safecalloc +#undef safemalloc +#define safemalloc CPerlObj::Perl_safemalloc +#undef saferealloc +#define saferealloc CPerlObj::Perl_saferealloc +#endif /* MYMALLOC */ +#undef same_dirent +#define same_dirent CPerlObj::same_dirent +#undef savepv +#define savepv CPerlObj::Perl_savepv +#undef savepvn +#define savepvn CPerlObj::Perl_savepvn +#undef savestack_grow +#define savestack_grow CPerlObj::Perl_savestack_grow +#undef save_aptr +#define save_aptr CPerlObj::Perl_save_aptr +#undef save_ary +#define save_ary CPerlObj::Perl_save_ary +#undef save_clearsv +#define save_clearsv CPerlObj::Perl_save_clearsv +#undef save_delete +#define save_delete CPerlObj::Perl_save_delete +#undef save_destructor +#define save_destructor CPerlObj::Perl_save_destructor +#undef save_freesv +#define save_freesv CPerlObj::Perl_save_freesv +#undef save_freeop +#define save_freeop CPerlObj::Perl_save_freeop +#undef save_freepv +#define save_freepv CPerlObj::Perl_save_freepv +#undef save_gp +#define save_gp CPerlObj::Perl_save_gp +#undef save_hash +#define save_hash CPerlObj::Perl_save_hash +#undef save_hek +#define save_hek CPerlObj::save_hek +#undef save_hptr +#define save_hptr CPerlObj::Perl_save_hptr +#undef save_I16 +#define save_I16 CPerlObj::Perl_save_I16 +#undef save_I32 +#define save_I32 CPerlObj::Perl_save_I32 +#undef save_int +#define save_int CPerlObj::Perl_save_int +#undef save_item +#define save_item CPerlObj::Perl_save_item +#undef save_iv +#define save_iv CPerlObj::Perl_save_iv +#undef save_lines +#define save_lines CPerlObj::save_lines +#undef save_list +#define save_list CPerlObj::Perl_save_list +#undef save_long +#define save_long CPerlObj::Perl_save_long +#undef save_magic +#define save_magic CPerlObj::save_magic +#undef save_nogv +#define save_nogv CPerlObj::Perl_save_nogv +#undef save_op +#define save_op CPerlObj::Perl_save_op +#undef save_scalar +#define save_scalar CPerlObj::Perl_save_scalar +#undef save_scalar_at +#define save_scalar_at CPerlObj::save_scalar_at +#undef save_pptr +#define save_pptr CPerlObj::Perl_save_pptr +#undef save_sptr +#define save_sptr CPerlObj::Perl_save_sptr +#undef save_svref +#define save_svref CPerlObj::Perl_save_svref +#undef save_threadsv +#define save_threadsv CPerlObj::Perl_save_threadsv +#undef sawparens +#define sawparens CPerlObj::Perl_sawparens +#undef scalar +#define scalar CPerlObj::Perl_scalar +#undef scalarboolean +#define scalarboolean CPerlObj::scalarboolean +#undef scalarkids +#define scalarkids CPerlObj::Perl_scalarkids +#undef scalarseq +#define scalarseq CPerlObj::Perl_scalarseq +#undef scalarvoid +#define scalarvoid CPerlObj::Perl_scalarvoid +#undef scan_commit +#define scan_commit CPerlObj::scan_commit +#undef scan_const +#define scan_const CPerlObj::Perl_scan_const +#undef scan_formline +#define scan_formline CPerlObj::Perl_scan_formline +#undef scan_ident +#define scan_ident CPerlObj::Perl_scan_ident +#undef scan_inputsymbol +#define scan_inputsymbol CPerlObj::Perl_scan_inputsymbol +#undef scan_heredoc +#define scan_heredoc CPerlObj::Perl_scan_heredoc +#undef scan_hex +#define scan_hex CPerlObj::Perl_scan_hex +#undef scan_num +#define scan_num CPerlObj::Perl_scan_num +#undef scan_oct +#define scan_oct CPerlObj::Perl_scan_oct +#undef scan_pat +#define scan_pat CPerlObj::Perl_scan_pat +#undef scan_str +#define scan_str CPerlObj::Perl_scan_str +#undef scan_subst +#define scan_subst CPerlObj::Perl_scan_subst +#undef scan_trans +#define scan_trans CPerlObj::Perl_scan_trans +#undef scan_word +#define scan_word CPerlObj::Perl_scan_word +#undef scope +#define scope CPerlObj::Perl_scope +#undef screaminstr +#define screaminstr CPerlObj::Perl_screaminstr +#undef seed +#define seed CPerlObj::seed +#undef setdefout +#define setdefout CPerlObj::Perl_setdefout +#undef setenv_getix +#define setenv_getix CPerlObj::Perl_setenv_getix +#undef sharepvn +#define sharepvn CPerlObj::Perl_sharepvn +#undef set_csh +#define set_csh CPerlObj::set_csh +#undef sighandler +#define sighandler CPerlObj::Perl_sighandler +#undef share_hek +#define share_hek CPerlObj::Perl_share_hek +#undef skipspace +#define skipspace CPerlObj::Perl_skipspace +#undef sortcv +#define sortcv CPerlObj::sortcv +#undef sortcmp +#define sortcmp CPerlObj::sortcmp +#undef sortcmp_locale +#define sortcmp_locale CPerlObj::sortcmp_locale +#ifndef PERL_OBJECT +#undef stack_base +#define stack_base CPerlObj::Perl_stack_base +#endif +#undef stack_grow +#define stack_grow CPerlObj::Perl_stack_grow +#undef start_subparse +#define start_subparse CPerlObj::Perl_start_subparse +#undef study_chunk +#define study_chunk CPerlObj::study_chunk +#undef sub_crush_depth +#define sub_crush_depth CPerlObj::Perl_sub_crush_depth +#undef sublex_done +#define sublex_done CPerlObj::sublex_done +#undef sublex_push +#define sublex_push CPerlObj::sublex_push +#undef sublex_start +#define sublex_start CPerlObj::sublex_start +#undef sv_2bool +#define sv_2bool CPerlObj::Perl_sv_2bool +#undef sv_2cv +#define sv_2cv CPerlObj::Perl_sv_2cv +#undef sv_2io +#define sv_2io CPerlObj::Perl_sv_2io +#undef sv_2iv +#define sv_2iv CPerlObj::Perl_sv_2iv +#undef sv_2uv +#define sv_2uv CPerlObj::Perl_sv_2uv +#undef sv_2mortal +#define sv_2mortal CPerlObj::Perl_sv_2mortal +#undef sv_2nv +#define sv_2nv CPerlObj::Perl_sv_2nv +#undef sv_2pv +#define sv_2pv CPerlObj::Perl_sv_2pv +#undef sv_add_arena +#define sv_add_arena CPerlObj::Perl_sv_add_arena +#undef sv_backoff +#define sv_backoff CPerlObj::Perl_sv_backoff +#undef sv_bless +#define sv_bless CPerlObj::Perl_sv_bless +#undef sv_catpv +#define sv_catpv CPerlObj::Perl_sv_catpv +#undef sv_catpvf +#define sv_catpvf CPerlObj::Perl_sv_catpvf +#undef sv_catpvn +#define sv_catpvn CPerlObj::Perl_sv_catpvn +#undef sv_catsv +#define sv_catsv CPerlObj::Perl_sv_catsv +#undef sv_check_thinkfirst +#define sv_check_thinkfirst CPerlObj::sv_check_thinkfirst +#undef sv_chop +#define sv_chop CPerlObj::Perl_sv_chop +#undef sv_clean_all +#define sv_clean_all CPerlObj::Perl_sv_clean_all +#undef sv_clean_objs +#define sv_clean_objs CPerlObj::Perl_sv_clean_objs +#undef sv_clear +#define sv_clear CPerlObj::Perl_sv_clear +#undef sv_cmp +#define sv_cmp CPerlObj::Perl_sv_cmp +#undef sv_cmp_locale +#define sv_cmp_locale CPerlObj::Perl_sv_cmp_locale +#undef sv_collxfrm +#define sv_collxfrm CPerlObj::Perl_sv_collxfrm +#undef sv_compile_2op +#define sv_compile_2op CPerlObj::Perl_sv_compile_2op +#undef sv_dec +#define sv_dec CPerlObj::Perl_sv_dec +#undef sv_derived_from +#define sv_derived_from CPerlObj::Perl_sv_derived_from +#undef sv_dump +#define sv_dump CPerlObj::Perl_sv_dump +#undef sv_eq +#define sv_eq CPerlObj::Perl_sv_eq +#undef sv_free +#define sv_free CPerlObj::Perl_sv_free +#undef sv_free_arenas +#define sv_free_arenas CPerlObj::Perl_sv_free_arenas +#undef sv_gets +#define sv_gets CPerlObj::Perl_sv_gets +#undef sv_grow +#define sv_grow CPerlObj::Perl_sv_grow +#undef sv_inc +#define sv_inc CPerlObj::Perl_sv_inc +#undef sv_insert +#define sv_insert CPerlObj::Perl_sv_insert +#undef sv_isa +#define sv_isa CPerlObj::Perl_sv_isa +#undef sv_isobject +#define sv_isobject CPerlObj::Perl_sv_isobject +#undef sv_iv +#define sv_iv CPerlObj::Perl_sv_iv +#undef sv_len +#define sv_len CPerlObj::Perl_sv_len +#undef sv_magic +#define sv_magic CPerlObj::Perl_sv_magic +#undef sv_mortalcopy +#define sv_mortalcopy CPerlObj::Perl_sv_mortalcopy +#undef sv_mortalgrow +#define sv_mortalgrow CPerlObj::sv_mortalgrow +#undef sv_newmortal +#define sv_newmortal CPerlObj::Perl_sv_newmortal +#undef sv_newref +#define sv_newref CPerlObj::Perl_sv_newref +#undef sv_nv +#define sv_nv CPerlObj::Perl_sv_nv +#undef sv_peek +#define sv_peek CPerlObj::Perl_sv_peek +#undef sv_pvn +#define sv_pvn CPerlObj::Perl_sv_pvn +#undef sv_pvn_force +#define sv_pvn_force CPerlObj::Perl_sv_pvn_force +#undef sv_reftype +#define sv_reftype CPerlObj::Perl_sv_reftype +#undef sv_replace +#define sv_replace CPerlObj::Perl_sv_replace +#undef sv_report_used +#define sv_report_used CPerlObj::Perl_sv_report_used +#undef sv_reset +#define sv_reset CPerlObj::Perl_sv_reset +#undef sv_setiv +#define sv_setiv CPerlObj::Perl_sv_setiv +#undef sv_setnv +#define sv_setnv CPerlObj::Perl_sv_setnv +#undef sv_setuv +#define sv_setuv CPerlObj::Perl_sv_setuv +#undef sv_setref_iv +#define sv_setref_iv CPerlObj::Perl_sv_setref_iv +#undef sv_setref_nv +#define sv_setref_nv CPerlObj::Perl_sv_setref_nv +#undef sv_setref_pv +#define sv_setref_pv CPerlObj::Perl_sv_setref_pv +#undef sv_setref_pvn +#define sv_setref_pvn CPerlObj::Perl_sv_setref_pvn +#undef sv_setpv +#define sv_setpv CPerlObj::Perl_sv_setpv +#undef sv_setpvf +#define sv_setpvf CPerlObj::Perl_sv_setpvf +#undef sv_setpviv +#define sv_setpviv CPerlObj::Perl_sv_setpviv +#undef sv_setpvn +#define sv_setpvn CPerlObj::Perl_sv_setpvn +#undef sv_setsv +#define sv_setsv CPerlObj::Perl_sv_setsv +#undef sv_taint +#define sv_taint CPerlObj::Perl_sv_taint +#undef sv_tainted +#define sv_tainted CPerlObj::Perl_sv_tainted +#undef sv_true +#define sv_true CPerlObj::Perl_sv_true +#undef sv_unglob +#define sv_unglob CPerlObj::sv_unglob +#undef sv_unmagic +#define sv_unmagic CPerlObj::Perl_sv_unmagic +#undef sv_unref +#define sv_unref CPerlObj::Perl_sv_unref +#undef sv_untaint +#define sv_untaint CPerlObj::Perl_sv_untaint +#undef sv_upgrade +#define sv_upgrade CPerlObj::Perl_sv_upgrade +#undef sv_usepvn +#define sv_usepvn CPerlObj::Perl_sv_usepvn +#undef sv_uv +#define sv_uv CPerlObj::Perl_sv_uv +#undef sv_vcatpvfn +#define sv_vcatpvfn CPerlObj::Perl_sv_vcatpvfn +#undef sv_vsetpvfn +#define sv_vsetpvfn CPerlObj::Perl_sv_vsetpvfn +#undef taint_env +#define taint_env CPerlObj::Perl_taint_env +#undef taint_not +#define taint_not CPerlObj::Perl_taint_not +#undef taint_proper +#define taint_proper CPerlObj::Perl_taint_proper +#undef tokeq +#define tokeq CPerlObj::tokeq +#undef too_few_arguments +#define too_few_arguments CPerlObj::Perl_too_few_arguments +#undef too_many_arguments +#define too_many_arguments CPerlObj::Perl_too_many_arguments +#undef unlnk +#define unlnk CPerlObj::unlnk +#undef unsharepvn +#define unsharepvn CPerlObj::Perl_unsharepvn +#undef unshare_hek +#define unshare_hek CPerlObj::Perl_unshare_hek +#undef unwind_handler_stack +#define unwind_handler_stack CPerlObj::unwind_handler_stack +#undef usage +#define usage CPerlObj::usage +#undef utilize +#define utilize CPerlObj::Perl_utilize +#undef validate_suid +#define validate_suid CPerlObj::validate_suid +#undef visit +#define visit CPerlObj::visit +#undef vivify_defelem +#define vivify_defelem CPerlObj::Perl_vivify_defelem +#undef vivify_ref +#define vivify_ref CPerlObj::Perl_vivify_ref +#undef wait4pid +#define wait4pid CPerlObj::Perl_wait4pid +#undef warn +#define warn CPerlObj::Perl_warn +#undef watch +#define watch CPerlObj::Perl_watch +#undef whichsig +#define whichsig CPerlObj::Perl_whichsig +#undef win32_textfilter +#define win32_textfilter CPerlObj::win32_textfilter +#undef yyerror +#define yyerror CPerlObj::Perl_yyerror +#undef yylex +#define yylex CPerlObj::Perl_yylex +#undef yyparse +#define yyparse CPerlObj::Perl_yyparse +#undef yywarn +#define yywarn CPerlObj::Perl_yywarn +#undef yydestruct +#define yydestruct CPerlObj::Perl_yydestruct + +#define new_he CPerlObj::new_he +#define more_he CPerlObj::more_he +#define del_he CPerlObj::del_he + +#ifdef WIN32 +#undef errno +#define errno CPerlObj::ErrorNo() + +#endif /* WIN32 */ + +#endif /* __Objpp_h__ */ @@ -18,6 +18,12 @@ #include "EXTERN.h" #include "perl.h" +#ifdef PERL_OBJECT +#define CHECKCALL this->*check +#else +#define CHECKCALL *check +#endif + /* * In the following definition, the ", Nullop" is just to make the compiler * think the expression is of the right type: croak actually does a Siglongjmp. @@ -27,13 +33,14 @@ ? ( op_free((OP*)o), \ croak("%s trapped by operation mask", op_desc[type]), \ Nullop ) \ - : (*check[type])((OP*)o)) + : (CHECKCALL[type])((OP*)o)) +static bool scalar_mod_type _((OP *o, I32 type)); +#ifndef PERL_OBJECT static I32 list_assignment _((OP *o)); static void bad_type _((I32 n, char *t, char *name, OP *kid)); static OP *modkids _((OP *o, I32 type)); static OP *no_fh_allowed _((OP *o)); -static bool scalar_mod_type _((OP *o, I32 type)); static OP *scalarboolean _((OP *o)); static OP *too_few_arguments _((OP *o, char* name)); static OP *too_many_arguments _((OP *o, char* name)); @@ -41,8 +48,9 @@ static void null _((OP* o)); static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)); static OP *newDEFSVOP _((void)); +#endif -static char* +STATIC char* gv_ename(GV *gv) { SV* tmpsv = sv_newmortal(); @@ -50,7 +58,7 @@ gv_ename(GV *gv) return SvPV(tmpsv,na); } -static OP * +STATIC OP * no_fh_allowed(OP *o) { yyerror(form("Missing comma after first argument to %s function", @@ -58,21 +66,21 @@ no_fh_allowed(OP *o) return o; } -static OP * +STATIC OP * too_few_arguments(OP *o, char *name) { yyerror(form("Not enough arguments for %s", name)); return o; } -static OP * +STATIC OP * too_many_arguments(OP *o, char *name) { yyerror(form("Too many arguments for %s", name)); return o; } -static void +STATIC void bad_type(I32 n, char *t, char *name, OP *kid) { yyerror(form("Type of arg %d to %s must be %s (not %s)", @@ -147,7 +155,7 @@ pad_allocmy(char *name) return off; } -static PADOFFSET +STATIC PADOFFSET #ifndef CAN_PROTOTYPE pad_findlex(name, newoff, seq, startcv, cx_ix) char *name; @@ -615,7 +623,7 @@ op_free(OP *o) Safefree(o); } -static void +STATIC void null(OP *o) { if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0) @@ -664,7 +672,7 @@ scalarkids(OP *o) return o; } -static OP * +STATIC OP * scalarboolean(OP *o) { if (dowarn && @@ -1034,7 +1042,7 @@ scalarseq(OP *o) return o; } -static OP * +STATIC OP * modkids(OP *o, I32 type) { OP *kid; @@ -1534,7 +1542,7 @@ block_end(I32 floor, OP *seq) return retval; } -static OP * +STATIC OP * newDEFSVOP(void) { #ifdef USE_THREADS @@ -1663,7 +1671,7 @@ fold_constants(register OP *o) curop = LINKLIST(o); o->op_next = 0; op = curop; - runops(); + CALLRUNOPS(); sv = *(stack_sp--); if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */ pad_swipe(o->op_targ); @@ -1725,7 +1733,7 @@ gen_constant_list(register OP *o) op = curop = LINKLIST(o); o->op_next = 0; pp_pushmark(ARGS); - runops(); + CALLRUNOPS(); op = curop; pp_anonlist(ARGS); tmps_floor = oldtmps_floor; @@ -2362,7 +2370,7 @@ newSLICEOP(I32 flags, OP *subscript, OP *listval) list(force_list(listval)) ); } -static I32 +STATIC I32 list_assignment(register OP *o) { if (!o) @@ -3047,7 +3055,7 @@ cv_undef(CV *cv) } #ifdef DEBUG_CLOSURES -static void +STATIC void cv_dump(cv) CV* cv; { @@ -3092,7 +3100,7 @@ CV* cv; } #endif /* DEBUG_CLOSURES */ -static CV * +STATIC CV * cv_clone2(CV *proto, CV *outside) { dTHR; @@ -3500,7 +3508,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) } CV * -newXS(char *name, void (*subaddr) (CV *), char *filename) +newXS(char *name, void (*subaddr) (CPERLproto_ CV *), char *filename) { dTHR; GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV); @@ -35,7 +35,7 @@ typedef U32 PADOFFSET; #define BASEOP \ OP* op_next; \ OP* op_sibling; \ - OP* (*op_ppaddr)_((ARGSproto)); \ + OP* (CPERLscope(*op_ppaddr))_((ARGSproto)); \ PADOFFSET op_targ; \ OPCODE op_type; \ U16 op_seq; \ @@ -1061,6 +1061,7 @@ EXT char *op_desc[] = { }; #endif +#ifndef PERL_OBJECT START_EXTERN_C OP * ck_anoncode _((OP* o)); @@ -1444,11 +1445,13 @@ OP * pp_lock _((ARGSproto)); OP * pp_threadsv _((ARGSproto)); END_EXTERN_C +#endif /* PERL_OBJECT */ #ifndef DOINIT -EXT OP * (*ppaddr[])(ARGSproto); +EXT OP * (CPERLscope(*ppaddr)[])(ARGSproto); #else -EXT OP * (*ppaddr[])(ARGSproto) = { +#ifndef PERL_OBJECT +EXT OP * (CPERLscope(*ppaddr)[])(ARGSproto) = { pp_null, pp_stub, pp_scalar, @@ -1796,12 +1799,14 @@ EXT OP * (*ppaddr[])(ARGSproto) = { pp_lock, pp_threadsv, }; +#endif /* PERL_OBJECT */ #endif -#ifndef DOINIT -EXT OP * (*check[]) _((OP *op)); +#ifndef DOINIT +EXT OP * (CPERLscope(*check)[]) _((OP *op)); #else -EXT OP * (*check[]) _((OP *op)) = { +#ifndef PERL_OBJECT +EXT OP * (CPERLscope(*check)[]) _((OP *op)) = { ck_null, /* null */ ck_null, /* stub */ ck_fun, /* scalar */ @@ -2149,6 +2154,7 @@ EXT OP * (*check[]) _((OP *op)) = { ck_rfun, /* lock */ ck_null, /* threadsv */ }; +#endif /* PERL_OBJECT */ #endif #ifndef DOINIT @@ -62,6 +62,7 @@ dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n"; mess_sv = Nullsv; \ } STMT_END +#ifndef PERL_OBJECT static void find_beginning _((void)); static void forbid_setid _((char *)); static void incpush _((char *, int)); @@ -80,12 +81,13 @@ static void nuke_stacks _((void)); static void open_script _((char *, bool, SV *)); static void usage _((char *)); static void validate_suid _((char *, char*)); +#endif static int fdscript = -1; #if defined(DEBUGGING) && defined(USE_THREADS) && defined(__linux__) #include <asm/sigcontext.h> -static void +STATIC void catch_sigsegv(int signo, struct sigcontext_struct sc) { PerlProc_signal(SIGSEGV, SIG_DFL); @@ -96,6 +98,17 @@ catch_sigsegv(int signo, struct sigcontext_struct sc) } #endif +#ifdef PERL_OBJECT +CPerlObj* perl_alloc(IPerlMem* ipM, IPerlEnv* ipE, IPerlStdIO* ipStd, + IPerlLIO* ipLIO, IPerlDir* ipD, IPerlSock* ipS, IPerlProc* ipP) +{ + CPerlObj* pPerl = new(ipM) CPerlObj(ipM, ipE, ipStd, ipLIO, ipD, ipS, ipP); + if(pPerl != NULL) + pPerl->Init(); + + return pPerl; +} +#else PerlInterpreter * perl_alloc(void) { @@ -105,9 +118,14 @@ perl_alloc(void) New(53, sv_interp, 1, PerlInterpreter); return sv_interp; } +#endif void +#ifdef PERL_OBJECT +CPerlObj::perl_construct(void) +#else perl_construct(register PerlInterpreter *sv_interp) +#endif { #ifdef USE_THREADS int i; @@ -116,8 +134,10 @@ perl_construct(register PerlInterpreter *sv_interp) #endif /* FAKE_THREADS */ #endif /* USE_THREADS */ +#ifndef PERL_OBJECT if (!(curinterp = sv_interp)) return; +#endif #ifdef MULTIPLICITY Zero(sv_interp, 1, PerlInterpreter); @@ -143,6 +163,10 @@ perl_construct(register PerlInterpreter *sv_interp) COND_INIT(&eval_cond); MUTEX_INIT(&threads_mutex); COND_INIT(&nthreads_cond); + +#ifdef PERL_OBJECT + MUTEX_INIT(&sort_mutex); +#endif thr = init_main_thread(); #endif /* USE_THREADS */ @@ -165,7 +189,12 @@ perl_construct(register PerlInterpreter *sv_interp) nrs = newSVpv("\n", 1); rs = SvREFCNT_inc(nrs); +#ifdef PERL_OBJECT + /* TODO: */ + /* sighandlerp = sighandler; */ +#else sighandlerp = sighandler; +#endif pidstatus = newHV(); #ifdef MSDOS @@ -224,7 +253,11 @@ perl_construct(register PerlInterpreter *sv_interp) } void +#ifdef PERL_OBJECT +CPerlObj::perl_destruct(void) +#else perl_destruct(register PerlInterpreter *sv_interp) +#endif { dTHR; int destruct_level; /* 0=none, 1=full, 2=full with checks */ @@ -234,8 +267,10 @@ perl_destruct(register PerlInterpreter *sv_interp) Thread t; #endif /* USE_THREADS */ +#ifndef PERL_OBJECT if (!(curinterp = sv_interp)) return; +#endif #ifdef USE_THREADS #ifndef FAKE_THREADS @@ -311,7 +346,7 @@ perl_destruct(register PerlInterpreter *sv_interp) #ifdef DEBUGGING { char *s; - if (s = PerlENV_getenv("PERL_DESTRUCT_LEVEL")) { + if (s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL")) { int i = atoi(s); if (destruct_level < i) destruct_level = i; @@ -526,6 +561,9 @@ perl_destruct(register PerlInterpreter *sv_interp) hints = 0; /* Reset hints. Should hints be per-interpreter ? */ DEBUG_P(debprofdump()); +#ifdef PERL_OBJECT + MUTEX_DESTROY(&sort_mutex); +#endif #ifdef USE_THREADS MUTEX_DESTROY(&sv_mutex); MUTEX_DESTROY(&eval_mutex); @@ -551,15 +589,26 @@ perl_destruct(register PerlInterpreter *sv_interp) } void +#ifdef PERL_OBJECT +CPerlObj::perl_free(void) +#else perl_free(PerlInterpreter *sv_interp) +#endif { +#ifdef PERL_OBJECT +#else if (!(curinterp = sv_interp)) return; Safefree(sv_interp); +#endif } int +#ifdef PERL_OBJECT +CPerlObj::perl_parse(void (*xsinit) (CPerlObj*), int argc, char **argv, char **env) +#else perl_parse(PerlInterpreter *sv_interp, void (*xsinit) (void), int argc, char **argv, char **env) +#endif { dTHR; register SV *sv; @@ -580,8 +629,10 @@ setuid perl scripts securely.\n"); #endif #endif +#ifndef PERL_OBJECT if (!(curinterp = sv_interp)) return 255; +#endif #if defined(NeXT) && defined(__DYNAMIC__) _dyld_lookup_and_bind @@ -821,7 +872,7 @@ print \" \\@INC:\\n @INC\\n\";"); } switch_end: - if (!tainting && (s = PerlENV_getenv("PERL5OPT"))) { + if (!tainting && (s = PerlEnv_getenv("PERL5OPT"))) { while (s && *s) { while (isSPACE(*s)) s++; @@ -896,7 +947,7 @@ print \" \\@INC:\\n @INC\\n\";"); boot_core_UNIVERSAL(); if (xsinit) - (*xsinit)(); /* in case linked C routines want magical variables */ + (*xsinit)(THIS); /* in case linked C routines want magical variables */ #if defined(VMS) || defined(WIN32) || defined(DJGPP) init_os_extras(); #endif @@ -950,7 +1001,7 @@ print \" \\@INC:\\n @INC\\n\";"); FREETMPS; #ifdef MYMALLOC - if ((s=PerlENV_getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2) + if ((s=PerlEnv_getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2) dump_mstats("after compilation:"); #endif @@ -961,15 +1012,21 @@ print \" \\@INC:\\n @INC\\n\";"); } int +#ifdef PERL_OBJECT +CPerlObj::perl_run(void) +#else perl_run(PerlInterpreter *sv_interp) +#endif { dTHR; I32 oldscope; dJMPENV; int ret; +#ifndef PERL_OBJECT if (!(curinterp = sv_interp)) return 255; +#endif oldscope = scopestack_ix; @@ -987,7 +1044,7 @@ perl_run(PerlInterpreter *sv_interp) if (endav) call_list(oldscope, endav); #ifdef MYMALLOC - if (PerlENV_getenv("PERL_DEBUG_MSTATS")) + if (PerlEnv_getenv("PERL_DEBUG_MSTATS")) dump_mstats("after execution: "); #endif JMPENV_POP; @@ -1032,12 +1089,12 @@ perl_run(PerlInterpreter *sv_interp) if (restartop) { op = restartop; restartop = 0; - runops(); + CALLRUNOPS(); } else if (main_start) { CvDEPTH(main_cv) = 1; op = main_start; - runops(); + CALLRUNOPS(); } my_exit(0); @@ -1252,7 +1309,7 @@ perl_call_sv(SV *sv, I32 flags) if (op == (OP*)&myop) op = pp_entersub(ARGS); if (op) - runops(); + CALLRUNOPS(); retval = stack_sp - (stack_base + oldmark); if ((flags & G_EVAL) && !(flags & G_KEEPERR)) sv_setpv(ERRSV,""); @@ -1361,7 +1418,7 @@ perl_eval_sv(SV *sv, I32 flags) if (op == (OP*)&myop) op = pp_entereval(ARGS); if (op) - runops(); + CALLRUNOPS(); retval = stack_sp - (stack_base + oldmark); if (!(flags & G_KEEPERR)) sv_setpv(ERRSV,""); @@ -1419,14 +1476,14 @@ magicname(char *sym, char *name, I32 namlen) sv_magic(GvSV(gv), (SV*)gv, 0, name, namlen); } -static void +STATIC void usage(char *name) /* XXX move this out into a module ? */ { /* This message really ought to be max 23 lines. * Removed -h because the user already knows that opton. Others? */ - static char *usage[] = { + static char *usage_msg[] = { "-0[octal] specify record separator (\\0, if no argument)", "-a autosplit mode with -n or -p (splits $_ into @F)", "-c check syntax only (runs BEGIN and END blocks)", @@ -1453,7 +1510,7 @@ usage(char *name) /* XXX move this out into a module ? */ "\n", NULL }; - char **p = usage; + char **p = usage_msg; printf("\nUsage: %s [switches] [--] [programfile] [arguments]", name); while (*p) @@ -1739,7 +1796,7 @@ my_unexec(void) #endif } -static void +STATIC void init_main_stash(void) { dTHR; @@ -1777,10 +1834,10 @@ init_main_stash(void) } #ifdef CAN_PROTOTYPE -static void +STATIC void open_script(char *scriptname, bool dosearch, SV *sv) #else -static void +STATIC void open_script(scriptname,dosearch,sv) char *scriptname; bool dosearch; @@ -1879,7 +1936,7 @@ SV *sv; #endif DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",cur)); - if (Stat(cur,&statbuf) >= 0) { + if (PerlLIO_stat(cur,&statbuf) >= 0) { dosearch = 0; scriptname = cur; #ifdef SEARCH_EXTS @@ -1903,7 +1960,7 @@ SV *sv; #ifdef DOSISH && !strchr(scriptname, '\\') #endif - && (s = PerlENV_getenv("PATH"))) { + && (s = PerlEnv_getenv("PATH"))) { bool seen_dot = 0; bufend = s + strlen(s); @@ -1947,7 +2004,7 @@ SV *sv; do { #endif DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tokenbuf)); - retval = Stat(tokenbuf,&statbuf); + retval = PerlLIO_stat(tokenbuf,&statbuf); #ifdef SEARCH_EXTS } while ( retval < 0 /* not there */ && extidx>=0 && ext[extidx] /* try an extension? */ @@ -1970,7 +2027,7 @@ SV *sv; xfailed = savepv(tokenbuf); } #ifndef DOSISH - if (!xfound && !seen_dot && !xfailed && (Stat(scriptname,&statbuf) < 0)) + if (!xfound && !seen_dot && !xfailed && (PerlLIO_stat(scriptname,&statbuf) < 0)) #endif seen_dot = 1; /* Disable message. */ if (!xfound) @@ -2066,11 +2123,11 @@ sed %s -e \"/^[^#]/b\" \ #ifdef HAS_SETRESUID (void)setresuid((Uid_t)-1, uid, (Uid_t)-1); #else - setuid(uid); + PerlProc_setuid(uid); #endif #endif #endif - if (geteuid() != uid) + if (PerlProc_geteuid() != uid) croak("Can't do seteuid!\n"); } #endif /* IAMSUID */ @@ -2095,7 +2152,7 @@ sed %s -e \"/^[^#]/b\" \ if (!rsfp) { #ifdef DOSUID #ifndef IAMSUID /* in case script is not readable before setuid */ - if (euid && Stat(SvPVX(GvSV(curcop->cop_filegv)),&statbuf) >= 0 && + if (euid && PerlLIO_stat(SvPVX(GvSV(curcop->cop_filegv)),&statbuf) >= 0 && statbuf.st_mode & (S_ISUID|S_ISGID)) { /* try again */ PerlProc_execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv); @@ -2108,7 +2165,7 @@ sed %s -e \"/^[^#]/b\" \ } } -static void +STATIC void validate_suid(char *validarg, char *scriptname) { int which; @@ -2171,9 +2228,9 @@ validate_suid(char *validarg, char *scriptname) setresuid(euid,uid,(Uid_t)-1) < 0 # endif #endif - || getuid() != euid || geteuid() != uid) + || PerlProc_getuid() != euid || PerlProc_geteuid() != uid) croak("Can't swap uid and euid"); /* really paranoid */ - if (Stat(SvPVX(GvSV(curcop->cop_filegv)),&tmpstatbuf) < 0) + if (PerlLIO_stat(SvPVX(GvSV(curcop->cop_filegv)),&tmpstatbuf) < 0) croak("Permission denied"); /* testing full pathname here */ if (tmpstatbuf.st_dev != statbuf.st_dev || tmpstatbuf.st_ino != statbuf.st_ino) { @@ -2198,7 +2255,7 @@ validate_suid(char *validarg, char *scriptname) setresuid(uid,euid,(Uid_t)-1) < 0 # endif #endif - || getuid() != uid || geteuid() != euid) + || PerlProc_getuid() != uid || PerlProc_geteuid() != euid) croak("Can't reswap uid and euid"); if (!cando(S_IXUSR,FALSE,&statbuf)) /* can real uid exec? */ croak("Permission denied\n"); @@ -2260,11 +2317,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #ifdef HAS_SETRESGID (void)setresgid((Gid_t)-1,statbuf.st_gid,(Gid_t)-1); #else - setgid(statbuf.st_gid); + PerlProc_setgid(statbuf.st_gid); #endif #endif #endif - if (getegid() != statbuf.st_gid) + if (PerlProc_getegid() != statbuf.st_gid) croak("Can't do setegid!\n"); } if (statbuf.st_mode & S_ISUID) { @@ -2278,11 +2335,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #ifdef HAS_SETRESUID (void)setresuid((Uid_t)-1,statbuf.st_uid,(Uid_t)-1); #else - setuid(statbuf.st_uid); + PerlProc_setuid(statbuf.st_uid); #endif #endif #endif - if (geteuid() != statbuf.st_uid) + if (PerlProc_geteuid() != statbuf.st_uid) croak("Can't do seteuid!\n"); } else if (uid) { /* oops, mustn't run as root */ @@ -2295,11 +2352,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #ifdef HAS_SETRESUID (void)setresuid((Uid_t)-1,(Uid_t)uid,(Uid_t)-1); #else - setuid((Uid_t)uid); + PerlProc_setuid((Uid_t)uid); #endif #endif #endif - if (geteuid() != uid) + if (PerlProc_geteuid() != uid) croak("Can't do seteuid!\n"); } init_ids(); @@ -2348,7 +2405,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #endif /* DOSUID */ } -static void +STATIC void find_beginning(void) { register char *s, *s2; @@ -2377,13 +2434,13 @@ find_beginning(void) } } -static void +STATIC void init_ids(void) { - uid = (int)getuid(); - euid = (int)geteuid(); - gid = (int)getgid(); - egid = (int)getegid(); + uid = (int)PerlProc_getuid(); + euid = (int)PerlProc_geteuid(); + gid = (int)PerlProc_getgid(); + egid = (int)PerlProc_getegid(); #ifdef VMS uid |= gid << 16; euid |= egid << 16; @@ -2391,7 +2448,7 @@ init_ids(void) tainting |= (uid && (euid != uid || egid != gid)); } -static void +STATIC void forbid_setid(char *s) { if (euid != uid) @@ -2400,7 +2457,7 @@ forbid_setid(char *s) croak("No %s allowed while running setgid", s); } -static void +STATIC void init_debugger(void) { dTHR; @@ -2478,7 +2535,7 @@ init_stacks(ARGSproto) } } -static void +STATIC void nuke_stacks(void) { dTHR; @@ -2490,11 +2547,16 @@ nuke_stacks(void) } ) } +#ifndef PERL_OBJECT static PerlIO *tmpfp; /* moved outside init_lexer() because of UNICOS bug */ +#endif -static void +STATIC void init_lexer(void) { +#ifdef PERL_OBJECT + PerlIO *tmpfp; +#endif tmpfp = rsfp; rsfp = Nullfp; lex_start(linestr); @@ -2502,7 +2564,7 @@ init_lexer(void) subname = newSVpv("main",4); } -static void +STATIC void init_predump_symbols(void) { dTHR; @@ -2543,7 +2605,7 @@ init_predump_symbols(void) osname = savepv(OSNAME); } -static void +STATIC void init_postdump_symbols(register int argc, register char **argv, register char **env) { dTHR; @@ -2618,7 +2680,7 @@ init_postdump_symbols(register int argc, register char **argv, register char **e *s = '='; #if defined(__BORLANDC__) && defined(USE_WIN32_RTL_ENV) /* Sins of the RTL. See note in my_setenv(). */ - (void)PerlENV_putenv(savepv(*env)); + (void)PerlEnv_putenv(savepv(*env)); #endif } #endif @@ -2631,17 +2693,17 @@ init_postdump_symbols(register int argc, register char **argv, register char **e sv_setiv(GvSV(tmpgv), (IV)getpid()); } -static void +STATIC void init_perllib(void) { char *s; if (!tainting) { #ifndef VMS - s = PerlENV_getenv("PERL5LIB"); + s = PerlEnv_getenv("PERL5LIB"); if (s) incpush(s, TRUE); else - incpush(PerlENV_getenv("PERLLIB"), FALSE); + incpush(PerlEnv_getenv("PERLLIB"), FALSE); #else /* VMS */ /* Treat PERL5?LIB as a possible search list logical name -- the * "natural" VMS idiom for a Unix path string. We allow each @@ -2698,7 +2760,7 @@ init_perllib(void) # define PERLLIB_MANGLE(s,n) (s) #endif -static void +STATIC void incpush(char *p, int addsubdirs) { SV *subdir = Nullsv; @@ -2767,7 +2829,7 @@ incpush(char *p, int addsubdirs) /* .../archname/version if -d .../archname/version/auto */ sv_setsv(subdir, libdir); sv_catpv(subdir, archpat_auto); - if (Stat(SvPVX(subdir), &tmpstatbuf) >= 0 && + if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) av_push(GvAVn(incgv), newSVpv(SvPVX(subdir), SvCUR(subdir) - sizeof "auto")); @@ -2775,7 +2837,7 @@ incpush(char *p, int addsubdirs) /* .../archname if -d .../archname/auto */ sv_insert(subdir, SvCUR(libdir) + sizeof(ARCHNAME), strlen(patchlevel) + 1, "", 0); - if (Stat(SvPVX(subdir), &tmpstatbuf) >= 0 && + if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) av_push(GvAVn(incgv), newSVpv(SvPVX(subdir), SvCUR(subdir) - sizeof "auto")); @@ -2789,7 +2851,7 @@ incpush(char *p, int addsubdirs) } #ifdef USE_THREADS -static struct perl_thread * +STATIC struct perl_thread * init_main_thread() { struct perl_thread *thr; @@ -2852,7 +2914,7 @@ init_main_thread() #endif /* USE_THREADS */ void -call_list(I32 oldscope, AV *list) +call_list(I32 oldscope, AV *paramList) { dTHR; line_t oldline = curcop->cop_line; @@ -2860,8 +2922,8 @@ call_list(I32 oldscope, AV *list) dJMPENV; int ret; - while (AvFILL(list) >= 0) { - CV *cv = (CV*)av_shift(list); + while (AvFILL(paramList) >= 0) { + CV *cv = (CV*)av_shift(paramList); SAVEFREESV(cv); @@ -2876,7 +2938,7 @@ call_list(I32 oldscope, AV *list) JMPENV_POP; curcop = &compiling; curcop->cop_line = oldline; - if (list == beginav) + if (paramList == beginav) sv_catpv(atsv, "BEGIN failed--compilation aborted"); else sv_catpv(atsv, "END failed--cleanup aborted"); @@ -2901,7 +2963,7 @@ call_list(I32 oldscope, AV *list) curcop = &compiling; curcop->cop_line = oldline; if (statusvalue) { - if (list == beginav) + if (paramList == beginav) croak("BEGIN failed--compilation aborted"); else croak("END failed--cleanup aborted"); @@ -2969,7 +3031,7 @@ my_failure_exit(void) my_exit_jump(); } -static void +STATIC void my_exit_jump(void) { dTHR; @@ -24,6 +24,33 @@ #define USE_STDIO #endif /* PERL_FOR_X2P */ +#ifdef PERL_OBJECT +class CPerlObj; + +#define STATIC +#define CPERLscope(x) CPerlObj::x +#define CPERLproto CPerlObj * +#define CPERLproto_ CPERLproto, +#define CPERLarg CPerlObj *pPerl +#define CPERLarg_ CPERLarg, +#define THIS this +#define THIS_ this, +#define CALLRUNOPS (this->*runops) + +#else /* !PERL_OBJECT */ + +#define STATIC static +#define CPERLscope(x) x +#define CPERLproto +#define CPERLproto_ +#define CPERLarg +#define CPERLarg_ +#define THIS +#define THIS_ +#define CALLRUNOPS runops + +#endif /* PERL_OBJECT */ + #define VOIDUSED 1 #include "config.h" @@ -204,6 +231,7 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); #endif #include "perlio.h" +#include "perlmem.h" #include "perllio.h" #include "perlsock.h" #include "perlproc.h" @@ -1072,7 +1100,11 @@ union any { I32 any_i32; IV any_iv; long any_long; +#ifdef PERL_OBJECT + void (*any_dptr) _((void*, void*)); +#else void (*any_dptr) _((void*)); +#endif }; #ifdef USE_THREADS @@ -1100,6 +1132,34 @@ union any { #include "mg.h" #include "scope.h" +#ifdef PERL_OBJECT +struct magic_state { + SV* mgs_sv; + U32 mgs_flags; +}; +typedef struct magic_state MGS; + +typedef struct { + I32 len_min; + I32 len_delta; + I32 pos_min; + I32 pos_delta; + SV *last_found; + I32 last_end; /* min value, <0 unless valid. */ + I32 last_start_min; + I32 last_start_max; + SV **longest; /* Either &l_fixed, or &l_float. */ + SV *longest_fixed; + I32 offset_fixed; + SV *longest_float; + I32 offset_float_min; + I32 offset_float_max; + I32 flags; +} scan_data_t; + +typedef I32 CHECKPOINT; +#endif /* PERL_OBJECT */ + /* work around some libPW problems */ #ifdef DOINIT EXT char Error[1]; @@ -1377,11 +1437,13 @@ typedef Sighandler_t Sigsave_t; * included until after runops is initialised. */ +#ifndef PERL_OBJECT typedef int runops_proc_t _((void)); int runops_standard _((void)); #ifdef DEBUGGING int runops_debug _((void)); #endif +#endif /* PERL_OBJECT */ #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@" @@ -1624,6 +1686,24 @@ typedef enum { #define PERLVARI(var,type,init) type var; #define PERLVARIC(var,type,init) type var; +#ifdef PERL_OBJECT +extern "C" CPerlObj* perl_alloc _((IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*)); + +typedef int (CPerlObj::*runops_proc_t) _((void)); +#undef EXT +#define EXT +#undef EXTCONST +#define EXTCONST +#undef INIT +#define INIT(x) + +class CPerlObj { +public: + CPerlObj(IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*); + void Init(void); + void* operator new(size_t nSize, IPerlMem *pvtbl); +#endif /* PERL_OBJECT */ + #ifdef PERL_GLOBAL_STRUCT struct perl_vars { #include "perlvars.h" @@ -1720,6 +1800,20 @@ typedef void *Thread; #include "intrpvar.h" #endif +#ifdef PERL_OBJECT +#if defined(WIN32) +char** environ; +#endif +}; + +#include "objpp.h" +#ifdef DOINIT +#include "INTERN.h" +#else +#include "EXTERN.h" +#endif +#endif /* PERL_OBJECT */ + #undef PERLVAR #undef PERLVARI @@ -1732,7 +1826,9 @@ typedef void *Thread; * It has to go here or #define of printf messes up __attribute__ * stuff in proto.h */ +#ifndef PERL_OBJECT # include <win32iop.h> +#endif /* PERL_OBJECT */ #endif /* WIN32 */ #ifdef DOINIT @@ -1925,7 +2021,7 @@ enum { subtr_amg, subtr_ass_amg, mult_amg, mult_ass_amg, div_amg, div_ass_amg, - mod_amg, mod_ass_amg, + modulo_amg, modulo_ass_amg, pow_amg, pow_ass_amg, lshift_amg, lshift_ass_amg, rshift_amg, rshift_ass_amg, @@ -2,6 +2,18 @@ #define H_PERLDIR 1 #ifdef PERL_OBJECT + +#include "ipdir.h" + +#define PerlDir_mkdir(name, mode) piDir->MKdir((name), (mode), ErrorNo()) +#define PerlDir_chdir(name) piDir->Chdir((name), ErrorNo()) +#define PerlDir_rmdir(name) piDir->Rmdir((name), ErrorNo()) +#define PerlDir_close(dir) piDir->Close((dir), ErrorNo()) +#define PerlDir_open(name) piDir->Open((name), ErrorNo()) +#define PerlDir_read(dir) piDir->Read((dir), ErrorNo()) +#define PerlDir_rewind(dir) piDir->Rewind((dir), ErrorNo()) +#define PerlDir_seek(dir, loc) piDir->Seek((dir), (loc), ErrorNo()) +#define PerlDir_tell(dir) piDir->Tell((dir), ErrorNo()) #else #define PerlDir_mkdir(name, mode) mkdir((name), (mode)) #define PerlDir_chdir(name) chdir((name)) @@ -2,9 +2,15 @@ #define H_PERLENV 1 #ifdef PERL_OBJECT + +#include "ipenv.h" + +#define PerlEnv_putenv(str) piENV->Putenv((str), ErrorNo()) +#define PerlEnv_getenv(str) piENV->Getenv((str), ErrorNo()) +#define PerlEnv_lib_path piENV->LibPath #else -#define PerlENV_putenv(str) putenv((str)) -#define PerlENV_getenv(str) getenv((str)) +#define PerlEnv_putenv(str) putenv((str)) +#define PerlEnv_getenv(str) getenv((str)) #endif /* PERL_OBJECT */ #endif /* Include guard */ @@ -20,7 +20,55 @@ extern void PerlIO_init _((void)); #endif +#ifdef PERL_OBJECT + +#include "ipstdio.h" + +#define PerlIO_canset_cnt(f) 1 +#define PerlIO_has_base(f) 1 +#define PerlIO_has_cntptr(f) 1 +#define PerlIO_fast_gets(f) 1 + +#define PerlIO_stdin() piStdIO->Stdin() +#define PerlIO_stdout() piStdIO->Stdout() +#define PerlIO_stderr() piStdIO->Stderr() +#define PerlIO_open(x,y) piStdIO->Open((x),(y), ErrorNo()) +#define PerlIO_close(f) piStdIO->Close((f), ErrorNo()) +#define PerlIO_eof(f) piStdIO->Eof((f), ErrorNo()) +#define PerlIO_error(f) piStdIO->Error((f), ErrorNo()) +#define PerlIO_clearerr(f) piStdIO->Clearerr((f), ErrorNo()) +#define PerlIO_getc(f) piStdIO->Getc((f), ErrorNo()) +#define PerlIO_get_base(f) piStdIO->GetBase((f), ErrorNo()) +#define PerlIO_get_bufsiz(f) piStdIO->GetBufsiz((f), ErrorNo()) +#define PerlIO_get_cnt(f) piStdIO->GetCnt((f), ErrorNo()) +#define PerlIO_get_ptr(f) piStdIO->GetPtr((f), ErrorNo()) +#define PerlIO_putc(f,c) piStdIO->Putc((f),(c), ErrorNo()) +#define PerlIO_puts(f,s) piStdIO->Puts((f),(s), ErrorNo()) +#define PerlIO_flush(f) piStdIO->Flush((f), ErrorNo()) +#define PerlIO_ungetc(f,c) piStdIO->Ungetc((f),(c), ErrorNo()) +#define PerlIO_fileno(f) piStdIO->Fileno((f), ErrorNo()) +#define PerlIO_fdopen(f, s) piStdIO->Fdopen((f),(s), ErrorNo()) +#define PerlIO_read(f,buf,count) (SSize_t)piStdIO->Read((f), (buf), (count), ErrorNo()) +#define PerlIO_write(f,buf,count) piStdIO->Write((f), (buf), (count), ErrorNo()) +#define PerlIO_set_cnt(f,c) piStdIO->SetCnt((f), (c), ErrorNo()) +#define PerlIO_set_ptrcnt(f,p,c) piStdIO->SetPtrCnt((f), (p), (c), ErrorNo()) +#define PerlIO_setlinebuf(f) piStdIO->Setlinebuf((f), ErrorNo()) +#define PerlIO_printf fprintf +#define PerlIO_stdoutf piStdIO->Printf +#define PerlIO_vprintf(f,fmt,a) piStdIO->Vprintf((f), ErrorNo(), (fmt),a) +#define PerlIO_tell(f) piStdIO->Tell((f), ErrorNo()) +#define PerlIO_seek(f,o,w) piStdIO->Seek((f),(o),(w), ErrorNo()) +#define PerlIO_getpos(f,p) piStdIO->Getpos((f),(p), ErrorNo()) +#define PerlIO_setpos(f,p) piStdIO->Setpos((f),(p), ErrorNo()) +#define PerlIO_rewind(f) piStdIO->Rewind((f), ErrorNo()) +#define PerlIO_tmpfile() piStdIO->Tmpfile(ErrorNo()) +#define PerlIO_init() piStdIO->Init(ErrorNo()) +#undef init_os_extras +#define init_os_extras() piStdIO->InitOSExtras(this) + +#else #include "perlsdio.h" +#endif #ifndef PERLIO_IS_STDIO #ifdef USE_SFIO @@ -2,6 +2,33 @@ #define H_PERLLIO 1 #ifdef PERL_OBJECT + +#include "iplio.h" + +#define PerlLIO_access(file, mode) piLIO->Access((file), (mode), ErrorNo()) +#define PerlLIO_chmod(file, mode) piLIO->Chmod((file), (mode), ErrorNo()) +#define PerlLIO_chsize(fd, size) piLIO->Chsize((fd), (size), ErrorNo()) +#define PerlLIO_close(fd) piLIO->Close((fd), ErrorNo()) +#define PerlLIO_dup(fd) piLIO->Dup((fd), ErrorNo()) +#define PerlLIO_dup2(fd1, fd2) piLIO->Dup2((fd1), (fd2), ErrorNo()) +#define PerlLIO_flock(fd, op) piLIO->Flock((fd), (op), ErrorNo()) +#define PerlLIO_fstat(fd, buf) piLIO->FStat((fd), (buf), ErrorNo()) +#define PerlLIO_ioctl(fd, u, buf) piLIO->IOCtl((fd), (u), (buf), ErrorNo()) +#define PerlLIO_isatty(fd) piLIO->Isatty((fd), ErrorNo()) +#define PerlLIO_lseek(fd, offset, mode) piLIO->Lseek((fd), (offset), (mode), ErrorNo()) +#define PerlLIO_lstat(name, buf) piLIO->Lstat((name), (buf), ErrorNo()) +#define PerlLIO_mktemp(file) piLIO->Mktemp((file), ErrorNo()) +#define PerlLIO_open(file, flag) piLIO->Open((file), (flag), ErrorNo()) +#define PerlLIO_open3(file, flag, perm) piLIO->Open((file), (flag), (perm), ErrorNo()) +#define PerlLIO_read(fd, buf, count) piLIO->Read((fd), (buf), (count), ErrorNo()) +#define PerlLIO_rename(oldname, newname) piLIO->Rename((oldname), (newname), ErrorNo()) +#define PerlLIO_setmode(fd, mode) piLIO->Setmode((fd), (mode), ErrorNo()) +#define PerlLIO_stat(name, buf) piLIO->STat((name), (buf), ErrorNo()) +#define PerlLIO_tmpnam(str) piLIO->Tmpnam((str), ErrorNo()) +#define PerlLIO_umask(mode) piLIO->Umask((mode), ErrorNo()) +#define PerlLIO_unlink(file) piLIO->Unlink((file), ErrorNo()) +#define PerlLIO_utime(file, time) piLIO->Utime((file), (time), ErrorNo()) +#define PerlLIO_write(fd, buf, count) piLIO->Write((fd), (buf), (count), ErrorNo()) #else #define PerlLIO_access(file, mode) access((file), (mode)) #define PerlLIO_chmod(file, mode) chmod((file), (mode)) @@ -9,7 +36,9 @@ #define PerlLIO_close(fd) close((fd)) #define PerlLIO_dup(fd) dup((fd)) #define PerlLIO_dup2(fd1, fd2) dup2((fd1), (fd2)) +#define PerlLIO_flock(fd, op) FLOCK((fd), (op)) #define PerlLIO_fstat(fd, buf) Fstat((fd), (buf)) +#define PerlLIO_ioctl(fd, u, buf) ioctl((fd), (u), (buf)) #define PerlLIO_isatty(fd) isatty((fd)) #define PerlLIO_lseek(fd, offset, mode) lseek((fd), (offset), (mode)) #define PerlLIO_lstat(name, buf) lstat((name), (buf)) @@ -2,6 +2,12 @@ #define H_PERLMEM 1 #ifdef PERL_OBJECT + +#include "ipmem.h" + +#define PerlMem_malloc(size) piMem->Malloc((size)) +#define PerlMem_realloc(buf, size) piMem->Realloc((buf), (size)) +#define PerlMem_free(buf) piMem->Free((buf)) #else #define PerlMem_malloc(size) malloc((size)) #define PerlMem_realloc(buf, size) realloc((buf), (size)) diff --git a/perlproc.h b/perlproc.h index 40218c2814..8e58c2232d 100644 --- a/perlproc.h +++ b/perlproc.h @@ -2,6 +2,42 @@ #define H_PERLPROC 1 #ifdef PERL_OBJECT + +#include "ipproc.h" + +#define PerlProc_abort() piProc->Abort() +#define PerlProc_exit(s) piProc->Exit((s)) +#define PerlProc__exit(s) piProc->_Exit((s)) +#define PerlProc_execl(c, w, x, y, z) piProc->Execl((c), (w), (x), (y), (z)) +#define PerlProc_execv(c, a) piProc->Execv((c), (a)) +#define PerlProc_execvp(c, a) piProc->Execvp((c), (a)) +#define PerlProc_getuid() piProc->Getuid() +#define PerlProc_geteuid() piProc->Geteuid() +#define PerlProc_getgid() piProc->Getgid() +#define PerlProc_getegid() piProc->Getegid() +#define PerlProc_getlogin() piProc->Getlogin() +#define PerlProc_kill(i, a) piProc->Kill((i), (a)) +#define PerlProc_killpg(i, a) piProc->Killpg((i), (a)) +#define PerlProc_pause() piProc->PauseProc() +#define PerlProc_popen(c, m) piProc->Popen((c), (m)) +#define PerlProc_pclose(f) piProc->Pclose((f)) +#define PerlProc_pipe(fd) piProc->Pipe((fd)) +#define PerlProc_setuid(u) piProc->Setuid((u)) +#define PerlProc_setgid(g) piProc->Setgid((g)) +#define PerlProc_sleep(t) piProc->Sleep((t)) +#define PerlProc_times(t) piProc->Times((t)) +#define PerlProc_wait(t) piProc->Wait((t)) +#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) +#define PerlProc_longjmp(b, n) Siglongjmp((b), (n)) +#define PerlProc_signal(n, h) piProc->Signal((n), (h)) +#ifdef WIN32 +#define PerlProc_GetSysMsg(s,l,e) piProc->GetSysMsg((s), (l), (e)) +#define PerlProc_FreeBuf(s) piProc->FreeBuf((s)) +#define PerlProc_Cmd(s) piProc->DoCmd((s)) +#define do_spawn(s) piProc->Spawn((s)) +#define do_spawnvp(m, c, a) piProc->Spawnvp((m), (c), (a)) +#define PerlProc_aspawn(m, c, a) piProc->ASpawn((m), (c), (a)) +#endif #else #define PerlProc_abort() abort() #define PerlProc_exit(s) exit((s)) @@ -9,11 +45,22 @@ #define PerlProc_execl(c, w, x, y, z) execl((c), (w), (x), (y), (z)) #define PerlProc_execv(c, a) execv((c), (a)) #define PerlProc_execvp(c, a) execvp((c), (a)) +#define PerlProc_getuid() getuid() +#define PerlProc_geteuid() geteuid() +#define PerlProc_getgid() getgid() +#define PerlProc_getegid() getegid() +#define PerlProc_getlogin() getlogin() #define PerlProc_kill(i, a) kill((i), (a)) #define PerlProc_killpg(i, a) killpg((i), (a)) +#define PerlProc_pause() Pause() #define PerlProc_popen(c, m) my_popen((c), (m)) #define PerlProc_pclose(f) my_pclose((f)) #define PerlProc_pipe(fd) pipe((fd)) +#define PerlProc_setuid(u) setuid((u)) +#define PerlProc_setgid(g) setgid((g)) +#define PerlProc_sleep(t) sleep((t)) +#define PerlProc_times(t) times((t)) +#define PerlProc_wait(t) wait((t)) #define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) #define PerlProc_longjmp(b, n) Siglongjmp((b), (n)) #define PerlProc_signal(n, h) signal((n), (h)) diff --git a/perlsock.h b/perlsock.h index 5c83082840..d1ae265fcf 100644 --- a/perlsock.h +++ b/perlsock.h @@ -2,36 +2,95 @@ #define H_PERLSOCK 1 #ifdef PERL_OBJECT + +#include "ipsock.h" + +#define PerlSock_htonl(x) piSock->Htonl(x) +#define PerlSock_htons(x) piSock->Htons(x) +#define PerlSock_ntohl(x) piSock->Ntohl(x) +#define PerlSock_ntohs(x) piSock->Ntohs(x) +#define PerlSock_accept(s, a, l) piSock->Accept(s, a, l, ErrorNo()) +#define PerlSock_bind(s, n, l) piSock->Bind(s, n, l, ErrorNo()) +#define PerlSock_connect(s, n, l) piSock->Connect(s, n, l, ErrorNo()) +#define PerlSock_endhostent() piSock->Endhostent(ErrorNo()) +#define PerlSock_endnetent() piSock->Endnetent(ErrorNo()) +#define PerlSock_endprotoent() piSock->Endprotoent(ErrorNo()) +#define PerlSock_endservent() piSock->Endservent(ErrorNo()) +#define PerlSock_gethostbyaddr(a, l, t) piSock->Gethostbyaddr(a, l, t, ErrorNo()) +#define PerlSock_gethostbyname(n) piSock->Gethostbyname(n, ErrorNo()) +#define PerlSock_gethostent() piSock->Gethostent(ErrorNo()) +#define PerlSock_gethostname(n, l) piSock->Gethostname(n, l, ErrorNo()) +#define PerlSock_getnetbyaddr(n, t) piSock->Getnetbyaddr(n, t, ErrorNo()) +#define PerlSock_getnetbyname(c) piSock->Getnetbyname(c, ErrorNo()) +#define PerlSock_getnetent() piSock->Getnetent(ErrorNo()) +#define PerlSock_getpeername(s, n, l) piSock->Getpeername(s, n, l, ErrorNo()) +#define PerlSock_getprotobyname(n) piSock->Getprotobyname(n, ErrorNo()) +#define PerlSock_getprotobynumber(n) piSock->Getprotobynumber(n, ErrorNo()) +#define PerlSock_getprotoent() piSock->Getprotoent(ErrorNo()) +#define PerlSock_getservbyname(n, p) piSock->Getservbyname(n, p, ErrorNo()) +#define PerlSock_getservbyport(port, p) piSock->Getservbyport(port, p, ErrorNo()) +#define PerlSock_getservent() piSock->Getservent(ErrorNo()) +#define PerlSock_getsockname(s, n, l) piSock->Getsockname(s, n, l, ErrorNo()) +#define PerlSock_getsockopt(s, l, n, v, i) piSock->Getsockopt(s, l, n, v, i, ErrorNo()) +#define PerlSock_inet_addr(c) piSock->InetAddr(c, ErrorNo()) +#define PerlSock_inet_ntoa(i) piSock->InetNtoa(i, ErrorNo()) +#define PerlSock_listen(s, b) piSock->Listen(s, b, ErrorNo()) +#define PerlSock_recvfrom(s, b, l, f, from, fromlen) piSock->Recvfrom(s, b, l, f, from, fromlen, ErrorNo()) +#define PerlSock_select(n, r, w, e, t) piSock->Select(n, (char*)r, (char*)w, (char*)e, t, ErrorNo()) +#define PerlSock_send(s, b, l, f) piSock->Send(s, b, l, f, ErrorNo()) +#define PerlSock_sendto(s, b, l, f, t, tlen) piSock->Sendto(s, b, l, f, t, tlen, ErrorNo()) +#define PerlSock_sethostent(f) piSock->Sethostent(f, ErrorNo()) +#define PerlSock_setnetent(f) piSock->Setnetent(f, ErrorNo()) +#define PerlSock_setprotoent(f) piSock->Setprotoent(f, ErrorNo()) +#define PerlSock_setservent(f) piSock->Setservent(f, ErrorNo()) +#define PerlSock_setsockopt(s, l, n, v, len) piSock->Setsockopt(s, l, n, v, len, ErrorNo()) +#define PerlSock_shutdown(s, h) piSock->Shutdown(s, h, ErrorNo()) +#define PerlSock_socket(a, t, p) piSock->Socket(a, t, p, ErrorNo()) +#define PerlSock_socketpair(a, t, p, f) piSock->Socketpair(a, t, p, f, ErrorNo()) #else -#define PerlSock_htonl(x) htonl((x)) -#define PerlSock_htons(x) htons((x)) -#define PerlSock_ntohl(x) ntohl((x)) -#define PerlSock_ntohs(x) ntohs((x)) -#define PerlSock_accept(s, a, l) accept((s), (a), (l)) -#define PerlSock_bind(s, n, l) bind((s), (n), (l)) -#define PerlSock_connect(s, n, l) connect((s), (n), (l)) -#define PerlSock_gethostbyaddr(a, l, t) gethostbyaddr((a), (l), (t)) -#define PerlSock_gethostbyname(n) gethostbyname((n)) +#define PerlSock_htonl(x) htonl(x) +#define PerlSock_htons(x) htons(x) +#define PerlSock_ntohl(x) ntohl(x) +#define PerlSock_ntohs(x) ntohs(x) +#define PerlSock_accept(s, a, l) accept(s, a, l) +#define PerlSock_bind(s, n, l) bind(s, n, l) +#define PerlSock_connect(s, n, l) connect(s, n, l) +#define PerlSock_endhostent() endhostent() +#define PerlSock_endnetent() endnetent() +#define PerlSock_endprotoent() endprotoent() +#define PerlSock_endservent() endservent() +#define PerlSock_gethostbyaddr(a, l, t) gethostbyaddr(a, l, t) +#define PerlSock_gethostbyname(n) gethostbyname(n) #define PerlSock_gethostent() gethostent() -#define PerlSock_gethostname(n, l) gethostname((n), (l)) -#define PerlSock_getpeername(s, n, l) getpeername((s), (n), (l)) -#define PerlSock_getprotobyname(n) getprotobyname((n)) -#define PerlSock_getprotobynumber(n) getprotobynumber((n)) +#define PerlSock_gethostname(n, l) gethostname(n, l) +#define PerlSock_getnetbyaddr(n, t) getnetbyaddr(n, t) +#define PerlSock_getnetbyname(c) getnetbyname(c) +#define PerlSock_getnetent() getnetent() +#define PerlSock_getpeername(s, n, l) getpeername(s, n, l) +#define PerlSock_getprotobyname(n) getprotobyname(n) +#define PerlSock_getprotobynumber(n) getprotobynumber(n) #define PerlSock_getprotoent() getprotoent() -#define PerlSock_getservbyname(n, p) getservbyname((n), (p)) -#define PerlSock_getservbyport(port, p) getservbyport((port), (p)) +#define PerlSock_getservbyname(n, p) getservbyname(n, p) +#define PerlSock_getservbyport(port, p) getservbyport(port, p) #define PerlSock_getservent() getservent() -#define PerlSock_getsockname(s, n, l) getsockname((s), (n), (l)) -#define PerlSock_getsockopt(s, l, n, v, i) getsockopt((s), (l), (n), (v), (i)) -#define PerlSock_listen(s, b) listen((s), (b)) -#define PerlSock_recvfrom(s, b, l, f, from, fromlen) recvfrom((s), (b), (l), (f), (from), (fromlen)) -#define PerlSock_select(n, r, w, e, t) select((n), (r), (w), (e), (t)) -#define PerlSock_send(s, b, l, f) send((s), (b), (l), (f)) -#define PerlSock_sendto(s, b, l, f, t, tlen) sendto((s), (b), (l), (f), (t), (tlen)) -#define PerlSock_setsockopt(s, l, n, v, len) setsockopt((s), (l), (n), (v), (len)) -#define PerlSock_shutdown(s, h) shutdown((s), (h)) -#define PerlSock_socket(a, t, p) socket((a), (t), (p)) -#define PerlSock_socketpair(a, t, p, f) socketpair((a), (t), (p), (f)) +#define PerlSock_getsockname(s, n, l) getsockname(s, n, l) +#define PerlSock_getsockopt(s, l, n, v, i) getsockopt(s, l, n, v, i) +#define PerlSock_inet_addr(c) inet_addr(c) +#define PerlSock_inet_ntoa(i) inet_ntoa(i) +#define PerlSock_listen(s, b) listen(s, b) +#define PerlSock_recvfrom(s, b, l, f, from, fromlen) recvfrom(s, b, l, f, from, fromlen) +#define PerlSock_select(n, r, w, e, t) select(n, r, w, e, t) +#define PerlSock_send(s, b, l, f) send(s, b, l, f) +#define PerlSock_sendto(s, b, l, f, t, tlen) sendto(s, b, l, f, t, tlen) +#define PerlSock_sethostent(f) sethostent(f) +#define PerlSock_setnetent(f) setnetent(f) +#define PerlSock_setprotoent(f) setprotoent(f) +#define PerlSock_setservent(f) setservent(f) +#define PerlSock_setsockopt(s, l, n, v, len) setsockopt(s, l, n, v, len) +#define PerlSock_shutdown(s, h) shutdown(s, h) +#define PerlSock_socket(a, t, p) socket(a, t, p) +#define PerlSock_socketpair(a, t, p, f) socketpair(a, t, p, f) #endif /* PERL_OBJECT */ #endif /* Include guard */ + diff --git a/perlvars.h b/perlvars.h index 8a72312e57..ab335493d2 100644 --- a/perlvars.h +++ b/perlvars.h @@ -24,6 +24,13 @@ PERLVARI(Gthreadsv_names, char *, THREADSV_NAMES) PERLVAR(Gcurthr, struct perl_thread *) /* Currently executing (fake) thread */ #endif #endif /* USE_THREADS */ +#ifdef PERL_OBJECT +/* TODO: move into thread section */ +PERLVAR(Gsort_mutex, CRITICAL_SECTION) /* Mutex for qsort */ +#ifdef WIN32 +PERLVAR(Gerror_no, int) /* errno for each interpreter */ +#endif +#endif PERLVAR(Guid, int) /* current real user id */ PERLVAR(Geuid, int) /* current effective user id */ @@ -53,7 +60,11 @@ PERLVAR(Ghe_root, HE *) /* free he list--shared by interpreters */ PERLVAR(Gnice_chunk, char *) /* a nice chunk of memory to reuse */ PERLVAR(Gnice_chunk_size, U32) /* how nice the chunk of memory is */ +#ifdef PERL_OBJECT +PERLVAR(Grunops, runops_proc_t) +#else PERLVARI(Grunops, runops_proc_t *, RUNOPS_DEFAULT) +#endif PERLVAR(Gtokenbuf[256], char) PERLVAR(Gna, STRLEN) /* for use in SvPV when length is Not Applicable */ @@ -6,11 +6,20 @@ static char yysccsid[] = "@(#)yaccpar 1.8 (Berkeley) 01/20/91"; #include "EXTERN.h" #include "perl.h" +#ifdef PERL_OBJECT +static void +Dep(CPerlObj *pPerl) +{ + pPerl->deprecate("\"do\" to call subroutines"); +} +#define dep() Dep(this) +#else static void dep(void) { deprecate("\"do\" to call subroutines"); } +#endif #line 16 "perly.c" #define YYERRCODE 256 @@ -1317,6 +1326,16 @@ yydestruct(void *ptr) Safefree(ysave); } +#ifdef PERL_OBJECT +static void YYDestructor(void *pPerl, void *ptr) +{ + ((CPerlObj*)pPerl)->yydestruct(ptr); +} +#define YYDESTRUCT YYDestructor +#else +#define YYDESTRUCT yydestruct +#endif + int yyparse(void) { @@ -1335,7 +1354,7 @@ yyparse(void) #endif struct ysv *ysave = (struct ysv*)safemalloc(sizeof(struct ysv)); - SAVEDESTRUCTOR(yydestruct, ysave); + SAVEDESTRUCTOR(YYDESTRUCT, ysave); ysave->oldyydebug = yydebug; ysave->oldyynerrs = yynerrs; ysave->oldyyerrflag = yyerrflag; @@ -97,9 +97,11 @@ typedef unsigned UBW; # define CAT32(sv,p) sv_catpvn(sv, (char*)(p), SIZE32) #endif +#ifndef PERL_OBJECT static void doencodes _((SV* sv, char* s, I32 len)); static SV* refto _((SV* sv)); static U32 seed _((void)); +#endif static bool srand_called = FALSE; @@ -314,8 +316,8 @@ PP(pp_pos) if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { mg = mg_find(sv, 'g'); - if (mg && mg->mg_len >= 0) { - PUSHi(mg->mg_len + curcop->cop_arybase); + if (mg && mg->mg_length >= 0) { + PUSHi(mg->mg_length + curcop->cop_arybase); RETURN; } } @@ -389,7 +391,7 @@ PP(pp_refgen) RETURN; } -static SV* +STATIC SV* refto(SV *sv) { SV* rv; @@ -451,40 +453,40 @@ PP(pp_gelem) { GV *gv; SV *sv; - SV *ref; + SV *tmpRef; char *elem; djSP; sv = POPs; elem = SvPV(sv, na); gv = (GV*)POPs; - ref = Nullsv; + tmpRef = Nullsv; sv = Nullsv; switch (elem ? *elem : '\0') { case 'A': if (strEQ(elem, "ARRAY")) - ref = (SV*)GvAV(gv); + tmpRef = (SV*)GvAV(gv); break; case 'C': if (strEQ(elem, "CODE")) - ref = (SV*)GvCVu(gv); + tmpRef = (SV*)GvCVu(gv); break; case 'F': if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */ - ref = (SV*)GvIOp(gv); + tmpRef = (SV*)GvIOp(gv); break; case 'G': if (strEQ(elem, "GLOB")) - ref = (SV*)gv; + tmpRef = (SV*)gv; break; case 'H': if (strEQ(elem, "HASH")) - ref = (SV*)GvHV(gv); + tmpRef = (SV*)GvHV(gv); break; case 'I': if (strEQ(elem, "IO")) - ref = (SV*)GvIOp(gv); + tmpRef = (SV*)GvIOp(gv); break; case 'N': if (strEQ(elem, "NAME")) @@ -496,11 +498,11 @@ PP(pp_gelem) break; case 'S': if (strEQ(elem, "SCALAR")) - ref = GvSV(gv); + tmpRef = GvSV(gv); break; } - if (ref) - sv = newRV(ref); + if (tmpRef) + sv = newRV(tmpRef); if (sv) sv_2mortal(sv); else @@ -832,7 +834,7 @@ PP(pp_divide) PP(pp_modulo) { - djSP; dATARGET; tryAMAGICbin(mod,opASSIGN); + djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { UV left; UV right; @@ -1318,7 +1320,7 @@ PP(pp_i_divide) PP(pp_i_modulo) { - djSP; dATARGET; tryAMAGICbin(mod,opASSIGN); + djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { dPOPTOPiirl; if (!right) @@ -1514,7 +1516,7 @@ PP(pp_srand) RETPUSHYES; } -static U32 +STATIC U32 seed(void) { /* @@ -2731,7 +2733,7 @@ PP(pp_reverse) RETURN; } -static SV * +STATIC SV * mul128(SV *sv, U8 m) { STRLEN len; @@ -3453,7 +3455,7 @@ PP(pp_unpack) RETURN; } -static void +STATIC void doencodes(register SV *sv, register char *s, register I32 len) { char hunk[5]; @@ -3477,7 +3479,7 @@ doencodes(register SV *sv, register char *s, register I32 len) sv_catpvn(sv, "\n", 1); } -static SV * +STATIC SV * is_an_int(char *s, STRLEN l) { SV *result = newSVpv("", l); @@ -3525,7 +3527,7 @@ is_an_int(char *s, STRLEN l) return (result); } -static int +STATIC int div128(SV *pnum, bool *done) /* must be '\0' terminated */ @@ -15,7 +15,11 @@ #define dARGS #endif /* USE_THREADS */ #ifdef CAN_PROTOTYPE +#ifdef PERL_OBJECT +#define PP(s) OP* CPerlObj::s _((ARGSproto)) +#else #define PP(s) OP * s(ARGSproto) +#endif #else /* CAN_PROTOTYPE */ #define PP(s) OP* s(ARGS) dARGS #endif /* CAN_PROTOTYPE */ @@ -217,10 +221,11 @@ /* newSVsv does not behave as advertised, so we copy missing * information by hand */ - -#define RvDEEPCP(rv) STMT_START { SV* ref=SvRV(rv); \ - if (SvREFCNT(ref)>1) { \ - SvREFCNT_dec(ref); \ +/* SV* ref causes confusion with the member variable + changed SV* ref to SV* tmpRef */ +#define RvDEEPCP(rv) STMT_START { SV* tmpRef=SvRV(rv); \ + if (SvREFCNT(tmpRef)>1) { \ + SvREFCNT_dec(tmpRef); \ SvRV(rv)=AMG_CALLun(rv,copy); \ } } STMT_END #else @@ -25,6 +25,10 @@ #define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o)) +#ifdef PERL_OBJECT +#define CALLOP this->*op +#else +#define CALLOP *op static OP *docatch _((OP *o)); static OP *dofindlabel _((OP *o, char *label, OP **opstack, OP **oplimit)); static void doparseform _((SV *sv)); @@ -37,6 +41,7 @@ static int sortcv _((const void *, const void *)); static int sortcmp _((const void *, const void *)); static int sortcmp_locale _((const void *, const void *)); static OP *doeval _((int gimme, OP** startop)); +#endif static I32 sortcxix; @@ -239,7 +244,7 @@ rxres_free(void **rsp) PP(pp_formline) { djSP; dMARK; dORIGMARK; - register SV *form = *++MARK; + register SV *tmpForm = *++MARK; register U16 *fpc; register char *t; register char *f; @@ -258,17 +263,17 @@ PP(pp_formline) bool gotsome; STRLEN len; - if (!SvMAGICAL(form) || !SvCOMPILED(form)) { - SvREADONLY_off(form); - doparseform(form); + if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) { + SvREADONLY_off(tmpForm); + doparseform(tmpForm); } SvPV_force(formtarget, len); - t = SvGROW(formtarget, len + SvCUR(form) + 1); /* XXX SvCUR bad */ + t = SvGROW(formtarget, len + SvCUR(tmpForm) + 1); /* XXX SvCUR bad */ t += len; - f = SvPV(form, len); + f = SvPV(tmpForm, len); /* need to jump to the next word */ - s = f + len + WORD_ALIGN - SvCUR(form) % WORD_ALIGN; + s = f + len + WORD_ALIGN - SvCUR(tmpForm) % WORD_ALIGN; fpc = (U16*)s; @@ -443,7 +448,7 @@ PP(pp_formline) } SvCUR_set(formtarget, t - SvPVX(formtarget)); sv_catpvn(formtarget, item, itemsize); - SvGROW(formtarget, SvCUR(formtarget) + SvCUR(form) + 1); + SvGROW(formtarget, SvCUR(formtarget) + SvCUR(tmpForm) + 1); t = SvPVX(formtarget) + SvCUR(formtarget); } break; @@ -634,6 +639,22 @@ PP(pp_mapwhile) } +#ifdef PERL_OBJECT +static CPerlObj *pSortPerl; +static int SortCv(const void *a, const void *b) +{ + return pSortPerl->sortcv(a, b); +} +static int SortCmp(const void *a, const void *b) +{ + return pSortPerl->sortcmp(a, b); +} +static int SortCmpLocale(const void *a, const void *b) +{ + return pSortPerl->sortcmp_locale(a, b); +} +#endif + PP(pp_sort) { djSP; dMARK; dORIGMARK; @@ -740,7 +761,14 @@ PP(pp_sort) } sortcxix = cxstack_ix; +#ifdef PERL_OBJECT + MUTEX_LOCK(&sort_mutex); + pSortPerl = this; + qsort((char*)(myorigmark+1), max, sizeof(SV*), SortCv); + MUTEX_UNLOCK(&sort_mutex); +#else qsort((char*)(myorigmark+1), max, sizeof(SV*), sortcv); +#endif POPBLOCK(cx,curpm); SWITCHSTACK(sortstack, oldstack); @@ -751,8 +779,16 @@ PP(pp_sort) else { if (max > 1) { MEXTEND(SP, 20); /* Can't afford stack realloc on signal. */ +#ifdef PERL_OBJECT + MUTEX_LOCK(&sort_mutex); + pSortPerl = this; + qsort((char*)(ORIGMARK+1), max, sizeof(SV*), + (op->op_private & OPpLOCALE) ? SortCmpLocale : SortCmp); + MUTEX_UNLOCK(&sort_mutex); +#else qsort((char*)(ORIGMARK+1), max, sizeof(SV*), (op->op_private & OPpLOCALE) ? sortcmp_locale : sortcmp); +#endif } } stack_sp = ORIGMARK + max; @@ -858,7 +894,7 @@ PP(pp_flop) /* Control. */ -static I32 +STATIC I32 dopoptolabel(char *label) { dTHR; @@ -927,7 +963,7 @@ block_gimme(void) } } -static I32 +STATIC I32 dopoptosub(I32 startingblock) { dTHR; @@ -947,7 +983,7 @@ dopoptosub(I32 startingblock) return i; } -static I32 +STATIC I32 dopoptoeval(I32 startingblock) { dTHR; @@ -966,7 +1002,7 @@ dopoptoeval(I32 startingblock) return i; } -static I32 +STATIC I32 dopoptoloop(I32 startingblock) { dTHR; @@ -1223,7 +1259,7 @@ PP(pp_caller) RETURN; } -static int +STATIC int sortcv(const void *a, const void *b) { dTHR; @@ -1236,7 +1272,7 @@ sortcv(const void *a, const void *b) GvSV(secondgv) = *str2; stack_sp = stack_base; op = sortcop; - runops(); + CALLRUNOPS(); if (stack_sp != stack_base + 1) croak("Sort subroutine didn't return single value"); if (!SvNIOKp(*stack_sp)) @@ -1249,13 +1285,13 @@ sortcv(const void *a, const void *b) return result; } -static int +STATIC int sortcmp(const void *a, const void *b) { return sv_cmp(*(SV * const *)a, *(SV * const *)b); } -static int +STATIC int sortcmp_locale(const void *a, const void *b) { return sv_cmp_locale(*(SV * const *)a, *(SV * const *)b); @@ -1637,7 +1673,7 @@ PP(pp_redo) static OP* lastgotoprobe; -static OP * +STATIC OP * dofindlabel(OP *o, char *label, OP **opstack, OP **oplimit) { OP *kid; @@ -1763,7 +1799,7 @@ PP(pp_goto) } else { stack_sp--; /* There is no cv arg. */ - (void)(*CvXSUB(cv))(cv); + (void)(*CvXSUB(cv))(THIS_ cv); } LEAVE; return pop_return(); @@ -1965,7 +2001,7 @@ PP(pp_goto) if (op->op_type == OP_ENTERITER) DIE("Can't \"goto\" into the middle of a foreach loop", label); - (*op->op_ppaddr)(ARGS); + (CALLOP->op_ppaddr)(ARGS); } op = oldop; } @@ -2053,7 +2089,7 @@ PP(pp_cswitch) /* Eval. */ -static void +STATIC void save_lines(AV *array, SV *sv) { register char *s = SvPVX(sv); @@ -2077,7 +2113,7 @@ save_lines(AV *array, SV *sv) } } -static OP * +STATIC OP * docatch(OP *o) { dTHR; @@ -2106,7 +2142,7 @@ docatch(OP *o) restartop = 0; /* FALL THROUGH */ case 0: - runops(); + CALLRUNOPS(); break; } JMPENV_POP; @@ -2169,7 +2205,7 @@ sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp) } /* With USE_THREADS, eval_owner must be held on entry to doeval */ -static OP * +STATIC OP * doeval(int gimme, OP** startop) { dSP; @@ -2707,7 +2743,7 @@ PP(pp_leavetry) RETURN; } -static void +STATIC void doparseform(SV *sv) { STRLEN len; @@ -678,12 +678,12 @@ PP(pp_aassign) if (delaymagic & DM_UID) { if (uid != euid) DIE("No setreuid available"); - (void)setuid(uid); + (void)PerlProc_setuid(uid); } # endif /* HAS_SETREUID */ #endif /* HAS_SETRESUID */ - uid = (int)getuid(); - euid = (int)geteuid(); + uid = (int)PerlProc_getuid(); + euid = (int)PerlProc_geteuid(); } if (delaymagic & DM_GID) { #ifdef HAS_SETRESGID @@ -707,12 +707,12 @@ PP(pp_aassign) if (delaymagic & DM_GID) { if (gid != egid) DIE("No setregid available"); - (void)setgid(gid); + (void)PerlProc_setgid(gid); } # endif /* HAS_SETREGID */ #endif /* HAS_SETRESGID */ - gid = (int)getgid(); - egid = (int)getegid(); + gid = (int)PerlProc_getgid(); + egid = (int)PerlProc_getegid(); } tainting |= (uid && (euid != uid || egid != gid)); } @@ -791,8 +791,8 @@ PP(pp_match) rx->startp[0] = 0; if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) { MAGIC* mg = mg_find(TARG, 'g'); - if (mg && mg->mg_len >= 0) { - rx->endp[0] = rx->startp[0] = s + mg->mg_len; + if (mg && mg->mg_length >= 0) { + rx->endp[0] = rx->startp[0] = s + mg->mg_length; minmatch = (mg->mg_flags & MGf_MINMATCH); update_minmatch = 0; } @@ -914,7 +914,7 @@ play_it_again: mg = mg_find(TARG, 'g'); } if (rx->startp[0]) { - mg->mg_len = rx->endp[0] - rx->subbeg; + mg->mg_length = rx->endp[0] - rx->subbeg; if (rx->startp[0] == rx->endp[0]) mg->mg_flags |= MGf_MINMATCH; else @@ -961,7 +961,7 @@ ret_no: if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) { MAGIC* mg = mg_find(TARG, 'g'); if (mg) - mg->mg_len = -1; + mg->mg_length = -1; } } LEAVE_SCOPE(oldsave); @@ -1209,7 +1209,7 @@ do_readline(void) if (!isALPHA(*tmps) && !isDIGIT(*tmps) && strchr("$&*(){}[]'\";\\|?<>~`", *tmps)) break; - if (*tmps && Stat(SvPVX(sv), &statbuf) < 0) { + if (*tmps && PerlLIO_stat(SvPVX(sv), &statbuf) < 0) { (void)POPs; /* Unmatched wildcard? Chuck it... */ continue; } @@ -1757,7 +1757,7 @@ PP(pp_leavesub) return pop_return(); } -static CV * +STATIC CV * get_db_sub(SV **svp, CV *cv) { dTHR; @@ -2056,7 +2056,7 @@ PP(pp_entersub) curcopdb = NULL; } /* Do we need to open block here? XXXX */ - (void)(*CvXSUB(cv))(cv); + (void)(*CvXSUB(cv))(THIS_ cv); /* Enforce some sanity in scalar context. */ if (gimme == G_SCALAR && ++markix != stack_sp - stack_base ) { @@ -553,7 +553,7 @@ PP(pp_tie) PUTBACK; if (op = pp_entersub(ARGS)) - runops(); + CALLRUNOPS(); SPAGAIN; CATCH_SET(oldcatch); @@ -686,7 +686,7 @@ PP(pp_dbmopen) PUTBACK; if (op = pp_entersub(ARGS)) - runops(); + CALLRUNOPS(); #else PUTBACK; perl_call_sv((SV*)GvCV(gv), G_SCALAR); @@ -714,7 +714,7 @@ PP(pp_dbmopen) #ifdef ORIGINAL_TIE if (op = pp_entersub(ARGS)) - runops(); + CALLRUNOPS(); #else perl_call_sv((SV*)GvCV(gv), G_SCALAR); #endif @@ -954,7 +954,7 @@ PP(pp_read) return pp_sysread(ARGS); } -static OP * +STATIC OP * doform(CV *cv, GV *gv, OP *retop) { dTHR; @@ -1600,7 +1600,7 @@ PP(pp_ioctl) if (optype == OP_IOCTL) #ifdef HAS_IOCTL - retval = ioctl(PerlIO_fileno(IoIFP(io)), func, s); + retval = PerlLIO_ioctl(PerlIO_fileno(IoIFP(io)), func, s); #else DIE("ioctl is not implemented"); #endif @@ -1654,7 +1654,7 @@ PP(pp_flock) fp = Nullfp; if (fp) { (void)PerlIO_flush(fp); - value = (I32)(FLOCK(PerlIO_fileno(fp), argtype) >= 0); + value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0); } else value = 0; @@ -2124,7 +2124,7 @@ PP(pp_stat) laststatval = PerlLIO_lstat(SvPV(statname, na), &statcache); else #endif - laststatval = Stat(SvPV(statname, na), &statcache); + laststatval = PerlLIO_stat(SvPV(statname, na), &statcache); if (laststatval < 0) { if (dowarn && strchr(SvPV(statname, na), '\n')) warn(warn_nl, "stat"); @@ -3381,11 +3381,11 @@ PP(pp_tms) EXTEND(SP, 4); #ifndef VMS - (void)times(×buf); + (void)PerlProc_times(×buf); #else - (void)times((tbuffer_t *)×buf); /* time.h uses different name for */ - /* struct tms, though same data */ - /* is returned. */ + (void)PerlProc_times((tbuffer_t *)×buf); /* time.h uses different name for */ + /* struct tms, though same data */ + /* is returned. */ #endif PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_utime)/HZ))); @@ -3483,10 +3483,10 @@ PP(pp_sleep) (void)time(&lasttime); if (MAXARG < 1) - Pause(); + PerlProc_pause(); else { duration = POPi; - sleep((unsigned int)duration); + PerlProc_sleep((unsigned int)duration); } (void)time(&when); XPUSHi(when - lasttime); @@ -3751,14 +3751,14 @@ PP(pp_gnetent) struct netent *nent; if (which == OP_GNBYNAME) - nent = getnetbyname(POPp); + nent = PerlSock_getnetbyname(POPp); else if (which == OP_GNBYADDR) { int addrtype = POPi; Getnbadd_net_t addr = (Getnbadd_net_t) U_L(POPn); - nent = getnetbyaddr(addr, addrtype); + nent = PerlSock_getnetbyaddr(addr, addrtype); } else - nent = getnetent(); + nent = PerlSock_getnetent(); EXTEND(SP, 4); if (GIMME != G_ARRAY) { @@ -3944,7 +3944,7 @@ PP(pp_gservent) } PUSHs(sv = sv_mortalcopy(&sv_no)); #ifdef HAS_NTOHS - sv_setiv(sv, (IV)ntohs(sent->s_port)); + sv_setiv(sv, (IV)PerlSock_ntohs(sent->s_port)); #else sv_setiv(sv, (IV)(sent->s_port)); #endif @@ -3962,7 +3962,7 @@ PP(pp_shostent) { djSP; #ifdef HAS_SOCKET - sethostent(TOPi); + PerlSock_sethostent(TOPi); RETSETYES; #else DIE(no_sock_func, "sethostent"); @@ -3973,7 +3973,7 @@ PP(pp_snetent) { djSP; #ifdef HAS_SOCKET - setnetent(TOPi); + PerlSock_setnetent(TOPi); RETSETYES; #else DIE(no_sock_func, "setnetent"); @@ -3984,7 +3984,7 @@ PP(pp_sprotoent) { djSP; #ifdef HAS_SOCKET - setprotoent(TOPi); + PerlSock_setprotoent(TOPi); RETSETYES; #else DIE(no_sock_func, "setprotoent"); @@ -3995,7 +3995,7 @@ PP(pp_sservent) { djSP; #ifdef HAS_SOCKET - setservent(TOPi); + PerlSock_setservent(TOPi); RETSETYES; #else DIE(no_sock_func, "setservent"); @@ -4006,7 +4006,7 @@ PP(pp_ehostent) { djSP; #ifdef HAS_SOCKET - endhostent(); + PerlSock_endhostent(); EXTEND(sp,1); RETPUSHYES; #else @@ -4018,7 +4018,7 @@ PP(pp_enetent) { djSP; #ifdef HAS_SOCKET - endnetent(); + PerlSock_endnetent(); EXTEND(sp,1); RETPUSHYES; #else @@ -4030,7 +4030,7 @@ PP(pp_eprotoent) { djSP; #ifdef HAS_SOCKET - endprotoent(); + PerlSock_endprotoent(); EXTEND(sp,1); RETPUSHYES; #else @@ -4042,7 +4042,7 @@ PP(pp_eservent) { djSP; #ifdef HAS_SOCKET - endservent(); + PerlSock_endservent(); EXTEND(sp,1); RETPUSHYES; #else @@ -4261,7 +4261,7 @@ PP(pp_getlogin) #ifdef HAS_GETLOGIN char *tmps; EXTEND(SP, 1); - if (!(tmps = getlogin())) + if (!(tmps = PerlProc_getlogin())) RETPUSHUNDEF; PUSHp(tmps, strlen(tmps)); RETURN; @@ -1,4 +1,16 @@ +#ifdef PERL_OBJECT +#include "ipstdio.h" +#include "ipdir.h" +#include "ipenv.h" +#include "iplio.h" +#include "ipmem.h" +#include "ipproc.h" +#include "ipsock.h" +#define VIRTUAL virtual +#else +#define VIRTUAL START_EXTERN_C +#endif #ifndef NEXT30_NO_ATTRIBUTE #ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */ @@ -9,72 +21,73 @@ START_EXTERN_C #endif #endif #ifdef OVERLOAD -SV* amagic_call _((SV* left,SV* right,int method,int dir)); -bool Gv_AMupdate _((HV* stash)); +VIRTUAL SV* amagic_call _((SV* left,SV* right,int method,int dir)); +VIRTUAL bool Gv_AMupdate _((HV* stash)); #endif /* OVERLOAD */ -OP* append_elem _((I32 optype, OP* head, OP* tail)); -OP* append_list _((I32 optype, LISTOP* first, LISTOP* last)); -I32 apply _((I32 type, SV** mark, SV** sp)); -void assertref _((OP* o)); -SV* avhv_delete _((AV *ar, char* key, U32 klen, I32 flags)); -SV* avhv_delete_ent _((AV *ar, SV* keysv, I32 flags, U32 hash)); -bool avhv_exists _((AV *ar, char* key, U32 klen)); -bool avhv_exists_ent _((AV *ar, SV* keysv, U32 hash)); -SV** avhv_fetch _((AV *ar, char* key, U32 klen, I32 lval)); -SV** avhv_fetch_ent _((AV *ar, SV* keysv, I32 lval, U32 hash)); -I32 avhv_iterinit _((AV *ar)); -HE* avhv_iternext _((AV *ar)); -SV * avhv_iternextsv _((AV *ar, char** key, I32* retlen)); -SV* avhv_iterval _((AV *ar, HE* entry)); -HV* avhv_keys _((AV *ar)); -SV** avhv_store _((AV *ar, char* key, U32 klen, SV* val, U32 hash)); -void av_clear _((AV* ar)); -void av_extend _((AV* ar, I32 key)); -AV* av_fake _((I32 size, SV** svp)); -SV** av_fetch _((AV* ar, I32 key, I32 lval)); -void av_fill _((AV* ar, I32 fill)); -I32 av_len _((AV* ar)); -AV* av_make _((I32 size, SV** svp)); -SV* av_pop _((AV* ar)); -void av_push _((AV* ar, SV* val)); -void av_reify _((AV* ar)); -SV* av_shift _((AV* ar)); -SV** av_store _((AV* ar, I32 key, SV* val)); -void av_undef _((AV* ar)); -void av_unshift _((AV* ar, I32 num)); -OP* bind_match _((I32 type, OP* left, OP* pat)); -OP* block_end _((I32 floor, OP* seq)); -I32 block_gimme _((void)); -int block_start _((int full)); -void boot_core_UNIVERSAL _((void)); -void call_list _((I32 oldscope, AV* list)); -I32 cando _((I32 bit, I32 effective, Stat_t* statbufp)); +VIRTUAL OP* append_elem _((I32 optype, OP* head, OP* tail)); +VIRTUAL OP* append_list _((I32 optype, LISTOP* first, LISTOP* last)); +VIRTUAL I32 apply _((I32 type, SV** mark, SV** sp)); +VIRTUAL void assertref _((OP* o)); +VIRTUAL SV* avhv_delete _((AV *ar, char* key, U32 klen, I32 flags)); +VIRTUAL SV* avhv_delete_ent _((AV *ar, SV* keysv, I32 flags, U32 hash)); +VIRTUAL bool avhv_exists _((AV *ar, char* key, U32 klen)); +VIRTUAL bool avhv_exists_ent _((AV *ar, SV* keysv, U32 hash)); +VIRTUAL SV** avhv_fetch _((AV *ar, char* key, U32 klen, I32 lval)); +VIRTUAL SV** avhv_fetch_ent _((AV *ar, SV* keysv, I32 lval, U32 hash)); +VIRTUAL I32 avhv_iterinit _((AV *ar)); +VIRTUAL HE* avhv_iternext _((AV *ar)); +VIRTUAL SV * avhv_iternextsv _((AV *ar, char** key, I32* retlen)); +VIRTUAL SV* avhv_iterval _((AV *ar, HE* entry)); +VIRTUAL HV* avhv_keys _((AV *ar)); +VIRTUAL SV** avhv_store _((AV *ar, char* key, U32 klen, SV* val, U32 hash)); +VIRTUAL SV** avhv_store_ent _((AV *av, SV *keysv, SV *val, U32 hash)); +VIRTUAL void av_clear _((AV* ar)); +VIRTUAL void av_extend _((AV* ar, I32 key)); +VIRTUAL AV* av_fake _((I32 size, SV** svp)); +VIRTUAL SV** av_fetch _((AV* ar, I32 key, I32 lval)); +VIRTUAL void av_fill _((AV* ar, I32 fill)); +VIRTUAL I32 av_len _((AV* ar)); +VIRTUAL AV* av_make _((I32 size, SV** svp)); +VIRTUAL SV* av_pop _((AV* ar)); +VIRTUAL void av_push _((AV* ar, SV* val)); +VIRTUAL void av_reify _((AV* ar)); +VIRTUAL SV* av_shift _((AV* ar)); +VIRTUAL SV** av_store _((AV* ar, I32 key, SV* val)); +VIRTUAL void av_undef _((AV* ar)); +VIRTUAL void av_unshift _((AV* ar, I32 num)); +VIRTUAL OP* bind_match _((I32 type, OP* left, OP* pat)); +VIRTUAL OP* block_end _((I32 floor, OP* seq)); +VIRTUAL I32 block_gimme _((void)); +VIRTUAL int block_start _((int full)); +VIRTUAL void boot_core_UNIVERSAL _((void)); +VIRTUAL void call_list _((I32 oldscope, AV* list)); +VIRTUAL I32 cando _((I32 bit, I32 effective, Stat_t* statbufp)); #ifndef CASTNEGFLOAT -U32 cast_ulong _((double f)); +VIRTUAL U32 cast_ulong _((double f)); #endif #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP) -I32 my_chsize _((int fd, Off_t length)); +VIRTUAL I32 my_chsize _((int fd, Off_t length)); #endif -OP* ck_gvconst _((OP* o)); -OP* ck_retarget _((OP* o)); +VIRTUAL OP* ck_gvconst _((OP* o)); +VIRTUAL OP* ck_retarget _((OP* o)); #ifdef USE_THREADS -MAGIC * condpair_magic _((SV *sv)); -#endif -OP* convert _((I32 optype, I32 flags, OP* o)); -void croak _((const char* pat,...)) __attribute__((noreturn)); -void cv_ckproto _((CV* cv, GV* gv, char* p)); -CV* cv_clone _((CV* proto)); -SV* cv_const_sv _((CV* cv)); -void cv_undef _((CV* cv)); +VIRTUAL MAGIC * condpair_magic _((SV *sv)); +#endif +VIRTUAL OP* convert _((I32 optype, I32 flags, OP* o)); +VIRTUAL void croak _((const char* pat,...)) __attribute__((noreturn)); +VIRTUAL void cv_ckproto _((CV* cv, GV* gv, char* p)); +VIRTUAL CV* cv_clone _((CV* proto)); +VIRTUAL SV* cv_const_sv _((CV* cv)); +VIRTUAL void cv_undef _((CV* cv)); #ifdef DEBUGGING void cx_dump _((PERL_CONTEXT* cs)); #endif -SV* filter_add _((filter_t funcp, SV* datasv)); -void filter_del _((filter_t funcp)); -I32 filter_read _((int idx, SV* buffer, int maxlen)); -char ** get_op_descs _((void)); -char ** get_op_names _((void)); -I32 cxinc _((void)); +VIRTUAL SV* filter_add _((filter_t funcp, SV* datasv)); +VIRTUAL void filter_del _((filter_t funcp)); +VIRTUAL I32 filter_read _((int idx, SV* buffer, int maxlen)); +VIRTUAL char ** get_op_descs _((void)); +VIRTUAL char ** get_op_names _((void)); +VIRTUAL I32 cxinc _((void)); void deb _((const char* pat,...)) __attribute__((format(printf,1,2))); void deb_growlevel _((void)); I32 debop _((OP* o)); @@ -83,48 +96,48 @@ I32 debstackptrs _((void)); void debprofdump _((void)); #endif I32 debstack _((void)); -char* delimcpy _((char* to, char* toend, char* from, char* fromend, +VIRTUAL char* delimcpy _((char* to, char* toend, char* from, char* fromend, int delim, I32* retlen)); -void deprecate _((char* s)); -OP* die _((const char* pat,...)); -OP* die_where _((char* message)); -void dounwind _((I32 cxix)); -bool do_aexec _((SV* really, SV** mark, SV** sp)); -void do_chop _((SV* asv, SV* sv)); -bool do_close _((GV* gv, bool not_implicit)); -bool do_eof _((GV* gv)); -bool do_exec _((char* cmd)); -void do_execfree _((void)); +VIRTUAL void deprecate _((char* s)); +VIRTUAL OP* die _((const char* pat,...)); +VIRTUAL OP* die_where _((char* message)); +VIRTUAL void dounwind _((I32 cxix)); +VIRTUAL bool do_aexec _((SV* really, SV** mark, SV** sp)); +VIRTUAL void do_chop _((SV* asv, SV* sv)); +VIRTUAL bool do_close _((GV* gv, bool not_implicit)); +VIRTUAL bool do_eof _((GV* gv)); +VIRTUAL bool do_exec _((char* cmd)); +VIRTUAL void do_execfree _((void)); #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) I32 do_ipcctl _((I32 optype, SV** mark, SV** sp)); I32 do_ipcget _((I32 optype, SV** mark, SV** sp)); #endif -void do_join _((SV* sv, SV* del, SV** mark, SV** sp)); -OP* do_kv _((ARGSproto)); +VIRTUAL void do_join _((SV* sv, SV* del, SV** mark, SV** sp)); +VIRTUAL OP* do_kv _((ARGSproto)); #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) I32 do_msgrcv _((SV** mark, SV** sp)); I32 do_msgsnd _((SV** mark, SV** sp)); #endif -bool do_open _((GV* gv, char* name, I32 len, +VIRTUAL bool do_open _((GV* gv, char* name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO* supplied_fp)); -void do_pipe _((SV* sv, GV* rgv, GV* wgv)); -bool do_print _((SV* sv, PerlIO* fp)); -OP* do_readline _((void)); -I32 do_chomp _((SV* sv)); -bool do_seek _((GV* gv, long pos, int whence)); +VIRTUAL void do_pipe _((SV* sv, GV* rgv, GV* wgv)); +VIRTUAL bool do_print _((SV* sv, PerlIO* fp)); +VIRTUAL OP* do_readline _((void)); +VIRTUAL I32 do_chomp _((SV* sv)); +VIRTUAL bool do_seek _((GV* gv, long pos, int whence)); #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) I32 do_semop _((SV** mark, SV** sp)); I32 do_shmio _((I32 optype, SV** mark, SV** sp)); #endif -void do_sprintf _((SV* sv, I32 len, SV** sarg)); -long do_sysseek _((GV* gv, long pos, int whence)); -long do_tell _((GV* gv)); -I32 do_trans _((SV* sv, OP* arg)); -void do_vecset _((SV* sv)); -void do_vop _((I32 optype, SV* sv, SV* left, SV* right)); -I32 dowantarray _((void)); -void dump_all _((void)); -void dump_eval _((void)); +VIRTUAL void do_sprintf _((SV* sv, I32 len, SV** sarg)); +VIRTUAL long do_sysseek _((GV* gv, long pos, int whence)); +VIRTUAL long do_tell _((GV* gv)); +VIRTUAL I32 do_trans _((SV* sv, OP* arg)); +VIRTUAL void do_vecset _((SV* sv)); +VIRTUAL void do_vop _((I32 optype, SV* sv, SV* left, SV* right)); +VIRTUAL I32 dowantarray _((void)); +VIRTUAL void dump_all _((void)); +VIRTUAL void dump_eval _((void)); #ifdef DUMP_FDS /* See util.c */ int dump_fds _((char* s)); #endif @@ -137,457 +150,1047 @@ void dump_op _((OP* arg)); void dump_pm _((PMOP* pm)); void dump_packsubs _((HV* stash)); void dump_sub _((GV* gv)); -void fbm_compile _((SV* sv)); -char* fbm_instr _((unsigned char* big, unsigned char* bigend, SV* littlesv)); +VIRTUAL void fbm_compile _((SV* sv)); +VIRTUAL char* fbm_instr _((unsigned char* big, unsigned char* bigend, SV* littlesv)); #ifdef USE_THREADS -PADOFFSET find_threadsv _((char *name)); -#endif -OP* force_list _((OP* arg)); -OP* fold_constants _((OP* arg)); -char* form _((const char* pat, ...)); -void free_tmps _((void)); -OP* gen_constant_list _((OP* o)); -void gp_free _((GV* gv)); -GP* gp_ref _((GP* gp)); -GV* gv_AVadd _((GV* gv)); -GV* gv_HVadd _((GV* gv)); -GV* gv_IOadd _((GV* gv)); -GV* gv_autoload4 _((HV* stash, char* name, STRLEN len, I32 method)); -void gv_check _((HV* stash)); -void gv_efullname _((SV* sv, GV* gv)); -void gv_efullname3 _((SV* sv, GV* gv, char* prefix)); -GV* gv_fetchfile _((char* name)); -GV* gv_fetchmeth _((HV* stash, char* name, STRLEN len, I32 level)); -GV* gv_fetchmethod _((HV* stash, char* name)); -GV* gv_fetchmethod_autoload _((HV* stash, char* name, I32 autoload)); -GV* gv_fetchpv _((char* name, I32 add, I32 sv_type)); -void gv_fullname _((SV* sv, GV* gv)); -void gv_fullname3 _((SV* sv, GV* gv, char* prefix)); -void gv_init _((GV* gv, HV* stash, char* name, STRLEN len, int multi)); -HV* gv_stashpv _((char* name, I32 create)); -HV* gv_stashpvn _((char* name, U32 namelen, I32 create)); -HV* gv_stashsv _((SV* sv, I32 create)); -void hv_clear _((HV* tb)); -void hv_delayfree_ent _((HV* hv, HE* entry)); -SV* hv_delete _((HV* tb, char* key, U32 klen, I32 flags)); -SV* hv_delete_ent _((HV* tb, SV* key, I32 flags, U32 hash)); -bool hv_exists _((HV* tb, char* key, U32 klen)); -bool hv_exists_ent _((HV* tb, SV* key, U32 hash)); -SV** hv_fetch _((HV* tb, char* key, U32 klen, I32 lval)); -HE* hv_fetch_ent _((HV* tb, SV* key, I32 lval, U32 hash)); -void hv_free_ent _((HV* hv, HE* entry)); -I32 hv_iterinit _((HV* tb)); -char* hv_iterkey _((HE* entry, I32* retlen)); -SV* hv_iterkeysv _((HE* entry)); -HE* hv_iternext _((HV* tb)); -SV* hv_iternextsv _((HV* hv, char** key, I32* retlen)); -SV* hv_iterval _((HV* tb, HE* entry)); -void hv_ksplit _((HV* hv, IV newmax)); -void hv_magic _((HV* hv, GV* gv, int how)); -SV** hv_store _((HV* tb, char* key, U32 klen, SV* val, U32 hash)); -HE* hv_store_ent _((HV* tb, SV* key, SV* val, U32 hash)); -void hv_undef _((HV* tb)); -I32 ibcmp _((char* a, char* b, I32 len)); -I32 ibcmp_locale _((char* a, char* b, I32 len)); -I32 ingroup _((I32 testgid, I32 effective)); -void init_stacks _((ARGSproto)); -U32 intro_my _((void)); -char* instr _((char* big, char* little)); -bool io_close _((IO* io)); -OP* invert _((OP* cmd)); -OP* jmaybe _((OP* arg)); -I32 keyword _((char* d, I32 len)); -void leave_scope _((I32 base)); -void lex_end _((void)); -void lex_start _((SV* line)); -OP* linklist _((OP* o)); -OP* list _((OP* o)); -OP* listkids _((OP* o)); -OP* localize _((OP* arg, I32 lexical)); -I32 looks_like_number _((SV* sv)); -int magic_clearenv _((SV* sv, MAGIC* mg)); -int magic_clear_all_env _((SV* sv, MAGIC* mg)); -int magic_clearpack _((SV* sv, MAGIC* mg)); -int magic_clearsig _((SV* sv, MAGIC* mg)); -int magic_existspack _((SV* sv, MAGIC* mg)); -int magic_freedefelem _((SV* sv, MAGIC* mg)); -int magic_freeregexp _((SV* sv, MAGIC* mg)); -int magic_get _((SV* sv, MAGIC* mg)); -int magic_getarylen _((SV* sv, MAGIC* mg)); -int magic_getdefelem _((SV* sv, MAGIC* mg)); -int magic_getglob _((SV* sv, MAGIC* mg)); -int magic_getpack _((SV* sv, MAGIC* mg)); -int magic_getpos _((SV* sv, MAGIC* mg)); -int magic_getsig _((SV* sv, MAGIC* mg)); -int magic_gettaint _((SV* sv, MAGIC* mg)); -int magic_getuvar _((SV* sv, MAGIC* mg)); -U32 magic_len _((SV* sv, MAGIC* mg)); +VIRTUAL PADOFFSET find_threadsv _((char *name)); +#endif +VIRTUAL OP* force_list _((OP* arg)); +VIRTUAL OP* fold_constants _((OP* arg)); +VIRTUAL char* form _((const char* pat, ...)); +VIRTUAL void free_tmps _((void)); +VIRTUAL OP* gen_constant_list _((OP* o)); +VIRTUAL void gp_free _((GV* gv)); +VIRTUAL GP* gp_ref _((GP* gp)); +VIRTUAL GV* gv_AVadd _((GV* gv)); +VIRTUAL GV* gv_HVadd _((GV* gv)); +VIRTUAL GV* gv_IOadd _((GV* gv)); +VIRTUAL GV* gv_autoload4 _((HV* stash, char* name, STRLEN len, I32 method)); +VIRTUAL void gv_check _((HV* stash)); +VIRTUAL void gv_efullname _((SV* sv, GV* gv)); +VIRTUAL void gv_efullname3 _((SV* sv, GV* gv, char* prefix)); +VIRTUAL GV* gv_fetchfile _((char* name)); +VIRTUAL GV* gv_fetchmeth _((HV* stash, char* name, STRLEN len, I32 level)); +VIRTUAL GV* gv_fetchmethod _((HV* stash, char* name)); +VIRTUAL GV* gv_fetchmethod_autoload _((HV* stash, char* name, I32 autoload)); +VIRTUAL GV* gv_fetchpv _((char* name, I32 add, I32 sv_type)); +VIRTUAL void gv_fullname _((SV* sv, GV* gv)); +VIRTUAL void gv_fullname3 _((SV* sv, GV* gv, char* prefix)); +VIRTUAL void gv_init _((GV* gv, HV* stash, char* name, STRLEN len, int multi)); +VIRTUAL HV* gv_stashpv _((char* name, I32 create)); +VIRTUAL HV* gv_stashpvn _((char* name, U32 namelen, I32 create)); +VIRTUAL HV* gv_stashsv _((SV* sv, I32 create)); +VIRTUAL void hv_clear _((HV* tb)); +VIRTUAL void hv_delayfree_ent _((HV* hv, HE* entry)); +VIRTUAL SV* hv_delete _((HV* tb, char* key, U32 klen, I32 flags)); +VIRTUAL SV* hv_delete_ent _((HV* tb, SV* key, I32 flags, U32 hash)); +VIRTUAL bool hv_exists _((HV* tb, char* key, U32 klen)); +VIRTUAL bool hv_exists_ent _((HV* tb, SV* key, U32 hash)); +VIRTUAL SV** hv_fetch _((HV* tb, char* key, U32 klen, I32 lval)); +VIRTUAL HE* hv_fetch_ent _((HV* tb, SV* key, I32 lval, U32 hash)); +VIRTUAL void hv_free_ent _((HV* hv, HE* entry)); +VIRTUAL I32 hv_iterinit _((HV* tb)); +VIRTUAL char* hv_iterkey _((HE* entry, I32* retlen)); +VIRTUAL SV* hv_iterkeysv _((HE* entry)); +VIRTUAL HE* hv_iternext _((HV* tb)); +VIRTUAL SV* hv_iternextsv _((HV* hv, char** key, I32* retlen)); +VIRTUAL SV* hv_iterval _((HV* tb, HE* entry)); +VIRTUAL void hv_ksplit _((HV* hv, IV newmax)); +VIRTUAL void hv_magic _((HV* hv, GV* gv, int how)); +VIRTUAL SV** hv_store _((HV* tb, char* key, U32 klen, SV* val, U32 hash)); +VIRTUAL HE* hv_store_ent _((HV* tb, SV* key, SV* val, U32 hash)); +VIRTUAL void hv_undef _((HV* tb)); +VIRTUAL I32 ibcmp _((char* a, char* b, I32 len)); +VIRTUAL I32 ibcmp_locale _((char* a, char* b, I32 len)); +VIRTUAL I32 ingroup _((I32 testgid, I32 effective)); +VIRTUAL void init_stacks _((ARGSproto)); +VIRTUAL U32 intro_my _((void)); +VIRTUAL char* instr _((char* big, char* little)); +VIRTUAL bool io_close _((IO* io)); +VIRTUAL OP* invert _((OP* cmd)); +VIRTUAL OP* jmaybe _((OP* arg)); +VIRTUAL I32 keyword _((char* d, I32 len)); +VIRTUAL void leave_scope _((I32 base)); +VIRTUAL void lex_end _((void)); +VIRTUAL void lex_start _((SV* line)); +VIRTUAL OP* linklist _((OP* o)); +VIRTUAL OP* list _((OP* o)); +VIRTUAL OP* listkids _((OP* o)); +VIRTUAL OP* localize _((OP* arg, I32 lexical)); +VIRTUAL I32 looks_like_number _((SV* sv)); +VIRTUAL int magic_clearenv _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_clear_all_env _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_clearpack _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_clearsig _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_existspack _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_freedefelem _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_freeregexp _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_get _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_getarylen _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_getdefelem _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_getglob _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_getpack _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_getpos _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_getsig _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_gettaint _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_getuvar _((SV* sv, MAGIC* mg)); +VIRTUAL U32 magic_len _((SV* sv, MAGIC* mg)); #ifdef USE_THREADS -int magic_mutexfree _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_mutexfree _((SV* sv, MAGIC* mg)); #endif /* USE_THREADS */ -int magic_nextpack _((SV* sv, MAGIC* mg, SV* key)); -int magic_set _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_nextpack _((SV* sv, MAGIC* mg, SV* key)); +VIRTUAL int magic_set _((SV* sv, MAGIC* mg)); #ifdef OVERLOAD -int magic_setamagic _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setamagic _((SV* sv, MAGIC* mg)); #endif /* OVERLOAD */ -int magic_setarylen _((SV* sv, MAGIC* mg)); -int magic_setbm _((SV* sv, MAGIC* mg)); -int magic_setdbline _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setarylen _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setbm _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setdbline _((SV* sv, MAGIC* mg)); #ifdef USE_LOCALE_COLLATE -int magic_setcollxfrm _((SV* sv, MAGIC* mg)); -#endif -int magic_setdefelem _((SV* sv, MAGIC* mg)); -int magic_setenv _((SV* sv, MAGIC* mg)); -int magic_setfm _((SV* sv, MAGIC* mg)); -int magic_setisa _((SV* sv, MAGIC* mg)); -int magic_setglob _((SV* sv, MAGIC* mg)); -int magic_setmglob _((SV* sv, MAGIC* mg)); -int magic_setnkeys _((SV* sv, MAGIC* mg)); -int magic_setpack _((SV* sv, MAGIC* mg)); -int magic_setpos _((SV* sv, MAGIC* mg)); -int magic_setsig _((SV* sv, MAGIC* mg)); -int magic_setsubstr _((SV* sv, MAGIC* mg)); -int magic_settaint _((SV* sv, MAGIC* mg)); -int magic_setuvar _((SV* sv, MAGIC* mg)); -int magic_setvec _((SV* sv, MAGIC* mg)); -int magic_set_all_env _((SV* sv, MAGIC* mg)); -int magic_wipepack _((SV* sv, MAGIC* mg)); -void magicname _((char* sym, char* name, I32 namlen)); +VIRTUAL int magic_setcollxfrm _((SV* sv, MAGIC* mg)); +#endif +VIRTUAL int magic_setdefelem _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setenv _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setfm _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setisa _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setglob _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setmglob _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setnkeys _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setpack _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setpos _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setsig _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setsubstr _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_settaint _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setuvar _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setvec _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_set_all_env _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_wipepack _((SV* sv, MAGIC* mg)); +VIRTUAL void magicname _((char* sym, char* name, I32 namlen)); int main _((int argc, char** argv, char** env)); -void markstack_grow _((void)); +VIRTUAL void markstack_grow _((void)); #ifdef USE_LOCALE_COLLATE -char* mem_collxfrm _((const char* s, STRLEN len, STRLEN* xlen)); -#endif -char* mess _((const char* pat, va_list* args)); -int mg_clear _((SV* sv)); -int mg_copy _((SV* , SV* , char* , I32)); -MAGIC* mg_find _((SV* sv, int type)); -int mg_free _((SV* sv)); -int mg_get _((SV* sv)); -U32 mg_len _((SV* sv)); -void mg_magical _((SV* sv)); -int mg_set _((SV* sv)); -OP* mod _((OP* o, I32 type)); -char* moreswitches _((char* s)); -OP* my _((OP* o)); +VIRTUAL char* mem_collxfrm _((const char* s, STRLEN len, STRLEN* xlen)); +#endif +VIRTUAL char* mess _((const char* pat, va_list* args)); +VIRTUAL int mg_clear _((SV* sv)); +VIRTUAL int mg_copy _((SV* , SV* , char* , I32)); +VIRTUAL MAGIC* mg_find _((SV* sv, int type)); +VIRTUAL int mg_free _((SV* sv)); +VIRTUAL int mg_get _((SV* sv)); +VIRTUAL U32 mg_len _((SV* sv)); +VIRTUAL void mg_magical _((SV* sv)); +VIRTUAL int mg_set _((SV* sv)); +VIRTUAL OP* mod _((OP* o, I32 type)); +VIRTUAL char* moreswitches _((char* s)); +VIRTUAL OP* my _((OP* o)); #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY) -char* my_bcopy _((char* from, char* to, I32 len)); +VIRTUAL char* my_bcopy _((char* from, char* to, I32 len)); #endif #if !defined(HAS_BZERO) && !defined(HAS_MEMSET) char* my_bzero _((char* loc, I32 len)); #endif -void my_exit _((U32 status)) __attribute__((noreturn)); -void my_failure_exit _((void)) __attribute__((noreturn)); -I32 my_lstat _((ARGSproto)); +VIRTUAL void my_exit _((U32 status)) __attribute__((noreturn)); +VIRTUAL void my_failure_exit _((void)) __attribute__((noreturn)); +VIRTUAL I32 my_lstat _((ARGSproto)); #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) I32 my_memcmp _((char* s1, char* s2, I32 len)); #endif #if !defined(HAS_MEMSET) void* my_memset _((char* loc, I32 ch, I32 len)); #endif -I32 my_pclose _((PerlIO* ptr)); -PerlIO* my_popen _((char* cmd, char* mode)); -void my_setenv _((char* nam, char* val)); -I32 my_stat _((ARGSproto)); +#ifndef PERL_OBJECT +VIRTUAL I32 my_pclose _((PerlIO* ptr)); +VIRTUAL PerlIO* my_popen _((char* cmd, char* mode)); +#endif +VIRTUAL void my_setenv _((char* nam, char* val)); +VIRTUAL I32 my_stat _((ARGSproto)); #ifdef MYSWAP -short my_swap _((short s)); -long my_htonl _((long l)); -long my_ntohl _((long l)); -#endif -void my_unexec _((void)); -OP* newANONLIST _((OP* o)); -OP* newANONHASH _((OP* o)); -OP* newANONSUB _((I32 floor, OP* proto, OP* block)); -OP* newASSIGNOP _((I32 flags, OP* left, I32 optype, OP* right)); -OP* newCONDOP _((I32 flags, OP* expr, OP* trueop, OP* falseop)); -void newFORM _((I32 floor, OP* o, OP* block)); -OP* newFOROP _((I32 flags, char* label, line_t forline, OP* scalar, OP* expr, OP*block, OP*cont)); -OP* newLOGOP _((I32 optype, I32 flags, OP* left, OP* right)); -OP* newLOOPEX _((I32 type, OP* label)); -OP* newLOOPOP _((I32 flags, I32 debuggable, OP* expr, OP* block)); -OP* newNULLLIST _((void)); -OP* newOP _((I32 optype, I32 flags)); -void newPROG _((OP* o)); -OP* newRANGE _((I32 flags, OP* left, OP* right)); -OP* newSLICEOP _((I32 flags, OP* subscript, OP* list)); -OP* newSTATEOP _((I32 flags, char* label, OP* o)); -CV* newSUB _((I32 floor, OP* o, OP* proto, OP* block)); -CV* newXS _((char* name, void (*subaddr)(CV* cv), char* filename)); -AV* newAV _((void)); -OP* newAVREF _((OP* o)); -OP* newBINOP _((I32 type, I32 flags, OP* first, OP* last)); -OP* newCVREF _((I32 flags, OP* o)); -OP* newGVOP _((I32 type, I32 flags, GV* gv)); -GV* newGVgen _((char* pack)); -OP* newGVREF _((I32 type, OP* o)); -OP* newHVREF _((OP* o)); -HV* newHV _((void)); -IO* newIO _((void)); -OP* newLISTOP _((I32 type, I32 flags, OP* first, OP* last)); -OP* newPMOP _((I32 type, I32 flags)); -OP* newPVOP _((I32 type, I32 flags, char* pv)); -SV* newRV _((SV* ref)); -SV* newRV_noinc _((SV *)); +VIRTUAL short my_swap _((short s)); +VIRTUAL long my_htonl _((long l)); +VIRTUAL long my_ntohl _((long l)); +#endif +VIRTUAL void my_unexec _((void)); +VIRTUAL OP* newANONLIST _((OP* o)); +VIRTUAL OP* newANONHASH _((OP* o)); +VIRTUAL OP* newANONSUB _((I32 floor, OP* proto, OP* block)); +VIRTUAL OP* newASSIGNOP _((I32 flags, OP* left, I32 optype, OP* right)); +VIRTUAL OP* newCONDOP _((I32 flags, OP* expr, OP* trueop, OP* falseop)); +VIRTUAL void newFORM _((I32 floor, OP* o, OP* block)); +VIRTUAL OP* newFOROP _((I32 flags, char* label, line_t forline, OP* scalar, OP* expr, OP*block, OP*cont)); +VIRTUAL OP* newLOGOP _((I32 optype, I32 flags, OP* left, OP* right)); +VIRTUAL OP* newLOOPEX _((I32 type, OP* label)); +VIRTUAL OP* newLOOPOP _((I32 flags, I32 debuggable, OP* expr, OP* block)); +VIRTUAL OP* newNULLLIST _((void)); +VIRTUAL OP* newOP _((I32 optype, I32 flags)); +VIRTUAL void newPROG _((OP* o)); +VIRTUAL OP* newRANGE _((I32 flags, OP* left, OP* right)); +VIRTUAL OP* newSLICEOP _((I32 flags, OP* subscript, OP* list)); +VIRTUAL OP* newSTATEOP _((I32 flags, char* label, OP* o)); +VIRTUAL CV* newSUB _((I32 floor, OP* o, OP* proto, OP* block)); +VIRTUAL CV* newXS _((char* name, void (*subaddr)(CPERLproto_ CV* cv), char* filename)); +VIRTUAL AV* newAV _((void)); +VIRTUAL OP* newAVREF _((OP* o)); +VIRTUAL OP* newBINOP _((I32 type, I32 flags, OP* first, OP* last)); +VIRTUAL OP* newCVREF _((I32 flags, OP* o)); +VIRTUAL OP* newGVOP _((I32 type, I32 flags, GV* gv)); +VIRTUAL GV* newGVgen _((char* pack)); +VIRTUAL OP* newGVREF _((I32 type, OP* o)); +VIRTUAL OP* newHVREF _((OP* o)); +VIRTUAL HV* newHV _((void)); +VIRTUAL IO* newIO _((void)); +VIRTUAL OP* newLISTOP _((I32 type, I32 flags, OP* first, OP* last)); +VIRTUAL OP* newPMOP _((I32 type, I32 flags)); +VIRTUAL OP* newPVOP _((I32 type, I32 flags, char* pv)); +VIRTUAL SV* newRV _((SV* ref)); +VIRTUAL SV* newRV_noinc _((SV *)); #ifdef LEAKTEST -SV* newSV _((I32 x, STRLEN len)); +VIRTUAL SV* newSV _((I32 x, STRLEN len)); #else -SV* newSV _((STRLEN len)); -#endif -OP* newSVREF _((OP* o)); -OP* newSVOP _((I32 type, I32 flags, SV* sv)); -SV* newSViv _((IV i)); -SV* newSVnv _((double n)); -SV* newSVpv _((char* s, STRLEN len)); -SV* newSVpvf _((const char* pat, ...)); -SV* newSVrv _((SV* rv, char* classname)); -SV* newSVsv _((SV* old)); -OP* newUNOP _((I32 type, I32 flags, OP* first)); -OP* newWHILEOP _((I32 flags, I32 debuggable, LOOP* loop, +VIRTUAL SV* newSV _((STRLEN len)); +#endif +VIRTUAL OP* newSVREF _((OP* o)); +VIRTUAL OP* newSVOP _((I32 type, I32 flags, SV* sv)); +VIRTUAL SV* newSViv _((IV i)); +VIRTUAL SV* newSVnv _((double n)); +VIRTUAL SV* newSVpv _((char* s, STRLEN len)); +VIRTUAL SV* newSVpvf _((const char* pat, ...)); +VIRTUAL SV* newSVrv _((SV* rv, char* classname)); +VIRTUAL SV* newSVsv _((SV* old)); +VIRTUAL OP* newUNOP _((I32 type, I32 flags, OP* first)); +VIRTUAL OP* newWHILEOP _((I32 flags, I32 debuggable, LOOP* loop, I32 whileline, OP* expr, OP* block, OP* cont)); #ifdef USE_THREADS -struct perl_thread * new_struct_thread _((struct perl_thread *t)); -#endif -PerlIO* nextargv _((GV* gv)); -char* ninstr _((char* big, char* bigend, char* little, char* lend)); -OP* oopsCV _((OP* o)); -void op_free _((OP* arg)); -void package _((OP* o)); -PADOFFSET pad_alloc _((I32 optype, U32 tmptype)); -PADOFFSET pad_allocmy _((char* name)); -PADOFFSET pad_findmy _((char* name)); -OP* oopsAV _((OP* o)); -OP* oopsHV _((OP* o)); -void pad_leavemy _((I32 fill)); -SV* pad_sv _((PADOFFSET po)); -void pad_free _((PADOFFSET po)); -void pad_reset _((void)); -void pad_swipe _((PADOFFSET po)); -void peep _((OP* o)); +VIRTUAL struct perl_thread * new_struct_thread _((struct perl_thread *t)); +#endif +VIRTUAL PerlIO* nextargv _((GV* gv)); +VIRTUAL char* ninstr _((char* big, char* bigend, char* little, char* lend)); +VIRTUAL OP* oopsCV _((OP* o)); +VIRTUAL void op_free _((OP* arg)); +VIRTUAL void package _((OP* o)); +VIRTUAL PADOFFSET pad_alloc _((I32 optype, U32 tmptype)); +VIRTUAL PADOFFSET pad_allocmy _((char* name)); +VIRTUAL PADOFFSET pad_findmy _((char* name)); +VIRTUAL OP* oopsAV _((OP* o)); +VIRTUAL OP* oopsHV _((OP* o)); +VIRTUAL void pad_leavemy _((I32 fill)); +VIRTUAL SV* pad_sv _((PADOFFSET po)); +VIRTUAL void pad_free _((PADOFFSET po)); +VIRTUAL void pad_reset _((void)); +VIRTUAL void pad_swipe _((PADOFFSET po)); +VIRTUAL void peep _((OP* o)); +#ifndef PERL_OBJECT PerlInterpreter* perl_alloc _((void)); -I32 perl_call_argv _((char* subname, I32 flags, char** argv)); -I32 perl_call_method _((char* methname, I32 flags)); -I32 perl_call_pv _((char* subname, I32 flags)); -I32 perl_call_sv _((SV* sv, I32 flags)); +#endif +VIRTUAL I32 perl_call_argv _((char* subname, I32 flags, char** argv)); +VIRTUAL I32 perl_call_method _((char* methname, I32 flags)); +VIRTUAL I32 perl_call_pv _((char* subname, I32 flags)); +VIRTUAL I32 perl_call_sv _((SV* sv, I32 flags)); +#ifdef PERL_OBJECT +VIRTUAL void perl_construct _((void)); +VIRTUAL void perl_destruct _((void)); +#else void perl_construct _((PerlInterpreter* sv_interp)); void perl_destruct _((PerlInterpreter* sv_interp)); -SV* perl_eval_pv _((char* p, I32 croak_on_error)); -I32 perl_eval_sv _((SV* sv, I32 flags)); +#endif +VIRTUAL SV* perl_eval_pv _((char* p, I32 croak_on_error)); +VIRTUAL I32 perl_eval_sv _((SV* sv, I32 flags)); +#ifdef PERL_OBJECT +VIRTUAL void perl_free _((void)); +#else void perl_free _((PerlInterpreter* sv_interp)); -SV* perl_get_sv _((char* name, I32 create)); -AV* perl_get_av _((char* name, I32 create)); -HV* perl_get_hv _((char* name, I32 create)); -CV* perl_get_cv _((char* name, I32 create)); -int perl_init_i18nl10n _((int printwarn)); -int perl_init_i18nl14n _((int printwarn)); -void perl_new_collate _((char* newcoll)); -void perl_new_ctype _((char* newctype)); -void perl_new_numeric _((char* newcoll)); -void perl_set_numeric_local _((void)); -void perl_set_numeric_standard _((void)); +#endif +VIRTUAL SV* perl_get_sv _((char* name, I32 create)); +VIRTUAL AV* perl_get_av _((char* name, I32 create)); +VIRTUAL HV* perl_get_hv _((char* name, I32 create)); +VIRTUAL CV* perl_get_cv _((char* name, I32 create)); +VIRTUAL int perl_init_i18nl10n _((int printwarn)); +VIRTUAL int perl_init_i18nl14n _((int printwarn)); +VIRTUAL void perl_new_collate _((char* newcoll)); +VIRTUAL void perl_new_ctype _((char* newctype)); +VIRTUAL void perl_new_numeric _((char* newcoll)); +VIRTUAL void perl_set_numeric_local _((void)); +VIRTUAL void perl_set_numeric_standard _((void)); +#ifdef PERL_OBJECT +VIRTUAL int perl_parse _((void(*xsinit)(CPerlObj*), int argc, char** argv, char** env)); +#else int perl_parse _((PerlInterpreter* sv_interp, void(*xsinit)(void), int argc, char** argv, char** env)); -void perl_require_pv _((char* pv)); +#endif +VIRTUAL void perl_require_pv _((char* pv)); #define perl_requirepv perl_require_pv +#ifdef PERL_OBJECT +VIRTUAL int perl_run _((void)); +#else int perl_run _((PerlInterpreter* sv_interp)); -void pidgone _((int pid, int status)); -void pmflag _((U16* pmfl, int ch)); -OP* pmruntime _((OP* pm, OP* expr, OP* repl)); -OP* pmtrans _((OP* o, OP* expr, OP* repl)); -OP* pop_return _((void)); -void pop_scope _((void)); -OP* prepend_elem _((I32 optype, OP* head, OP* tail)); -void push_return _((OP* o)); -void push_scope _((void)); -regexp* pregcomp _((char* exp, char* xend, PMOP* pm)); -OP* ref _((OP* o, I32 type)); -OP* refkids _((OP* o, I32 type)); -void regdump _((regexp* r)); -I32 pregexec _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, U32 nosave)); -I32 regexec_flags _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, void* data, U32 flags)); - void pregfree _((struct regexp* r)); -regnode*regnext _((regnode* p)); -void regprop _((SV* sv, regnode* o)); -void repeatcpy _((char* to, char* from, I32 len, I32 count)); -char* rninstr _((char* big, char* bigend, char* little, char* lend)); -Sighandler_t rsignal _((int, Sighandler_t)); -int rsignal_restore _((int, Sigsave_t*)); -int rsignal_save _((int, Sighandler_t, Sigsave_t*)); -Sighandler_t rsignal_state _((int)); -void rxres_free _((void** rsp)); -void rxres_restore _((void** rsp, REGEXP* rx)); -void rxres_save _((void** rsp, REGEXP* rx)); +#endif +VIRTUAL void pidgone _((int pid, int status)); +VIRTUAL void pmflag _((U16* pmfl, int ch)); +VIRTUAL OP* pmruntime _((OP* pm, OP* expr, OP* repl)); +VIRTUAL OP* pmtrans _((OP* o, OP* expr, OP* repl)); +VIRTUAL OP* pop_return _((void)); +VIRTUAL void pop_scope _((void)); +VIRTUAL OP* prepend_elem _((I32 optype, OP* head, OP* tail)); +VIRTUAL void push_return _((OP* o)); +VIRTUAL void push_scope _((void)); +VIRTUAL regexp* pregcomp _((char* exp, char* xend, PMOP* pm)); +VIRTUAL OP* ref _((OP* o, I32 type)); +VIRTUAL OP* refkids _((OP* o, I32 type)); +VIRTUAL void regdump _((regexp* r)); +VIRTUAL I32 pregexec _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, U32 nosave)); +VIRTUAL I32 regexec_flags _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, void* data, U32 flags)); +VIRTUAL void pregfree _((struct regexp* r)); +VIRTUAL regnode*regnext _((regnode* p)); +VIRTUAL void regprop _((SV* sv, regnode* o)); +VIRTUAL void repeatcpy _((char* to, char* from, I32 len, I32 count)); +VIRTUAL char* rninstr _((char* big, char* bigend, char* little, char* lend)); +VIRTUAL Sighandler_t rsignal _((int, Sighandler_t)); +VIRTUAL int rsignal_restore _((int, Sigsave_t*)); +VIRTUAL int rsignal_save _((int, Sighandler_t, Sigsave_t*)); +VIRTUAL Sighandler_t rsignal_state _((int)); +VIRTUAL void rxres_free _((void** rsp)); +VIRTUAL void rxres_restore _((void** rsp, REGEXP* rx)); +VIRTUAL void rxres_save _((void** rsp, REGEXP* rx)); #ifndef HAS_RENAME -I32 same_dirent _((char* a, char* b)); -#endif -char* savepv _((char* sv)); -char* savepvn _((char* sv, I32 len)); -void savestack_grow _((void)); -void save_aptr _((AV** aptr)); -AV* save_ary _((GV* gv)); -void save_clearsv _((SV** svp)); -void save_delete _((HV* hv, char* key, I32 klen)); +VIRTUAL I32 same_dirent _((char* a, char* b)); +#endif +VIRTUAL char* savepv _((char* sv)); +VIRTUAL char* savepvn _((char* sv, I32 len)); +VIRTUAL void savestack_grow _((void)); +VIRTUAL void save_aptr _((AV** aptr)); +VIRTUAL AV* save_ary _((GV* gv)); +VIRTUAL void save_clearsv _((SV** svp)); +VIRTUAL void save_delete _((HV* hv, char* key, I32 klen)); #ifndef titan /* TitanOS cc can't handle this */ +#ifdef PERL_OBJECT +VIRTUAL void save_destructor _((void (*f)(void*, void*), void* p)); +#else void save_destructor _((void (*f)(void*), void* p)); +#endif #endif /* titan */ -void save_freesv _((SV* sv)); -void save_freeop _((OP* o)); -void save_freepv _((char* pv)); -void save_gp _((GV* gv, I32 empty)); -HV* save_hash _((GV* gv)); -void save_hptr _((HV** hptr)); -void save_I16 _((I16* intp)); -void save_I32 _((I32* intp)); -void save_int _((int* intp)); -void save_item _((SV* item)); -void save_iv _((IV* iv)); -void save_list _((SV** sarg, I32 maxsarg)); -void save_long _((long* longp)); -void save_nogv _((GV* gv)); -void save_op _((void)); -SV* save_scalar _((GV* gv)); -void save_pptr _((char** pptr)); -void save_sptr _((SV** sptr)); -SV* save_svref _((SV** sptr)); -SV** save_threadsv _((PADOFFSET i)); -OP* sawparens _((OP* o)); -OP* scalar _((OP* o)); -OP* scalarkids _((OP* o)); -OP* scalarseq _((OP* o)); -OP* scalarvoid _((OP* o)); -UV scan_hex _((char* start, I32 len, I32* retlen)); -char* scan_num _((char* s)); -UV scan_oct _((char* start, I32 len, I32* retlen)); -OP* scope _((OP* o)); -char* screaminstr _((SV* bigsv, SV* littlesv, I32 start_shift, I32 end_shift, I32 *state, I32 last)); +VIRTUAL void save_freesv _((SV* sv)); +VIRTUAL void save_freeop _((OP* o)); +VIRTUAL void save_freepv _((char* pv)); +VIRTUAL void save_gp _((GV* gv, I32 empty)); +VIRTUAL HV* save_hash _((GV* gv)); +VIRTUAL void save_hptr _((HV** hptr)); +VIRTUAL void save_I16 _((I16* intp)); +VIRTUAL void save_I32 _((I32* intp)); +VIRTUAL void save_int _((int* intp)); +VIRTUAL void save_item _((SV* item)); +VIRTUAL void save_iv _((IV* iv)); +VIRTUAL void save_list _((SV** sarg, I32 maxsarg)); +VIRTUAL void save_long _((long* longp)); +VIRTUAL void save_nogv _((GV* gv)); +VIRTUAL void save_op _((void)); +VIRTUAL SV* save_scalar _((GV* gv)); +VIRTUAL void save_pptr _((char** pptr)); +VIRTUAL void save_sptr _((SV** sptr)); +VIRTUAL SV* save_svref _((SV** sptr)); +VIRTUAL SV** save_threadsv _((PADOFFSET i)); +VIRTUAL OP* sawparens _((OP* o)); +VIRTUAL OP* scalar _((OP* o)); +VIRTUAL OP* scalarkids _((OP* o)); +VIRTUAL OP* scalarseq _((OP* o)); +VIRTUAL OP* scalarvoid _((OP* o)); +VIRTUAL UV scan_hex _((char* start, I32 len, I32* retlen)); +VIRTUAL char* scan_num _((char* s)); +VIRTUAL UV scan_oct _((char* start, I32 len, I32* retlen)); +VIRTUAL OP* scope _((OP* o)); +VIRTUAL char* screaminstr _((SV* bigsv, SV* littlesv, I32 start_shift, I32 end_shift, I32 *state, I32 last)); #ifndef VMS -I32 setenv_getix _((char* nam)); -#endif -void setdefout _((GV* gv)); -char* sharepvn _((char* sv, I32 len, U32 hash)); -HEK* share_hek _((char* sv, I32 len, U32 hash)); -Signal_t sighandler _((int sig)); -SV** stack_grow _((SV** sp, SV**p, int n)); -I32 start_subparse _((I32 is_format, U32 flags)); -void sub_crush_depth _((CV* cv)); -bool sv_2bool _((SV* sv)); -CV* sv_2cv _((SV* sv, HV** st, GV** gvp, I32 lref)); -IO* sv_2io _((SV* sv)); -IV sv_2iv _((SV* sv)); -SV* sv_2mortal _((SV* sv)); -double sv_2nv _((SV* sv)); -char* sv_2pv _((SV* sv, STRLEN* lp)); -UV sv_2uv _((SV* sv)); -IV sv_iv _((SV* sv)); -UV sv_uv _((SV* sv)); -double sv_nv _((SV* sv)); -char * sv_pvn _((SV *, STRLEN *)); -I32 sv_true _((SV *)); -void sv_add_arena _((char* ptr, U32 size, U32 flags)); -int sv_backoff _((SV* sv)); -SV* sv_bless _((SV* sv, HV* stash)); -void sv_catpvf _((SV* sv, const char* pat, ...)); -void sv_catpv _((SV* sv, char* ptr)); -void sv_catpvn _((SV* sv, char* ptr, STRLEN len)); -void sv_catsv _((SV* dsv, SV* ssv)); -void sv_chop _((SV* sv, char* ptr)); -void sv_clean_all _((void)); -void sv_clean_objs _((void)); -void sv_clear _((SV* sv)); -I32 sv_cmp _((SV* sv1, SV* sv2)); -I32 sv_cmp_locale _((SV* sv1, SV* sv2)); +VIRTUAL I32 setenv_getix _((char* nam)); +#endif +VIRTUAL void setdefout _((GV* gv)); +VIRTUAL char* sharepvn _((char* sv, I32 len, U32 hash)); +VIRTUAL HEK* share_hek _((char* sv, I32 len, U32 hash)); +VIRTUAL Signal_t sighandler _((int sig)); +VIRTUAL SV** stack_grow _((SV** sp, SV**p, int n)); +VIRTUAL I32 start_subparse _((I32 is_format, U32 flags)); +VIRTUAL void sub_crush_depth _((CV* cv)); +VIRTUAL bool sv_2bool _((SV* sv)); +VIRTUAL CV* sv_2cv _((SV* sv, HV** st, GV** gvp, I32 lref)); +VIRTUAL IO* sv_2io _((SV* sv)); +VIRTUAL IV sv_2iv _((SV* sv)); +VIRTUAL SV* sv_2mortal _((SV* sv)); +VIRTUAL double sv_2nv _((SV* sv)); +VIRTUAL char* sv_2pv _((SV* sv, STRLEN* lp)); +VIRTUAL UV sv_2uv _((SV* sv)); +VIRTUAL IV sv_iv _((SV* sv)); +VIRTUAL UV sv_uv _((SV* sv)); +VIRTUAL double sv_nv _((SV* sv)); +VIRTUAL char * sv_pvn _((SV *, STRLEN *)); +VIRTUAL I32 sv_true _((SV *)); +VIRTUAL void sv_add_arena _((char* ptr, U32 size, U32 flags)); +VIRTUAL int sv_backoff _((SV* sv)); +VIRTUAL SV* sv_bless _((SV* sv, HV* stash)); +VIRTUAL void sv_catpvf _((SV* sv, const char* pat, ...)); +VIRTUAL void sv_catpv _((SV* sv, char* ptr)); +VIRTUAL void sv_catpvn _((SV* sv, char* ptr, STRLEN len)); +VIRTUAL void sv_catsv _((SV* dsv, SV* ssv)); +VIRTUAL void sv_chop _((SV* sv, char* ptr)); +VIRTUAL void sv_clean_all _((void)); +VIRTUAL void sv_clean_objs _((void)); +VIRTUAL void sv_clear _((SV* sv)); +VIRTUAL I32 sv_cmp _((SV* sv1, SV* sv2)); +VIRTUAL I32 sv_cmp_locale _((SV* sv1, SV* sv2)); #ifdef USE_LOCALE_COLLATE -char* sv_collxfrm _((SV* sv, STRLEN* nxp)); -#endif -OP* sv_compile_2op _((SV* sv, OP** startp, char* code, AV** avp)); -void sv_dec _((SV* sv)); -void sv_dump _((SV* sv)); -bool sv_derived_from _((SV* sv, char* name)); -I32 sv_eq _((SV* sv1, SV* sv2)); -void sv_free _((SV* sv)); -void sv_free_arenas _((void)); -char* sv_gets _((SV* sv, PerlIO* fp, I32 append)); +VIRTUAL char* sv_collxfrm _((SV* sv, STRLEN* nxp)); +#endif +VIRTUAL OP* sv_compile_2op _((SV* sv, OP** startp, char* code, AV** avp)); +VIRTUAL void sv_dec _((SV* sv)); +VIRTUAL void sv_dump _((SV* sv)); +VIRTUAL bool sv_derived_from _((SV* sv, char* name)); +VIRTUAL I32 sv_eq _((SV* sv1, SV* sv2)); +VIRTUAL void sv_free _((SV* sv)); +VIRTUAL void sv_free_arenas _((void)); +VIRTUAL char* sv_gets _((SV* sv, PerlIO* fp, I32 append)); #ifndef DOSISH -char* sv_grow _((SV* sv, I32 newlen)); +VIRTUAL char* sv_grow _((SV* sv, I32 newlen)); #else -char* sv_grow _((SV* sv, unsigned long newlen)); -#endif -void sv_inc _((SV* sv)); -void sv_insert _((SV* bigsv, STRLEN offset, STRLEN len, char* little, STRLEN littlelen)); -int sv_isa _((SV* sv, char* name)); -int sv_isobject _((SV* sv)); -STRLEN sv_len _((SV* sv)); -void sv_magic _((SV* sv, SV* obj, int how, char* name, I32 namlen)); -SV* sv_mortalcopy _((SV* oldsv)); -SV* sv_newmortal _((void)); -SV* sv_newref _((SV* sv)); -char* sv_peek _((SV* sv)); -char* sv_pvn_force _((SV* sv, STRLEN* lp)); -char* sv_reftype _((SV* sv, int ob)); -void sv_replace _((SV* sv, SV* nsv)); -void sv_report_used _((void)); -void sv_reset _((char* s, HV* stash)); -void sv_setpvf _((SV* sv, const char* pat, ...)); -void sv_setiv _((SV* sv, IV num)); -void sv_setpviv _((SV* sv, IV num)); -void sv_setuv _((SV* sv, UV num)); -void sv_setnv _((SV* sv, double num)); -SV* sv_setref_iv _((SV* rv, char* classname, IV iv)); -SV* sv_setref_nv _((SV* rv, char* classname, double nv)); -SV* sv_setref_pv _((SV* rv, char* classname, void* pv)); -SV* sv_setref_pvn _((SV* rv, char* classname, char* pv, I32 n)); -void sv_setpv _((SV* sv, const char* ptr)); -void sv_setpvn _((SV* sv, const char* ptr, STRLEN len)); -void sv_setsv _((SV* dsv, SV* ssv)); -void sv_taint _((SV* sv)); -bool sv_tainted _((SV* sv)); -int sv_unmagic _((SV* sv, int type)); -void sv_unref _((SV* sv)); -void sv_untaint _((SV* sv)); -bool sv_upgrade _((SV* sv, U32 mt)); -void sv_usepvn _((SV* sv, char* ptr, STRLEN len)); -void sv_vcatpvfn _((SV* sv, const char* pat, STRLEN patlen, +VIRTUAL char* sv_grow _((SV* sv, unsigned long newlen)); +#endif +VIRTUAL void sv_inc _((SV* sv)); +VIRTUAL void sv_insert _((SV* bigsv, STRLEN offset, STRLEN len, char* little, STRLEN littlelen)); +VIRTUAL int sv_isa _((SV* sv, char* name)); +VIRTUAL int sv_isobject _((SV* sv)); +VIRTUAL STRLEN sv_len _((SV* sv)); +VIRTUAL void sv_magic _((SV* sv, SV* obj, int how, char* name, I32 namlen)); +VIRTUAL SV* sv_mortalcopy _((SV* oldsv)); +VIRTUAL SV* sv_newmortal _((void)); +VIRTUAL SV* sv_newref _((SV* sv)); +VIRTUAL char* sv_peek _((SV* sv)); +VIRTUAL char* sv_pvn_force _((SV* sv, STRLEN* lp)); +VIRTUAL char* sv_reftype _((SV* sv, int ob)); +VIRTUAL void sv_replace _((SV* sv, SV* nsv)); +VIRTUAL void sv_report_used _((void)); +VIRTUAL void sv_reset _((char* s, HV* stash)); +VIRTUAL void sv_setpvf _((SV* sv, const char* pat, ...)); +VIRTUAL void sv_setiv _((SV* sv, IV num)); +VIRTUAL void sv_setpviv _((SV* sv, IV num)); +VIRTUAL void sv_setuv _((SV* sv, UV num)); +VIRTUAL void sv_setnv _((SV* sv, double num)); +VIRTUAL SV* sv_setref_iv _((SV* rv, char* classname, IV iv)); +VIRTUAL SV* sv_setref_nv _((SV* rv, char* classname, double nv)); +VIRTUAL SV* sv_setref_pv _((SV* rv, char* classname, void* pv)); +VIRTUAL SV* sv_setref_pvn _((SV* rv, char* classname, char* pv, I32 n)); +VIRTUAL void sv_setpv _((SV* sv, const char* ptr)); +VIRTUAL void sv_setpvn _((SV* sv, const char* ptr, STRLEN len)); +VIRTUAL void sv_setsv _((SV* dsv, SV* ssv)); +VIRTUAL void sv_taint _((SV* sv)); +VIRTUAL bool sv_tainted _((SV* sv)); +VIRTUAL int sv_unmagic _((SV* sv, int type)); +VIRTUAL void sv_unref _((SV* sv)); +VIRTUAL void sv_untaint _((SV* sv)); +VIRTUAL bool sv_upgrade _((SV* sv, U32 mt)); +VIRTUAL void sv_usepvn _((SV* sv, char* ptr, STRLEN len)); +VIRTUAL void sv_vcatpvfn _((SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *used_locale)); -void sv_vsetpvfn _((SV* sv, const char* pat, STRLEN patlen, +VIRTUAL void sv_vsetpvfn _((SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *used_locale)); -void taint_env _((void)); -void taint_proper _((const char* f, char* s)); +VIRTUAL void taint_env _((void)); +VIRTUAL void taint_proper _((const char* f, char* s)); #ifdef UNLINK_ALL_VERSIONS -I32 unlnk _((char* f)); +VIRTUAL I32 unlnk _((char* f)); #endif #ifdef USE_THREADS -void unlock_condpair _((void* svv)); -#endif -void unsharepvn _((char* sv, I32 len, U32 hash)); -void unshare_hek _((HEK* hek)); -void utilize _((int aver, I32 floor, OP* version, OP* id, OP* arg)); -void vivify_defelem _((SV* sv)); -void vivify_ref _((SV* sv, U32 to_what)); -I32 wait4pid _((int pid, int* statusp, int flags)); -void warn _((const char* pat,...)); -void watch _((char** addr)); -I32 whichsig _((char* sig)); -int yyerror _((char* s)); -int yylex _((void)); -int yyparse _((void)); -int yywarn _((char* s)); +VIRTUAL void unlock_condpair _((void* svv)); +#endif +VIRTUAL void unsharepvn _((char* sv, I32 len, U32 hash)); +VIRTUAL void unshare_hek _((HEK* hek)); +VIRTUAL void utilize _((int aver, I32 floor, OP* version, OP* id, OP* arg)); +VIRTUAL void vivify_defelem _((SV* sv)); +VIRTUAL void vivify_ref _((SV* sv, U32 to_what)); +VIRTUAL I32 wait4pid _((int pid, int* statusp, int flags)); +VIRTUAL void warn _((const char* pat,...)); +VIRTUAL void watch _((char** addr)); +VIRTUAL I32 whichsig _((char* sig)); +VIRTUAL int yyerror _((char* s)); +VIRTUAL int yylex _((void)); +VIRTUAL int yyparse _((void)); +VIRTUAL int yywarn _((char* s)); #ifndef MYMALLOC -Malloc_t safemalloc _((MEM_SIZE nbytes)); -Malloc_t safecalloc _((MEM_SIZE elements, MEM_SIZE size)); -Malloc_t saferealloc _((Malloc_t where, MEM_SIZE nbytes)); -Free_t safefree _((Malloc_t where)); +VIRTUAL Malloc_t safemalloc _((MEM_SIZE nbytes)); +VIRTUAL Malloc_t safecalloc _((MEM_SIZE elements, MEM_SIZE size)); +VIRTUAL Malloc_t saferealloc _((Malloc_t where, MEM_SIZE nbytes)); +VIRTUAL Free_t safefree _((Malloc_t where)); #endif #ifdef LEAKTEST -Malloc_t safexmalloc _((I32 x, MEM_SIZE size)); -Malloc_t safexcalloc _((I32 x, MEM_SIZE elements, MEM_SIZE size)); -Malloc_t safexrealloc _((Malloc_t where, MEM_SIZE size)); -void safexfree _((Malloc_t where)); +VIRTUAL Malloc_t safexmalloc _((I32 x, MEM_SIZE size)); +VIRTUAL Malloc_t safexcalloc _((I32 x, MEM_SIZE elements, MEM_SIZE size)); +VIRTUAL Malloc_t safexrealloc _((Malloc_t where, MEM_SIZE size)); +VIRTUAL void safexfree _((Malloc_t where)); #endif #ifdef PERL_GLOBAL_STRUCT -struct perl_vars *Perl_GetVars _((void)); +VIRTUAL struct perl_vars *Perl_GetVars _((void)); +#endif + +#ifdef PERL_OBJECT +protected: +void hsplit _((HV *hv)); +void hfreeentries _((HV *hv)); +HE* more_he _((void)); +HE* new_he _((void)); +void del_he _((HE *p)); +HEK *save_hek _((char *str, I32 len, U32 hash)); +SV *mess_alloc _((void)); +void gv_init_sv _((GV *gv, I32 sv_type)); +SV *save_scalar_at _((SV **sptr)); +IV asIV _((SV* sv)); +UV asUV _((SV* sv)); +SV *more_sv _((void)); +XPVIV *more_xiv _((void)); +XPVNV *more_xnv _((void)); +XPV *more_xpv _((void)); +XRV *more_xrv _((void)); +XPVIV *new_xiv _((void)); +XPVNV *new_xnv _((void)); +XPV *new_xpv _((void)); +XRV *new_xrv _((void)); +void del_xiv _((XPVIV* p)); +void del_xnv _((XPVNV* p)); +void del_xpv _((XPV* p)); +void del_xrv _((XRV* p)); +void sv_mortalgrow _((void)); +void sv_unglob _((SV* sv)); +void sv_check_thinkfirst _((SV *sv)); +void do_report_used _((SV *sv)); +void do_clean_objs _((SV *sv)); +void do_clean_named_objs _((SV *sv)); +void do_clean_all _((SV *sv)); +void not_a_number _((SV *sv)); + +typedef void (CPerlObj::*SVFUNC) _((SV*)); +void visit _((SVFUNC f)); + +void save_magic _((MGS *mgs, SV *sv)); +int magic_methpack _((SV *sv, MAGIC *mg, char *meth)); +OP * doform _((CV *cv, GV *gv, OP *retop)); +void doencodes _((SV* sv, char* s, I32 len)); +SV* refto _((SV* sv)); +U32 seed _((void)); +OP *docatch _((OP *o)); +OP *dofindlabel _((OP *o, char *label, OP **opstack, OP **oplimit)); +void doparseform _((SV *sv)); +I32 dopoptoeval _((I32 startingblock)); +I32 dopoptolabel _((char *label)); +I32 dopoptoloop _((I32 startingblock)); +I32 dopoptosub _((I32 startingblock)); +void save_lines _((AV *array, SV *sv)); +OP *doeval _((int gimme, OP** startop)); +SV *mul128 _((SV *sv, U8 m)); +SV *is_an_int _((char *s, STRLEN l)); +int div128 _((SV *pnum, bool *done)); + +int runops_standard _((void)); +#ifdef DEBUGGING +int runops_debug _((void)); #endif +void check_uni _((void)); +void force_next _((I32 type)); +char *force_version _((char *start)); +char *force_word _((char *start, int token, int check_keyword, int allow_pack, int allow_tick)); +SV *tokeq _((SV *sv)); +char *scan_const _((char *start)); +char *scan_formline _((char *s)); +char *scan_heredoc _((char *s)); +char *scan_ident _((char *s, char *send, char *dest, STRLEN destlen, I32 ck_uni)); +char *scan_inputsymbol _((char *start)); +char *scan_pat _((char *start)); +char *scan_str _((char *start)); +char *scan_subst _((char *start)); +char *scan_trans _((char *start)); +char *scan_word _((char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)); +char *skipspace _((char *s)); +void checkcomma _((char *s, char *name, char *what)); +void force_ident _((char *s, int kind)); +void incline _((char *s)); +int intuit_method _((char *s, GV *gv)); +int intuit_more _((char *s)); +I32 lop _((I32 f, expectation x, char *s)); +void missingterm _((char *s)); +void no_op _((char *what, char *s)); +void set_csh _((void)); +I32 sublex_done _((void)); +I32 sublex_push _((void)); +I32 sublex_start _((void)); +#ifdef CRIPPLED_CC +int uni _((I32 f, char *s)); +#endif +char * filter_gets _((SV *sv, PerlIO *fp, STRLEN append)); +int ao _((int toketype)); +void depcom _((void)); +#ifdef WIN32 +I32 win32_textfilter _((int idx, SV *sv, int maxlen)); +#endif +char* incl_perldb _((void)); +SV *isa_lookup _((HV *stash, char *name, int len, int level)); +CV *get_db_sub _((SV **svp, CV *cv)); +I32 list_assignment _((OP *o)); +void bad_type _((I32 n, char *t, char *name, OP *kid)); +OP *modkids _((OP *o, I32 type)); +OP *no_fh_allowed _((OP *o)); +OP *scalarboolean _((OP *o)); +OP *too_few_arguments _((OP *o, char* name)); +OP *too_many_arguments _((OP *o, char* name)); +void null _((OP* o)); +PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)); +OP *newDEFSVOP _((void)); +char* gv_ename _((GV *gv)); +CV *cv_clone2 _((CV *proto, CV *outside)); +void find_beginning _((void)); +void forbid_setid _((char *)); +void incpush _((char *, int)); +void init_ids _((void)); +void init_debugger _((void)); +void init_lexer _((void)); +void init_main_stash _((void)); +#ifdef USE_THREADS +struct perl_thread * init_main_thread _((void)); +#endif /* USE_THREADS */ +void init_perllib _((void)); +void init_postdump_symbols _((int, char **, char **)); +void init_predump_symbols _((void)); +void my_exit_jump _((void)) __attribute__((noreturn)); +void nuke_stacks _((void)); +void open_script _((char *, bool, SV *)); +void usage _((char *)); +void validate_suid _((char *, char*)); + +regnode *reg _((I32, I32 *)); +regnode *reganode _((U8, U32)); +regnode *regatom _((I32 *)); +regnode *regbranch _((I32 *, I32)); +void regc _((U8, char *)); +regnode *regclass _((void)); +I32 regcurly _((char *)); +regnode *reg_node _((U8)); +regnode *regpiece _((I32 *)); +void reginsert _((U8, regnode *)); +void regoptail _((regnode *, regnode *)); +void regset _((char *, I32)); +void regtail _((regnode *, regnode *)); +char* nextchar _((void)); +regnode *dumpuntil _((regnode *start, regnode *node, regnode *last, SV* sv, I32 l)); +void debprof _((OP *o)); +void scan_commit _((scan_data_t *data)); +I32 study_chunk _((regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 flags)); +I32 add_data _((I32 n, char *s)); +void re_croak2 _((const char* pat1,const char* pat2,...)) __attribute__((noreturn)); +I32 regmatch _((regnode *prog)); +I32 regrepeat _((regnode *p, I32 max)); +I32 regrepeat_hard _((regnode *p, I32 max, I32 *lp)); +I32 regtry _((regexp *prog, char *startpos)); +bool reginclass _((char *p, I32 c)); +CHECKPOINT regcppush _((I32 parenfloor)); +char * regcppop _((void)); +void dump _((char *pat,...)); +#ifdef WIN32 +int do_aspawn _((void *vreally, void **vmark, void **vsp)); +#endif + +#ifdef DEBUGGING +void del_sv _((SV *p)); +#endif + +#define PPDEF(s) OP* CPerlObj::s _((ARGSproto)); + +public: +PPDEF(pp_aassign) +PPDEF(pp_abs) +PPDEF(pp_accept) +PPDEF(pp_add) +PPDEF(pp_aelem) +PPDEF(pp_aelemfast) +PPDEF(pp_alarm) +PPDEF(pp_and) +PPDEF(pp_andassign) +PPDEF(pp_anoncode) +PPDEF(pp_anonhash) +PPDEF(pp_anonlist) +PPDEF(pp_aslice) +PPDEF(pp_atan2) +PPDEF(pp_av2arylen) +PPDEF(pp_backtick) +PPDEF(pp_bind) +PPDEF(pp_binmode) +PPDEF(pp_bit_and) +PPDEF(pp_bit_or) +PPDEF(pp_bit_xor) +PPDEF(pp_bless) +PPDEF(pp_caller) +PPDEF(pp_chdir) +PPDEF(pp_chmod) +PPDEF(pp_chomp) +PPDEF(pp_chop) +PPDEF(pp_chown) +PPDEF(pp_chr) +PPDEF(pp_chroot) +PPDEF(pp_close) +PPDEF(pp_closedir) +PPDEF(pp_complement) +PPDEF(pp_concat) +PPDEF(pp_cond_expr) +PPDEF(pp_connect) +PPDEF(pp_const) +PPDEF(pp_cos) +PPDEF(pp_crypt) +PPDEF(pp_cswitch) +PPDEF(pp_dbmclose) +PPDEF(pp_dbmopen) +PPDEF(pp_dbstate) +PPDEF(pp_defined) +PPDEF(pp_delete) +PPDEF(pp_die) +PPDEF(pp_divide) +PPDEF(pp_dofile) +PPDEF(pp_dump) +PPDEF(pp_each) +PPDEF(pp_egrent) +PPDEF(pp_ehostent) +PPDEF(pp_enetent) +PPDEF(pp_enter) +PPDEF(pp_entereval) +PPDEF(pp_enteriter) +PPDEF(pp_enterloop) +PPDEF(pp_entersub) +PPDEF(pp_entertry) +PPDEF(pp_enterwrite) +PPDEF(pp_eof) +PPDEF(pp_eprotoent) +PPDEF(pp_epwent) +PPDEF(pp_eq) +PPDEF(pp_eservent) +PPDEF(pp_exec) +PPDEF(pp_exists) +PPDEF(pp_exit) +PPDEF(pp_exp) +PPDEF(pp_fcntl) +PPDEF(pp_fileno) +PPDEF(pp_flip) +PPDEF(pp_flock) +PPDEF(pp_flop) +PPDEF(pp_fork) +PPDEF(pp_formline) +PPDEF(pp_ftatime) +PPDEF(pp_ftbinary) +PPDEF(pp_ftblk) +PPDEF(pp_ftchr) +PPDEF(pp_ftctime) +PPDEF(pp_ftdir) +PPDEF(pp_fteexec) +PPDEF(pp_fteowned) +PPDEF(pp_fteread) +PPDEF(pp_ftewrite) +PPDEF(pp_ftfile) +PPDEF(pp_ftis) +PPDEF(pp_ftlink) +PPDEF(pp_ftmtime) +PPDEF(pp_ftpipe) +PPDEF(pp_ftrexec) +PPDEF(pp_ftrowned) +PPDEF(pp_ftrread) +PPDEF(pp_ftrwrite) +PPDEF(pp_ftsgid) +PPDEF(pp_ftsize) +PPDEF(pp_ftsock) +PPDEF(pp_ftsuid) +PPDEF(pp_ftsvtx) +PPDEF(pp_fttext) +PPDEF(pp_fttty) +PPDEF(pp_ftzero) +PPDEF(pp_ge) +PPDEF(pp_gelem) +PPDEF(pp_getc) +PPDEF(pp_getlogin) +PPDEF(pp_getpeername) +PPDEF(pp_getpgrp) +PPDEF(pp_getppid) +PPDEF(pp_getpriority) +PPDEF(pp_getsockname) +PPDEF(pp_ggrent) +PPDEF(pp_ggrgid) +PPDEF(pp_ggrnam) +PPDEF(pp_ghbyaddr) +PPDEF(pp_ghbyname) +PPDEF(pp_ghostent) +PPDEF(pp_glob) +PPDEF(pp_gmtime) +PPDEF(pp_gnbyaddr) +PPDEF(pp_gnbyname) +PPDEF(pp_gnetent) +PPDEF(pp_goto) +PPDEF(pp_gpbyname) +PPDEF(pp_gpbynumber) +PPDEF(pp_gprotoent) +PPDEF(pp_gpwent) +PPDEF(pp_gpwnam) +PPDEF(pp_gpwuid) +PPDEF(pp_grepstart) +PPDEF(pp_grepwhile) +PPDEF(pp_gsbyname) +PPDEF(pp_gsbyport) +PPDEF(pp_gservent) +PPDEF(pp_gsockopt) +PPDEF(pp_gt) +PPDEF(pp_gv) +PPDEF(pp_gvsv) +PPDEF(pp_helem) +PPDEF(pp_hex) +PPDEF(pp_hslice) +PPDEF(pp_i_add) +PPDEF(pp_i_divide) +PPDEF(pp_i_eq) +PPDEF(pp_i_ge) +PPDEF(pp_i_gt) +PPDEF(pp_i_le) +PPDEF(pp_i_lt) +PPDEF(pp_i_modulo) +PPDEF(pp_i_multiply) +PPDEF(pp_i_ncmp) +PPDEF(pp_i_ne) +PPDEF(pp_i_negate) +PPDEF(pp_i_subtract) +PPDEF(pp_index) +PPDEF(pp_indread) +PPDEF(pp_int) +PPDEF(pp_ioctl) +PPDEF(pp_iter) +PPDEF(pp_join) +PPDEF(pp_keys) +PPDEF(pp_kill) +PPDEF(pp_last) +PPDEF(pp_lc) +PPDEF(pp_lcfirst) +PPDEF(pp_le) +PPDEF(pp_leave) +PPDEF(pp_leaveeval) +PPDEF(pp_leaveloop) +PPDEF(pp_leavesub) +PPDEF(pp_leavetry) +PPDEF(pp_leavewrite) +PPDEF(pp_left_shift) +PPDEF(pp_length) +PPDEF(pp_lineseq) +PPDEF(pp_link) +PPDEF(pp_list) +PPDEF(pp_listen) +PPDEF(pp_localtime) +PPDEF(pp_lock) +PPDEF(pp_log) +PPDEF(pp_lslice) +PPDEF(pp_lstat) +PPDEF(pp_lt) +PPDEF(pp_mapstart) +PPDEF(pp_mapwhile) +PPDEF(pp_match) +PPDEF(pp_method) +PPDEF(pp_mkdir) +PPDEF(pp_modulo) +PPDEF(pp_msgctl) +PPDEF(pp_msgget) +PPDEF(pp_msgrcv) +PPDEF(pp_msgsnd) +PPDEF(pp_multiply) +PPDEF(pp_ncmp) +PPDEF(pp_ne) +PPDEF(pp_negate) +PPDEF(pp_next) +PPDEF(pp_nextstate) +PPDEF(pp_not) +PPDEF(pp_nswitch) +PPDEF(pp_null) +PPDEF(pp_oct) +PPDEF(pp_open) +PPDEF(pp_open_dir) +PPDEF(pp_or) +PPDEF(pp_orassign) +PPDEF(pp_ord) +PPDEF(pp_pack) +PPDEF(pp_padany) +PPDEF(pp_padav) +PPDEF(pp_padhv) +PPDEF(pp_padsv) +PPDEF(pp_pipe_op) +PPDEF(pp_pop) +PPDEF(pp_pos) +PPDEF(pp_postdec) +PPDEF(pp_postinc) +PPDEF(pp_pow) +PPDEF(pp_predec) +PPDEF(pp_preinc) +PPDEF(pp_print) +PPDEF(pp_prototype) +PPDEF(pp_prtf) +PPDEF(pp_push) +PPDEF(pp_pushmark) +PPDEF(pp_pushre) +PPDEF(pp_quotemeta) +PPDEF(pp_rand) +PPDEF(pp_range) +PPDEF(pp_rcatline) +PPDEF(pp_read) +PPDEF(pp_readdir) +PPDEF(pp_readline) +PPDEF(pp_readlink) +PPDEF(pp_recv) +PPDEF(pp_redo) +PPDEF(pp_ref) +PPDEF(pp_refgen) +PPDEF(pp_regcmaybe) +PPDEF(pp_regcomp) +PPDEF(pp_rename) +PPDEF(pp_repeat) +PPDEF(pp_require) +PPDEF(pp_reset) +PPDEF(pp_return) +PPDEF(pp_reverse) +PPDEF(pp_rewinddir) +PPDEF(pp_right_shift) +PPDEF(pp_rindex) +PPDEF(pp_rmdir) +PPDEF(pp_rv2av) +PPDEF(pp_rv2cv) +PPDEF(pp_rv2gv) +PPDEF(pp_rv2hv) +PPDEF(pp_rv2sv) +PPDEF(pp_sassign) +PPDEF(pp_scalar) +PPDEF(pp_schomp) +PPDEF(pp_schop) +PPDEF(pp_scmp) +PPDEF(pp_scope) +PPDEF(pp_seek) +PPDEF(pp_seekdir) +PPDEF(pp_select) +PPDEF(pp_semctl) +PPDEF(pp_semget) +PPDEF(pp_semop) +PPDEF(pp_send) +PPDEF(pp_seq) +PPDEF(pp_setpgrp) +PPDEF(pp_setpriority) +PPDEF(pp_sge) +PPDEF(pp_sgrent) +PPDEF(pp_sgt) +PPDEF(pp_shift) +PPDEF(pp_shmctl) +PPDEF(pp_shmget) +PPDEF(pp_shmread) +PPDEF(pp_shmwrite) +PPDEF(pp_shostent) +PPDEF(pp_shutdown) +PPDEF(pp_sin) +PPDEF(pp_sle) +PPDEF(pp_sleep) +PPDEF(pp_slt) +PPDEF(pp_sne) +PPDEF(pp_snetent) +PPDEF(pp_socket) +PPDEF(pp_sockpair) +PPDEF(pp_sort) +PPDEF(pp_splice) +PPDEF(pp_split) +PPDEF(pp_sprintf) +PPDEF(pp_sprotoent) +PPDEF(pp_spwent) +PPDEF(pp_sqrt) +PPDEF(pp_srand) +PPDEF(pp_srefgen) +PPDEF(pp_sselect) +PPDEF(pp_sservent) +PPDEF(pp_ssockopt) +PPDEF(pp_stat) +PPDEF(pp_stringify) +PPDEF(pp_stub) +PPDEF(pp_study) +PPDEF(pp_subst) +PPDEF(pp_substcont) +PPDEF(pp_substr) +PPDEF(pp_subtract) +PPDEF(pp_symlink) +PPDEF(pp_syscall) +PPDEF(pp_sysopen) +PPDEF(pp_sysread) +PPDEF(pp_sysseek) +PPDEF(pp_system) +PPDEF(pp_syswrite) +PPDEF(pp_tell) +PPDEF(pp_telldir) +PPDEF(pp_threadsv) +PPDEF(pp_tie) +PPDEF(pp_tied) +PPDEF(pp_time) +PPDEF(pp_tms) +PPDEF(pp_trans) +PPDEF(pp_truncate) +PPDEF(pp_uc) +PPDEF(pp_ucfirst) +PPDEF(pp_umask) +PPDEF(pp_undef) +PPDEF(pp_unlink) +PPDEF(pp_unpack) +PPDEF(pp_unshift) +PPDEF(pp_unstack) +PPDEF(pp_untie) +PPDEF(pp_utime) +PPDEF(pp_values) +PPDEF(pp_vec) +PPDEF(pp_wait) +PPDEF(pp_waitpid) +PPDEF(pp_wantarray) +PPDEF(pp_warn) +PPDEF(pp_xor) + +OP * ck_ftst _((OP *o)); +OP *ck_anoncode _((OP *o)); +OP *ck_bitop _((OP *o)); +OP *ck_concat _((OP *o)); +OP *ck_spair _((OP *o)); +OP *ck_delete _((OP *o)); +OP *ck_eof _((OP *o)); +OP *ck_eval _((OP *o)); +OP *ck_exec _((OP *o)); +OP *ck_exists _((OP *o)); +OP *ck_rvconst _((OP *o)); +OP *ck_fun _((OP *o)); +OP *ck_glob _((OP *o)); +OP *ck_grep _((OP *o)); +OP *ck_index _((OP *o)); +OP *ck_lengthconst _((OP *o)); +OP *ck_lfun _((OP *o)); +OP *ck_rfun _((OP *o)); +OP *ck_listiob _((OP *o)); +OP *ck_fun_locale _((OP *o)); +OP *ck_scmp _((OP *o)); +OP *ck_match _((OP *o)); +OP *ck_null _((OP *o)); +OP *ck_repeat _((OP *o)); +OP *ck_require _((OP *o)); +OP *ck_select _((OP *o)); +OP *ck_shift _((OP *o)); +OP *ck_sort _((OP *o)); +OP *ck_split _((OP *o)); +OP *ck_subr _((OP *o)); +OP *ck_svconst _((OP *o)); +OP *ck_trunc _((OP *o)); +void unwind_handler_stack _((void *p)); +void restore_magic _((void *p)); +void restore_rsfp _((void *f)); +void yydestruct _((void *ptr)); +int sortcv _((const void *, const void *)); +int sortcmp _((const void *, const void *)); +int sortcmp_locale _((const void *, const void *)); +VIRTUAL int fprintf _((PerlIO *, const char *, ...)); + +#ifdef WIN32 +VIRTUAL int& ErrorNo(); +#endif /* WIN32 */ +#else /* !PERL_OBJECT */ END_EXTERN_C +#endif /* PERL_OBJECT */ + @@ -116,6 +116,8 @@ static U16 regflags; /* are we folding, multilining? */ * Forward declarations for pregcomp()'s friends. */ +static char* regwhite _((char *, char *)); +#ifndef PERL_OBJECT static regnode *reg _((I32, I32 *)); static regnode *reganode _((U8, U32)); static regnode *regatom _((I32 *)); @@ -129,8 +131,8 @@ static void reginsert _((U8, regnode *)); static void regoptail _((regnode *, regnode *)); static void regset _((char *, I32)); static void regtail _((regnode *, regnode *)); -static char* regwhite _((char *, char *)); static char* nextchar _((void)); +#endif static U32 regseen; static I32 seen_zerolen; @@ -144,6 +146,7 @@ char *colors[4]; /* Length of a variant. */ +#ifndef PERL_OBJECT typedef struct { I32 len_min; I32 len_delta; @@ -161,6 +164,7 @@ typedef struct { I32 offset_float_max; I32 flags; } scan_data_t; +#endif static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }; @@ -183,7 +187,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }; #define SF_IN_PAR 0x100 #define SF_HAS_EVAL 0x200 -static void +STATIC void scan_commit(scan_data_t *data) { STRLEN l = SvCUR(data->last_found); @@ -220,7 +224,7 @@ scan_commit(scan_data_t *data) /* Stops at toplevel WHILEM as well as at `last'. At end *scanp is set to the position after last scanned or to NULL. */ -static I32 +STATIC I32 study_chunk(regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 flags) /* scanp: Start here (read-write). */ /* deltap: Write maxlen-minlen here. */ @@ -671,7 +675,7 @@ study_chunk(regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 return min; } -static I32 +STATIC I32 add_data(I32 n, char *s) { if (rx->data) { @@ -750,7 +754,7 @@ pregcomp(char *exp, char *xend, PMOP *pm) DEBUG_r( if (!colorset) { int i = 0; - char *s = PerlENV_getenv("TERMCAP_COLORS"); + char *s = PerlEnv_getenv("TERMCAP_COLORS"); colorset = 1; if (s) { @@ -980,7 +984,7 @@ pregcomp(char *exp, char *xend, PMOP *pm) * is a trifle forced, but the need to tie the tails of the branches to what * follows makes it hard to avoid. */ -static regnode * +STATIC regnode * reg(I32 paren, I32 *flagp) /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */ { @@ -1257,7 +1261,7 @@ reg(I32 paren, I32 *flagp) * * Implements the concatenation operator. */ -static regnode * +STATIC regnode * regbranch(I32 *flagp, I32 first) { register regnode *ret; @@ -1321,7 +1325,7 @@ regbranch(I32 *flagp, I32 first) * It might seem that this node could be dispensed with entirely, but the * endmarker role is not redundant. */ -static regnode * +STATIC regnode * regpiece(I32 *flagp) { register regnode *ret; @@ -1477,7 +1481,7 @@ regpiece(I32 *flagp) * * [Yes, it is worth fixing, some scripts can run twice the speed.] */ -static regnode * +STATIC regnode * regatom(I32 *flagp) { register regnode *ret = 0; @@ -1821,7 +1825,7 @@ regwhite(char *p, char *e) return p; } -static void +STATIC void regset(char *opnd, register I32 c) { if (SIZE_ONLY) @@ -1830,7 +1834,7 @@ regset(char *opnd, register I32 c) opnd[1 + (c >> 3)] |= (1 << (c & 7)); } -static regnode * +STATIC regnode * regclass(void) { register char *opnd, *s; @@ -1988,7 +1992,7 @@ regclass(void) return ret; } -static char* +STATIC char* nextchar(void) { char* retval = regparse++; @@ -2020,7 +2024,7 @@ nextchar(void) /* - reg_node - emit a node */ -static regnode * /* Location. */ +STATIC regnode * /* Location. */ #ifdef CAN_PROTOTYPE reg_node(U8 op) #else @@ -2053,7 +2057,7 @@ U8 op; /* - reganode - emit a node with an argument */ -static regnode * /* Location. */ +STATIC regnode * /* Location. */ #ifdef CAN_PROTOTYPE reganode(U8 op, U32 arg) #else @@ -2088,7 +2092,7 @@ U32 arg; - regc - emit (if appropriate) a byte of code */ #ifdef CAN_PROTOTYPE -static void +STATIC void regc(U8 b, char* s) #else static void @@ -2107,7 +2111,7 @@ char *s; * Means relocating the operand. */ #ifdef CAN_PROTOTYPE -static void +STATIC void reginsert(U8 op, regnode *opnd) #else static void @@ -2146,7 +2150,7 @@ regnode *opnd; /* - regtail - set the next-pointer at the end of a node chain of p to val. */ -static void +STATIC void regtail(regnode *p, regnode *val) { register regnode *scan; @@ -2191,7 +2195,7 @@ regtail(regnode *p, regnode *val) /* - regoptail - regtail on operand of first argument; nop if operandless */ -static void +STATIC void regoptail(regnode *p, regnode *val) { /* "Operandless" and "op != BRANCH" are synonymous in practice. */ @@ -2228,7 +2232,7 @@ regcurly(register char *s) #ifdef DEBUGGING -static regnode * +STATIC regnode * dumpuntil(regnode *start, regnode *node, regnode *last, SV* sv, I32 l) { register char op = EXACT; /* Arbitrary non-END op. */ @@ -448,4 +448,6 @@ const static char reg_off_by_arg[] = { extern char *colors[4]; #endif +#ifndef PERL_OBJECT void re_croak2 _((const char* pat1,const char* pat2,...)) __attribute__((noreturn)); +#endif @@ -104,6 +104,7 @@ struct curcur { static CURCUR* regcc; +#ifndef PERL_OBJECT typedef I32 CHECKPOINT; /* @@ -117,8 +118,9 @@ static I32 regtry _((regexp *prog, char *startpos)); static bool reginclass _((char *p, I32 c)); static CHECKPOINT regcppush _((I32 parenfloor)); static char * regcppop _((void)); +#endif -static CHECKPOINT +STATIC CHECKPOINT regcppush(I32 parenfloor) { dTHR; @@ -145,7 +147,7 @@ regcppush(I32 parenfloor) # define REGCP_SET DEBUG_r(PerlIO_printf(Perl_debug_log, " Setting an EVAL scope, savestack=%i\n", savestack_ix)); lastcp = savestack_ix # define REGCP_UNWIND DEBUG_r(lastcp != savestack_ix ? PerlIO_printf(Perl_debug_log," Clearing an EVAL scope, savestack=%i..%i\n", lastcp, savestack_ix) : 0); regcpblow(lastcp) -static char * +STATIC char * regcppop(void) { dTHR; @@ -678,7 +680,7 @@ phooey: /* - regtry - try match at specific point */ -static I32 /* 0 failure, 1 success */ +STATIC I32 /* 0 failure, 1 success */ regtry(regexp *prog, char *startpos) { dTHR; @@ -734,14 +736,14 @@ regtry(regexp *prog, char *startpos) * maybe save a little bit of pushing and popping on the stack. It also takes * advantage of machines that use a register save mask on subroutine entry. */ -static I32 /* 0 failure, 1 success */ +STATIC I32 /* 0 failure, 1 success */ regmatch(regnode *prog) { dTHR; register regnode *scan; /* Current node. */ regnode *next; /* Next node. */ regnode *inner; /* Next node in internal branch. */ - register I32 nextchar; + register I32 nextchr; /* renamed nextchr - nextchar colides with function of same name */ register I32 n; /* no or next */ register I32 ln; /* len or last */ register char *s; /* operand or save */ @@ -753,7 +755,7 @@ regmatch(regnode *prog) regindent++; #endif - nextchar = UCHARAT(locinput); + nextchr = UCHARAT(locinput); scan = prog; while (scan != NULL) { #define sayNO_L (logical ? (logical = 0, sw = 0, goto cont) : sayNO) @@ -804,7 +806,7 @@ regmatch(regnode *prog) if (locinput == regbol ? regprev == '\n' : (multiline && - (nextchar || locinput < regeol) && locinput[-1] == '\n') ) + (nextchr || locinput < regeol) && locinput[-1] == '\n') ) { /* regtill = regbol; */ break; @@ -813,7 +815,7 @@ regmatch(regnode *prog) case MBOL: if (locinput == regbol ? regprev == '\n' - : ((nextchar || locinput < regeol) && locinput[-1] == '\n') ) + : ((nextchr || locinput < regeol) && locinput[-1] == '\n') ) { break; } @@ -833,38 +835,38 @@ regmatch(regnode *prog) goto seol; case MEOL: meol: - if ((nextchar || locinput < regeol) && nextchar != '\n') + if ((nextchr || locinput < regeol) && nextchr != '\n') sayNO; break; case SEOL: seol: - if ((nextchar || locinput < regeol) && nextchar != '\n') + if ((nextchr || locinput < regeol) && nextchr != '\n') sayNO; if (regeol - locinput > 1) sayNO; break; case SANY: - if (!nextchar && locinput >= regeol) + if (!nextchr && locinput >= regeol) sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case ANY: - if (!nextchar && locinput >= regeol || nextchar == '\n') + if (!nextchr && locinput >= regeol || nextchr == '\n') sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case EXACT: s = (char *) OPERAND(scan); ln = UCHARAT(s++); /* Inline the first character, for speed. */ - if (UCHARAT(s) != nextchar) + if (UCHARAT(s) != nextchr) sayNO; if (regeol - locinput < ln) sayNO; if (ln > 1 && memNE(s, locinput, ln)) sayNO; locinput += ln; - nextchar = UCHARAT(locinput); + nextchr = UCHARAT(locinput); break; case EXACTFL: reg_flags |= RF_tainted; @@ -873,9 +875,9 @@ regmatch(regnode *prog) s = (char *) OPERAND(scan); ln = UCHARAT(s++); /* Inline the first character, for speed. */ - if (UCHARAT(s) != nextchar && + if (UCHARAT(s) != nextchr && UCHARAT(s) != ((OP(scan) == EXACTF) - ? fold : fold_locale)[nextchar]) + ? fold : fold_locale)[nextchr]) sayNO; if (regeol - locinput < ln) sayNO; @@ -884,39 +886,39 @@ regmatch(regnode *prog) : ibcmp_locale(s, locinput, ln))) sayNO; locinput += ln; - nextchar = UCHARAT(locinput); + nextchr = UCHARAT(locinput); break; case ANYOF: s = (char *) OPERAND(scan); - if (nextchar < 0) - nextchar = UCHARAT(locinput); - if (!reginclass(s, nextchar)) + if (nextchr < 0) + nextchr = UCHARAT(locinput); + if (!reginclass(s, nextchr)) sayNO; - if (!nextchar && locinput >= regeol) + if (!nextchr && locinput >= regeol) sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case ALNUML: reg_flags |= RF_tainted; /* FALL THROUGH */ case ALNUM: - if (!nextchar) + if (!nextchr) sayNO; if (!(OP(scan) == ALNUM - ? isALNUM(nextchar) : isALNUM_LC(nextchar))) + ? isALNUM(nextchr) : isALNUM_LC(nextchr))) sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case NALNUML: reg_flags |= RF_tainted; /* FALL THROUGH */ case NALNUM: - if (!nextchar && locinput >= regeol) + if (!nextchr && locinput >= regeol) sayNO; if (OP(scan) == NALNUM - ? isALNUM(nextchar) : isALNUM_LC(nextchar)) + ? isALNUM(nextchr) : isALNUM_LC(nextchr)) sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case BOUNDL: case NBOUNDL: @@ -928,11 +930,11 @@ regmatch(regnode *prog) ln = (locinput != regbol) ? UCHARAT(locinput - 1) : regprev; if (OP(scan) == BOUND || OP(scan) == NBOUND) { ln = isALNUM(ln); - n = isALNUM(nextchar); + n = isALNUM(nextchr); } else { ln = isALNUM_LC(ln); - n = isALNUM_LC(nextchar); + n = isALNUM_LC(nextchr); } if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL)) sayNO; @@ -941,35 +943,35 @@ regmatch(regnode *prog) reg_flags |= RF_tainted; /* FALL THROUGH */ case SPACE: - if (!nextchar && locinput >= regeol) + if (!nextchr && locinput >= regeol) sayNO; if (!(OP(scan) == SPACE - ? isSPACE(nextchar) : isSPACE_LC(nextchar))) + ? isSPACE(nextchr) : isSPACE_LC(nextchr))) sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case NSPACEL: reg_flags |= RF_tainted; /* FALL THROUGH */ case NSPACE: - if (!nextchar) + if (!nextchr) sayNO; if (OP(scan) == SPACE - ? isSPACE(nextchar) : isSPACE_LC(nextchar)) + ? isSPACE(nextchr) : isSPACE_LC(nextchr)) sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case DIGIT: - if (!isDIGIT(nextchar)) + if (!isDIGIT(nextchr)) sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case NDIGIT: - if (!nextchar && locinput >= regeol) + if (!nextchr && locinput >= regeol) sayNO; - if (isDIGIT(nextchar)) + if (isDIGIT(nextchr)) sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case REFFL: reg_flags |= RF_tainted; @@ -983,10 +985,10 @@ regmatch(regnode *prog) if (s == regendp[n]) break; /* Inline the first character, for speed. */ - if (UCHARAT(s) != nextchar && + if (UCHARAT(s) != nextchr && (OP(scan) == REF || (UCHARAT(s) != ((OP(scan) == REFF - ? fold : fold_locale)[nextchar])))) + ? fold : fold_locale)[nextchr])))) sayNO; ln = regendp[n] - s; if (locinput + ln > regeol) @@ -998,7 +1000,7 @@ regmatch(regnode *prog) : ibcmp_locale(s, locinput, ln)))) sayNO; locinput += ln; - nextchar = UCHARAT(locinput); + nextchr = UCHARAT(locinput); break; case NOTHING: @@ -1035,7 +1037,7 @@ regmatch(regnode *prog) cxstack[cxstack_ix].blk_gimme = G_SCALAR; */ } - runops(); /* Scalar context. */ + CALLRUNOPS(); /* Scalar context. */ SPAGAIN; ret = POPs; PUTBACK; @@ -1622,7 +1624,7 @@ no: * That was true before, but now we assume scan - reginput is the count, * rather than incrementing count on every character.] */ -static I32 +STATIC I32 regrepeat(regnode *p, I32 max) { register char *scan; @@ -1734,7 +1736,7 @@ regrepeat(regnode *p, I32 max) * The repeater is supposed to have constant length. */ -static I32 +STATIC I32 regrepeat_hard(regnode *p, I32 max, I32 *lp) { register char *scan; @@ -1765,7 +1767,7 @@ regrepeat_hard(regnode *p, I32 max, I32 *lp) - regclass - determine if a character falls into a character class */ -static bool +STATIC bool reginclass(register char *p, register I32 c) { char flags = *p; @@ -16,12 +16,17 @@ * know. Run now! Hope is in speed!" --Gandalf */ +#ifdef PERL_OBJECT +#define CALLOP this->*op +#else +#define CALLOP *op +#endif int runops_standard(void) { dTHR; - while ( op = (*op->op_ppaddr)(ARGS) ) ; + while ( op = (CALLOP->op_ppaddr)(ARGS) ) ; TAINT_NOT; return 0; @@ -32,7 +37,9 @@ runops_standard(void) { dEXT char **watchaddr = 0; dEXT char *watchok; +#ifndef PERL_OBJECT static void debprof _((OP*o)); +#endif int runops_debug(void) { @@ -51,7 +58,7 @@ runops_debug(void) { DEBUG_t(debop(op)); DEBUG_P(debprof(op)); } - } while ( op = (*op->op_ppaddr)(ARGS) ); + } while ( op = (CALLOP->op_ppaddr)(ARGS) ); TAINT_NOT; return 0; @@ -93,7 +100,7 @@ watch(char **addr) (long)watchaddr, (long)watchok); } -static void +STATIC void debprof(OP *o) { if (!profiledata) @@ -112,7 +112,7 @@ free_tmps(void) } } -static SV * +STATIC SV * save_scalar_at(SV **sptr) { dTHR; @@ -440,7 +440,11 @@ save_list(register SV **sarg, I32 maxsarg) } void +#ifdef PERL_OBJECT +save_destructor(void (*f) (void*, void*), void* p) +#else save_destructor(void (*f) (void *), void *p) +#endif { dTHR; SSCHECK(3); @@ -676,7 +680,7 @@ leave_scope(I32 base) break; case SAVEt_DESTRUCTOR: ptr = SSPOPPTR; - (*SSPOPDPTR)(ptr); + (*SSPOPDPTR)(THIS_ ptr); break; case SAVEt_REGCONTEXT: { @@ -60,8 +60,13 @@ #define SAVECLEARSV(sv) save_clearsv(SOFT_CAST(SV**)&(sv)) #define SAVEDELETE(h,k,l) \ save_delete(SOFT_CAST(HV*)(h), SOFT_CAST(char*)(k), (I32)(l)) +#ifdef PERL_OBJECT +#define SAVEDESTRUCTOR(f,p) \ + save_destructor(SOFT_CAST(void(*)_((void*, void*)))(f),SOFT_CAST(void*)(p)) +#else #define SAVEDESTRUCTOR(f,p) \ save_destructor(SOFT_CAST(void(*)_((void*)))(f),SOFT_CAST(void*)(p)) +#endif #define SAVESTACK_POS() STMT_START { \ SSCHECK(2); \ SSPUSHINT(stack_sp - stack_base); \ @@ -40,6 +40,12 @@ # define FAST_SV_GETS #endif +#ifdef PERL_OBJECT +#define FCALL this->*f +#define VTBL this->*vtbl + +#else /* !PERL_OBJECT */ + static IV asIV _((SV* sv)); static UV asUV _((SV* sv)); static SV *more_sv _((void)); @@ -60,6 +66,10 @@ static void sv_unglob _((SV* sv)); static void sv_check_thinkfirst _((SV *sv)); typedef void (*SVFUNC) _((SV*)); +#define VTBL *vtbl +#define FCALL *f + +#endif /* PERL_OBJECT */ #ifdef PURIFY @@ -203,7 +213,7 @@ U32 flags; MUTEX_UNLOCK(&sv_mutex); \ } while (0) -static void +STATIC void del_sv(SV *p) { if (debug & 32768) { @@ -259,7 +269,7 @@ sv_add_arena(char *ptr, U32 size, U32 flags) } /* sv_mutex must be held while calling more_sv() */ -static SV* +STATIC SV* more_sv(void) { register SV* sv; @@ -277,7 +287,7 @@ more_sv(void) return sv; } -static void +STATIC void visit(SVFUNC f) { SV* sva; @@ -288,14 +298,14 @@ visit(SVFUNC f) svend = &sva[SvREFCNT(sva)]; for (sv = sva + 1; sv < svend; ++sv) { if (SvTYPE(sv) != SVTYPEMASK) - (*f)(sv); + (FCALL)(sv); } } } #endif /* PURIFY */ -static void +STATIC void do_report_used(SV *sv) { if (SvTYPE(sv) != SVTYPEMASK) { @@ -311,7 +321,7 @@ sv_report_used(void) visit(do_report_used); } -static void +STATIC void do_clean_objs(SV *sv) { SV* rv; @@ -327,7 +337,7 @@ do_clean_objs(SV *sv) } #ifndef DISABLE_DESTRUCTOR_KLUDGE -static void +STATIC void do_clean_named_objs(SV *sv) { if (SvTYPE(sv) == SVt_PVGV && GvSV(sv)) @@ -348,7 +358,7 @@ sv_clean_objs(void) in_clean_objs = FALSE; } -static void +STATIC void do_clean_all(SV *sv) { DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops:\n "), sv_dump(sv));) @@ -388,7 +398,7 @@ sv_free_arenas(void) sv_root = 0; } -static XPVIV* +STATIC XPVIV* new_xiv(void) { IV** xiv; @@ -403,7 +413,7 @@ new_xiv(void) return more_xiv(); } -static void +STATIC void del_xiv(XPVIV *p) { IV** xiv = (IV**)((char*)(p) + sizeof(XPV)); @@ -411,7 +421,7 @@ del_xiv(XPVIV *p) xiv_root = xiv; } -static XPVIV* +STATIC XPVIV* more_xiv(void) { register IV** xiv; @@ -432,7 +442,7 @@ more_xiv(void) return new_xiv(); } -static XPVNV* +STATIC XPVNV* new_xnv(void) { double* xnv; @@ -444,7 +454,7 @@ new_xnv(void) return more_xnv(); } -static void +STATIC void del_xnv(XPVNV *p) { double* xnv = (double*)((char*)(p) + sizeof(XPVIV)); @@ -452,7 +462,7 @@ del_xnv(XPVNV *p) xnv_root = xnv; } -static XPVNV* +STATIC XPVNV* more_xnv(void) { register double* xnv; @@ -469,7 +479,7 @@ more_xnv(void) return new_xnv(); } -static XRV* +STATIC XRV* new_xrv(void) { XRV* xrv; @@ -481,14 +491,14 @@ new_xrv(void) return more_xrv(); } -static void +STATIC void del_xrv(XRV *p) { p->xrv_rv = (SV*)xrv_root; xrv_root = p; } -static XRV* +STATIC XRV* more_xrv(void) { register XRV* xrv; @@ -504,7 +514,7 @@ more_xrv(void) return new_xrv(); } -static XPV* +STATIC XPV* new_xpv(void) { XPV* xpv; @@ -516,14 +526,14 @@ new_xpv(void) return more_xpv(); } -static void +STATIC void del_xpv(XPV *p) { p->xpv_pv = (char*)xpv_root; xpv_root = p; } -static XPV* +STATIC XPV* more_xpv(void) { register XPV* xpv; @@ -1172,7 +1182,7 @@ sv_setnv(register SV *sv, double num) SvTAINT(sv); } -static void +STATIC void not_a_number(SV *sv) { dTHR; @@ -1467,7 +1477,7 @@ sv_2nv(register SV *sv) return SvNVX(sv); } -static IV +STATIC IV asIV(SV *sv) { I32 numtype = looks_like_number(sv); @@ -1485,7 +1495,7 @@ asIV(SV *sv) return (IV) U_V(d); } -static UV +STATIC UV asUV(SV *sv) { I32 numtype = looks_like_number(sv); @@ -2219,7 +2229,7 @@ sv_usepvn(register SV *sv, register char *ptr, register STRLEN len) SvTAINT(sv); } -static void +STATIC void sv_check_thinkfirst(register SV *sv) { if (SvTHINKFIRST(sv)) { @@ -2343,7 +2353,7 @@ sv_magic(register SV *sv, SV *obj, int how, char *name, I32 namlen) if (SvMAGICAL(sv) || (how == 't' && SvTYPE(sv) >= SVt_PVMG)) { if (SvMAGIC(sv) && (mg = mg_find(sv, how))) { if (how == 't') - mg->mg_len |= 1; + mg->mg_length |= 1; return; } } @@ -2363,7 +2373,7 @@ sv_magic(register SV *sv, SV *obj, int how, char *name, I32 namlen) mg->mg_flags |= MGf_REFCOUNTED; } mg->mg_type = how; - mg->mg_len = namlen; + mg->mg_length = namlen; if (name) if (namlen >= 0) mg->mg_ptr = savepvn(name, namlen); @@ -2444,7 +2454,7 @@ sv_magic(register SV *sv, SV *obj, int how, char *name, I32 namlen) break; case 't': mg->mg_virtual = &vtbl_taint; - mg->mg_len = 1; + mg->mg_length = 1; break; case 'U': mg->mg_virtual = &vtbl_uvar; @@ -2493,12 +2503,12 @@ sv_unmagic(SV *sv, int type) if (mg->mg_type == type) { MGVTBL* vtbl = mg->mg_virtual; *mgp = mg->mg_moremagic; - if (vtbl && vtbl->svt_free) - (*vtbl->svt_free)(sv, mg); + if (vtbl && (vtbl->svt_free != NULL)) + (VTBL->svt_free)(sv, mg); if (mg->mg_ptr && mg->mg_type != 'g') - if (mg->mg_len >= 0) + if (mg->mg_length >= 0) Safefree(mg->mg_ptr); - else if (mg->mg_len == HEf_SVKEY) + else if (mg->mg_length == HEf_SVKEY) SvREFCNT_dec((SV*)mg->mg_ptr); if (mg->mg_flags & MGf_REFCOUNTED) SvREFCNT_dec(mg->mg_obj); @@ -2636,23 +2646,23 @@ sv_clear(register SV *sv) destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY"); if (destructor) { - SV ref; + SV tmpRef; - Zero(&ref, 1, SV); - sv_upgrade(&ref, SVt_RV); - SvRV(&ref) = SvREFCNT_inc(sv); - SvROK_on(&ref); - SvREFCNT(&ref) = 1; /* Fake, but otherwise + Zero(&tmpRef, 1, SV); + sv_upgrade(&tmpRef, SVt_RV); + SvRV(&tmpRef) = SvREFCNT_inc(sv); + SvROK_on(&tmpRef); + SvREFCNT(&tmpRef) = 1; /* Fake, but otherwise creating+destructing a ref leads to disaster. */ EXTEND(SP, 2); PUSHMARK(SP); - PUSHs(&ref); + PUSHs(&tmpRef); PUTBACK; perl_call_sv((SV*)GvCV(destructor), G_DISCARD|G_EVAL|G_KEEPERR); - del_XRV(SvANY(&ref)); + del_XRV(SvANY(&tmpRef)); SvREFCNT(sv)--; } @@ -2961,17 +2971,17 @@ sv_collxfrm(SV *sv, STRLEN *nxp) assert(mg); } mg->mg_ptr = xf; - mg->mg_len = xlen; + mg->mg_length = xlen; } else { if (mg) { mg->mg_ptr = NULL; - mg->mg_len = -1; + mg->mg_length = -1; } } } if (mg && mg->mg_ptr) { - *nxp = mg->mg_len; + *nxp = mg->mg_length; return mg->mg_ptr + sizeof(collation_ix); } else { @@ -2983,7 +2993,7 @@ sv_collxfrm(SV *sv, STRLEN *nxp) #endif /* USE_LOCALE_COLLATE */ char * -sv_gets(register SV *sv, register FILE *fp, I32 append) +sv_gets(register SV *sv, register PerlIO *fp, I32 append) { dTHR; char *rsptr; @@ -3356,7 +3366,7 @@ sv_dec(register SV *sv) * hopefully we won't free it until it has been assigned to a * permanent location. */ -static void +STATIC void sv_mortalgrow(void) { dTHR; @@ -3486,7 +3496,7 @@ newSViv(IV i) } SV * -newRV(SV *ref) +newRV(SV *tmpRef) { dTHR; register SV *sv; @@ -3496,8 +3506,8 @@ newRV(SV *ref) SvREFCNT(sv) = 1; SvFLAGS(sv) = 0; sv_upgrade(sv, SVt_RV); - SvTEMP_off(ref); - SvRV(sv) = SvREFCNT_inc(ref); + SvTEMP_off(tmpRef); + SvRV(sv) = SvREFCNT_inc(tmpRef); SvROK_on(sv); return sv; } @@ -3505,12 +3515,12 @@ newRV(SV *ref) SV * -Perl_newRV_noinc(SV *ref) +Perl_newRV_noinc(SV *tmpRef) { register SV *sv; - sv = newRV(ref); - SvREFCNT_dec(ref); + sv = newRV(tmpRef); + SvREFCNT_dec(tmpRef); return sv; } @@ -3938,24 +3948,24 @@ SV* sv_bless(SV *sv, HV *stash) { dTHR; - SV *ref; + SV *tmpRef; if (!SvROK(sv)) croak("Can't bless non-reference value"); - ref = SvRV(sv); - if (SvFLAGS(ref) & (SVs_OBJECT|SVf_READONLY)) { - if (SvREADONLY(ref)) + tmpRef = SvRV(sv); + if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) { + if (SvREADONLY(tmpRef)) croak(no_modify); - if (SvOBJECT(ref)) { - if (SvTYPE(ref) != SVt_PVIO) + if (SvOBJECT(tmpRef)) { + if (SvTYPE(tmpRef) != SVt_PVIO) --sv_objcount; - SvREFCNT_dec(SvSTASH(ref)); + SvREFCNT_dec(SvSTASH(tmpRef)); } } - SvOBJECT_on(ref); - if (SvTYPE(ref) != SVt_PVIO) + SvOBJECT_on(tmpRef); + if (SvTYPE(tmpRef) != SVt_PVIO) ++sv_objcount; - (void)SvUPGRADE(ref, SVt_PVMG); - SvSTASH(ref) = (HV*)SvREFCNT_inc(stash); + (void)SvUPGRADE(tmpRef, SVt_PVMG); + SvSTASH(tmpRef) = (HV*)SvREFCNT_inc(stash); #ifdef OVERLOAD if (Gv_AMG(stash)) @@ -3967,7 +3977,7 @@ sv_bless(SV *sv, HV *stash) return sv; } -static void +STATIC void sv_unglob(SV *sv) { assert(SvTYPE(sv) == SVt_PVGV); @@ -4006,7 +4016,7 @@ sv_untaint(SV *sv) if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { MAGIC *mg = mg_find(sv, 't'); if (mg) - mg->mg_len &= ~1; + mg->mg_length &= ~1; } } @@ -4015,7 +4025,7 @@ sv_tainted(SV *sv) { if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { MAGIC *mg = mg_find(sv, 't'); - if (mg && ((mg->mg_len & 1) || (mg->mg_len & 2) && mg->mg_obj == sv)) + if (mg && ((mg->mg_length & 1) || (mg->mg_length & 2) && mg->mg_obj == sv)) return TRUE; } return FALSE; @@ -604,7 +604,7 @@ struct xpvio { # undef newRV_noinc # define newRV_noinc(sv) ({SV *nsv=newRV((sv)); --SvREFCNT(SvRV(nsv)); nsv;}) #else -# if defined(CRIPPLED_CC) || defined(USE_THREADS) +# if defined(CRIPPLED_CC) || defined(USE_THREADS) || defined(PERL_OBJECT) # else # undef newRV_noinc # define newRV_noinc(sv) ((Sv = newRV(sv)), --SvREFCNT(SvRV(Sv)), Sv) @@ -183,5 +183,9 @@ typedef struct condpair { #define THR /* Rats: if dTHR is just blank then the subsequent ";" throws an error */ +#ifdef WIN32 +#define dTHR +#else #define dTHR extern int errno +#endif #endif /* USE_THREADS */ @@ -14,11 +14,12 @@ #include "EXTERN.h" #include "perl.h" +#ifndef PERL_OBJECT static void check_uni _((void)); static void force_next _((I32 type)); static char *force_version _((char *start)); static char *force_word _((char *start, int token, int check_keyword, int allow_pack, int allow_tick)); -static SV *q _((SV *sv)); +static SV *tokeq _((SV *sv)); static char *scan_const _((char *start)); static char *scan_formline _((char *s)); static char *scan_heredoc _((char *s)); @@ -49,6 +50,7 @@ static int uni _((I32 f, char *s)); #endif static char * filter_gets _((SV *sv, PerlIO *fp, STRLEN append)); static void restore_rsfp _((void *f)); +#endif /* PERL_OBJECT */ static char ident_too_long[] = "Identifier too long"; @@ -143,7 +145,17 @@ static struct { /* grandfather return to old style */ #define OLDLOP(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LSTOP) -static int +#ifdef PERL_OBJECT +static void RestoreRsfp(void *pPerl, void *ptr) +{ + ((CPerlObj*)pPerl)->restore_rsfp(ptr); +} +#define RESTORERSFP RestoreRsfp +#else +#define RESTORERSFP restore_rsfp +#endif + +STATIC int ao(int toketype) { if (*bufptr == '=') { @@ -157,7 +169,7 @@ ao(int toketype) return toketype; } -static void +STATIC void no_op(char *what, char *s) { char *oldbp = bufptr; @@ -180,7 +192,7 @@ no_op(char *what, char *s) bufptr = oldbp; } -static void +STATIC void missingterm(char *s) { char tmpbuf[3]; @@ -213,7 +225,7 @@ deprecate(char *s) warn("Use of %s is deprecated", s); } -static void +STATIC void depcom(void) { deprecate("comma-less variable list"); @@ -221,7 +233,7 @@ depcom(void) #ifdef WIN32 -static I32 +STATIC I32 win32_textfilter(int idx, SV *sv, int maxlen) { I32 count = FILTER_READ(idx+1, sv, maxlen); @@ -256,7 +268,7 @@ lex_start(SV *line) SAVESPTR(linestr); SAVEPPTR(lex_brackstack); SAVEPPTR(lex_casestack); - SAVEDESTRUCTOR(restore_rsfp, rsfp); + SAVEDESTRUCTOR(RESTORERSFP, rsfp); lex_state = LEX_NORMAL; lex_defer = 0; @@ -302,7 +314,7 @@ lex_end(void) doextract = FALSE; } -static void +STATIC void restore_rsfp(void *f) { PerlIO *fp = (PerlIO*)f; @@ -314,7 +326,7 @@ restore_rsfp(void *f) rsfp = fp; } -static void +STATIC void incline(char *s) { dTHR; @@ -355,7 +367,7 @@ incline(char *s) curcop->cop_line = atoi(n)-1; } -static char * +STATIC char * skipspace(register char *s) { dTHR; @@ -413,7 +425,7 @@ skipspace(register char *s) } } -static void +STATIC void check_uni(void) { char *s; char ch; @@ -437,7 +449,7 @@ check_uni(void) { #undef UNI #define UNI(f) return uni(f,s) -static int +STATIC int uni(I32 f, char *s) { yylval.ival = f; @@ -458,7 +470,7 @@ uni(I32 f, char *s) #define LOP(f,x) return lop(f,x,s) -static I32 +STATIC I32 lop #ifdef CAN_PROTOTYPE (I32 f, expectation x, char *s) @@ -487,7 +499,7 @@ char *s; return LSTOP; } -static void +STATIC void force_next(I32 type) { nexttype[nexttoke] = type; @@ -499,7 +511,7 @@ force_next(I32 type) } } -static char * +STATIC char * force_word(register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick) { register char *s; @@ -531,7 +543,7 @@ force_word(register char *start, int token, int check_keyword, int allow_pack, i return s; } -static void +STATIC void force_ident(register char *s, int kind) { if (s && *s) { @@ -554,7 +566,7 @@ force_ident(register char *s, int kind) } } -static char * +STATIC char * force_version(char *s) { OP *version = Nullop; @@ -581,8 +593,8 @@ force_version(char *s) return (s); } -static SV * -q(SV *sv) +STATIC SV * +tokeq(SV *sv) { register char *s; register char *send; @@ -614,7 +626,7 @@ q(SV *sv) return sv; } -static I32 +STATIC I32 sublex_start(void) { register I32 op_type = yylval.ival; @@ -625,7 +637,7 @@ sublex_start(void) return THING; } if (op_type == OP_CONST || op_type == OP_READLINE) { - SV *sv = q(lex_stuff); + SV *sv = tokeq(lex_stuff); STRLEN len; char *p = SvPV(sv, len); yylval.opval = (OP*)newSVOP(op_type, 0, newSVpv(p, len)); @@ -649,7 +661,7 @@ sublex_start(void) return FUNC; } -static I32 +STATIC I32 sublex_push(void) { dTHR; @@ -702,7 +714,7 @@ sublex_push(void) return '('; } -static I32 +STATIC I32 sublex_done(void) { if (!lex_starts++) { @@ -747,7 +759,7 @@ sublex_done(void) } } -static char * +STATIC char * scan_const(char *start) { register char *send = bufend; @@ -886,7 +898,7 @@ scan_const(char *start) } /* This is the one truly awful dwimmer necessary to conflate C and sed. */ -static int +STATIC int intuit_more(register char *s) { if (lex_brackets) @@ -1014,7 +1026,7 @@ intuit_more(register char *s) return TRUE; } -static int +STATIC int intuit_method(char *start, GV *gv) { char *s = start + (*start == '$'); @@ -1060,11 +1072,11 @@ intuit_method(char *start, GV *gv) return 0; } -static char* +STATIC char* incl_perldb(void) { if (perldb) { - char *pdb = PerlENV_getenv("PERL5DB"); + char *pdb = PerlEnv_getenv("PERL5DB"); if (pdb) return pdb; @@ -1194,8 +1206,8 @@ filter_read(int idx, SV *buf_sv, int maxlen) } -static char * -filter_gets(register SV *sv, register FILE *fp, STRLEN append) +STATIC char * +filter_gets(register SV *sv, register PerlIO *fp, STRLEN append) { #ifdef WIN32FILTER if (!rsfp_filters) { @@ -1438,7 +1450,7 @@ yylex(void) if (SvIVX(linestr) == '\'') { SV *sv = newSVsv(linestr); if (!lex_inpat) - sv = q(sv); + sv = tokeq(sv); yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv); s = bufend; } @@ -3354,7 +3366,7 @@ yylex(void) } } force_next(')'); - nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, q(lex_stuff)); + nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, tokeq(lex_stuff)); lex_stuff = Nullsv; force_next(THING); force_next(','); @@ -4408,7 +4420,7 @@ keyword(register char *d, I32 len) return 0; } -static void +STATIC void checkcomma(register char *s, char *name, char *what) { char *w; @@ -4450,7 +4462,7 @@ checkcomma(register char *s, char *name, char *what) } } -static char * +STATIC char * scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp) { register char *d = dest; @@ -4477,7 +4489,7 @@ scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLE } } -static char * +STATIC char * scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I32 ck_uni) { register char *d; @@ -4612,7 +4624,7 @@ void pmflag(U16 *pmfl, int ch) *pmfl |= PMf_EXTENDED; } -static char * +STATIC char * scan_pat(char *start) { PMOP *pm; @@ -4638,7 +4650,7 @@ scan_pat(char *start) return s; } -static char * +STATIC char * scan_subst(char *start) { register char *s; @@ -4703,7 +4715,7 @@ scan_subst(char *start) return s; } -static char * +STATIC char * scan_trans(char *start) { register char* s; @@ -4756,7 +4768,7 @@ scan_trans(char *start) return s; } -static char * +STATIC char * scan_heredoc(register char *s) { dTHR; @@ -4882,7 +4894,7 @@ scan_heredoc(register char *s) return s; } -static char * +STATIC char * scan_inputsymbol(char *start) { register char *s = start; @@ -4938,7 +4950,7 @@ scan_inputsymbol(char *start) return s; } -static char * +STATIC char * scan_str(char *start) { dTHR; @@ -5162,7 +5174,7 @@ scan_num(char *start) return s; } -static char * +STATIC char * scan_formline(register char *s) { dTHR; @@ -5232,7 +5244,7 @@ scan_formline(register char *s) return s; } -static void +STATIC void set_csh(void) { #ifdef CSH diff --git a/universal.c b/universal.c index 9a867631d0..5ccd731a70 100644 --- a/universal.c +++ b/universal.c @@ -1,13 +1,12 @@ #include "EXTERN.h" #include "perl.h" -#include "XSUB.h" /* * Contributed by Graham Barr <Graham.Barr@tiuk.ti.com> * The main guts of traverse_isa was actually copied from gv_fetchmeth */ -static SV * +STATIC SV * isa_lookup(HV *stash, char *name, int len, int level) { AV* av; @@ -100,6 +99,7 @@ sv_derived_from(SV *sv, char *name) } +#include "XSUB.h" static XS(XS_UNIVERSAL_isa) @@ -196,6 +196,12 @@ XS(XS_UNIVERSAL_VERSION) XSRETURN(1); } +#ifdef PERL_OBJECT +#undef boot_core_UNIVERSAL +#define boot_core_UNIVERSAL CPerlObj::Perl_boot_core_UNIVERSAL +#define pPerl this +#endif + void boot_core_UNIVERSAL(void) { @@ -536,8 +536,8 @@ perl_init_i18nl10n(int printwarn) #ifdef USE_LOCALE_NUMERIC char *curnum = NULL; #endif /* USE_LOCALE_NUMERIC */ - char *lc_all = PerlENV_getenv("LC_ALL"); - char *lang = PerlENV_getenv("LANG"); + char *lc_all = PerlEnv_getenv("LC_ALL"); + char *lang = PerlEnv_getenv("LANG"); bool setlocale_failure = FALSE; #ifdef LOCALE_ENVIRON_REQUIRED @@ -561,19 +561,19 @@ perl_init_i18nl10n(int printwarn) { #ifdef USE_LOCALE_CTYPE if (! (curctype = setlocale(LC_CTYPE, - (!done && (lang || PerlENV_getenv("LC_CTYPE"))) + (!done && (lang || PerlEnv_getenv("LC_CTYPE"))) ? "" : Nullch))) setlocale_failure = TRUE; #endif /* USE_LOCALE_CTYPE */ #ifdef USE_LOCALE_COLLATE if (! (curcoll = setlocale(LC_COLLATE, - (!done && (lang || PerlENV_getenv("LC_COLLATE"))) + (!done && (lang || PerlEnv_getenv("LC_COLLATE"))) ? "" : Nullch))) setlocale_failure = TRUE; #endif /* USE_LOCALE_COLLATE */ #ifdef USE_LOCALE_NUMERIC if (! (curnum = setlocale(LC_NUMERIC, - (!done && (lang || PerlENV_getenv("LC_NUMERIC"))) + (!done && (lang || PerlEnv_getenv("LC_NUMERIC"))) ? "" : Nullch))) setlocale_failure = TRUE; #endif /* USE_LOCALE_NUMERIC */ @@ -620,7 +620,7 @@ perl_init_i18nl10n(int printwarn) char *p; bool locwarn = (printwarn > 1 || printwarn && - (!(p = PerlENV_getenv("PERL_BADLANG")) || atoi(p))); + (!(p = PerlEnv_getenv("PERL_BADLANG")) || atoi(p))); if (locwarn) { #ifdef LC_ALL @@ -763,13 +763,13 @@ char * mem_collxfrm(const char *s, STRLEN len, STRLEN *xlen) { char *xbuf; - STRLEN xalloc, xin, xout; + STRLEN xAlloc, xin, xout; /* xalloc is a reserved word in VC */ /* the first sizeof(collationix) bytes are used by sv_collxfrm(). */ /* the +1 is for the terminating NUL. */ - xalloc = sizeof(collation_ix) + collxfrm_base + (collxfrm_mult * len) + 1; - New(171, xbuf, xalloc, char); + xAlloc = sizeof(collation_ix) + collxfrm_base + (collxfrm_mult * len) + 1; + New(171, xbuf, xAlloc, char); if (! xbuf) goto bad; @@ -779,13 +779,13 @@ mem_collxfrm(const char *s, STRLEN len, STRLEN *xlen) SSize_t xused; for (;;) { - xused = strxfrm(xbuf + xout, s + xin, xalloc - xout); + xused = strxfrm(xbuf + xout, s + xin, xAlloc - xout); if (xused == -1) goto bad; - if (xused < xalloc - xout) + if (xused < xAlloc - xout) break; - xalloc = (2 * xalloc) + 1; - Renew(xbuf, xalloc, char); + xAlloc = (2 * xAlloc) + 1; + Renew(xbuf, xAlloc, char); if (! xbuf) goto bad; } @@ -1097,7 +1097,7 @@ savepvn(char *sv, register I32 len) /* the SV for form() and mess() is not kept in an arena */ -static SV * +STATIC SV * mess_alloc(void) { SV *sv; @@ -1455,7 +1455,7 @@ my_setenv(char *nam,char *val) vallen = strlen(val); New(904, envstr, namlen + vallen + 3, char); (void)sprintf(envstr,"%s=%s",nam,val); - (void)PerlENV_putenv(envstr); + (void)PerlEnv_putenv(envstr); if (oldstr) Safefree(oldstr); #ifdef _MSC_VER @@ -2115,7 +2115,7 @@ wait4pid(int pid, int *statusp, int flags) if (flags) croak("Can't do waitpid with flags"); else { - while ((result = wait(statusp)) != pid && pid > 0 && result >= 0) + while ((result = PerlProc_wait(statusp)) != pid && pid > 0 && result >= 0) pidgone(result,*statusp); if (result < 0) *statusp = -1; @@ -2457,7 +2457,7 @@ condpair_magic(SV *sv) sv_magic(sv, Nullsv, 'm', 0, 0); mg = SvMAGIC(sv); mg->mg_ptr = (char *)cp; - mg->mg_len = sizeof(cp); + mg->mg_length = sizeof(cp); MUTEX_UNLOCK(&sv_mutex); DEBUG_L(WITH_THR(PerlIO_printf(PerlIO_stderr(), "%p: condpair_magic %p\n", thr, sv));) @@ -3224,7 +3224,7 @@ struct passwd *my_getpwuid(Uid_t uid) else { uic.uic$l_uic= uid; if (!uic.uic$v_group) - uic.uic$v_group= getgid(); + uic.uic$v_group= PerlProc_getgid(); if (valid_uic(uic)) status = sys$idtoasc(uic.uic$l_uic, &lname, &name_desc, 0, 0, 0); else status = SS$_IVIDENT; diff --git a/win32/Makefile b/win32/Makefile index 12410e21fb..b5413bdf46 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -21,6 +21,10 @@ BUILDOPT=-DUSE_THREADS #CCTYPE=MSVC20 # +# uncomment next line if you want to use the perl object +#OBJECT=-DPERL_OBJECT + +# # uncomment next line if you want debug version of perl (big,slow) #CFG=Debug @@ -70,7 +74,7 @@ RUNTIME = -MD !ENDIF INCLUDES = -I.\include -I. -I.. #PCHFLAGS = -Fp"$(INTDIR)/modules.pch" -YX -DEFINES = -DWIN32 -D_CONSOLE $(BUILDOPT) $(CRYPT_FLAG) +DEFINES = -DWIN32 -D_CONSOLE $(BUILDOPT) $(CRYPT_FLAG) $(OBJECT) LOCDEFS = -DPERLDLL -DPERL_CORE SUBSYS = console @@ -104,7 +108,11 @@ 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 +!IF "$(OBJECT)" == "-DPERL_OBJECT" +CFLAGS = -nologo -Gf -W3 -TP $(INCLUDES) $(DEFINES) $(LOCDEFS) $(PCHFLAGS) $(OPTIMIZE) +!ELSE CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) $(PCHFLAGS) $(OPTIMIZE) +!ENDIF LINK_FLAGS = -nologo $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE) OBJOUT_FLAG = -Fo EXEOUT_FLAG = -Fe diff --git a/win32/config_H.bc b/win32/config_H.bc index f587e019c8..6cdae5d536 100644 --- a/win32/config_H.bc +++ b/win32/config_H.bc @@ -1686,7 +1686,9 @@ /* MYMALLOC: * This symbol, if defined, indicates that we're using our own malloc. */ +#ifndef PERL_OBJECT #define MYMALLOC /**/ +#endif /* OLDARCHLIB: * This variable, if defined, holds the name of the directory in diff --git a/win32/config_H.vc b/win32/config_H.vc index 42578bad8e..4124b6188f 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -18,6 +18,14 @@ #ifndef _config_h_ #define _config_h_ +#ifdef PERL_OBJECT +#ifdef PERL_GLOBAL_STRUCT +#error PERL_GLOBAL_STRUCT cannot be defined with PERL_OBJECT +#endif +#define win32_perllib_path PerlEnv_lib_path +#endif + + /* MEM_ALIGNBYTES: * This symbol contains the number of bytes required to align a * double. Usual values are 2, 4 and 8. @@ -57,8 +65,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\bin" /**/ -#define BIN_EXP "c:\\perl\\bin" /**/ +#define BIN "c:\\perl5004.5x\\bin" /**/ +#define BIN_EXP "c:\\perl5004.5x\\bin" /**/ /* CAT2: * This macro catenates 2 tokens together. @@ -548,6 +556,12 @@ */ /*#define HAS_POLL /**/ +/* HAS_PTHREAD_YIELD: + * This symbol, if defined, indicates that the pthread_yield routine is + * available to yield the execution of the current thread. + */ +#undef HAS_PTHREAD_YIELD + /* HAS_READDIR: * This symbol, if defined, indicates that the readdir routine is * available to read directory entries. You may have to include @@ -555,6 +569,12 @@ */ #define HAS_READDIR /**/ +/* HAS_SCHED_YIELD: + * This symbol, if defined, indicates that the sched_yield + * routine is available to yield the execution of the current thread. + */ +#undef HAS_SCHED_YIELD + /* HAS_SEEKDIR: * This symbol, if defined, indicates that the seekdir routine is * available. You may have to include <dirent.h>. See I_DIRENT. @@ -1466,7 +1486,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\lib\\MSWin32-x86-thread" /**/ +#define ARCHLIB "c:\\perl5004.5x\\lib" /**/ #define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL)) /**/ /* BINCOMPAT3: @@ -1606,6 +1626,12 @@ */ /*#define USE_SFIO /**/ +/* PTHREADS_CREATED_JOINABLE: + * This symbol, if defined, indicates that pthreads are created + * in the joinable (aka undetached) state. + */ +/*#define PTHREADS_CREATED_JOINABLE /**/ + /* Sigjmp_buf: * This is the buffer type to be used with Sigsetjmp and Siglongjmp. */ @@ -1686,7 +1712,9 @@ /* MYMALLOC: * This symbol, if defined, indicates that we're using our own malloc. */ +#ifndef PERL_OBJECT #define MYMALLOC /**/ +#endif /* OLDARCHLIB: * This variable, if defined, holds the name of the directory in @@ -1713,7 +1741,7 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "c:\\perl\\lib" /**/ +#define PRIVLIB "c:\\perl5004.5x\\lib" /**/ #define PRIVLIB_EXP (win32_perllib_path(NULL)) /**/ /* SH_PATH: @@ -1769,7 +1797,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\lib\\site" /**/ +#define SITEARCH "c:\\perl5004.5x\\lib\\site" /**/ #define SITEARCH_EXP (win32_perllib_path("site",ARCHNAME,NULL)) /**/ /* SITELIB: @@ -1785,7 +1813,7 @@ * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITELIB "c:\\perl\\lib\\site" /**/ +#define SITELIB "c:\\perl5004.5x\\lib\\site" /**/ #define SITELIB_EXP (win32_perllib_path("site",NULL)) /**/ /* STARTPERL: diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs index 0f869e1f85..13d97211a3 100644 --- a/win32/dl_win32.xs +++ b/win32/dl_win32.xs @@ -57,12 +57,12 @@ dl_load_file(filename,flags=0) int flags PREINIT: CODE: - DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename)); if (dl_static_linked(filename) == 0) RETVAL = (void*) LoadLibraryEx(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ; else RETVAL = (void*) GetModuleHandle(NULL); - DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError("%d",GetLastError()) ; @@ -75,10 +75,10 @@ dl_find_symbol(libhandle, symbolname) void * libhandle char * symbolname CODE: - DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n", libhandle, symbolname)); RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname); - DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref = %x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError("%d",GetLastError()) ; @@ -100,7 +100,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CV*))symref, filename))); diff --git a/win32/include/sys/socket.h b/win32/include/sys/socket.h index 40a5485343..6ffb0ac269 100644 --- a/win32/include/sys/socket.h +++ b/win32/include/sys/socket.h @@ -142,6 +142,7 @@ void win32_endprotoent(void); void win32_endservent(void); #ifndef WIN32SCK_IS_STDSCK +#ifndef PERL_OBJECT // // direct to our version // @@ -203,6 +204,7 @@ void win32_endservent(void); #define FD_ZERO(p) PERL_FD_ZERO(p) #endif /* USE_SOCKETS_AS_HANDLES */ +#endif /* PERL_OBJECT */ #endif /* WIN32SCK_IS_STDSCK */ #ifdef __cplusplus diff --git a/win32/ipdir.c b/win32/ipdir.c new file mode 100644 index 0000000000..29702c8f26 --- /dev/null +++ b/win32/ipdir.c @@ -0,0 +1,186 @@ +/* + + 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 new file mode 100644 index 0000000000..9033b55138 --- /dev/null +++ b/win32/ipenv.c @@ -0,0 +1,62 @@ +/* + + 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; +}; + +char *CPerlEnv::Getenv(const char *varname, int &err) +{ + return getenv(varname); +} + +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) + : 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 new file mode 100644 index 0000000000..3522284219 --- /dev/null +++ b/win32/iplio.c @@ -0,0 +1,307 @@ +/* + + 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) +{ + int ret = fstat(fd, sbufptr); + if(errno) + err = errno; + return ret; +} + +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); +} + +char *CPerlLIO::Mktemp(char *Template, int &err) +{ + return mktemp(Template); +} + +int CPerlLIO::Open(const char *filename, int oflag, int &err) +{ + CALLFUNCERR(open(filename, oflag)) +} + +int CPerlLIO::Open(const char *filename, int oflag, int pmode, int &err) +{ + CALLFUNCERR(open(filename, oflag, pmode)) +} + +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) +{ + return stat(path, sbufptr); +} + +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 new file mode 100644 index 0000000000..62e72ab8db --- /dev/null +++ b/win32/ipmem.c @@ -0,0 +1,39 @@ +/* + + 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 new file mode 100644 index 0000000000..f6445291d1 --- /dev/null +++ b/win32/ipproc.c @@ -0,0 +1,620 @@ +/* + + 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 new file mode 100644 index 0000000000..a6510b9d83 --- /dev/null +++ b/win32/ipsock.c @@ -0,0 +1,681 @@ +/* + + 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 new file mode 100644 index 0000000000..7d37373b9a --- /dev/null +++ b/win32/ipstdio.c @@ -0,0 +1,447 @@ +/* + + 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; + }; + 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 SSize_t Read(PerlIO*,void *,Size_t, int &err); + virtual SSize_t Write(PerlIO*,const void *,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') + { + 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; +} + +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*, int &err) +{ + croak("setlinebuf not implemented!\n"); +} + +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::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) +{ +} + +void CPerlStdIO::InitOSExtras(void* p) +{ +} + + diff --git a/win32/ipstdiowin.h b/win32/ipstdiowin.h new file mode 100644 index 0000000000..e4895272c0 --- /dev/null +++ b/win32/ipstdiowin.h @@ -0,0 +1,22 @@ +/* + + 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/makedef.pl b/win32/makedef.pl index ddf01fdab8..b4097d5c23 100644 --- a/win32/makedef.pl +++ b/win32/makedef.pl @@ -104,6 +104,7 @@ Perl_dump_packsubs Perl_dump_pm Perl_dump_sub Perl_expectterm +Perl_error_no Perl_fetch_gv Perl_fetch_io Perl_force_ident @@ -156,6 +157,7 @@ Perl_scan_trans Perl_scan_word Perl_setenv_getix Perl_skipspace +Perl_sort_mutex Perl_sublex_done Perl_sublex_start Perl_sv_ref diff --git a/win32/perlobj.def b/win32/perlobj.def new file mode 100644 index 0000000000..6b0f65dad8 --- /dev/null +++ b/win32/perlobj.def @@ -0,0 +1,4 @@ +LIBRARY Perl500 +DESCRIPTION 'Perl interpreter' +EXPORTS + perl_alloc diff --git a/win32/runperl.c b/win32/runperl.c index 954460739f..76f9ea0b93 100644 --- a/win32/runperl.c +++ b/win32/runperl.c @@ -1,3 +1,173 @@ + +#ifdef PERL_OBJECT +#define USE_SOCKETS_AS_HANDLES +#include "EXTERN.h" +#include "perl.h" + +#include "XSUB.H" + +#include <ipdir.h> +#include <ipenv.h> +#include <ipsock.h> +#include <iplio.h> +#include <ipmem.h> +#include <ipproc.h> + +#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]) +#undef fprintf +#undef environ + +class CPerlHost +{ +public: + CPerlHost() { pPerl = NULL; }; + inline BOOL PerlCreate(void) + { + 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; + } + } + } + catch(...) + { + 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 + { + 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) + { + 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; +}; + +#undef PERL_SYS_INIT +#define PERL_SYS_INIT(a, c) + +int +main(int argc, char **argv, char **env) +{ + CPerlHost host; + int exitstatus = 1; + + if(!host.PerlCreate()) + exit(exitstatus); + + + exitstatus = host.PerlParse(argc, argv, env); + + if (!exitstatus) + { + exitstatus = host.PerlRun(); + } + + host.PerlDestroy(); + + return exitstatus; +} + + +static void xs_init(CPERLarg) +{ +} + +#else /* PERL_OBJECT */ + /* Say NO to CPP! Hallelujah! */ #ifdef __GNUC__ /* @@ -22,3 +192,5 @@ main(int argc, char **argv, char **env) { return RunPerl(argc, argv, env, (void*)0); } + +#endif /* PERL_OBJECT */ diff --git a/win32/win32iop.h b/win32/win32iop.h index e71bf3865e..98627e4c6b 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -151,6 +151,7 @@ END_EXTERN_C #undef fileno #endif +#ifndef PERL_OBJECT #define stderr win32_stderr() #define stdout win32_stdout() #define stdin win32_stdin() @@ -163,6 +164,7 @@ END_EXTERN_C /* * redirect to our own version */ +#undef fprintf #define fprintf win32_fprintf #define vfprintf win32_vfprintf #define printf win32_printf @@ -177,6 +179,7 @@ END_EXTERN_C #define fputs(s,f) win32_fputs(s,f) #define fputc(c,f) win32_fputc(c,f) #define ungetc(c,f) win32_ungetc(c,f) +#undef getc #define getc(f) win32_getc(f) #define fileno(f) win32_fileno(f) #define clearerr(f) win32_clearerr(f) @@ -218,9 +221,12 @@ END_EXTERN_C #define fgets win32_fgets #define gets win32_gets #define fgetc win32_fgetc +#undef putc #define putc win32_putc #define puts win32_puts +#undef getchar #define getchar win32_getchar +#undef putchar #define putchar win32_putchar #if !defined(MYMALLOC) || !defined(PERL_CORE) @@ -241,6 +247,7 @@ END_EXTERN_C #define alarm win32_alarm #define ioctl win32_ioctl #define wait win32_wait +#endif /* PERL_OBJECT */ #ifdef HAVE_DES_FCRYPT #undef crypt @@ -248,8 +255,10 @@ END_EXTERN_C #endif #ifndef USE_WIN32_RTL_ENV +#ifndef PERL_OBJECT #undef getenv #define getenv win32_getenv +#endif /* PERL_OBJECT */ #endif #endif /* WIN32IO_IS_STDIO */ |