# 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
--- /dev/null
+#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__ */
+
#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
#else
# define XS_VERSION_BOOTCHECK
#endif
+
+#ifdef PERL_OBJECT
+#include "ObjXSub.h"
+#endif
\ No newline at end of file
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;
#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;
#endif /* F_FREESP */
bool
-do_print(register SV *sv, FILE *fp)
+do_print(register SV *sv, PerlIO *fp)
{
register char *tmps;
STRLEN len;
* 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 */
}
#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)
#else
#ifdef I_STDARG
-static void
+STATIC void
dump(char *pat,...)
#else
/*VARARGS0*/
#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)
#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)
#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
#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
#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
#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
#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 */
GvMULTI_on(gv);
}
-static void
+STATIC void
gv_init_sv(GV *gv, I32 sv_type)
{
switch (sv_type) {
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;
}
}
PUTBACK;
if (op = pp_entersub(ARGS))
- runops();
+ CALLRUNOPS();
LEAVE;
SPAGAIN;
#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;
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;
return new_he();
}
-static HEK *
+STATIC HEK *
save_hek(char *str, I32 len, U32 hash)
{
char *k;
return FALSE;
}
-static void
+STATIC void
hsplit(HV *hv)
{
register XPVHV* xhv = (XPVHV*)SvANY(hv);
mg_clear((SV*)hv);
}
-static void
+STATIC void
hfreeentries(HV *hv)
{
register HE **array;
#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
--- /dev/null
+/*
+
+ 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___ */
+
--- /dev/null
+/*
+
+ 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___ */
+
--- /dev/null
+/*
+
+ 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___ */
--- /dev/null
+/*
+
+ 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___ */
+
--- /dev/null
+/*
+
+ 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___ */
+
--- /dev/null
+/*
+
+ 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___ */
+
--- /dev/null
+/*
+
+ 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___ */
+
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)
* 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;
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;
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);
}
}
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))
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;
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;
}
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;
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);
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);
return 0;
}
-static int
+STATIC int
magic_methpack(SV *sv, MAGIC *mg, char *meth)
{
dSP;
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))
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;
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;
}
}
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);
}
else if (pos > len)
pos = len;
- mg->mg_len = pos;
+ mg->mg_length = pos;
mg->mg_flags &= ~MGf_MINMATCH;
return 0;
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;
}
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;
}
int
magic_setmglob(SV *sv, MAGIC *mg)
{
- mg->mg_len = -1;
+ mg->mg_length = -1;
SvSCREAM_off(sv);
return 0;
}
if (mg->mg_ptr) {
Safefree(mg->mg_ptr);
mg->mg_ptr = NULL;
- mg->mg_len = -1;
+ mg->mg_length = -1;
}
return 0;
}
(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 '>':
(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 '(':
(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 ')':
(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 ':':
static SV* sig_sv;
-static void
+STATIC void
unwind_handler_stack(void *p)
{
dTHR;
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. */
*/
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 {
U8 mg_flags;
SV* mg_obj;
char* mg_ptr;
- I32 mg_len;
+ I32 mg_length;
};
#define MGf_TAINTEDDIR 1
#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)
--- /dev/null
+#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__ */
#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.
? ( 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));
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();
return SvPV(tmpsv,na);
}
-static OP *
+STATIC OP *
no_fh_allowed(OP *o)
{
yyerror(form("Missing comma after first argument to %s function",
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)",
return off;
}
-static PADOFFSET
+STATIC PADOFFSET
#ifndef CAN_PROTOTYPE
pad_findlex(name, newoff, seq, startcv, cx_ix)
char *name;
Safefree(o);
}
-static void
+STATIC void
null(OP *o)
{
if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0)
return o;
}
-static OP *
+STATIC OP *
scalarboolean(OP *o)
{
if (dowarn &&
return o;
}
-static OP *
+STATIC OP *
modkids(OP *o, I32 type)
{
OP *kid;
return retval;
}
-static OP *
+STATIC OP *
newDEFSVOP(void)
{
#ifdef USE_THREADS
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);
op = curop = LINKLIST(o);
o->op_next = 0;
pp_pushmark(ARGS);
- runops();
+ CALLRUNOPS();
op = curop;
pp_anonlist(ARGS);
tmps_floor = oldtmps_floor;
list(force_list(listval)) );
}
-static I32
+STATIC I32
list_assignment(register OP *o)
{
if (!o)
}
#ifdef DEBUG_CLOSURES
-static void
+STATIC void
cv_dump(cv)
CV* cv;
{
}
#endif /* DEBUG_CLOSURES */
-static CV *
+STATIC CV *
cv_clone2(CV *proto, CV *outside)
{
dTHR;
}
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);
#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; \
};
#endif
+#ifndef PERL_OBJECT
START_EXTERN_C
OP * ck_anoncode _((OP* o));
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,
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 */
ck_rfun, /* lock */
ck_null, /* threadsv */
};
+#endif /* PERL_OBJECT */
#endif
#ifndef DOINIT
mess_sv = Nullsv; \
} STMT_END
+#ifndef PERL_OBJECT
static void find_beginning _((void));
static void forbid_setid _((char *));
static void incpush _((char *, int));
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);
}
#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)
{
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;
#endif /* FAKE_THREADS */
#endif /* USE_THREADS */
+#ifndef PERL_OBJECT
if (!(curinterp = sv_interp))
return;
+#endif
#ifdef MULTIPLICITY
Zero(sv_interp, 1, PerlInterpreter);
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 */
nrs = newSVpv("\n", 1);
rs = SvREFCNT_inc(nrs);
+#ifdef PERL_OBJECT
+ /* TODO: */
+ /* sighandlerp = sighandler; */
+#else
sighandlerp = sighandler;
+#endif
pidstatus = newHV();
#ifdef MSDOS
}
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 */
Thread t;
#endif /* USE_THREADS */
+#ifndef PERL_OBJECT
if (!(curinterp = sv_interp))
return;
+#endif
#ifdef USE_THREADS
#ifndef FAKE_THREADS
#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;
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);
}
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;
#endif
#endif
+#ifndef PERL_OBJECT
if (!(curinterp = sv_interp))
return 255;
+#endif
#if defined(NeXT) && defined(__DYNAMIC__)
_dyld_lookup_and_bind
}
switch_end:
- if (!tainting && (s = PerlENV_getenv("PERL5OPT"))) {
+ if (!tainting && (s = PerlEnv_getenv("PERL5OPT"))) {
while (s && *s) {
while (isSPACE(*s))
s++;
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
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
}
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;
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;
if (restartop) {
op = restartop;
restartop = 0;
- runops();
+ CALLRUNOPS();
}
else if (main_start) {
CvDEPTH(main_cv) = 1;
op = main_start;
- runops();
+ CALLRUNOPS();
}
my_exit(0);
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,"");
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,"");
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)",
"\n",
NULL
};
- char **p = usage;
+ char **p = usage_msg;
printf("\nUsage: %s [switches] [--] [programfile] [arguments]", name);
while (*p)
#endif
}
-static void
+STATIC void
init_main_stash(void)
{
dTHR;
}
#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;
#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
#ifdef DOSISH
&& !strchr(scriptname, '\\')
#endif
- && (s = PerlENV_getenv("PATH"))) {
+ && (s = PerlEnv_getenv("PATH"))) {
bool seen_dot = 0;
bufend = s + strlen(s);
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? */
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)
#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 */
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);
}
}
-static void
+STATIC void
validate_suid(char *validarg, char *scriptname)
{
int which;
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) {
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");
#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) {
#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 */
#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();
#endif /* DOSUID */
}
-static void
+STATIC void
find_beginning(void)
{
register char *s, *s2;
}
}
-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;
tainting |= (uid && (euid != uid || egid != gid));
}
-static void
+STATIC void
forbid_setid(char *s)
{
if (euid != uid)
croak("No %s allowed while running setgid", s);
}
-static void
+STATIC void
init_debugger(void)
{
dTHR;
}
}
-static void
+STATIC void
nuke_stacks(void)
{
dTHR;
} )
}
+#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);
subname = newSVpv("main",4);
}
-static void
+STATIC void
init_predump_symbols(void)
{
dTHR;
osname = savepv(OSNAME);
}
-static void
+STATIC void
init_postdump_symbols(register int argc, register char **argv, register char **env)
{
dTHR;
*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
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
# define PERLLIB_MANGLE(s,n) (s)
#endif
-static void
+STATIC void
incpush(char *p, int addsubdirs)
{
SV *subdir = Nullsv;
/* .../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"));
/* .../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"));
}
#ifdef USE_THREADS
-static struct perl_thread *
+STATIC struct perl_thread *
init_main_thread()
{
struct perl_thread *thr;
#endif /* USE_THREADS */
void
-call_list(I32 oldscope, AV *list)
+call_list(I32 oldscope, AV *paramList)
{
dTHR;
line_t oldline = curcop->cop_line;
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);
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");
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");
my_exit_jump();
}
-static void
+STATIC void
my_exit_jump(void)
{
dTHR;
#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"
#endif
#include "perlio.h"
+#include "perlmem.h"
#include "perllio.h"
#include "perlsock.h"
#include "perlproc.h"
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
#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];
* 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!@"
#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"
#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
* 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
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,
#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))
#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 */
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
#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))
#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))
#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))
#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))
#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))
#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 */
+
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 */
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 */
#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
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)
{
#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;
# 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;
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;
}
}
RETURN;
}
-static SV*
+STATIC SV*
refto(SV *sv)
{
SV* rv;
{
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"))
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
PP(pp_modulo)
{
- djSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
UV left;
UV right;
PP(pp_i_modulo)
{
- djSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
RETPUSHYES;
}
-static U32
+STATIC U32
seed(void)
{
/*
RETURN;
}
-static SV *
+STATIC SV *
mul128(SV *sv, U8 m)
{
STRLEN len;
RETURN;
}
-static void
+STATIC void
doencodes(register SV *sv, register char *s, register I32 len)
{
char hunk[5];
sv_catpvn(sv, "\n", 1);
}
-static SV *
+STATIC SV *
is_an_int(char *s, STRLEN l)
{
SV *result = newSVpv("", l);
return (result);
}
-static int
+STATIC int
div128(SV *pnum, bool *done)
/* must be '\0' terminated */
#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 */
/* 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
#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));
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;
PP(pp_formline)
{
djSP; dMARK; dORIGMARK;
- register SV *form = *++MARK;
+ register SV *tmpForm = *++MARK;
register U16 *fpc;
register char *t;
register char *f;
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;
}
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;
}
+#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;
}
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);
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;
/* Control. */
-static I32
+STATIC I32
dopoptolabel(char *label)
{
dTHR;
}
}
-static I32
+STATIC I32
dopoptosub(I32 startingblock)
{
dTHR;
return i;
}
-static I32
+STATIC I32
dopoptoeval(I32 startingblock)
{
dTHR;
return i;
}
-static I32
+STATIC I32
dopoptoloop(I32 startingblock)
{
dTHR;
RETURN;
}
-static int
+STATIC int
sortcv(const void *a, const void *b)
{
dTHR;
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))
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);
static OP* lastgotoprobe;
-static OP *
+STATIC OP *
dofindlabel(OP *o, char *label, OP **opstack, OP **oplimit)
{
OP *kid;
}
else {
stack_sp--; /* There is no cv arg. */
- (void)(*CvXSUB(cv))(cv);
+ (void)(*CvXSUB(cv))(THIS_ cv);
}
LEAVE;
return pop_return();
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;
}
/* Eval. */
-static void
+STATIC void
save_lines(AV *array, SV *sv)
{
register char *s = SvPVX(sv);
}
}
-static OP *
+STATIC OP *
docatch(OP *o)
{
dTHR;
restartop = 0;
/* FALL THROUGH */
case 0:
- runops();
+ CALLRUNOPS();
break;
}
JMPENV_POP;
}
/* With USE_THREADS, eval_owner must be held on entry to doeval */
-static OP *
+STATIC OP *
doeval(int gimme, OP** startop)
{
dSP;
RETURN;
}
-static void
+STATIC void
doparseform(SV *sv)
{
STRLEN len;
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
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));
}
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;
}
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
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);
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;
}
return pop_return();
}
-static CV *
+STATIC CV *
get_db_sub(SV **svp, CV *cv)
{
dTHR;
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 ) {
PUTBACK;
if (op = pp_entersub(ARGS))
- runops();
+ CALLRUNOPS();
SPAGAIN;
CATCH_SET(oldcatch);
PUTBACK;
if (op = pp_entersub(ARGS))
- runops();
+ CALLRUNOPS();
#else
PUTBACK;
perl_call_sv((SV*)GvCV(gv), G_SCALAR);
#ifdef ORIGINAL_TIE
if (op = pp_entersub(ARGS))
- runops();
+ CALLRUNOPS();
#else
perl_call_sv((SV*)GvCV(gv), G_SCALAR);
#endif
return pp_sysread(ARGS);
}
-static OP *
+STATIC OP *
doform(CV *cv, GV *gv, OP *retop)
{
dTHR;
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
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;
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");
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)));
(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);
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) {
}
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
{
djSP;
#ifdef HAS_SOCKET
- sethostent(TOPi);
+ PerlSock_sethostent(TOPi);
RETSETYES;
#else
DIE(no_sock_func, "sethostent");
{
djSP;
#ifdef HAS_SOCKET
- setnetent(TOPi);
+ PerlSock_setnetent(TOPi);
RETSETYES;
#else
DIE(no_sock_func, "setnetent");
{
djSP;
#ifdef HAS_SOCKET
- setprotoent(TOPi);
+ PerlSock_setprotoent(TOPi);
RETSETYES;
#else
DIE(no_sock_func, "setprotoent");
{
djSP;
#ifdef HAS_SOCKET
- setservent(TOPi);
+ PerlSock_setservent(TOPi);
RETSETYES;
#else
DIE(no_sock_func, "setservent");
{
djSP;
#ifdef HAS_SOCKET
- endhostent();
+ PerlSock_endhostent();
EXTEND(sp,1);
RETPUSHYES;
#else
{
djSP;
#ifdef HAS_SOCKET
- endnetent();
+ PerlSock_endnetent();
EXTEND(sp,1);
RETPUSHYES;
#else
{
djSP;
#ifdef HAS_SOCKET
- endprotoent();
+ PerlSock_endprotoent();
EXTEND(sp,1);
RETPUSHYES;
#else
{
djSP;
#ifdef HAS_SOCKET
- endservent();
+ PerlSock_endservent();
EXTEND(sp,1);
RETPUSHYES;
#else
#ifdef HAS_GETLOGIN
char *tmps;
EXTEND(SP, 1);
- if (!(tmps = getlogin()))
+ if (!(tmps = PerlProc_getlogin()))
RETPUSHUNDEF;
PUSHp(tmps, strlen(tmps));
RETURN;
+#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? */
#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));
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
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 */
+
* 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 *));
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;
/* Length of a variant. */
+#ifndef PERL_OBJECT
typedef struct {
I32 len_min;
I32 len_delta;
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 };
#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);
/* 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. */
return min;
}
-static I32
+STATIC I32
add_data(I32 n, char *s)
{
if (rx->data) {
DEBUG_r(
if (!colorset) {
int i = 0;
- char *s = PerlENV_getenv("TERMCAP_COLORS");
+ char *s = PerlEnv_getenv("TERMCAP_COLORS");
colorset = 1;
if (s) {
* 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. */
{
*
* Implements the concatenation operator.
*/
-static regnode *
+STATIC regnode *
regbranch(I32 *flagp, I32 first)
{
register regnode *ret;
* 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;
*
* [Yes, it is worth fixing, some scripts can run twice the speed.]
*/
-static regnode *
+STATIC regnode *
regatom(I32 *flagp)
{
register regnode *ret = 0;
return p;
}
-static void
+STATIC void
regset(char *opnd, register I32 c)
{
if (SIZE_ONLY)
opnd[1 + (c >> 3)] |= (1 << (c & 7));
}
-static regnode *
+STATIC regnode *
regclass(void)
{
register char *opnd, *s;
return ret;
}
-static char*
+STATIC char*
nextchar(void)
{
char* retval = regparse++;
/*
- reg_node - emit a node
*/
-static regnode * /* Location. */
+STATIC regnode * /* Location. */
#ifdef CAN_PROTOTYPE
reg_node(U8 op)
#else
/*
- reganode - emit a node with an argument
*/
-static regnode * /* Location. */
+STATIC regnode * /* Location. */
#ifdef CAN_PROTOTYPE
reganode(U8 op, U32 arg)
#else
- regc - emit (if appropriate) a byte of code
*/
#ifdef CAN_PROTOTYPE
-static void
+STATIC void
regc(U8 b, char* s)
#else
static void
* Means relocating the operand.
*/
#ifdef CAN_PROTOTYPE
-static void
+STATIC void
reginsert(U8 op, regnode *opnd)
#else
static void
/*
- 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;
/*
- 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. */
#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. */
extern char *colors[4];
#endif
+#ifndef PERL_OBJECT
void re_croak2 _((const char* pat1,const char* pat2,...)) __attribute__((noreturn));
+#endif
static CURCUR* regcc;
+#ifndef PERL_OBJECT
typedef I32 CHECKPOINT;
/*
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;
# 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;
/*
- regtry - try match at specific point
*/
-static I32 /* 0 failure, 1 success */
+STATIC I32 /* 0 failure, 1 success */
regtry(regexp *prog, char *startpos)
{
dTHR;
* 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 */
regindent++;
#endif
- nextchar = UCHARAT(locinput);
+ nextchr = UCHARAT(locinput);
scan = prog;
while (scan != NULL) {
#define sayNO_L (logical ? (logical = 0, sw = 0, goto cont) : sayNO)
if (locinput == regbol
? regprev == '\n'
: (multiline &&
- (nextchar || locinput < regeol) && locinput[-1] == '\n') )
+ (nextchr || locinput < regeol) && locinput[-1] == '\n') )
{
/* regtill = regbol; */
break;
case MBOL:
if (locinput == regbol
? regprev == '\n'
- : ((nextchar || locinput < regeol) && locinput[-1] == '\n') )
+ : ((nextchr || locinput < regeol) && locinput[-1] == '\n') )
{
break;
}
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;
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;
: 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:
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;
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;
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)
: ibcmp_locale(s, locinput, ln))))
sayNO;
locinput += ln;
- nextchar = UCHARAT(locinput);
+ nextchr = UCHARAT(locinput);
break;
case NOTHING:
cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
}
- runops(); /* Scalar context. */
+ CALLRUNOPS(); /* Scalar context. */
SPAGAIN;
ret = POPs;
PUTBACK;
* 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;
* The repeater is supposed to have constant length.
*/
-static I32
+STATIC I32
regrepeat_hard(regnode *p, I32 max, I32 *lp)
{
register char *scan;
- regclass - determine if a character falls into a character class
*/
-static bool
+STATIC bool
reginclass(register char *p, register I32 c)
{
char flags = *p;
* 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;
dEXT char **watchaddr = 0;
dEXT char *watchok;
+#ifndef PERL_OBJECT
static void debprof _((OP*o));
+#endif
int
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;
(long)watchaddr, (long)watchok);
}
-static void
+STATIC void
debprof(OP *o)
{
if (!profiledata)
}
}
-static SV *
+STATIC SV *
save_scalar_at(SV **sptr)
{
dTHR;
}
void
+#ifdef PERL_OBJECT
+save_destructor(void (*f) (void*, void*), void* p)
+#else
save_destructor(void (*f) (void *), void *p)
+#endif
{
dTHR;
SSCHECK(3);
break;
case SAVEt_DESTRUCTOR:
ptr = SSPOPPTR;
- (*SSPOPDPTR)(ptr);
+ (*SSPOPDPTR)(THIS_ ptr);
break;
case SAVEt_REGCONTEXT:
{
#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); \
# 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));
static void sv_check_thinkfirst _((SV *sv));
typedef void (*SVFUNC) _((SV*));
+#define VTBL *vtbl
+#define FCALL *f
+
+#endif /* PERL_OBJECT */
#ifdef PURIFY
MUTEX_UNLOCK(&sv_mutex); \
} while (0)
-static void
+STATIC void
del_sv(SV *p)
{
if (debug & 32768) {
}
/* sv_mutex must be held while calling more_sv() */
-static SV*
+STATIC SV*
more_sv(void)
{
register SV* sv;
return sv;
}
-static void
+STATIC void
visit(SVFUNC f)
{
SV* sva;
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) {
visit(do_report_used);
}
-static void
+STATIC void
do_clean_objs(SV *sv)
{
SV* rv;
}
#ifndef DISABLE_DESTRUCTOR_KLUDGE
-static void
+STATIC void
do_clean_named_objs(SV *sv)
{
if (SvTYPE(sv) == SVt_PVGV && GvSV(sv))
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));)
sv_root = 0;
}
-static XPVIV*
+STATIC XPVIV*
new_xiv(void)
{
IV** xiv;
return more_xiv();
}
-static void
+STATIC void
del_xiv(XPVIV *p)
{
IV** xiv = (IV**)((char*)(p) + sizeof(XPV));
xiv_root = xiv;
}
-static XPVIV*
+STATIC XPVIV*
more_xiv(void)
{
register IV** xiv;
return new_xiv();
}
-static XPVNV*
+STATIC XPVNV*
new_xnv(void)
{
double* xnv;
return more_xnv();
}
-static void
+STATIC void
del_xnv(XPVNV *p)
{
double* xnv = (double*)((char*)(p) + sizeof(XPVIV));
xnv_root = xnv;
}
-static XPVNV*
+STATIC XPVNV*
more_xnv(void)
{
register double* xnv;
return new_xnv();
}
-static XRV*
+STATIC XRV*
new_xrv(void)
{
XRV* xrv;
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;
return new_xrv();
}
-static XPV*
+STATIC XPV*
new_xpv(void)
{
XPV* xpv;
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;
SvTAINT(sv);
}
-static void
+STATIC void
not_a_number(SV *sv)
{
dTHR;
return SvNVX(sv);
}
-static IV
+STATIC IV
asIV(SV *sv)
{
I32 numtype = looks_like_number(sv);
return (IV) U_V(d);
}
-static UV
+STATIC UV
asUV(SV *sv)
{
I32 numtype = looks_like_number(sv);
SvTAINT(sv);
}
-static void
+STATIC void
sv_check_thinkfirst(register SV *sv)
{
if (SvTHINKFIRST(sv)) {
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;
}
}
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);
break;
case 't':
mg->mg_virtual = &vtbl_taint;
- mg->mg_len = 1;
+ mg->mg_length = 1;
break;
case 'U':
mg->mg_virtual = &vtbl_uvar;
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);
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)--;
}
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 {
#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;
* hopefully we won't free it until it has been assigned to a
* permanent location. */
-static void
+STATIC void
sv_mortalgrow(void)
{
dTHR;
}
SV *
-newRV(SV *ref)
+newRV(SV *tmpRef)
{
dTHR;
register SV *sv;
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;
}
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;
}
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))
return sv;
}
-static void
+STATIC void
sv_unglob(SV *sv)
{
assert(SvTYPE(sv) == SVt_PVGV);
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
MAGIC *mg = mg_find(sv, 't');
if (mg)
- mg->mg_len &= ~1;
+ mg->mg_length &= ~1;
}
}
{
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;
# 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)
#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 */
#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));
#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";
/* 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 == '=') {
return toketype;
}
-static void
+STATIC void
no_op(char *what, char *s)
{
char *oldbp = bufptr;
bufptr = oldbp;
}
-static void
+STATIC void
missingterm(char *s)
{
char tmpbuf[3];
warn("Use of %s is deprecated", s);
}
-static void
+STATIC void
depcom(void)
{
deprecate("comma-less variable list");
#ifdef WIN32
-static I32
+STATIC I32
win32_textfilter(int idx, SV *sv, int maxlen)
{
I32 count = FILTER_READ(idx+1, sv, maxlen);
SAVESPTR(linestr);
SAVEPPTR(lex_brackstack);
SAVEPPTR(lex_casestack);
- SAVEDESTRUCTOR(restore_rsfp, rsfp);
+ SAVEDESTRUCTOR(RESTORERSFP, rsfp);
lex_state = LEX_NORMAL;
lex_defer = 0;
doextract = FALSE;
}
-static void
+STATIC void
restore_rsfp(void *f)
{
PerlIO *fp = (PerlIO*)f;
rsfp = fp;
}
-static void
+STATIC void
incline(char *s)
{
dTHR;
curcop->cop_line = atoi(n)-1;
}
-static char *
+STATIC char *
skipspace(register char *s)
{
dTHR;
}
}
-static void
+STATIC void
check_uni(void) {
char *s;
char ch;
#undef UNI
#define UNI(f) return uni(f,s)
-static int
+STATIC int
uni(I32 f, char *s)
{
yylval.ival = f;
#define LOP(f,x) return lop(f,x,s)
-static I32
+STATIC I32
lop
#ifdef CAN_PROTOTYPE
(I32 f, expectation x, char *s)
return LSTOP;
}
-static void
+STATIC void
force_next(I32 type)
{
nexttype[nexttoke] = 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;
return s;
}
-static void
+STATIC void
force_ident(register char *s, int kind)
{
if (s && *s) {
}
}
-static char *
+STATIC char *
force_version(char *s)
{
OP *version = Nullop;
return (s);
}
-static SV *
-q(SV *sv)
+STATIC SV *
+tokeq(SV *sv)
{
register char *s;
register char *send;
return sv;
}
-static I32
+STATIC I32
sublex_start(void)
{
register I32 op_type = yylval.ival;
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));
return FUNC;
}
-static I32
+STATIC I32
sublex_push(void)
{
dTHR;
return '(';
}
-static I32
+STATIC I32
sublex_done(void)
{
if (!lex_starts++) {
}
}
-static char *
+STATIC char *
scan_const(char *start)
{
register char *send = bufend;
}
/* 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)
return TRUE;
}
-static int
+STATIC int
intuit_method(char *start, GV *gv)
{
char *s = start + (*start == '$');
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;
}
-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) {
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;
}
}
}
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(',');
return 0;
}
-static void
+STATIC void
checkcomma(register char *s, char *name, char *what)
{
char *w;
}
}
-static char *
+STATIC char *
scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
{
register char *d = dest;
}
}
-static char *
+STATIC char *
scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I32 ck_uni)
{
register char *d;
*pmfl |= PMf_EXTENDED;
}
-static char *
+STATIC char *
scan_pat(char *start)
{
PMOP *pm;
return s;
}
-static char *
+STATIC char *
scan_subst(char *start)
{
register char *s;
return s;
}
-static char *
+STATIC char *
scan_trans(char *start)
{
register char* s;
return s;
}
-static char *
+STATIC char *
scan_heredoc(register char *s)
{
dTHR;
return s;
}
-static char *
+STATIC char *
scan_inputsymbol(char *start)
{
register char *s = start;
return s;
}
-static char *
+STATIC char *
scan_str(char *start)
{
dTHR;
return s;
}
-static char *
+STATIC char *
scan_formline(register char *s)
{
dTHR;
return s;
}
-static void
+STATIC void
set_csh(void)
{
#ifdef CSH
#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;
}
+#include "XSUB.h"
static
XS(XS_UNIVERSAL_isa)
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)
{
#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
{
#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 */
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
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;
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;
}
/* the SV for form() and mess() is not kept in an arena */
-static SV *
+STATIC SV *
mess_alloc(void)
{
SV *sv;
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
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;
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));)
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;
#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
!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
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
/* 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
#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.
* 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.
*/
/*#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
*/
#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.
* 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:
*/
/*#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.
*/
/* 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
* 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:
* 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:
* 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:
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()) ;
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()) ;
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)));
void win32_endservent(void);
#ifndef WIN32SCK_IS_STDSCK
+#ifndef PERL_OBJECT
//
// direct to our version
//
#define FD_ZERO(p) PERL_FD_ZERO(p)
#endif /* USE_SOCKETS_AS_HANDLES */
+#endif /* PERL_OBJECT */
#endif /* WIN32SCK_IS_STDSCK */
#ifdef __cplusplus
--- /dev/null
+/*
+
+ 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;
+}
+
+
--- /dev/null
+/*
+
+ 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);
+}
+
+
+
+
--- /dev/null
+/*
+
+ 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))
+}
+
--- /dev/null
+/*
+
+ 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);
+}
+
+
+
--- /dev/null
+/*
+
+ 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;
+}
+
+
+
+
--- /dev/null
+/*
+
+ 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;
+}
+
+
--- /dev/null
+/*
+
+ 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)
+{
+}
+
+
--- /dev/null
+/*
+
+ 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___ */
+
Perl_dump_pm
Perl_dump_sub
Perl_expectterm
+Perl_error_no
Perl_fetch_gv
Perl_fetch_io
Perl_force_ident
Perl_scan_word
Perl_setenv_getix
Perl_skipspace
+Perl_sort_mutex
Perl_sublex_done
Perl_sublex_start
Perl_sv_ref
--- /dev/null
+LIBRARY Perl500
+DESCRIPTION 'Perl interpreter'
+EXPORTS
+ perl_alloc
+
+#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__
/*
{
return RunPerl(argc, argv, env, (void*)0);
}
+
+#endif /* PERL_OBJECT */
#undef fileno
#endif
+#ifndef PERL_OBJECT
#define stderr win32_stderr()
#define stdout win32_stdout()
#define stdin win32_stdin()
/*
* redirect to our own version
*/
+#undef fprintf
#define fprintf win32_fprintf
#define vfprintf win32_vfprintf
#define printf win32_printf
#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)
#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)
#define alarm win32_alarm
#define ioctl win32_ioctl
#define wait win32_wait
+#endif /* PERL_OBJECT */
#ifdef HAVE_DES_FCRYPT
#undef crypt
#endif
#ifndef USE_WIN32_RTL_ENV
+#ifndef PERL_OBJECT
#undef getenv
#define getenv win32_getenv
+#endif /* PERL_OBJECT */
#endif
#endif /* WIN32IO_IS_STDIO */
projects / p5sagit/p5-mst-13.2.git / commitdiff