diff options
| -rw-r--r-- | EXTERN.h | 2 | ||||
| -rw-r--r-- | MANIFEST | 22 | ||||
| -rw-r--r-- | ObjXSub.h | 1977 | ||||
| -rw-r--r-- | XSLock.h | 35 | ||||
| -rw-r--r-- | XSUB.h | 13 | ||||
| -rw-r--r-- | bytecode.h | 18 | ||||
| -rw-r--r-- | byterun.c | 94 | ||||
| -rw-r--r-- | cv.h | 2 | ||||
| -rw-r--r-- | doio.c | 4 | ||||
| -rw-r--r-- | dosish.h | 4 | ||||
| -rw-r--r-- | dump.c | 4 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | embedvar.h | 141 | ||||
| -rw-r--r-- | ext/DynaLoader/dlutils.c | 4 | ||||
| -rw-r--r-- | ext/Opcode/Opcode.xs | 13 | ||||
| -rw-r--r-- | global.sym | 2 | ||||
| -rw-r--r-- | globals.c | 1497 | ||||
| -rw-r--r-- | gv.c | 16 | ||||
| -rw-r--r-- | hv.c | 20 | ||||
| -rwxr-xr-x | installperl | 11 | ||||
| -rw-r--r-- | interp.sym | 45 | ||||
| -rw-r--r-- | intrpvar.h | 70 | ||||
| -rw-r--r-- | ipdir.h | 26 | ||||
| -rw-r--r-- | ipenv.h | 21 | ||||
| -rw-r--r-- | iplio.h | 41 | ||||
| -rw-r--r-- | ipmem.h | 20 | ||||
| -rw-r--r-- | ipproc.h | 55 | ||||
| -rw-r--r-- | ipsock.h | 59 | ||||
| -rw-r--r-- | ipstdio.h | 58 | ||||
| -rw-r--r-- | lib/ExtUtils/MM_Unix.pm | 83 | ||||
| -rw-r--r-- | lib/ExtUtils/MM_Win32.pm | 9 | ||||
| -rw-r--r-- | lib/ExtUtils/MakeMaker.pm | 10 | ||||
| -rw-r--r-- | lib/ExtUtils/Mksymlists.pm | 6 | ||||
| -rwxr-xr-x | lib/ExtUtils/xsubpp | 8 | ||||
| -rw-r--r-- | mg.c | 82 | ||||
| -rw-r--r-- | mg.h | 10 | ||||
| -rw-r--r-- | objpp.h | 1439 | ||||
| -rw-r--r-- | op.c | 52 | ||||
| -rw-r--r-- | op.h | 2 | ||||
| -rw-r--r-- | opcode.h | 16 | ||||
| -rw-r--r-- | perl.c | 172 | ||||
| -rw-r--r-- | perl.h | 118 | ||||
| -rw-r--r-- | perldir.h | 12 | ||||
| -rw-r--r-- | perlenv.h | 9 | ||||
| -rw-r--r-- | perlio.h | 51 | ||||
| -rw-r--r-- | perllio.h | 31 | ||||
| -rw-r--r-- | perlmem.h | 6 | ||||
| -rw-r--r-- | perlproc.h | 47 | ||||
| -rw-r--r-- | perlsock.h | 53 | ||||
| -rw-r--r-- | perlvars.h | 9 | ||||
| -rw-r--r-- | perly.c | 9 | ||||
| -rw-r--r-- | perly.c.diff | 18 | ||||
| -rw-r--r-- | pp.c | 40 | ||||
| -rw-r--r-- | pp.h | 13 | ||||
| -rw-r--r-- | pp_ctl.c | 70 | ||||
| -rw-r--r-- | pp_hot.c | 16 | ||||
| -rw-r--r-- | pp_sys.c | 32 | ||||
| -rw-r--r-- | proto.h | 1637 | ||||
| -rw-r--r-- | regcomp.c | 66 | ||||
| -rw-r--r-- | regexec.c | 152 | ||||
| -rw-r--r-- | run.c | 13 | ||||
| -rw-r--r-- | scope.c | 8 | ||||
| -rw-r--r-- | scope.h | 11 | ||||
| -rw-r--r-- | sv.c | 142 | ||||
| -rw-r--r-- | sv.h | 2 | ||||
| -rw-r--r--[-rwxr-xr-x] | t/lib/thread.t | 0 | ||||
| -rw-r--r--[-rwxr-xr-x] | t/op/nothread.t | 0 | ||||
| -rw-r--r-- | thread.h | 4 | ||||
| -rw-r--r-- | toke.c | 102 | ||||
| -rw-r--r-- | universal.c | 14 | ||||
| -rw-r--r-- | util.c | 18 | ||||
| -rw-r--r-- | vms/vms.c | 2 | ||||
| -rw-r--r-- | win32/Makefile | 714 | ||||
| -rw-r--r-- | win32/config.bc | 14 | ||||
| -rw-r--r-- | win32/config.gc | 14 | ||||
| -rw-r--r-- | win32/config.vc | 20 | ||||
| -rw-r--r-- | win32/config_H.bc | 14 | ||||
| -rw-r--r-- | win32/config_H.gc | 14 | ||||
| -rw-r--r-- | win32/config_H.vc | 14 | ||||
| -rw-r--r-- | win32/config_h.PL | 28 | ||||
| -rw-r--r-- | win32/config_sh.PL | 1 | ||||
| -rw-r--r-- | win32/dl_win32.xs | 55 | ||||
| -rw-r--r-- | win32/include/sys/socket.h | 2 | ||||
| -rw-r--r-- | win32/makedef.pl | 97 | ||||
| -rw-r--r-- | win32/makefile.mk | 754 | ||||
| -rw-r--r-- | win32/runperl.c | 1017 | ||||
| -rw-r--r-- | win32/win32.c | 1025 | ||||
| -rw-r--r-- | win32/win32.h | 34 | ||||
| -rw-r--r-- | win32/win32iop.h | 9 | ||||
| -rw-r--r-- | win32/win32sck.c | 13 | ||||
| -rw-r--r-- | win32/win32thread.c | 6 | ||||
| -rw-r--r-- | x2p/a2py.c | 3 | ||||
| -rw-r--r-- | x2p/util.c | 2 |
93 files changed, 10838 insertions, 1882 deletions
@@ -27,7 +27,7 @@ # define EXTCONST globalref # define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly #else -# if defined(WIN32) && !defined(PERL_STATIC_SYMS) && !defined(__GNUC__) +# if defined(WIN32) && !defined(PERL_STATIC_SYMS) && !defined(__GNUC__) && !defined(PERL_OBJECT) # ifdef PERLDLL # define EXT extern __declspec(dllexport) # define dEXT @@ -31,6 +31,7 @@ README.vms Notes about VMS port README.win32 Notes about Win32 port Todo The Wishlist Todo.5.005 What needs doing before 5.005 release +XSLock.h Include file for extensions built with PERL_OBJECT defined XSUB.h Include file for extension subroutines atomic.h Atomic refcount handling for multi-threading av.c Array value code @@ -390,6 +391,13 @@ installman Perl script to install man pages for pods installperl Perl script to do "make install" dirty work interp.sym Interpreter specific symbols to hide in a struct intrpvar.h Variables held in each interpreter instance +ipdir.h Directory interface for Perl Object +ipenv.h Environment interface for Perl Object +iplio.h Low level IO interface for Perl Object +ipmem.h Memory interface for Perl Object +ipproc.h Process interface for Perl Object +ipsock.h Socket interface for Perl Object +ipstdio.h Stdio interface for Perl Object keywords.h The keyword numbers keywords.pl Program to write keywords.h lib/AnyDBM_File.pm Perl module to emulate dbmopen @@ -552,6 +560,8 @@ miniperlmain.c Basic perl w/o dynamic loading or extensions mv-if-diff Script to mv a file if it changed myconfig Prints summary of the current configuration nostdio.h Cause compile error on stdio calls +objpp.h Scoping macros for Perl Object +ObjXSub.h Scoping macros for Perl Object in extensions op.c Opcode syntax tree code op.h Opcode syntax tree header opcode.h Automatically generated opcode header @@ -604,18 +614,18 @@ patchlevel.h The current patch level of perl perl.c main() perl.h Global declarations perl_exp.SH Creates list of exported symbols for AIX -perldir.h perldir stuff -perlenv.h perlenv stuff +perldir.h Macros for directory abstraction +perlenv.h Macros for environment abstraction perlio.c C code for PerlIO abstraction perlio.h Interface to PerlIO abstraction perlio.sym Symbols for PerlIO abstraction -perllio.h perllio stuff -perlmem.h perlmem stuff -perlproc.h perlproc stuff +perllio.h Macros for Low level IO abstraction +perlmem.h Macros for memory allocation abstraction +perlproc.h Macros for process abstraction perlsdio.h Fake stdio using perlio perlsfio.h Prototype sfio mapping for PerlIO perlsh A poor man's perl shell -perlsock.h perlsock stuff +perlsock.h Macros for socket abstraction perlvars.h Global variables perly.c A byacc'ed perly.y perly.c.diff Fixup perly.c to allow recursion diff --git a/ObjXSub.h b/ObjXSub.h new file mode 100644 index 0000000000..08446c8a9b --- /dev/null +++ b/ObjXSub.h @@ -0,0 +1,1977 @@ +#ifndef __ObjXSub_h__ +#define __ObjXSub_h__ + + +/* Varibles */ +#undef Argv +#define Argv pPerl->Perl_Argv +#undef Cmd +#define Cmd pPerl->Perl_Cmd +#undef DBcv +#define DBcv pPerl->Perl_DBcv +#undef DBgv +#define DBgv pPerl->Perl_DBgv +#undef DBline +#define DBline pPerl->Perl_DBline +#undef DBsignal +#define DBsignal pPerl->Perl_DBsignal +#undef DBsingle +#define DBsingle pPerl->Perl_DBsingle +#undef DBsub +#define DBsub pPerl->Perl_DBsub +#undef DBtrace +#define DBtrace pPerl->Perl_DBtrace +#undef No +#define No pPerl->Perl_No +#undef Sv +#define Sv pPerl->Perl_Sv +#undef Xpv +#define Xpv pPerl->Perl_Xpv +#undef Yes +#define Yes pPerl->Perl_Yes +#undef amagic_generation +#define amagic_generation pPerl->Perl_amagic_generation +#undef ampergv +#define ampergv pPerl->Perl_ampergv +#undef an +#define an pPerl->Perl_an +#undef archpat_auto +#define archpat_auto pPerl->Perl_archpat_auto +#undef argvgv +#define argvgv pPerl->Perl_argvgv +#undef argvoutgv +#define argvoutgv pPerl->Perl_argvoutgv +#undef basetime +#define basetime pPerl->Perl_basetime +#undef beginav +#define beginav pPerl->Perl_beginav +#undef bodytarget +#define bodytarget pPerl->Perl_bodytarget +#undef bostr +#define bostr pPerl->Perl_bostr +#undef bufend +#define bufend pPerl->Perl_bufend +#undef bufptr +#define bufptr pPerl->Perl_bufptr +#undef cddir +#define cddir pPerl->Perl_cddir +#undef chopset +#define chopset pPerl->Perl_chopset +#undef collation_ix +#define collation_ix pPerl->Perl_collation_ix +#undef collation_name +#define collation_name pPerl->Perl_collation_name +#undef collation_standard +#define collation_standard pPerl->Perl_collation_standard +#undef collxfrm_base +#define collxfrm_base pPerl->Perl_collxfrm_base +#undef collxfrm_mult +#define collxfrm_mult pPerl->Perl_collxfrm_mult +#undef colors +#define colors pPerl->Perl_colors +#undef colorset +#define colorset pPerl->Perl_colorset +#undef compcv +#define compcv pPerl->Perl_compcv +#undef compiling +#define compiling pPerl->Perl_compiling +#undef comppad +#define comppad pPerl->Perl_comppad +#undef comppad_name +#define comppad_name pPerl->Perl_comppad_name +#undef comppad_name_fill +#define comppad_name_fill pPerl->Perl_comppad_name_fill +#undef comppad_name_floor +#define comppad_name_floor pPerl->Perl_comppad_name_floor +#undef cop_seqmax +#define cop_seqmax pPerl->Perl_cop_seqmax +#undef copline +#define copline pPerl->Perl_copline +#undef cryptseen +#define cryptseen pPerl->Perl_cryptseen +#undef cshlen +#define cshlen pPerl->Perl_cshlen +#undef cshname +#define cshname pPerl->Perl_cshname +#undef curcop +#define curcop pPerl->Perl_curcop +#undef curcopdb +#define curcopdb pPerl->Perl_curcopdb +#undef curinterp +#define curinterp pPerl->Perl_curinterp +#undef curpad +#define curpad pPerl->Perl_curpad +#undef curpm +#define curpm pPerl->Perl_curpm +#undef curstack +#define curstack pPerl->Perl_curstack +#undef curstackinfo +#define curstackinfo pPerl->Perl_curstackinfo +#undef curstash +#define curstash pPerl->Perl_curstash +#undef curstname +#define curstname pPerl->Perl_curstname +#undef curthr +#define curthr pPerl->Perl_curthr +#undef dbargs +#define dbargs pPerl->Perl_dbargs +#undef debdelim +#define debdelim pPerl->Perl_debdelim +#undef debname +#define debname pPerl->Perl_debname +#undef debstash +#define debstash pPerl->Perl_debstash +#undef debug +#define debug pPerl->Perl_debug +#undef defgv +#define defgv pPerl->Perl_defgv +#undef defoutgv +#define defoutgv pPerl->Perl_defoutgv +#undef defstash +#define defstash pPerl->Perl_defstash +#undef delaymagic +#define delaymagic pPerl->Perl_delaymagic +#undef diehook +#define diehook pPerl->Perl_diehook +#undef dirty +#define dirty pPerl->Perl_dirty +#undef dlevel +#define dlevel pPerl->Perl_dlevel +#undef dlmax +#define dlmax pPerl->Perl_dlmax +#undef do_undump +#define do_undump pPerl->Perl_do_undump +#undef doextract +#define doextract pPerl->Perl_doextract +#undef doswitches +#define doswitches pPerl->Perl_doswitches +#undef dowarn +#define dowarn pPerl->Perl_dowarn +#undef dumplvl +#define dumplvl pPerl->Perl_dumplvl +#undef e_fp +#define e_fp pPerl->Perl_e_fp +#undef e_tmpname +#define e_tmpname pPerl->Perl_e_tmpname +#undef egid +#define egid pPerl->Perl_egid +#undef endav +#define endav pPerl->Perl_endav +#undef envgv +#define envgv pPerl->Perl_envgv +#undef errgv +#define errgv pPerl->Perl_errgv +#undef error_count +#define error_count pPerl->Perl_error_count +#undef euid +#define euid pPerl->Perl_euid +#undef eval_cond +#define eval_cond pPerl->Perl_eval_cond +#undef eval_mutex +#define eval_mutex pPerl->Perl_eval_mutex +#undef eval_owner +#define eval_owner pPerl->Perl_eval_owner +#undef eval_root +#define eval_root pPerl->Perl_eval_root +#undef eval_start +#define eval_start pPerl->Perl_eval_start +#undef evalseq +#define evalseq pPerl->Perl_evalseq +#undef expect +#define expect pPerl->Perl_expect +#undef extralen +#define extralen pPerl->Perl_extralen +#undef fdpid +#define fdpid pPerl->Perl_fdpid +#undef filemode +#define filemode pPerl->Perl_filemode +#undef firstgv +#define firstgv pPerl->Perl_firstgv +#undef forkprocess +#define forkprocess pPerl->Perl_forkprocess +#undef formfeed +#define formfeed pPerl->Perl_formfeed +#undef formtarget +#define formtarget pPerl->Perl_formtarget +#undef generation +#define generation pPerl->Perl_generation +#undef gensym +#define gensym pPerl->Perl_gensym +#undef gid +#define gid pPerl->Perl_gid +#undef globalstash +#define globalstash pPerl->Perl_globalstash +#undef he_root +#define he_root pPerl->Perl_he_root +#undef hexdigit +#define hexdigit pPerl->Perl_hexdigit +#undef hints +#define hints pPerl->Perl_hints +#undef in_clean_all +#define in_clean_all pPerl->Perl_in_clean_all +#undef in_clean_objs +#define in_clean_objs pPerl->Perl_in_clean_objs +#undef in_eval +#define in_eval pPerl->Perl_in_eval +#undef in_my +#define in_my pPerl->Perl_in_my +#undef in_my_stash +#define in_my_stash pPerl->Perl_in_my_stash +#undef incgv +#define incgv pPerl->Perl_incgv +#undef initav +#define initav pPerl->Perl_initav +#undef inplace +#define inplace pPerl->Perl_inplace +#undef last_in_gv +#define last_in_gv pPerl->Perl_last_in_gv +#undef last_lop +#define last_lop pPerl->Perl_last_lop +#undef last_lop_op +#define last_lop_op pPerl->Perl_last_lop_op +#undef last_uni +#define last_uni pPerl->Perl_last_uni +#undef lastfd +#define lastfd pPerl->Perl_lastfd +#undef lastgotoprobe +#define lastgotoprobe pPerl->Perl_lastgotoprobe +#undef lastscream +#define lastscream pPerl->Perl_lastscream +#undef lastsize +#define lastsize pPerl->Perl_lastsize +#undef lastspbase +#define lastspbase pPerl->Perl_lastspbase +#undef laststatval +#define laststatval pPerl->Perl_laststatval +#undef laststype +#define laststype pPerl->Perl_laststype +#undef leftgv +#define leftgv pPerl->Perl_leftgv +#undef lex_brackets +#define lex_brackets pPerl->Perl_lex_brackets +#undef lex_brackstack +#define lex_brackstack pPerl->Perl_lex_brackstack +#undef lex_casemods +#define lex_casemods pPerl->Perl_lex_casemods +#undef lex_casestack +#define lex_casestack pPerl->Perl_lex_casestack +#undef lex_defer +#define lex_defer pPerl->Perl_lex_defer +#undef lex_dojoin +#define lex_dojoin pPerl->Perl_lex_dojoin +#undef lex_expect +#define lex_expect pPerl->Perl_lex_expect +#undef lex_fakebrack +#define lex_fakebrack pPerl->Perl_lex_fakebrack +#undef lex_formbrack +#define lex_formbrack pPerl->Perl_lex_formbrack +#undef lex_inpat +#define lex_inpat pPerl->Perl_lex_inpat +#undef lex_inwhat +#define lex_inwhat pPerl->Perl_lex_inwhat +#undef lex_op +#define lex_op pPerl->Perl_lex_op +#undef lex_repl +#define lex_repl pPerl->Perl_lex_repl +#undef lex_starts +#define lex_starts pPerl->Perl_lex_starts +#undef lex_state +#define lex_state pPerl->Perl_lex_state +#undef lex_stuff +#define lex_stuff pPerl->Perl_lex_stuff +#undef lineary +#define lineary pPerl->Perl_lineary +#undef linestart +#define linestart pPerl->Perl_linestart +#undef linestr +#define linestr pPerl->Perl_linestr +#undef localizing +#define localizing pPerl->Perl_localizing +#undef localpatches +#define localpatches pPerl->Perl_localpatches +#undef main_cv +#define main_cv pPerl->Perl_main_cv +#undef main_root +#define main_root pPerl->Perl_main_root +#undef main_start +#define main_start pPerl->Perl_main_start +#undef mainstack +#define mainstack pPerl->Perl_mainstack +#undef malloc_mutex +#define malloc_mutex pPerl->Perl_malloc_mutex +#undef markstack +#define markstack pPerl->Perl_markstack +#undef markstack_max +#define markstack_max pPerl->Perl_markstack_max +#undef markstack_ptr +#define markstack_ptr pPerl->Perl_markstack_ptr +#undef max_intro_pending +#define max_intro_pending pPerl->Perl_max_intro_pending +#undef maxo +#define maxo pPerl->Perl_maxo +#undef maxscream +#define maxscream pPerl->Perl_maxscream +#undef maxsysfd +#define maxsysfd pPerl->Perl_maxsysfd +#undef mess_sv +#define mess_sv pPerl->Perl_mess_sv +#undef mh +#define mh pPerl->Perl_mh +#undef min_intro_pending +#define min_intro_pending pPerl->Perl_min_intro_pending +#undef minus_F +#define minus_F pPerl->Perl_minus_F +#undef minus_a +#define minus_a pPerl->Perl_minus_a +#undef minus_c +#define minus_c pPerl->Perl_minus_c +#undef minus_l +#define minus_l pPerl->Perl_minus_l +#undef minus_n +#define minus_n pPerl->Perl_minus_n +#undef minus_p +#define minus_p pPerl->Perl_minus_p +#undef modcount +#define modcount pPerl->Perl_modcount +#undef multi_close +#define multi_close pPerl->Perl_multi_close +#undef multi_end +#define multi_end pPerl->Perl_multi_end +#undef multi_open +#define multi_open pPerl->Perl_multi_open +#undef multi_start +#define multi_start pPerl->Perl_multi_start +#undef multiline +#define multiline pPerl->Perl_multiline +#undef mystrk +#define mystrk pPerl->Perl_mystrk +#undef na +#define na pPerl->Perl_na +#undef nexttoke +#define nexttoke pPerl->Perl_nexttoke +#undef nexttype +#define nexttype pPerl->Perl_nexttype +#undef nextval +#define nextval pPerl->Perl_nextval +#undef nice_chunk +#define nice_chunk pPerl->Perl_nice_chunk +#undef nice_chunk_size +#define nice_chunk_size pPerl->Perl_nice_chunk_size +#undef nomemok +#define nomemok pPerl->Perl_nomemok +#undef nrs +#define nrs pPerl->Perl_nrs +#undef nthreads +#define nthreads pPerl->Perl_nthreads +#undef nthreads_cond +#define nthreads_cond pPerl->Perl_nthreads_cond +#undef numeric_local +#define numeric_local pPerl->Perl_numeric_local +#undef numeric_name +#define numeric_name pPerl->Perl_numeric_name +#undef numeric_standard +#define numeric_standard pPerl->Perl_numeric_standard +#undef ofmt +#define ofmt pPerl->Perl_ofmt +#undef ofs +#define ofs pPerl->Perl_ofs +#undef ofslen +#define ofslen pPerl->Perl_ofslen +#undef oldbufptr +#define oldbufptr pPerl->Perl_oldbufptr +#undef oldlastpm +#define oldlastpm pPerl->Perl_oldlastpm +#undef oldname +#define oldname pPerl->Perl_oldname +#undef oldoldbufptr +#define oldoldbufptr pPerl->Perl_oldoldbufptr +#undef op +#define op pPerl->Perl_op +#undef op_mask +#define op_mask pPerl->Perl_op_mask +#undef op_seqmax +#define op_seqmax pPerl->Perl_op_seqmax +#undef opsave +#define opsave pPerl->Perl_opsave +#undef origalen +#define origalen pPerl->Perl_origalen +#undef origargc +#define origargc pPerl->Perl_origargc +#undef origargv +#define origargv pPerl->Perl_origargv +#undef origenviron +#define origenviron pPerl->Perl_origenviron +#undef origfilename +#define origfilename pPerl->Perl_origfilename +#undef ors +#define ors pPerl->Perl_ors +#undef orslen +#define orslen pPerl->Perl_orslen +#undef osname +#define osname pPerl->Perl_osname +#undef pad_reset_pending +#define pad_reset_pending pPerl->Perl_pad_reset_pending +#undef padix +#define padix pPerl->Perl_padix +#undef padix_floor +#define padix_floor pPerl->Perl_padix_floor +#undef parsehook +#define parsehook pPerl->Perl_parsehook +#undef patchlevel +#define patchlevel pPerl->Perl_patchlevel +#undef patleave +#define patleave pPerl->Perl_patleave +#undef pending_ident +#define pending_ident pPerl->Perl_pending_ident +#undef perl_destruct_level +#define perl_destruct_level pPerl->Perl_perl_destruct_level +#undef perldb +#define perldb pPerl->Perl_perldb +#undef pidstatus +#define pidstatus pPerl->Perl_pidstatus +#undef preambleav +#define preambleav pPerl->Perl_preambleav +#undef preambled +#define preambled pPerl->Perl_preambled +#undef preprocess +#define preprocess pPerl->Perl_preprocess +#undef profiledata +#define profiledata pPerl->Perl_profiledata +#undef reg_eval_set +#define reg_eval_set pPerl->Perl_reg_eval_set +#undef reg_flags +#define reg_flags pPerl->Perl_reg_flags +#undef reg_start_tmp +#define reg_start_tmp pPerl->Perl_reg_start_tmp +#undef reg_start_tmpl +#define reg_start_tmpl pPerl->Perl_reg_start_tmpl +#undef regbol +#define regbol pPerl->Perl_regbol +#undef regcc +#define regcc pPerl->Perl_regcc +#undef regcode +#define regcode pPerl->Perl_regcode +#undef regdata +#define regdata pPerl->Perl_regdata +#undef regdummy +#define regdummy pPerl->Perl_regdummy +#undef regendp +#define regendp pPerl->Perl_regendp +#undef regeol +#define regeol pPerl->Perl_regeol +#undef regflags +#define regflags pPerl->Perl_regflags +#undef regindent +#define regindent pPerl->Perl_regindent +#undef reginput +#define reginput pPerl->Perl_reginput +#undef reglastparen +#define reglastparen pPerl->Perl_reglastparen +#undef regnarrate +#define regnarrate pPerl->Perl_regnarrate +#undef regnaughty +#define regnaughty pPerl->Perl_regnaughty +#undef regnpar +#define regnpar pPerl->Perl_regnpar +#undef regparse +#define regparse pPerl->Perl_regparse +#undef regprecomp +#define regprecomp pPerl->Perl_regprecomp +#undef regprev +#define regprev pPerl->Perl_regprev +#undef regprogram +#define regprogram pPerl->Perl_regprogram +#undef regsawback +#define regsawback pPerl->Perl_regsawback +#undef regseen +#define regseen pPerl->Perl_regseen +#undef regsize +#define regsize pPerl->Perl_regsize +#undef regstartp +#define regstartp pPerl->Perl_regstartp +#undef regtill +#define regtill pPerl->Perl_regtill +#undef regxend +#define regxend pPerl->Perl_regxend +#undef restartop +#define restartop pPerl->Perl_restartop +#undef retstack +#define retstack pPerl->Perl_retstack +#undef retstack_ix +#define retstack_ix pPerl->Perl_retstack_ix +#undef retstack_max +#define retstack_max pPerl->Perl_retstack_max +#undef rightgv +#define rightgv pPerl->Perl_rightgv +#undef rs +#define rs pPerl->Perl_rs +#undef rsfp +#define rsfp pPerl->Perl_rsfp +#undef rsfp_filters +#define rsfp_filters pPerl->Perl_rsfp_filters +#undef runops +#define runops pPerl->Perl_runops +#undef rx +#define rx pPerl->Perl_rx +#undef savestack +#define savestack pPerl->Perl_savestack +#undef savestack_ix +#define savestack_ix pPerl->Perl_savestack_ix +#undef savestack_max +#define savestack_max pPerl->Perl_savestack_max +#undef sawampersand +#define sawampersand pPerl->Perl_sawampersand +#undef sawstudy +#define sawstudy pPerl->Perl_sawstudy +#undef sawvec +#define sawvec pPerl->Perl_sawvec +#undef scopestack +#define scopestack pPerl->Perl_scopestack +#undef scopestack_ix +#define scopestack_ix pPerl->Perl_scopestack_ix +#undef scopestack_max +#define scopestack_max pPerl->Perl_scopestack_max +#undef screamfirst +#define screamfirst pPerl->Perl_screamfirst +#undef screamnext +#define screamnext pPerl->Perl_screamnext +#undef scrgv +#define scrgv pPerl->Perl_scrgv +#undef secondgv +#define secondgv pPerl->Perl_secondgv +#undef seen_zerolen +#define seen_zerolen pPerl->Perl_seen_zerolen +#undef sh_path +#define sh_path pPerl->Perl_sh_path +#undef siggv +#define siggv pPerl->Perl_siggv +#undef sighandlerp +#define sighandlerp pPerl->Perl_sighandlerp +#undef sortcop +#define sortcop pPerl->Perl_sortcop +#undef sortcxix +#define sortcxix pPerl->Perl_sortcxix +#undef sortstash +#define sortstash pPerl->Perl_sortstash +#undef splitstr +#define splitstr pPerl->Perl_splitstr +#undef stack_base +#define stack_base pPerl->Perl_stack_base +#undef stack_max +#define stack_max pPerl->Perl_stack_max +#undef stack_sp +#define stack_sp pPerl->Perl_stack_sp +#undef start_env +#define start_env pPerl->Perl_start_env +#undef statbuf +#define statbuf pPerl->Perl_statbuf +#undef statcache +#define statcache pPerl->Perl_statcache +#undef statgv +#define statgv pPerl->Perl_statgv +#undef statname +#define statname pPerl->Perl_statname +#undef statusvalue +#define statusvalue pPerl->Perl_statusvalue +#undef statusvalue_vms +#define statusvalue_vms pPerl->Perl_statusvalue_vms +#undef stdingv +#define stdingv pPerl->Perl_stdingv +#undef strchop +#define strchop pPerl->Perl_strchop +#undef strtab +#define strtab pPerl->Perl_strtab +#undef sub_generation +#define sub_generation pPerl->Perl_sub_generation +#undef sublex_info +#define sublex_info pPerl->Perl_sublex_info +#undef subline +#define subline pPerl->Perl_subline +#undef subname +#define subname pPerl->Perl_subname +#undef sv_arenaroot +#define sv_arenaroot pPerl->Perl_sv_arenaroot +#undef sv_count +#define sv_count pPerl->Perl_sv_count +#undef sv_mutex +#define sv_mutex pPerl->Perl_sv_mutex +#undef sv_no +#define sv_no pPerl->Perl_sv_no +#undef sv_objcount +#define sv_objcount pPerl->Perl_sv_objcount +#undef sv_root +#define sv_root pPerl->Perl_sv_root +#undef sv_undef +#define sv_undef pPerl->Perl_sv_undef +#undef sv_yes +#define sv_yes pPerl->Perl_sv_yes +#undef tainted +#define tainted pPerl->Perl_tainted +#undef tainting +#define tainting pPerl->Perl_tainting +#undef thisexpr +#define thisexpr pPerl->Perl_thisexpr +#undef thr_key +#define thr_key pPerl->Perl_thr_key +#undef threadnum +#define threadnum pPerl->Perl_threadnum +#undef threads_mutex +#define threads_mutex pPerl->Perl_threads_mutex +#undef threadsv_names +#define threadsv_names pPerl->Perl_threadsv_names +#undef thrsv +#define thrsv pPerl->Perl_thrsv +#undef timesbuf +#define timesbuf pPerl->Perl_timesbuf +#undef tmps_floor +#define tmps_floor pPerl->Perl_tmps_floor +#undef tmps_ix +#define tmps_ix pPerl->Perl_tmps_ix +#undef tmps_max +#define tmps_max pPerl->Perl_tmps_max +#undef tmps_stack +#define tmps_stack pPerl->Perl_tmps_stack +#undef tokenbuf +#define tokenbuf pPerl->Perl_tokenbuf +#undef top_env +#define top_env pPerl->Perl_top_env +#undef toptarget +#define toptarget pPerl->Perl_toptarget +#undef uid +#define uid pPerl->Perl_uid +#undef unsafe +#define unsafe pPerl->Perl_unsafe +#undef warnhook +#define warnhook pPerl->Perl_warnhook +#undef xiv_arenaroot +#define xiv_arenaroot pPerl->Perl_xiv_arenaroot +#undef xiv_root +#define xiv_root pPerl->Perl_xiv_root +#undef xnv_root +#define xnv_root pPerl->Perl_xnv_root +#undef xpv_root +#define xpv_root pPerl->Perl_xpv_root +#undef xrv_root +#define xrv_root pPerl->Perl_xrv_root + +/* Functions */ + +#undef amagic_call +#define amagic_call pPerl->Perl_amagic_call +#undef Perl_GetVars +#define Perl_GetVars pPerl->Perl_GetVars +#undef Gv_AMupdate +#define Gv_AMupdate pPerl->Perl_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_reify +#define av_reify pPerl->Perl_av_reify +#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 avhv_delete +#define avhv_delete pPerl->Perl_avhv_delete +#undef avhv_delete_ent +#define avhv_delete_ent pPerl->Perl_avhv_delete_ent +#undef avhv_exists +#define avhv_exists pPerl->Perl_avhv_exists +#undef avhv_exists_ent +#define avhv_exists_ent pPerl->Perl_avhv_exists_ent +#undef avhv_fetch +#define avhv_fetch pPerl->Perl_avhv_fetch +#undef avhv_fetch_ent +#define avhv_fetch_ent pPerl->Perl_avhv_fetch_ent +#undef avhv_iterinit +#define avhv_iterinit pPerl->Perl_avhv_iterinit +#undef avhv_iternext +#define avhv_iternext pPerl->Perl_avhv_iternext +#undef avhv_iternextsv +#define avhv_iternextsv pPerl->Perl_avhv_iternextsv +#undef avhv_iterval +#define avhv_iterval pPerl->Perl_avhv_iterval +#undef avhv_keys +#define avhv_keys pPerl->Perl_avhv_keys +#undef avhv_store +#define avhv_store pPerl->Perl_avhv_store +#undef avhv_store_ent +#define avhv_store_ent pPerl->Perl_avhv_store_ent +#undef bind_match +#define bind_match pPerl->Perl_bind_match +#undef block_end +#define block_end pPerl->Perl_block_end +#undef block_gimme +#define block_gimme pPerl->Perl_block_gimme +#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->Perl_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 condpair_magic +#define condpair_magic pPerl->Perl_condpair_magic +#undef convert +#define convert pPerl->Perl_convert +#undef cpytill +#define cpytill pPerl->Perl_cpytill +#undef croak +#define croak pPerl->Perl_croak +#undef cv_ckproto +#define cv_ckproto pPerl->Perl_cv_ckproto +#undef cv_clone +#define cv_clone pPerl->Perl_cv_clone +#undef cv_const_sv +#define cv_const_sv pPerl->Perl_cv_const_sv +#undef cv_undef +#define cv_undef pPerl->Perl_cv_undef +#undef cxinc +#define cxinc pPerl->Perl_cxinc +#undef deb +#define deb pPerl->Perl_deb +#undef delimcpy +#define delimcpy pPerl->Perl_delimcpy +#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 dopoptoeval +#define dopoptoeval pPerl->Perl_dopoptoeval +#undef dounwind +#define dounwind pPerl->Perl_dounwind +#undef do_aexec +#define do_aexec pPerl->Perl_do_aexec +#undef do_chomp +#define do_chomp pPerl->Perl_do_chomp +#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_join +#define do_join pPerl->Perl_do_join +#undef do_kv +#define do_kv pPerl->Perl_do_kv +#undef do_open +#define do_open pPerl->Perl_do_open +#undef do_pipe +#define do_pipe pPerl->Perl_do_pipe +#undef do_print +#define do_print pPerl->Perl_do_print +#undef do_readline +#define do_readline pPerl->Perl_do_readline +#undef do_seek +#define do_seek pPerl->Perl_do_seek +#undef do_sprintf +#define do_sprintf pPerl->Perl_do_sprintf +#undef do_sysseek +#define do_sysseek pPerl->Perl_do_sysseek +#undef do_tell +#define do_tell pPerl->Perl_do_tell +#undef do_trans +#define do_trans pPerl->Perl_do_trans +#undef do_vecset +#define do_vecset pPerl->Perl_do_vecset +#undef do_vop +#define do_vop pPerl->Perl_do_vop +#undef dowantarray +#define dowantarray pPerl->Perl_dowantarray +#undef dump_all +#define dump_all pPerl->Perl_dump_all +#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_read +#define filter_read pPerl->Perl_filter_read +#undef find_threadsv +#define find_threadsv pPerl->Perl_find_threadsv +#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 form +#define form pPerl->Perl_form +#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 get_op_descs +#define get_op_descs pPerl->Perl_get_op_descs +#undef get_op_names +#define get_op_names pPerl->Perl_get_op_names +#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_autoload4 +#define gv_autoload4 pPerl->Perl_gv_autoload4 +#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_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 hoistmust +#define hoistmust pPerl->Perl_hoistmust +#undef hv_clear +#define hv_clear pPerl->Perl_hv_clear +#undef hv_delayfree_ent +#define hv_delayfree_ent pPerl->Perl_hv_delayfree_ent +#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_free_ent +#define hv_free_ent pPerl->Perl_hv_free_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 ibcmp_locale +#define ibcmp_locale pPerl->Perl_ibcmp_locale +#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 init_stacks +#define init_stacks pPerl->Perl_init_stacks +#undef instr +#define instr pPerl->Perl_instr +#undef intro_my +#define intro_my pPerl->Perl_intro_my +#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 io_close +#define io_close pPerl->Perl_io_close +#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_clear_all_env +#define magic_clear_all_env pPerl->Perl_magic_clear_all_env +#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_freedefelem +#define magic_freedefelem pPerl->Perl_magic_freedefelem +#undef magic_freeregexp +#define magic_freeregexp pPerl->Perl_magic_freeregexp +#undef magic_get +#define magic_get pPerl->Perl_magic_get +#undef magic_getarylen +#define magic_getarylen pPerl->Perl_magic_getarylen +#undef magic_getdefelem +#define magic_getdefelem pPerl->Perl_magic_getdefelem +#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_mutexfree +#define magic_mutexfree pPerl->Perl_magic_mutexfree +#undef magic_nextpack +#define magic_nextpack pPerl->Perl_magic_nextpack +#undef magic_set +#define magic_set pPerl->Perl_magic_set +#undef magic_set_all_env +#define magic_set_all_env pPerl->Perl_magic_set_all_env +#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_setcollxfrm +#define magic_setcollxfrm pPerl->Perl_magic_setcollxfrm +#undef magic_setdbline +#define magic_setdbline pPerl->Perl_magic_setdbline +#undef magic_setdefelem +#define magic_setdefelem pPerl->Perl_magic_setdefelem +#undef magic_setenv +#define magic_setenv pPerl->Perl_magic_setenv +#undef magic_setfm +#define magic_setfm pPerl->Perl_magic_setfm +#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_sizepack +#define magic_sizepack pPerl->Perl_magic_sizepack +#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 mem_collxfrm +#define mem_collxfrm pPerl->Perl_mem_collxfrm +#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_magical +#define mg_magical pPerl->Perl_mg_magical +#undef mg_length +#define mg_length pPerl->Perl_mg_length +#undef mg_set +#define mg_set pPerl->Perl_mg_set +#undef mg_size +#define mg_size pPerl->Perl_mg_size +#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_chsize +#define my_chsize pPerl->Perl_my_chsize +#undef my_exit +#define my_exit pPerl->Perl_my_exit +#undef my_failure_exit +#define my_failure_exit pPerl->Perl_my_failure_exit +#undef my_htonl +#define my_htonl pPerl->Perl_my_htonl +#undef my_lstat +#define my_lstat pPerl->Perl_my_lstat +#undef my_memcmp +#define my_memcmp pPerl->my_memcmp +#undef my_ntohl +#define my_ntohl pPerl->Perl_my_ntohl +#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_swap +#define my_swap pPerl->Perl_my_swap +#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 newCONSTSUB +#define newCONSTSUB pPerl->Perl_newCONSTSUB +#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 newRV_noinc +#undef Perl_newRV_noinc +#define newRV_noinc pPerl->Perl_newRV_noinc +#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 newSVpvf +#define newSVpvf pPerl->Perl_newSVpvf +#undef newSVpvn +#define newSVpvn pPerl->Perl_newSVpvn +#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_struct_thread +#define new_struct_thread pPerl->Perl_new_struct_thread +#undef new_stackinfo +#define new_stackinfo pPerl->Perl_new_stackinfo +#undef new_sv +#define new_sv pPerl->new_sv +#undef new_xnv +#define new_xnv pPerl->new_xnv +#undef new_xpv +#define new_xpv pPerl->new_xpv +#undef nextargv +#define nextargv pPerl->Perl_nextargv +#undef nextchar +#define nextchar pPerl->nextchar +#undef ninstr +#define ninstr pPerl->Perl_ninstr +#undef no_fh_allowed +#define no_fh_allowed pPerl->Perl_no_fh_allowed +#undef no_op +#define no_op pPerl->Perl_no_op +#undef package +#define package pPerl->Perl_package +#undef pad_alloc +#define pad_alloc pPerl->Perl_pad_alloc +#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 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_pv +#define perl_eval_pv pPerl->perl_eval_pv +#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_init_i18nl10n +#define perl_init_i18nl10n pPerl->perl_init_i18nl10n +#undef perl_init_i18nl14n +#define perl_init_i18nl14n pPerl->perl_init_i18nl14n +#undef perl_new_collate +#define perl_new_collate pPerl->perl_new_collate +#undef perl_new_ctype +#define perl_new_ctype pPerl->perl_new_ctype +#undef perl_new_numeric +#define perl_new_numeric pPerl->perl_new_numeric +#undef perl_set_numeric_local +#define perl_set_numeric_local pPerl->perl_set_numeric_local +#undef perl_set_numeric_standard +#define perl_set_numeric_standard pPerl->perl_set_numeric_standard +#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 regexec_flags +#define regexec_flags pPerl->Perl_regexec_flags +#undef pregexec +#define pregexec pPerl->Perl_pregexec +#undef pregfree +#define pregfree pPerl->Perl_pregfree +#undef regnext +#define regnext pPerl->Perl_regnext +#undef regnoderegnext +#define regnoderegnext pPerl->regnoderegnext +#undef repeatcpy +#define repeatcpy pPerl->Perl_repeatcpy +#undef rninstr +#define rninstr pPerl->Perl_rninstr +#undef rsignal +#define rsignal pPerl->Perl_rsignal +#undef rsignal_restore +#define rsignal_restore pPerl->Perl_rsignal_restore +#undef rsignal_save +#define rsignal_save pPerl->Perl_rsignal_save +#undef rsignal_state +#define rsignal_state pPerl->Perl_rsignal_state +#undef run +#define run pPerl->Perl_run +#undef rxres_free +#define rxres_free pPerl->Perl_rxres_free +#undef rxres_restore +#define rxres_restore pPerl->Perl_rxres_restore +#undef rxres_save +#define rxres_save pPerl->Perl_rxres_save +#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 safexcalloc +#define safexcalloc pPerl->Perl_safexcalloc +#undef safexfree +#define safexfree pPerl->Perl_safexfree +#undef safexmalloc +#define safexmalloc pPerl->Perl_safexmalloc +#undef safexrealloc +#define safexrealloc pPerl->Perl_safexrealloc +#undef same_dirent +#define same_dirent pPerl->Perl_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_aelem +#define save_aelem pPerl->Perl_save_aelem +#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_destructor +#define save_destructor pPerl->Perl_save_destructor +#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_gp +#define save_gp pPerl->Perl_save_gp +#undef save_hash +#define save_hash pPerl->Perl_save_hash +#undef save_helem +#define save_helem pPerl->Perl_save_helem +#undef save_hptr +#define save_hptr pPerl->Perl_save_hptr +#undef save_I16 +#define save_I16 pPerl->Perl_save_I16 +#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->Perl_save_iv +#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_op +#define save_op pPerl->Perl_save_op +#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 save_threadsv +#define save_threadsv pPerl->Perl_save_threadsv +#undef sawparens +#define sawparens pPerl->Perl_sawparens +#undef scalar +#define scalar pPerl->Perl_scalar +#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 setdefout +#define setdefout pPerl->Perl_setdefout +#undef setenv_getix +#define setenv_getix pPerl->Perl_setenv_getix +#undef share_hek +#define share_hek pPerl->Perl_share_hek +#undef sharepvn +#define sharepvn pPerl->Perl_sharepvn +#undef sighandler +#define sighandler pPerl->Perl_sighandler +#undef skipspace +#define skipspace pPerl->Perl_skipspace +#undef stack_grow +#define stack_grow pPerl->Perl_stack_grow +#undef start_subparse +#define start_subparse pPerl->Perl_start_subparse +#undef sub_crush_depth +#define sub_crush_depth pPerl->Perl_sub_crush_depth +#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_2uv +#define sv_2uv pPerl->Perl_sv_2uv +#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_catpvf +#define sv_catpvf pPerl->Perl_sv_catpvf +#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_cmp_locale +#define sv_cmp_locale pPerl->Perl_sv_cmp_locale +#undef sv_collxfrm +#define sv_collxfrm pPerl->Perl_sv_collxfrm +#undef sv_compile_2op +#define sv_compile_2op pPerl->Perl_sv_compile_2op +#undef sv_dec +#define sv_dec pPerl->Perl_sv_dec +#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_iv +#define sv_iv pPerl->Perl_sv_iv +#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_newmortal +#define sv_newmortal pPerl->Perl_sv_newmortal +#undef sv_newref +#define sv_newref pPerl->Perl_sv_newref +#undef sv_nv +#define sv_nv pPerl->Perl_sv_nv +#undef sv_pvn +#define sv_pvn pPerl->Perl_sv_pvn +#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_setpv +#define sv_setpv pPerl->Perl_sv_setpv +#undef sv_setpvf +#define sv_setpvf pPerl->Perl_sv_setpvf +#undef sv_setpviv +#define sv_setpviv pPerl->Perl_sv_setpviv +#undef sv_setpvn +#define sv_setpvn pPerl->Perl_sv_setpvn +#undef sv_setref_iv +#define sv_setref_iv pPerl->Perl_sv_setref_iv +#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_setsv +#define sv_setsv pPerl->Perl_sv_setsv +#undef sv_setuv +#define sv_setuv pPerl->Perl_sv_setuv +#undef sv_taint +#define sv_taint pPerl->Perl_sv_taint +#undef sv_tainted +#define sv_tainted pPerl->Perl_sv_tainted +#undef sv_true +#define sv_true pPerl->Perl_sv_true +#undef sv_unmagic +#define sv_unmagic pPerl->Perl_sv_unmagic +#undef sv_unref +#define sv_unref pPerl->Perl_sv_unref +#undef sv_untaint +#define sv_untaint pPerl->Perl_sv_untaint +#undef sv_upgrade +#define sv_upgrade pPerl->Perl_sv_upgrade +#undef sv_usepvn +#define sv_usepvn pPerl->Perl_sv_usepvn +#undef sv_uv +#define sv_uv pPerl->Perl_sv_uv +#undef sv_vcatpvfn +#define sv_vcatpvfn pPerl->Perl_sv_vcatpvfn +#undef sv_vsetpvfn +#define sv_vsetpvfn pPerl->Perl_sv_vsetpvfn +#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 unlnk +#define unlnk pPerl->Perl_unlnk +#undef unlock_condpair +#define unlock_condpair pPerl->Perl_unlock_condpair +#undef unshare_hek +#define unshare_hek pPerl->Perl_unshare_hek +#undef unsharepvn +#define unsharepvn pPerl->Perl_unsharepvn +#undef utilize +#define utilize pPerl->Perl_utilize +#undef vivify_defelem +#define vivify_defelem pPerl->Perl_vivify_defelem +#undef vivify_ref +#define vivify_ref pPerl->Perl_vivify_ref +#undef wait4pid +#define wait4pid pPerl->Perl_wait4pid +#undef warn +#define warn pPerl->Perl_warn +#undef whichsig +#define whichsig pPerl->Perl_whichsig +#undef yyerror +#define yyerror pPerl->Perl_yyerror +#undef yylex +#define yylex pPerl->Perl_yylex +#undef yyparse +#define yyparse pPerl->Perl_yyparse +#undef yywarn +#define yywarn pPerl->Perl_yywarn + + +#undef piMem +#define piMem (pPerl->piMem) +#undef piENV +#define piENV (pPerl->piENV) +#undef piStdIO +#define piStdIO (pPerl->piStdIO) +#undef piLIO +#define piLIO (pPerl->piLIO) +#undef piDir +#define piDir (pPerl->piDir) +#undef piSock +#define piSock (pPerl->piSock) +#undef piProc +#define piProc (pPerl->piProc) + +#ifndef NO_XSLOCKS +#undef closedir +#undef opendir +#undef stdin +#undef stdout +#undef stderr +#undef feof +#undef ferror +#undef fgetpos +#undef ioctl +#undef getlogin +#undef setjmp +#undef getc +#undef ungetc +#undef fileno + +#define mkdir PerlDir_mkdir +#define chdir PerlDir_chdir +#define rmdir PerlDir_rmdir +#define closedir PerlDir_close +#define opendir PerlDir_open +#define readdir PerlDir_read +#define rewinddir PerlDir_rewind +#define seekdir PerlDir_seek +#define telldir PerlDir_tell +#define putenv PerlEnv_putenv +#define getenv PerlEnv_getenv +#define stdin PerlIO_stdin() +#define stdout PerlIO_stdout() +#define stderr PerlIO_stderr() +#define fopen PerlIO_open +#define fclose PerlIO_close +#define feof PerlIO_eof +#define ferror PerlIO_error +#define fclearerr PerlIO_clearerr +#define getc PerlIO_getc +#define fputc(c, f) PerlIO_putc(f,c) +#define fputs(s, f) PerlIO_puts(f,s) +#define fflush PerlIO_flush +#define ungetc(c, f) PerlIO_ungetc((f),(c)) +#define fileno PerlIO_fileno +#define fdopen PerlIO_fdopen +#define freopen PerlIO_reopen +#define fread(b,s,c,f) PerlIO_read((f),(b),(s*c)) +#define fwrite(b,s,c,f) PerlIO_write((f),(b),(s*c)) +#define setbuf PerlIO_setbuf +#define setvbuf PerlIO_setvbuf +#define setlinebuf PerlIO_setlinebuf +#define stdoutf PerlIO_stdoutf +#define vfprintf PerlIO_vprintf +#define ftell PerlIO_tell +#define fseek PerlIO_seek +#define fgetpos PerlIO_getpos +#define fsetpos PerlIO_setpos +#define frewind PerlIO_rewind +#define tmpfile PerlIO_tmpfile +#define access PerlLIO_access +#define chmod PerlLIO_chmod +#define chsize PerlLIO_chsize +#define close PerlLIO_close +#define dup PerlLIO_dup +#define dup2 PerlLIO_dup2 +#define flock PerlLIO_flock +#define fstat PerlLIO_fstat +#define ioctl PerlLIO_ioctl +#define isatty PerlLIO_isatty +#define lseek PerlLIO_lseek +#define lstat PerlLIO_lstat +#define mktemp PerlLIO_mktemp +#define open PerlLIO_open +#define read PerlLIO_read +#define rename PerlLIO_rename +#define setmode PerlLIO_setmode +#define stat PerlLIO_stat +#define tmpnam PerlLIO_tmpnam +#define umask PerlLIO_umask +#define unlink PerlLIO_unlink +#define utime PerlLIO_utime +#define write PerlLIO_write +#define malloc PerlMem_malloc +#define realloc PerlMem_realloc +#define free PerlMem_free +#define abort PerlProc_abort +#define exit PerlProc_exit +#define _exit PerlProc__exit +#define execl PerlProc_execl +#define execv PerlProc_execv +#define execvp PerlProc_execvp +#define getuid PerlProc_getuid +#define geteuid PerlProc_geteuid +#define getgid PerlProc_getgid +#define getegid PerlProc_getegid +#define getlogin PerlProc_getlogin +#define kill PerlProc_kill +#define killpg PerlProc_killpg +#define pause PerlProc_pause +#define popen PerlProc_popen +#define pclose PerlProc_pclose +#define pipe PerlProc_pipe +#define setuid PerlProc_setuid +#define setgid PerlProc_setgid +#define sleep PerlProc_sleep +#define times PerlProc_times +#define wait PerlProc_wait +#define setjmp PerlProc_setjmp +#define longjmp PerlProc_longjmp +#define signal PerlProc_signal +#define htonl PerlSock_htonl +#define htons PerlSock_htons +#define ntohs PerlSock_ntohl +#define ntohl PerlSock_ntohs +#define accept PerlSock_accept +#define bind PerlSock_bind +#define connect PerlSock_connect +#define endhostent PerlSock_endhostent +#define endnetent PerlSock_endnetent +#define endprotoent PerlSock_endprotoent +#define endservent PerlSock_endservent +#define gethostbyaddr PerlSock_gethostbyaddr +#define gethostbyname PerlSock_gethostbyname +#define gethostent PerlSock_gethostent +#define gethostname PerlSock_gethostname +#define getnetbyaddr PerlSock_getnetbyaddr +#define getnetbyname PerlSock_getnetbyname +#define getnetent PerlSock_getnetent +#define getpeername PerlSock_getpeername +#define getprotobyname PerlSock_getprotobyname +#define getprotobynumber PerlSock_getprotobynumber +#define getprotoent PerlSock_getprotoent +#define getservbyname PerlSock_getservbyname +#define getservbyport PerlSock_getservbyport +#define getservent PerlSock_getservent +#define getsockname PerlSock_getsockname +#define getsockopt PerlSock_getsockopt +#define inet_addr PerlSock_inet_addr +#define inet_ntoa PerlSock_inet_ntoa +#define listen PerlSock_listen +#define recvfrom PerlSock_recvfrom +#define select PerlSock_select +#define send PerlSock_send +#define sendto PerlSock_sendto +#define sethostent PerlSock_sethostent +#define setnetent PerlSock_setnetent +#define setprotoent PerlSock_setprotoent +#define setservent PerlSock_setservent +#define setsockopt PerlSock_setsockopt +#define shutdown PerlSock_shutdown +#define socket PerlSock_socket +#define socketpair PerlSock_socketpair +#endif /* NO_XSLOCKS */ + +#undef THIS +#define THIS pPerl +#undef THIS_ +#define THIS_ pPerl, + +#undef SAVEDESTRUCTOR +#define SAVEDESTRUCTOR(f,p) \ + pPerl->Perl_save_destructor((FUNC_NAME_TO_PTR(f)),(p)) + +#ifdef WIN32 + +#ifndef WIN32IO_IS_STDIO +#undef errno +#define errno ErrorNo() +#endif + +#undef ErrorNo +#define ErrorNo pPerl->ErrorNo +#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__ */ + diff --git a/XSLock.h b/XSLock.h new file mode 100644 index 0000000000..652f4929f1 --- /dev/null +++ b/XSLock.h @@ -0,0 +1,35 @@ +#ifndef __XSLock_h__ +#define __XSLock_h__ + +class XSLockManager +{ +public: + XSLockManager() { InitializeCriticalSection(&cs); }; + ~XSLockManager() { DeleteCriticalSection(&cs); }; + void Enter(void) { EnterCriticalSection(&cs); }; + void Leave(void) { LeaveCriticalSection(&cs); }; +protected: + CRITICAL_SECTION cs; +}; + +XSLockManager g_XSLock; + +class XSLock +{ +public: + XSLock() { g_XSLock.Enter(); }; + ~XSLock() { g_XSLock.Leave(); }; +}; + +CPerlObj* pPerl; + +#undef dXSARGS +#define dXSARGS \ + dSP; dMARK; \ + I32 ax = mark - stack_base + 1; \ + I32 items = sp - mark; \ + XSLock localLock; \ + ::pPerl = pPerl + + +#endif @@ -1,7 +1,11 @@ #define ST(off) stack_base[ax + (off)] #ifdef CAN_PROTOTYPE +#ifdef PERL_OBJECT +#define XS(name) void name(CPerlObj* pPerl, CV* cv) +#else #define XS(name) void name(CV* cv) +#endif #else #define XS(name) void name(cv) CV* cv; #endif @@ -63,3 +67,12 @@ #else # define XS_VERSION_BOOTCHECK #endif + +#ifdef PERL_OBJECT +#include "ObjXSub.h" +#ifndef NO_XSLOCKS +#ifdef WIN32 +#include "XSLock.h" +#endif /* WIN32 */ +#endif /* NO_XSLOCKS */ +#endif /* PERL_OBJECT */ diff --git a/bytecode.h b/bytecode.h index e86c146505..0239866d0a 100644 --- a/bytecode.h +++ b/bytecode.h @@ -28,11 +28,11 @@ EXT I32 obj_list_fill INIT(-1); #endif /* INDIRECT_BGET_MACROS */ #define BGET_U32(arg) \ - BGET_FREAD(&arg, sizeof(U32), 1); arg = ntohl((U32)arg) + BGET_FREAD(&arg, sizeof(U32), 1); arg = PerlSock_ntohl((U32)arg) #define BGET_I32(arg) \ - BGET_FREAD(&arg, sizeof(I32), 1); arg = (I32)ntohl((U32)arg) + BGET_FREAD(&arg, sizeof(I32), 1); arg = (I32)PerlSock_ntohl((U32)arg) #define BGET_U16(arg) \ - BGET_FREAD(&arg, sizeof(U16), 1); arg = ntohs((U16)arg) + BGET_FREAD(&arg, sizeof(U16), 1); arg = PerlSock_ntohs((U16)arg) #define BGET_U8(arg) arg = BGET_FGETC() #if INDIRECT_BGET_MACROS @@ -92,7 +92,7 @@ EXT I32 obj_list_fill INIT(-1); New(666, ary, 256, unsigned short); \ BGET_FREAD(ary, 256, 2); \ for (i = 0; i < 256; i++) \ - ary[i] = ntohs(ary[i]); \ + ary[i] = PerlSock_ntohs(ary[i]); \ arg = (char *) ary; \ } while (0) @@ -108,11 +108,13 @@ EXT I32 obj_list_fill INIT(-1); arg = atof(str); \ } STMT_END -#define BGET_objindex(arg) STMT_START { \ - U32 ix; \ - BGET_U32(ix); \ - arg = obj_list[ix]; \ +#define BGET_objindex(arg, type) STMT_START { \ + U32 ix; \ + BGET_U32(ix); \ + arg = (type)obj_list[ix]; \ } STMT_END +#define BGET_svindex(arg) BGET_objindex(arg, svindex) +#define BGET_opindex(arg) BGET_objindex(arg, opindex) #define BSET_ldspecsv(sv, arg) sv = specialsv_list[arg] @@ -55,14 +55,14 @@ void byterun(PerlIO *fp) case INSN_LDSV: /* 1 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); sv = arg; break; } case INSN_LDOP: /* 2 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); op = arg; break; } @@ -157,7 +157,7 @@ void byterun(PerlIO *fp) case INSN_XRV: /* 17 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); SvRV(sv) = arg; break; } @@ -204,7 +204,7 @@ void byterun(PerlIO *fp) case INSN_XLV_TARG: /* 24 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); LvTARG(sv) = arg; break; } @@ -281,7 +281,7 @@ void byterun(PerlIO *fp) case INSN_XIO_TOP_GV: /* 36 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&IoTOP_GV(sv) = arg; break; } @@ -295,7 +295,7 @@ void byterun(PerlIO *fp) case INSN_XIO_FMT_GV: /* 38 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&IoFMT_GV(sv) = arg; break; } @@ -309,7 +309,7 @@ void byterun(PerlIO *fp) case INSN_XIO_BOTTOM_GV: /* 40 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&IoBOTTOM_GV(sv) = arg; break; } @@ -337,35 +337,35 @@ void byterun(PerlIO *fp) case INSN_XCV_STASH: /* 44 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&CvSTASH(sv) = arg; break; } case INSN_XCV_START: /* 45 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); CvSTART(sv) = arg; break; } case INSN_XCV_ROOT: /* 46 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); CvROOT(sv) = arg; break; } case INSN_XCV_GV: /* 47 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&CvGV(sv) = arg; break; } case INSN_XCV_FILEGV: /* 48 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&CvFILEGV(sv) = arg; break; } @@ -379,14 +379,14 @@ void byterun(PerlIO *fp) case INSN_XCV_PADLIST: /* 50 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&CvPADLIST(sv) = arg; break; } case INSN_XCV_OUTSIDE: /* 51 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&CvOUTSIDE(sv) = arg; break; } @@ -407,7 +407,7 @@ void byterun(PerlIO *fp) case INSN_AV_PUSH: /* 54 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); BSET_av_push(sv, arg); break; } @@ -449,7 +449,7 @@ void byterun(PerlIO *fp) case INSN_HV_STORE: /* 60 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); BSET_hv_store(sv, arg); break; } @@ -463,7 +463,7 @@ void byterun(PerlIO *fp) case INSN_MG_OBJ: /* 62 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); SvMAGIC(sv)->mg_obj = arg; break; } @@ -491,7 +491,7 @@ void byterun(PerlIO *fp) case INSN_XMG_STASH: /* 66 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&SvSTASH(sv) = arg; break; } @@ -512,7 +512,7 @@ void byterun(PerlIO *fp) case INSN_GP_SV: /* 69 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); GvSV(sv) = arg; break; } @@ -533,42 +533,42 @@ void byterun(PerlIO *fp) case INSN_GP_AV: /* 72 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&GvAV(sv) = arg; break; } case INSN_GP_HV: /* 73 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&GvHV(sv) = arg; break; } case INSN_GP_CV: /* 74 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&GvCV(sv) = arg; break; } case INSN_GP_FILEGV: /* 75 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&GvFILEGV(sv) = arg; break; } case INSN_GP_IO: /* 76 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&GvIOp(sv) = arg; break; } case INSN_GP_FORM: /* 77 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&GvFORM(sv) = arg; break; } @@ -589,7 +589,7 @@ void byterun(PerlIO *fp) case INSN_GP_SHARE: /* 80 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); BSET_gp_share(sv, arg); break; } @@ -603,14 +603,14 @@ void byterun(PerlIO *fp) case INSN_OP_NEXT: /* 82 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); op->op_next = arg; break; } case INSN_OP_SIBLING: /* 83 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); op->op_sibling = arg; break; } @@ -659,35 +659,35 @@ void byterun(PerlIO *fp) case INSN_OP_FIRST: /* 90 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); cUNOP->op_first = arg; break; } case INSN_OP_LAST: /* 91 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); cBINOP->op_last = arg; break; } case INSN_OP_OTHER: /* 92 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); cLOGOP->op_other = arg; break; } case INSN_OP_TRUE: /* 93 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); cCONDOP->op_true = arg; break; } case INSN_OP_FALSE: /* 94 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); cCONDOP->op_false = arg; break; } @@ -701,28 +701,28 @@ void byterun(PerlIO *fp) case INSN_OP_PMREPLROOT: /* 96 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); cPMOP->op_pmreplroot = arg; break; } case INSN_OP_PMREPLROOTGV: /* 97 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&cPMOP->op_pmreplroot = arg; break; } case INSN_OP_PMREPLSTART: /* 98 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); cPMOP->op_pmreplstart = arg; break; } case INSN_OP_PMNEXT: /* 99 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); *(OP**)&cPMOP->op_pmnext = arg; break; } @@ -750,14 +750,14 @@ void byterun(PerlIO *fp) case INSN_OP_SV: /* 103 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); cSVOP->op_sv = arg; break; } case INSN_OP_GV: /* 104 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&cGVOP->op_gv = arg; break; } @@ -778,21 +778,21 @@ void byterun(PerlIO *fp) case INSN_OP_REDOOP: /* 107 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); cLOOP->op_redoop = arg; break; } case INSN_OP_NEXTOP: /* 108 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); cLOOP->op_nextop = arg; break; } case INSN_OP_LASTOP: /* 109 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); cLOOP->op_lastop = arg; break; } @@ -806,14 +806,14 @@ void byterun(PerlIO *fp) case INSN_COP_STASH: /* 111 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&cCOP->cop_stash = arg; break; } case INSN_COP_FILEGV: /* 112 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); *(SV**)&cCOP->cop_filegv = arg; break; } @@ -841,21 +841,21 @@ void byterun(PerlIO *fp) case INSN_MAIN_START: /* 116 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); main_start = arg; break; } case INSN_MAIN_ROOT: /* 117 */ { opindex arg; - BGET_objindex(arg); + BGET_opindex(arg); main_root = arg; break; } case INSN_CURPAD: /* 118 */ { svindex arg; - BGET_objindex(arg); + BGET_svindex(arg); BSET_curpad(curpad, arg); break; } @@ -21,7 +21,7 @@ struct xpvcv { HV * xcv_stash; OP * xcv_start; OP * xcv_root; - void (*xcv_xsub) _((CV*)); + void (*xcv_xsub) _((CPERLproto_ CV*)); ANY xcv_xsubany; GV * xcv_gv; GV * xcv_filegv; @@ -503,7 +503,7 @@ nextargv(register GV *gv) (void)fchown(lastfd,fileuid,filegid); #else #ifdef HAS_CHOWN - (void)chown(oldname,fileuid,filegid); + (void)PerlLIO_chown(oldname,fileuid,filegid); #endif #endif } @@ -1065,7 +1065,7 @@ apply(I32 type, register SV **mark, register SV **sp) val2 = SvIVx(*++mark); tot = sp - mark; while (++mark <= sp) { - if (chown(SvPVx(*mark, na),val,val2)) + if (PerlLIO_chown(SvPVx(*mark, na),val,val2)) tot--; } } @@ -128,6 +128,8 @@ * get to use the same RTL functions as the core. */ # ifndef HASATTRIBUTE -# include <win32iop.h> +# ifndef PERL_OBJECT +# include <win32iop.h> +# endif # endif #endif /* WIN32 */ @@ -22,11 +22,13 @@ dump_all(void) } #else /* Rest of file is for DEBUGGING */ +#ifndef PERL_OBJECT #ifdef I_STDARG static void dump(char *pat, ...); #else static void dump(); #endif +#endif /* PERL_OBJECT */ void dump_all(void) @@ -408,7 +410,7 @@ long arg2, arg3, arg4, arg5; #else #ifdef I_STDARG -static void +STATIC void dump(char *pat,...) #else /*VARARGS0*/ @@ -327,7 +327,7 @@ #define mg_find Perl_mg_find #define mg_free Perl_mg_free #define mg_get Perl_mg_get -#define mg_len Perl_mg_len +#define mg_length Perl_mg_length #define mg_magical Perl_mg_magical #define mg_set Perl_mg_set #define mg_size Perl_mg_size diff --git a/embedvar.h b/embedvar.h index 667edab2fd..0ba157975e 100644 --- a/embedvar.h +++ b/embedvar.h @@ -81,6 +81,7 @@ #define Argv (curinterp->IArgv) #define Cmd (curinterp->ICmd) +#define DBcv (curinterp->IDBcv) #define DBgv (curinterp->IDBgv) #define DBline (curinterp->IDBline) #define DBsignal (curinterp->IDBsignal) @@ -88,11 +89,15 @@ #define DBsub (curinterp->IDBsub) #define DBtrace (curinterp->IDBtrace) #define ampergv (curinterp->Iampergv) +#define archpat_auto (curinterp->Iarchpat_auto) #define argvgv (curinterp->Iargvgv) #define argvoutgv (curinterp->Iargvoutgv) #define basetime (curinterp->Ibasetime) #define beginav (curinterp->Ibeginav) +#define bostr (curinterp->Ibostr) #define cddir (curinterp->Icddir) +#define colors (curinterp->Icolors) +#define colorset (curinterp->Icolorset) #define copline (curinterp->Icopline) #define curcopdb (curinterp->Icurcopdb) #define curstname (curinterp->Icurstname) @@ -115,17 +120,22 @@ #define errgv (curinterp->Ierrgv) #define eval_root (curinterp->Ieval_root) #define eval_start (curinterp->Ieval_start) +#define extralen (curinterp->Iextralen) #define fdpid (curinterp->Ifdpid) #define filemode (curinterp->Ifilemode) #define firstgv (curinterp->Ifirstgv) #define forkprocess (curinterp->Iforkprocess) #define formfeed (curinterp->Iformfeed) +#define generation (curinterp->Igeneration) #define gensym (curinterp->Igensym) #define globalstash (curinterp->Iglobalstash) +#define in_clean_all (curinterp->Iin_clean_all) +#define in_clean_objs (curinterp->Iin_clean_objs) #define incgv (curinterp->Iincgv) #define initav (curinterp->Iinitav) #define inplace (curinterp->Iinplace) #define lastfd (curinterp->Ilastfd) +#define lastgotoprobe (curinterp->Ilastgotoprobe) #define lastscream (curinterp->Ilastscream) #define lastsize (curinterp->Ilastsize) #define lastspbase (curinterp->Ilastspbase) @@ -133,6 +143,7 @@ #define laststype (curinterp->Ilaststype) #define leftgv (curinterp->Ileftgv) #define lineary (curinterp->Ilineary) +#define linestart (curinterp->Ilinestart) #define localpatches (curinterp->Ilocalpatches) #define main_cv (curinterp->Imain_cv) #define main_root (curinterp->Imain_root) @@ -140,12 +151,14 @@ #define maxscream (curinterp->Imaxscream) #define maxsysfd (curinterp->Imaxsysfd) #define mess_sv (curinterp->Imess_sv) +#define mh (curinterp->Imh) #define minus_F (curinterp->Iminus_F) #define minus_a (curinterp->Iminus_a) #define minus_c (curinterp->Iminus_c) #define minus_l (curinterp->Iminus_l) #define minus_n (curinterp->Iminus_n) #define minus_p (curinterp->Iminus_p) +#define modcount (curinterp->Imodcount) #define multiline (curinterp->Imultiline) #define mystrk (curinterp->Imystrk) #define ofmt (curinterp->Iofmt) @@ -159,20 +172,52 @@ #define orslen (curinterp->Iorslen) #define parsehook (curinterp->Iparsehook) #define patchlevel (curinterp->Ipatchlevel) +#define pending_ident (curinterp->Ipending_ident) #define perl_destruct_level (curinterp->Iperl_destruct_level) #define perldb (curinterp->Iperldb) #define preambleav (curinterp->Ipreambleav) #define preambled (curinterp->Ipreambled) #define preprocess (curinterp->Ipreprocess) +#define reg_eval_set (curinterp->Ireg_eval_set) +#define reg_flags (curinterp->Ireg_flags) +#define reg_start_tmp (curinterp->Ireg_start_tmp) +#define reg_start_tmpl (curinterp->Ireg_start_tmpl) +#define regbol (curinterp->Iregbol) +#define regcc (curinterp->Iregcc) +#define regcode (curinterp->Iregcode) +#define regdata (curinterp->Iregdata) +#define regdummy (curinterp->Iregdummy) +#define regendp (curinterp->Iregendp) +#define regeol (curinterp->Iregeol) +#define regflags (curinterp->Iregflags) +#define regindent (curinterp->Iregindent) +#define reginput (curinterp->Ireginput) +#define reglastparen (curinterp->Ireglastparen) +#define regnarrate (curinterp->Iregnarrate) +#define regnaughty (curinterp->Iregnaughty) +#define regnpar (curinterp->Iregnpar) +#define regparse (curinterp->Iregparse) +#define regprecomp (curinterp->Iregprecomp) +#define regprev (curinterp->Iregprev) +#define regprogram (curinterp->Iregprogram) +#define regsawback (curinterp->Iregsawback) +#define regseen (curinterp->Iregseen) +#define regsize (curinterp->Iregsize) +#define regstartp (curinterp->Iregstartp) +#define regtill (curinterp->Iregtill) +#define regxend (curinterp->Iregxend) #define rightgv (curinterp->Irightgv) +#define rx (curinterp->Irx) #define sawampersand (curinterp->Isawampersand) #define sawstudy (curinterp->Isawstudy) #define sawvec (curinterp->Isawvec) +#define seen_zerolen (curinterp->Iseen_zerolen) #define screamfirst (curinterp->Iscreamfirst) #define screamnext (curinterp->Iscreamnext) #define secondgv (curinterp->Isecondgv) #define siggv (curinterp->Isiggv) #define sortcop (curinterp->Isortcop) +#define sortcxix (curinterp->Isortcxix) #define sortstash (curinterp->Isortstash) #define splitstr (curinterp->Isplitstr) #define statcache (curinterp->Istatcache) @@ -183,6 +228,7 @@ #define stdingv (curinterp->Istdingv) #define strchop (curinterp->Istrchop) #define strtab (curinterp->Istrtab) +#define sublex_info (curinterp->Isublex_info) #define sv_arenaroot (curinterp->Isv_arenaroot) #define sv_count (curinterp->Isv_count) #define sv_objcount (curinterp->Isv_objcount) @@ -197,6 +243,7 @@ #define IArgv Argv #define ICmd Cmd +#define IDBcv DBcv #define IDBgv DBgv #define IDBline DBline #define IDBsignal DBsignal @@ -204,11 +251,15 @@ #define IDBsub DBsub #define IDBtrace DBtrace #define Iampergv ampergv +#define Iarchpat_auto archpat_auto #define Iargvgv argvgv #define Iargvoutgv argvoutgv #define Ibasetime basetime #define Ibeginav beginav +#define Ibostr bostr #define Icddir cddir +#define Icolors colors +#define Icolorset colorset #define Icopline copline #define Icurcopdb curcopdb #define Icurstname curstname @@ -231,17 +282,22 @@ #define Ierrgv errgv #define Ieval_root eval_root #define Ieval_start eval_start +#define Iextralen extralen #define Ifdpid fdpid #define Ifilemode filemode #define Ifirstgv firstgv #define Iforkprocess forkprocess #define Iformfeed formfeed +#define Igeneration generation #define Igensym gensym #define Iglobalstash globalstash +#define Iin_clean_all in_clean_all +#define Iin_clean_objs in_clean_objs #define Iincgv incgv #define Iinitav initav #define Iinplace inplace #define Ilastfd lastfd +#define Ilastgotoprobe lastgotoprobe #define Ilastscream lastscream #define Ilastsize lastsize #define Ilastspbase lastspbase @@ -249,6 +305,7 @@ #define Ilaststype laststype #define Ileftgv leftgv #define Ilineary lineary +#define Ilinestart linestart #define Ilocalpatches localpatches #define Imain_cv main_cv #define Imain_root main_root @@ -256,12 +313,14 @@ #define Imaxscream maxscream #define Imaxsysfd maxsysfd #define Imess_sv mess_sv +#define Imh mh #define Iminus_F minus_F #define Iminus_a minus_a #define Iminus_c minus_c #define Iminus_l minus_l #define Iminus_n minus_n #define Iminus_p minus_p +#define Imodcount modcount #define Imultiline multiline #define Imystrk mystrk #define Iofmt ofmt @@ -275,20 +334,52 @@ #define Iorslen orslen #define Iparsehook parsehook #define Ipatchlevel patchlevel +#define Ipending_ident pending_ident #define Iperl_destruct_level perl_destruct_level #define Iperldb perldb #define Ipreambleav preambleav #define Ipreambled preambled #define Ipreprocess preprocess +#define Ireg_eval_set reg_eval_set +#define Ireg_flags reg_flags +#define Ireg_start_tmp reg_start_tmp +#define Ireg_start_tmpl reg_start_tmpl +#define Iregbol regbol +#define Iregcc regcc +#define Iregcode regcode +#define Iregdata regdata +#define Iregdummy regdummy +#define Iregendp regendp +#define Iregeol regeol +#define Iregflags regflags +#define Iregindent regindent +#define Ireginput reginput +#define Ireglastparen reglastparen +#define Iregnarrate regnarrate +#define Iregnaughty regnaughty +#define Iregnpar regnpar +#define Iregparse regparse +#define Iregprecomp regprecomp +#define Iregprev regprev +#define Iregprogram regprogram +#define Iregsawback regsawback +#define Iregseen regseen +#define Iregsize regsize +#define Iregstartp regstartp +#define Iregtill regtill +#define Iregxend regxend #define Irightgv rightgv +#define Irx rx #define Isawampersand sawampersand #define Isawstudy sawstudy #define Isawvec sawvec #define Iscreamfirst screamfirst #define Iscreamnext screamnext #define Isecondgv secondgv +#define Iseen_zerolen seen_zerolen #define Isiggv siggv #define Isortcop sortcop +#define Isortcxix sortcxix #define Isortstash sortstash #define Isplitstr splitstr #define Istatcache statcache @@ -299,6 +390,7 @@ #define Istdingv stdingv #define Istrchop strchop #define Istrtab strtab +#define Isublex_info sublex_info #define Isv_arenaroot sv_arenaroot #define Isv_count sv_count #define Isv_objcount sv_objcount @@ -374,6 +466,7 @@ #define Argv Perl_Argv #define Cmd Perl_Cmd +#define DBcv Perl_DBcv #define DBgv Perl_DBgv #define DBline Perl_DBline #define DBsignal Perl_DBsignal @@ -381,11 +474,15 @@ #define DBsub Perl_DBsub #define DBtrace Perl_DBtrace #define ampergv Perl_ampergv +#define archpat_auto Perl_archpat_auto #define argvgv Perl_argvgv #define argvoutgv Perl_argvoutgv #define basetime Perl_basetime #define beginav Perl_beginav +#define bostr Perl_bostr #define cddir Perl_cddir +#define colors Perl_colors +#define colorset Perl_colorset #define copline Perl_copline #define curcopdb Perl_curcopdb #define curstname Perl_curstname @@ -408,17 +505,22 @@ #define errgv Perl_errgv #define eval_root Perl_eval_root #define eval_start Perl_eval_start +#define extralen Perl_extralen #define fdpid Perl_fdpid #define filemode Perl_filemode #define firstgv Perl_firstgv #define forkprocess Perl_forkprocess #define formfeed Perl_formfeed +#define generation Perl_generation #define gensym Perl_gensym #define globalstash Perl_globalstash +#define in_clean_all Perl_in_clean_all +#define in_clean_objs Perl_in_clean_objs #define incgv Perl_incgv #define initav Perl_initav #define inplace Perl_inplace #define lastfd Perl_lastfd +#define lastgotoprobe Perl_lastgotoprobe #define lastscream Perl_lastscream #define lastsize Perl_lastsize #define lastspbase Perl_lastspbase @@ -426,6 +528,7 @@ #define laststype Perl_laststype #define leftgv Perl_leftgv #define lineary Perl_lineary +#define linestart Perl_linestart #define localpatches Perl_localpatches #define main_cv Perl_main_cv #define main_root Perl_main_root @@ -433,12 +536,14 @@ #define maxscream Perl_maxscream #define maxsysfd Perl_maxsysfd #define mess_sv Perl_mess_sv +#define mh Perl_mh #define minus_F Perl_minus_F #define minus_a Perl_minus_a #define minus_c Perl_minus_c #define minus_l Perl_minus_l #define minus_n Perl_minus_n #define minus_p Perl_minus_p +#define modcount Perl_modcount #define multiline Perl_multiline #define mystrk Perl_mystrk #define ofmt Perl_ofmt @@ -452,20 +557,52 @@ #define orslen Perl_orslen #define parsehook Perl_parsehook #define patchlevel Perl_patchlevel +#define pending_ident Perl_pending_ident #define perl_destruct_level Perl_perl_destruct_level #define perldb Perl_perldb #define preambleav Perl_preambleav #define preambled Perl_preambled #define preprocess Perl_preprocess +#define reg_eval_set Perl_reg_eval_set +#define reg_flags Perl_reg_flags +#define reg_start_tmp Perl_reg_start_tmp +#define reg_start_tmpl Perl_reg_start_tmpl +#define regbol Perl_regbol +#define regcc Perl_regcc +#define regcode Perl_regcode +#define regdata Perl_regdata +#define regdummy Perl_regdummy +#define regendp Perl_regendp +#define regeol Perl_regeol +#define regflags Perl_regflags +#define regindent Perl_regindent +#define reginput Perl_reginput +#define reglastparen Perl_reglastparen +#define regnarrate Perl_regnarrate +#define regnaughty Perl_regnaughty +#define regnpar Perl_regnpar +#define regparse Perl_regparse +#define regprecomp Perl_regprecomp +#define regprev Perl_regprev +#define regprogram Perl_regprogram +#define regsawback Perl_regsawback +#define regseen Perl_regseen +#define regsize Perl_regsize +#define regstartp Perl_regstartp +#define regtill Perl_regtill +#define regxend Perl_regxend #define rightgv Perl_rightgv +#define rx Perl_rx #define sawampersand Perl_sawampersand #define sawstudy Perl_sawstudy #define sawvec Perl_sawvec #define screamfirst Perl_screamfirst #define screamnext Perl_screamnext #define secondgv Perl_secondgv +#define seen_zerolen Perl_seen_zerolen #define siggv Perl_siggv #define sortcop Perl_sortcop +#define sortcxix Perl_sortcxix #define sortstash Perl_sortstash #define splitstr Perl_splitstr #define statcache Perl_statcache @@ -476,6 +613,7 @@ #define stdingv Perl_stdingv #define strchop Perl_strchop #define strtab Perl_strtab +#define sublex_info Perl_sublex_info #define sv_arenaroot Perl_sv_arenaroot #define sv_count Perl_sv_count #define sv_objcount Perl_sv_objcount @@ -637,6 +775,7 @@ #define do_undump (Perl_Vars.Gdo_undump) #define egid (Perl_Vars.Gegid) #define error_count (Perl_Vars.Gerror_count) +#define error_no (Perl_Vars.Gerror_no) #define euid (Perl_Vars.Geuid) #define eval_cond (Perl_Vars.Geval_cond) #define eval_mutex (Perl_Vars.Geval_mutex) @@ -756,6 +895,7 @@ #define Gdo_undump do_undump #define Gegid egid #define Gerror_count error_count +#define Gerror_no error_no #define Geuid euid #define Geval_cond eval_cond #define Geval_mutex eval_mutex @@ -875,6 +1015,7 @@ #define do_undump Perl_do_undump #define egid Perl_egid #define error_count Perl_error_count +#define error_no Perl_error_no #define euid Perl_euid #define eval_cond Perl_eval_cond #define eval_mutex Perl_eval_mutex diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c index 422b3d1bf9..f7c630aacf 100644 --- a/ext/DynaLoader/dlutils.c +++ b/ext/DynaLoader/dlutils.c @@ -26,7 +26,7 @@ static int dl_debug = 0; /* value copied from $DynaLoader::dl_error */ static void -dl_generic_private_init(void) /* called by dl_*.xs dl_private_init() */ +dl_generic_private_init(CPERLarg) /* called by dl_*.xs dl_private_init() */ { char *perl_dl_nonlazy; #ifdef DEBUGGING @@ -45,7 +45,7 @@ dl_generic_private_init(void) /* called by dl_*.xs dl_private_init() */ /* SaveError() takes printf style args and saves the result in LastError */ static void -SaveError(char* pat, ...) +SaveError(CPERLarg_ char* pat, ...) { va_list args; char *message; diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs index b9e4c87200..559d3843ff 100644 --- a/ext/Opcode/Opcode.xs +++ b/ext/Opcode/Opcode.xs @@ -201,8 +201,13 @@ opmask_addlocal(SV *opset, char *op_mask_buf) /* Localise op_mask then opmask_ad { char *orig_op_mask = op_mask; SAVEPPTR(op_mask); +#if !(defined(PERL_OBJECT) && defined(__BORLANDC__)) + /* XXX casting to an ordinary function ptr from a member function ptr + * is disallowed by Borland + */ if (opcode_debug >= 2) - SAVEDESTRUCTOR((void(*)_((void*)))warn,"op_mask restored"); + SAVEDESTRUCTOR((void(CPERLscope(*))_((void*)))warn,"op_mask restored"); +#endif op_mask = &op_mask_buf[0]; if (orig_op_mask) Copy(orig_op_mask, op_mask, maxo, char); @@ -226,8 +231,8 @@ BOOT: void -_safe_call_sv(package, mask, codesv) - char * package +_safe_call_sv(Package, mask, codesv) + char * Package SV * mask SV * codesv PPCODE: @@ -243,7 +248,7 @@ _safe_call_sv(package, mask, codesv) save_hptr(&defstash); /* save current default stack */ /* the assignment to global defstash changes our sense of 'main' */ - defstash = gv_stashpv(package, GV_ADDWARN); /* should exist already */ + defstash = gv_stashpv(Package, GV_ADDWARN); /* should exist already */ /* defstash must itself contain a main:: so we'll add that now */ /* take care with the ref counts (was cause of long standing bug) */ diff --git a/global.sym b/global.sym index 43a223ebd7..28080ce035 100644 --- a/global.sym +++ b/global.sym @@ -427,7 +427,7 @@ mg_copy mg_find mg_free mg_get -mg_len +mg_length mg_magical mg_set mg_size @@ -1,2 +1,1499 @@ #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; + chopset = " \n-"; +#ifdef USE_THREADS + threadsv_names = THREADSV_NAMES; + tmps_ix = -1; + tmps_floor = -1; +#endif + maxo = MAXO; + sh_path = SH_PATH; + runops = FUNC_NAME_TO_PTR(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; + generation = 100; + +#ifdef WIN32 + New(2904, environ, 1, char*); + *environ = NULL; +#endif +} + +#ifdef WIN32 +bool +do_exec(char *cmd) +{ + return PerlProc_Cmd(cmd); +} + +int +do_aspawn(void *vreally, void **vmark, void **vsp) +{ + return PerlProc_aspawn(vreally, vmark, vsp); +} +#endif /* WIN32 */ + +#endif /* PERL_OBJECT */ @@ -104,7 +104,7 @@ gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi) GvMULTI_on(gv); } -static void +STATIC void gv_init_sv(GV *gv, I32 sv_type) { switch (sv_type) { @@ -1145,15 +1145,19 @@ amagic_call(SV *left, SV *right, int method, int flags) break; case copy_amg: { - SV* ref=SvRV(left); - if (!SvROK(ref) && SvTYPE(ref) <= SVt_PVMG) { + /* + * SV* ref causes confusion with the interpreter variable of + * the same name + */ + SV* tmpRef=SvRV(left); + if (!SvROK(tmpRef) && SvTYPE(tmpRef) <= SVt_PVMG) { /* * Just to be extra cautious. Maybe in some * additional cases sv_setsv is safe, too. */ - SV* newref = newSVsv(ref); + SV* newref = newSVsv(tmpRef); SvOBJECT_on(newref); - SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(ref)); + SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(tmpRef)); return newref; } } @@ -1323,7 +1327,7 @@ amagic_call(SV *left, SV *right, int method, int flags) PUTBACK; if (op = pp_entersub(ARGS)) - runops(); + CALLRUNOPS(); LEAVE; SPAGAIN; @@ -14,12 +14,14 @@ #include "EXTERN.h" #include "perl.h" +static void hv_magic_check _((HV *hv, bool *needs_copy, bool *needs_store)); +#ifndef PERL_OBJECT static void hsplit _((HV *hv)); static void hfreeentries _((HV *hv)); -static void hv_magic_check _((HV *hv, bool *needs_copy, bool *needs_store)); static HE* more_he _((void)); +#endif -static HE* +STATIC HE* new_he(void) { HE* he; @@ -31,14 +33,14 @@ new_he(void) return more_he(); } -static void +STATIC void del_he(HE *p) { HeNEXT(p) = (HE*)he_root; he_root = p; } -static HE* +STATIC HE* more_he(void) { register HE* he; @@ -54,7 +56,7 @@ more_he(void) return new_he(); } -static HEK * +STATIC HEK * save_hek(char *str, I32 len, U32 hash) { char *k; @@ -140,7 +142,7 @@ hv_fetch(HV *hv, char *key, U32 klen, I32 lval) if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) { char *gotenv; - if ((gotenv = ENV_getenv(key)) != Nullch) { + if ((gotenv = PerlEnv_getenv(key)) != Nullch) { sv = newSVpv(gotenv,strlen(gotenv)); SvTAINTED_on(sv); return hv_store(hv,key,klen,sv,hash); @@ -231,7 +233,7 @@ hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash) if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) { char *gotenv; - if ((gotenv = ENV_getenv(key)) != Nullch) { + if ((gotenv = PerlEnv_getenv(key)) != Nullch) { sv = newSVpv(gotenv,strlen(gotenv)); SvTAINTED_on(sv); return hv_store_ent(hv,keysv,sv,hash); @@ -656,7 +658,7 @@ hv_exists_ent(HV *hv, SV *keysv, U32 hash) return FALSE; } -static void +STATIC void hsplit(HV *hv) { register XPVHV* xhv = (XPVHV*)SvANY(hv); @@ -891,7 +893,7 @@ hv_clear(HV *hv) mg_clear((SV*)hv); } -static void +STATIC void hfreeentries(HV *hv) { register HE **array; diff --git a/installperl b/installperl index fe168c9217..07be34188f 100755 --- a/installperl +++ b/installperl @@ -108,13 +108,16 @@ if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; } if ($^O eq 'MSWin32') { --f 'perl.' . $dlext || die "No perl DLL built\n"; +$perldll = 'perl.' . $dlext; +$perldll = 'perlcore.' . $dlext if $Config{'ccflags'} =~ /PERL_OBJECT/i; + +-f $perldll || die "No perl DLL built\n"; # Install the DLL -safe_unlink("$installbin/perl.$dlext"); -copy("perl.$dlext", "$installbin/perl.$dlext"); -chmod(0755, "$installbin/perl.$dlext"); +safe_unlink("$installbin/$perldll"); +copy("$perldll", "$installbin/$perldll"); +chmod(0755, "$installbin/$perldll"); } # This will be used to store the packlist diff --git a/interp.sym b/interp.sym index 3e06da36ed..b715d1c37c 100644 --- a/interp.sym +++ b/interp.sym @@ -1,5 +1,6 @@ Argv Cmd +DBcv DBgv DBline DBsignal @@ -7,13 +8,17 @@ DBsingle DBsub DBtrace ampergv +archpat_auto argvgv argvoutgv basetime beginav bodytarget +bostr cddir chopset +colors +colorset copline curcop curcopdb @@ -44,20 +49,25 @@ envgv errgv eval_root eval_start +extralen fdpid filemode firstgv forkprocess formfeed formtarget +generation gensym globalstash +in_clean_all +in_clean_objs in_eval incgv initav inplace last_in_gv lastfd +lastgotoprobe lastscream lastsize lastspbase @@ -65,6 +75,7 @@ laststatval laststype leftgv lineary +linestart localizing localpatches main_cv @@ -80,6 +91,7 @@ minus_c minus_l minus_n minus_p +modcount multiline mystrk nrs @@ -96,22 +108,54 @@ ors orslen parsehook patchlevel +pending_ident perldb perl_destruct_level preambled preambleav preprocess +reg_eval_set +reg_flags +reg_start_tmp +reg_start_tmpl +regbol +regcc +regcode +regdata +regdummy +regendp +regeol +regflags +regindent +reginput +reglastparen +regnarrate +regnaughty +regnpar +regparse +regprecomp +regprev +regprogram +regsawback +regseen +regsize +regstartp +regtill +regxend restartop rightgv rs +rx sawampersand sawstudy sawvec screamfirst screamnext secondgv +seen_zerolen siggv sortcop +sortcxix sortstash splitstr start_env @@ -123,6 +167,7 @@ statusvalue_vms stdingv strchop strtab +sublex_info sv_count sv_objcount sv_root diff --git a/intrpvar.h b/intrpvar.h index 59f7e098db..ad9bb81bf3 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -152,7 +152,77 @@ PERLVAR(Iors, char *) /* $\ */ PERLVAR(Iorslen, STRLEN) PERLVAR(Iofmt, char *) /* $# */ +/* more statics moved here */ +PERLVAR(Imh, HE) /* from hv.c */ +PERLVAR(Imodcount, I32) /* from op.c */ +PERLVARI(Igeneration, int, 100) /* from op.c */ +PERLVAR(IDBcv, CV *) /* from perl.c */ +PERLVAR(Iarchpat_auto, char*) /* from perl.c */ +PERLVAR(Isortcxix, I32) /* from pp_ctl.c */ +PERLVAR(Ilastgotoprobe, OP*) /* from pp_ctl.c */ +PERLVAR(Iregdummy, regnode) /* from regcomp.c */ +PERLVAR(Iregparse, char*) /* Input-scan pointer. */ +PERLVAR(Iregxend, char*) /* End of input for compile */ +PERLVAR(Iregcode, regnode*) /* Code-emit pointer; ®dummy = don't. */ +PERLVAR(Iregnaughty, I32) /* How bad is this pattern? */ +PERLVAR(Iregsawback, I32) /* Did we see \1, ...? */ + +/* This guys appear both in regcomp.c and regexec.c, */ +PERLVAR(Iregprecomp, char *) /* uncompiled string. */ +PERLVAR(Iregnpar, I32) /* () count. */ +PERLVAR(Iregsize, I32) /* Code size. */ +PERLVAR(Iregflags, U16) /* are we folding, multilining? */ + +PERLVAR(Iregseen, U32) /* from regcomp.c */ +PERLVAR(Iseen_zerolen, I32) /* from regcomp.c */ +PERLVAR(Irx, regexp *) /* from regcomp.c */ +PERLVAR(Iextralen, I32) /* from regcomp.c */ +#ifdef DEBUGGING +PERLVAR(Icolorset, int) /* from regcomp.c */ +PERLVAR(Icolors[4], char *) /* from regcomp.c */ +#endif + +PERLVAR(Ireginput, char *) /* String-input pointer. */ +PERLVAR(Iregbol, char *) /* Beginning of input, for ^ check. */ +PERLVAR(Iregeol, char *) /* End of input, for $ check. */ +PERLVAR(Iregstartp, char **) /* Pointer to startp array. */ +PERLVAR(Iregendp, char **) /* Ditto for endp. */ +PERLVAR(Ireglastparen, U32 *) /* Similarly for lastparen. */ +PERLVAR(Iregtill, char *) /* How far we are required to go. */ +PERLVAR(Iregprev, char) /* char before regbol, \n if none */ + +PERLVAR(Ireg_start_tmp, char **) /* from regexec.c */ +PERLVAR(Ireg_start_tmpl,U32) /* from regexec.c */ +PERLVAR(Iregdata, struct reg_data *) /* from regexec.c renamed was data */ +PERLVAR(Ibostr, char *) /* from regexec.c */ +PERLVAR(Ireg_flags, U32) /* from regexec.c */ +PERLVAR(Ireg_eval_set, I32) /* from regexec.c */ + +#ifdef DEBUGGING +PERLVAR(Iregnarrate, I32) /* from regexec.c */ +PERLVAR(Iregprogram, regnode *) /* from regexec.c */ +PERLVARI(Iregindent, int, 0) /* from regexec.c */ +#endif + +PERLVAR(Iregcc, CURCUR *) /* from regexec.c */ +PERLVARI(Iin_clean_objs,bool, FALSE) /* from sv.c */ +PERLVARI(Iin_clean_all, bool, FALSE) /* from sv.c */ + +PERLVAR(Ilinestart, char *) /* beg. of most recently read line */ +PERLVAR(Ipending_ident, char) /* pending identifier lookup */ +PERLVAR(Isublex_info, SUBLEXINFO) /* from toke.c */ + #ifdef USE_THREADS PERLVAR(Ithrsv, SV *) /* holds struct perl_thread for main thread */ PERLVARI(Ithreadnum, U32, 0) /* incremented each thread creation */ #endif /* USE_THREADS */ + +#ifdef PERL_OBJECT +PERLVARI(piMem, IPerlMem*, NULL) +PERLVARI(piENV, IPerlEnv*, NULL) +PERLVARI(piStdIO, IPerlStdIO*, NULL) +PERLVARI(piLIO, IPerlLIO*, NULL) +PERLVARI(piDir, IPerlDir*, NULL) +PERLVARI(piSock, IPerlSock*, NULL) +PERLVARI(piProc, IPerlProc*, NULL) +#endif diff --git a/ipdir.h b/ipdir.h new file mode 100644 index 0000000000..d5c2c2f9ad --- /dev/null +++ b/ipdir.h @@ -0,0 +1,26 @@ +/* + + ipdir.h + Interface for perl directory functions + +*/ + +#ifndef __Inc__IPerlDir___ +#define __Inc__IPerlDir___ + +class IPerlDir +{ +public: + virtual int Makedir(const char *dirname, int mode, int &err) = 0; + virtual int Chdir(const char *dirname, int &err) = 0; + virtual int Rmdir(const char *dirname, int &err) = 0; + virtual int Close(DIR *dirp, int &err) = 0; + virtual DIR *Open(char *filename, int &err) = 0; + virtual struct direct *Read(DIR *dirp, int &err) = 0; + virtual void Rewind(DIR *dirp, int &err) = 0; + virtual void Seek(DIR *dirp, long loc, int &err) = 0; + virtual long Tell(DIR *dirp, int &err) = 0; +}; + +#endif /* __Inc__IPerlDir___ */ + diff --git a/ipenv.h b/ipenv.h new file mode 100644 index 0000000000..30acffbeb8 --- /dev/null +++ b/ipenv.h @@ -0,0 +1,21 @@ +/* + + 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 *patchlevel) =0; + virtual char* SiteLibPath(char *patchlevel) =0; +}; + +#endif /* __Inc__IPerlEnv___ */ + diff --git a/iplio.h b/iplio.h new file mode 100644 index 0000000000..0c5455f116 --- /dev/null +++ b/iplio.h @@ -0,0 +1,41 @@ +/* + + 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 Chown(const char *filename, uid_t owner, gid_t group, 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 FileStat(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 NameStat(const char *path, struct stat *buffer, int &err) = 0; + virtual char *Tmpnam(char *string, int &err) = 0; + virtual int Umask(int pmode, int &err) = 0; + virtual int Unlink(const char *filename, int &err) = 0; + virtual int Utime(char *filename, struct utimbuf *times, int &err) = 0; + virtual int Write(int handle, const void *buffer, unsigned int count, int &err) = 0; +}; + +#endif /* __Inc__IPerlLIO___ */ diff --git a/ipmem.h b/ipmem.h new file mode 100644 index 0000000000..0554cf5f95 --- /dev/null +++ b/ipmem.h @@ -0,0 +1,20 @@ +/* + + ipmem.h + Interface for perl memory allocation + +*/ + +#ifndef __Inc__IPerlMem___ +#define __Inc__IPerlMem___ + +class IPerlMem +{ +public: + virtual void* Malloc(size_t) = 0; + virtual void* Realloc(void*, size_t) = 0; + virtual void Free(void*) = 0; +}; + +#endif /* __Inc__IPerlMem___ */ + diff --git a/ipproc.h b/ipproc.h new file mode 100644 index 0000000000..80e5da41dd --- /dev/null +++ b/ipproc.h @@ -0,0 +1,55 @@ +/* + + ipproc.h + Interface for perl process functions + +*/ + +#ifndef __Inc__IPerlProc___ +#define __Inc__IPerlProc___ + +#ifndef Sighandler_t +typedef Signal_t (*Sighandler_t) _((int)); +#endif +#ifndef jmp_buf +#include <setjmp.h> +#endif + +class IPerlProc +{ +public: + virtual void Abort(void) = 0; + virtual void Exit(int status) = 0; + virtual void _Exit(int status) = 0; + virtual int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3) = 0; + virtual int Execv(const char *cmdname, const char *const *argv) = 0; + virtual int Execvp(const char *cmdname, const char *const *argv) = 0; + virtual uid_t Getuid(void) = 0; + virtual uid_t Geteuid(void) = 0; + virtual gid_t Getgid(void) = 0; + virtual gid_t Getegid(void) = 0; + virtual char *Getlogin(void) = 0; + virtual int Kill(int pid, int sig) = 0; + virtual int Killpg(int pid, int sig) = 0; + virtual int PauseProc(void) = 0; + virtual PerlIO* Popen(const char *command, const char *mode) = 0; + virtual int Pclose(PerlIO *stream) = 0; + virtual int Pipe(int *phandles) = 0; + virtual int Setuid(uid_t uid) = 0; + virtual int Setgid(gid_t gid) = 0; + virtual int Sleep(unsigned int) = 0; + virtual int Times(struct tms *timebuf) = 0; + virtual int Wait(int *status) = 0; + virtual Sighandler_t Signal(int sig, Sighandler_t subcode) = 0; +#ifdef WIN32 + virtual void GetSysMsg(char*& msg, DWORD& dwLen, DWORD dwErr) = 0; + virtual void FreeBuf(char* msg) = 0; + virtual BOOL DoCmd(char *cmd) = 0; + virtual int Spawn(char*cmds) = 0; + virtual int Spawnvp(int mode, const char *cmdname, const char *const *argv) = 0; + virtual int ASpawn(void *vreally, void **vmark, void **vsp) = 0; +#endif +}; + +#endif /* __Inc__IPerlProc___ */ + diff --git a/ipsock.h b/ipsock.h new file mode 100644 index 0000000000..152eb2d2f1 --- /dev/null +++ b/ipsock.h @@ -0,0 +1,59 @@ +/* + + ipsock.h + Interface for perl socket functions + +*/ + +#ifndef __Inc__IPerlSock___ +#define __Inc__IPerlSock___ + +class IPerlSock +{ +public: + virtual u_long Htonl(u_long hostlong) = 0; + virtual u_short Htons(u_short hostshort) = 0; + virtual u_long Ntohl(u_long netlong) = 0; + virtual u_short Ntohs(u_short netshort) = 0; + virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err) = 0; + virtual int Bind(SOCKET s, const struct sockaddr* name, int namelen, int &err) = 0; + virtual int Connect(SOCKET s, const struct sockaddr* name, int namelen, int &err) = 0; + virtual void Endhostent(int &err) = 0; + virtual void Endnetent(int &err) = 0; + virtual void Endprotoent(int &err) = 0; + virtual void Endservent(int &err) = 0; + virtual struct hostent* Gethostbyaddr(const char* addr, int len, int type, int &err) = 0; + virtual struct hostent* Gethostbyname(const char* name, int &err) = 0; + virtual struct hostent* Gethostent(int &err) = 0; + virtual int Gethostname(char* name, int namelen, int &err) = 0; + virtual struct netent *Getnetbyaddr(long net, int type, int &err) = 0; + virtual struct netent *Getnetbyname(const char *, int &err) = 0; + virtual struct netent *Getnetent(int &err) = 0; + virtual int Getpeername(SOCKET s, struct sockaddr* name, int* namelen, int &err) = 0; + virtual struct protoent* Getprotobyname(const char* name, int &err) = 0; + virtual struct protoent* Getprotobynumber(int number, int &err) = 0; + virtual struct protoent* Getprotoent(int &err) = 0; + virtual struct servent* Getservbyname(const char* name, const char* proto, int &err) = 0; + virtual struct servent* Getservbyport(int port, const char* proto, int &err) = 0; + virtual struct servent* Getservent(int &err) = 0; + virtual int Getsockname(SOCKET s, struct sockaddr* name, int* namelen, int &err) = 0; + virtual int Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err) = 0; + virtual unsigned long InetAddr(const char* cp, int &err) = 0; + virtual char* InetNtoa(struct in_addr in, int &err) = 0; + virtual int Listen(SOCKET s, int backlog, int &err) = 0; + virtual int Recvfrom(SOCKET s, char* buf, int len, int flags, struct sockaddr* from, int* fromlen, int &err) = 0; + virtual int Select(int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout, int &err) = 0; + virtual int Send(SOCKET s, const char* buf, int len, int flags, int &err) = 0; + virtual int Sendto(SOCKET s, const char* buf, int len, int flags, const struct sockaddr* to, int tolen, int &err) = 0; + virtual void Sethostent(int stayopen, int &err) = 0; + virtual void Setnetent(int stayopen, int &err) = 0; + virtual void Setprotoent(int stayopen, int &err) = 0; + virtual void Setservent(int stayopen, int &err) = 0; + virtual int Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err) = 0; + virtual int Shutdown(SOCKET s, int how, int &err) = 0; + virtual SOCKET Socket(int af, int type, int protocol, int &err) = 0; + virtual int Socketpair(int domain, int type, int protocol, int* fds, int &err) = 0; +}; + +#endif /* __Inc__IPerlSock___ */ + diff --git a/ipstdio.h b/ipstdio.h new file mode 100644 index 0000000000..e49f1be293 --- /dev/null +++ b/ipstdio.h @@ -0,0 +1,58 @@ +/* + + 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 PerlIO* Reopen(const char*, const char*, PerlIO*, 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 SetBuf(PerlIO *, char*, int &err) = 0; + virtual int SetVBuf(PerlIO *, char*, int, 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___ */ + diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index 8e61fe0703..92a46426da 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -208,6 +208,7 @@ sub ExtUtils::MM_Unix::pm_to_blib ; sub ExtUtils::MM_Unix::post_constants ; sub ExtUtils::MM_Unix::post_initialize ; sub ExtUtils::MM_Unix::postamble ; +sub ExtUtils::MM_Unix::ppd ; sub ExtUtils::MM_Unix::prefixify ; sub ExtUtils::MM_Unix::processPL ; sub ExtUtils::MM_Unix::realclean ; @@ -2561,6 +2562,45 @@ sub parse_version { return $result; } +=item parse_abstract + +parse a file and return what you think is the ABSTRACT + +=cut + +sub parse_abstract { + my($self,$parsefile) = @_; + my $result; + local *FH; + local $/ = "\n"; + open(FH,$parsefile) or die "Could not open '$parsefile': $!"; + my $inpod = 0; + my $package = $self->{DISTNAME}; + $package =~ s/-/::/; + while (<FH>) { + $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; + next if !$inpod; + chop; + next unless /^($package\s-\s)(.*)/; + $result = $2; +# my $eval = qq{ +# package ExtUtils::MakeMaker::_version; +# no strict; +# +# local $1$2; +# \$$2=undef; do { +# $_ +# }; \$$2 +# }; +# local($^W) = 0; +# $result = eval($eval); +# die "Could not eval '$eval' in $parsefile: $@" if $@; +# $result = "undef" unless defined $result; + last; + } + close FH; + return $result; +} =item pasthru (o) @@ -2660,6 +2700,49 @@ $(OBJECT) : $(PERL_HDRS) join "\n", @m; } +=item ppd + +Defines target that creates a PPD (Perl Package Description) file +for a binary distribution. + +=cut + +sub ppd { + my($self) = @_; + my(@m); + if ($self->{ABSTRACT_FROM}){ + $self->{ABSTRACT} = $self->parse_abstract($self->{ABSTRACT_FROM}) or + Carp::carp "WARNING: Setting ABSTRACT via file '$self->{ABSTRACT_FROM}' failed\n" + } + my ($pack_ver) = join ",", (split (/\./, $self->{VERSION}), (0) x 4) [0 .. 3]; + push(@m, "# Creates a PPD (Perl Package Description) for a binary distribution.\n"); + push(@m, "ppd:\n"); + push(@m, "\t\@\$(PERL) -e \"print qq{<SOFTPKG NAME=\\\"$self->{DISTNAME}\\\" VERSION=\\\"$pack_ver\\\">\\n}"); + push(@m, ". qq{\\t<TITLE>$self->{DISTNAME}</TITLE>\\n}"); + my $abstract = $self->{ABSTRACT}; + $abstract =~ s/</</g; + $abstract =~ s/>/>/g; + push(@m, ". qq{\\t<ABSTRACT>$abstract</ABSTRACT>\\n}"); + my ($author) = $self->{AUTHOR}; + $author =~ s/@/\\@/g; + push(@m, ". qq{\\t<AUTHOR>$author</AUTHOR>\\n}"); + push(@m, ". qq{\\t<IMPLEMENTATION>\\n}"); + my ($prereq); + foreach $prereq (sort keys %{$self->{PREREQ_PM}}) { + my $pre_req = $prereq; + $pre_req =~ s/::/-/g; + push(@m, ". qq{\\t\\t<DEPENDENCY NAME=\\\"$pre_req\\\" />\\n}"); + } + push(@m, ". qq{\\t\\t<OS NAME=\\\"\$(OSNAME)\\\" />\\n}"); + my ($bin_location) = $self->{BINARY_LOCATION}; + $bin_location =~ s/\\/\\\\/g; + push(@m, ". qq{\\t\\t<CODEBASE HREF=\\\"$bin_location\\\" />\\n}"); + push(@m, ". qq{\\t</IMPLEMENTATION>\\n}"); + push(@m, ". qq{</SOFTPKG>\\n}\" > $self->{DISTNAME}.ppd"); + + join("", @m); +} + =item pm_to_blib Defines target that copies all files in the hash PM to their diff --git a/lib/ExtUtils/MM_Win32.pm b/lib/ExtUtils/MM_Win32.pm index 101f76ada1..d6dfe4a613 100644 --- a/lib/ExtUtils/MM_Win32.pm +++ b/lib/ExtUtils/MM_Win32.pm @@ -33,6 +33,7 @@ $BORLAND = 1 if $Config{'cc'} =~ /^bcc/i; $GCC = 1 if $Config{'cc'} =~ /^gcc/i; $DMAKE = 1 if $Config{'make'} =~ /^dmake/i; $NMAKE = 1 if $Config{'make'} =~ /^nmake/i; +$OBJ = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i; sub dlsyms { my($self,%attribs) = @_; @@ -163,7 +164,8 @@ sub init_others $self->{'LDLOADLIBS'} ||= ( $BORLAND ? 'import32.lib cw32mti.lib ' - : 'msvcrt.lib oldnames.lib kernel32.lib comdlg32.lib winspool.lib gdi32.lib ' + : ( $OBJ ? '' : 'msvcrt.lib ' ) + .'oldnames.lib kernel32.lib comdlg32.lib winspool.lib gdi32.lib ' .'advapi32.lib user32.lib shell32.lib netapi32.lib ole32.lib ' .'oleaut32.lib uuid.lib wsock32.lib mpr.lib winmm.lib version.lib ' ) . ' odbc32.lib odbccp32.lib'; @@ -447,7 +449,10 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)\.exists sub perl_archive { - return '$(PERL_INC)\perl$(LIB_EXT)'; + if($OBJ) { + return '$(PERL_INC)\perlcore$(LIB_EXT)'; + } + return '$(PERL_INC)\perl$(LIB_EXT)'; } sub export_list diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index f3b843f6f2..c86486ac1a 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -235,6 +235,7 @@ sub full_setup { @Attrib_help = qw/ + AUTHOR ABSTRACT ABSTRACT_FROM BINARY_LOCATION LICENSE_HREF C CCFLAGS CONFIG CONFIGURE DEFINE DIR DISTNAME DL_FUNCS DL_VARS EXE_FILES EXCLUDE_EXT INCLUDE_EXT NO_VC FIRST_MAKEFILE FULLPERL H INC INSTALLARCHLIB INSTALLBIN INSTALLDIRS INSTALLMAN1DIR @@ -278,7 +279,7 @@ sub full_setup { c_o xs_c xs_o top_targets linkext dlsyms dynamic dynamic_bs dynamic_lib static static_lib manifypods processPL installbin subdirs clean realclean dist_basics dist_core dist_dir dist_test dist_ci - install force perldepend makefile staticmake test + install force perldepend makefile staticmake test ppd ); # loses section ordering @@ -307,7 +308,7 @@ sub full_setup { @Get_from_Config = qw( ar cc cccdlflags ccdlflags dlext dlsrc ld lddlflags ldflags libc - lib_ext obj_ext ranlib sitelibexp sitearchexp so exe_ext + lib_ext obj_ext osname osvers ranlib sitelibexp sitearchexp so exe_ext ); my $item; @@ -381,8 +382,9 @@ sub ExtUtils::MakeMaker::new { eval $eval; if ($@){ warn "Warning: prerequisite $prereq $self->{PREREQ_PM}->{$prereq} not found"; - } else { - delete $self->{PREREQ_PM}{$prereq}; +# mjn +# } else { +# delete $self->{PREREQ_PM}{$prereq}; } } # if (@unsatisfied){ diff --git a/lib/ExtUtils/Mksymlists.pm b/lib/ExtUtils/Mksymlists.pm index 4ec091d562..4ac175af5e 100644 --- a/lib/ExtUtils/Mksymlists.pm +++ b/lib/ExtUtils/Mksymlists.pm @@ -109,8 +109,10 @@ sub _write_win32 { # put library name in quotes (it could be a keyword, like 'Alias') if ($Config::Config{'cc'} !~ /^gcc/i) { print DEF "LIBRARY \"$data->{DLBASE}\"\n"; - print DEF "CODE LOADONCALL\n"; - print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n"; + if ($Config{'ccflags'} !~ /PERL_OBJECT/i) { + print DEF "CODE LOADONCALL\n"; + print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n"; + } } print DEF "EXPORTS\n "; my @syms; diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp index b8ec042b41..58b3a08705 100755 --- a/lib/ExtUtils/xsubpp +++ b/lib/ExtUtils/xsubpp @@ -83,6 +83,8 @@ require 5.002; use Cwd; use vars '$cplusplus'; +use Config; + sub Q ; # Global Constants @@ -103,6 +105,8 @@ $FH = 'File0000' ; $usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-s pattern] [-typemap typemap]... file.xs\n"; $proto_re = "[" . quotemeta('\$%&*@;') . "]" ; +# mjn +$OBJ = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i; $except = ""; $WantPrototypes = -1 ; @@ -714,6 +718,10 @@ print("#line 1 \"$filename\"\n") while (<$FH>) { last if ($Module, $Package, $Prefix) = /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/; + + if ($OBJ) { + s/#if(?:def|\s+defined)\s+(\(__cplusplus\)|__cplusplus)/#if defined(__cplusplus) && !defined(PERL_OBJECT)/; + } print $_; } &Exit unless defined $_; @@ -30,6 +30,11 @@ * Use the "DESTRUCTOR" scope cleanup to reinstate magic. */ +#ifdef PERL_OBJECT + +#define VTBL this->*vtbl + +#else struct magic_state { SV* mgs_sv; U32 mgs_flags; @@ -37,8 +42,11 @@ struct magic_state { typedef struct magic_state MGS; static void restore_magic _((void *p)); +#define VTBL *vtbl + +#endif -static void +STATIC void save_magic(MGS *mgs, SV *sv) { assert(SvMAGICAL(sv)); @@ -52,7 +60,7 @@ save_magic(MGS *mgs, SV *sv) SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; } -static void +STATIC void restore_magic(void *p) { MGS* mgs = (MGS*)p; @@ -76,11 +84,11 @@ mg_magical(SV *sv) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; if (vtbl) { - if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP)) + if ((vtbl->svt_get != NULL) && !(mg->mg_flags & MGf_GSKIP)) SvGMAGICAL_on(sv); if (vtbl->svt_set) SvSMAGICAL_on(sv); - if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear) + if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || (vtbl->svt_clear != NULL)) SvRMAGICAL_on(sv); } } @@ -100,8 +108,8 @@ mg_get(SV *sv) mgp = &SvMAGIC(sv); while ((mg = *mgp) != 0) { MGVTBL* vtbl = mg->mg_virtual; - if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) { - (*vtbl->svt_get)(sv, mg); + if (!(mg->mg_flags & MGf_GSKIP) && vtbl && (vtbl->svt_get != NULL)) { + (VTBL->svt_get)(sv, mg); /* Ignore this magic if it's been deleted */ if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) && (mg->mg_flags & MGf_GSKIP)) @@ -137,8 +145,8 @@ mg_set(SV *sv) mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */ mgs.mgs_flags = 0; } - if (vtbl && vtbl->svt_set) - (*vtbl->svt_set)(sv, mg); + if (vtbl && (vtbl->svt_set != NULL)) + (VTBL->svt_set)(sv, mg); } LEAVE; @@ -146,7 +154,7 @@ mg_set(SV *sv) } U32 -mg_len(SV *sv) +mg_length(SV *sv) { MAGIC* mg; char *junk; @@ -154,13 +162,13 @@ mg_len(SV *sv) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; - if (vtbl && vtbl->svt_len) { + if (vtbl && (vtbl->svt_len != NULL)) { MGS mgs; ENTER; save_magic(&mgs, sv); /* omit MGf_GSKIP -- not changed here */ - len = (*vtbl->svt_len)(sv, mg); + len = (VTBL->svt_len)(sv, mg); LEAVE; return len; } @@ -178,11 +186,11 @@ mg_size(SV *sv) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; - if (vtbl && vtbl->svt_len) { + if (vtbl && (vtbl->svt_len != NULL)) { MGS mgs; ENTER; /* omit MGf_GSKIP -- not changed here */ - len = (*vtbl->svt_len)(sv, mg); + len = (VTBL->svt_len)(sv, mg); LEAVE; return len; } @@ -214,8 +222,8 @@ mg_clear(SV *sv) MGVTBL* vtbl = mg->mg_virtual; /* omit GSKIP -- never set here */ - if (vtbl && vtbl->svt_clear) - (*vtbl->svt_clear)(sv, mg); + if (vtbl && (vtbl->svt_clear != NULL)) + (VTBL->svt_clear)(sv, mg); } LEAVE; @@ -255,8 +263,8 @@ mg_free(SV *sv) for (mg = SvMAGIC(sv); mg; mg = moremagic) { MGVTBL* vtbl = mg->mg_virtual; moremagic = mg->mg_moremagic; - if (vtbl && vtbl->svt_free) - (*vtbl->svt_free)(sv, mg); + if (vtbl && (vtbl->svt_free != NULL)) + (VTBL->svt_free)(sv, mg); if (mg->mg_ptr && mg->mg_type != 'g') if (mg->mg_len >= 0) Safefree(mg->mg_ptr); @@ -385,7 +393,17 @@ magic_get(SV *sv, MAGIC *mg) DWORD dwErr = GetLastError(); sv_setnv(sv, (double)dwErr); if (dwErr) + { +#ifdef PERL_OBJECT + char *sMsg; + DWORD dwLen; + PerlProc_GetSysMsg(sMsg, dwLen, dwErr); + sv_setpvn(sv, sMsg, dwLen); + PerlProc_FreeBuf(sMsg); +#else win32_str_os_error(sv, dwErr); +#endif + } else sv_setpv(sv, ""); SetLastError(dwErr); @@ -955,7 +973,7 @@ magic_setnkeys(SV *sv, MAGIC *mg) } /* caller is responsible for stack switching/cleanup */ -static int +STATIC int magic_methcall(MAGIC *mg, char *meth, I32 flags, int n, SV *val) { dSP; @@ -982,7 +1000,7 @@ magic_methcall(MAGIC *mg, char *meth, I32 flags, int n, SV *val) return perl_call_method(meth, flags); } -static int +STATIC int magic_methpack(SV *sv, MAGIC *mg, char *meth) { dSP; @@ -1578,15 +1596,15 @@ magic_set(SV *sv, MAGIC *mg) (void)setresuid((Uid_t)uid, (Uid_t)-1, (Uid_t)-1); #else if (uid == euid) /* special case $< = $> */ - (void)setuid(uid); + (void)PerlProc_setuid(uid); else { - uid = (I32)getuid(); + uid = (I32)PerlProc_getuid(); croak("setruid() not implemented"); } #endif #endif #endif - uid = (I32)getuid(); + uid = (I32)PerlProc_getuid(); tainting |= (uid && (euid != uid || egid != gid)); break; case '>': @@ -1605,15 +1623,15 @@ magic_set(SV *sv, MAGIC *mg) (void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1); #else if (euid == uid) /* special case $> = $< */ - setuid(euid); + PerlProc_setuid(euid); else { - euid = (I32)geteuid(); + euid = (I32)PerlProc_geteuid(); croak("seteuid() not implemented"); } #endif #endif #endif - euid = (I32)geteuid(); + euid = (I32)PerlProc_geteuid(); tainting |= (uid && (euid != uid || egid != gid)); break; case '(': @@ -1632,15 +1650,15 @@ magic_set(SV *sv, MAGIC *mg) (void)setresgid((Gid_t)gid, (Gid_t)-1, (Gid_t) 1); #else if (gid == egid) /* special case $( = $) */ - (void)setgid(gid); + (void)PerlProc_setgid(gid); else { - gid = (I32)getgid(); + gid = (I32)PerlProc_getgid(); croak("setrgid() not implemented"); } #endif #endif #endif - gid = (I32)getgid(); + gid = (I32)PerlProc_getgid(); tainting |= (uid && (euid != uid || egid != gid)); break; case ')': @@ -1682,15 +1700,15 @@ magic_set(SV *sv, MAGIC *mg) (void)setresgid((Gid_t)-1, (Gid_t)egid, (Gid_t)-1); #else if (egid == gid) /* special case $) = $( */ - (void)setgid(egid); + (void)PerlProc_setgid(egid); else { - egid = (I32)getegid(); + egid = (I32)PerlProc_getegid(); croak("setegid() not implemented"); } #endif #endif #endif - egid = (I32)getegid(); + egid = (I32)PerlProc_getegid(); tainting |= (uid && (euid != uid || egid != gid)); break; case ':': @@ -1794,7 +1812,7 @@ whichsig(char *sig) static SV* sig_sv; -static void +STATIC void unwind_handler_stack(void *p) { dTHR; @@ -8,11 +8,11 @@ */ struct mgvtbl { - int (*svt_get) _((SV *sv, MAGIC* mg)); - int (*svt_set) _((SV *sv, MAGIC* mg)); - U32 (*svt_len) _((SV *sv, MAGIC* mg)); - int (*svt_clear) _((SV *sv, MAGIC* mg)); - int (*svt_free) _((SV *sv, MAGIC* mg)); + int (CPERLscope(*svt_get)) _((SV *sv, MAGIC* mg)); + int (CPERLscope(*svt_set)) _((SV *sv, MAGIC* mg)); + U32 (CPERLscope(*svt_len)) _((SV *sv, MAGIC* mg)); + int (CPERLscope(*svt_clear)) _((SV *sv, MAGIC* mg)); + int (CPERLscope(*svt_free)) _((SV *sv, MAGIC* mg)); }; struct magic { diff --git a/objpp.h b/objpp.h new file mode 100644 index 0000000000..3042828a3f --- /dev/null +++ b/objpp.h @@ -0,0 +1,1439 @@ +#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 bset_obj_store +#define bset_obj_store CPerlObj::Perl_bset_obj_store +#undef byterun +#define byterun CPerlObj::Perl_byterun +#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_methcall +#define magic_methcall CPerlObj::magic_methcall +#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_sizepack +#define magic_sizepack CPerlObj::Perl_magic_sizepack +#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_length +#define mg_length CPerlObj::Perl_mg_length +#undef mg_magical +#define mg_magical CPerlObj::Perl_mg_magical +#undef mg_set +#define mg_set CPerlObj::Perl_mg_set +#undef mg_size +#define mg_size CPerlObj::Perl_mg_size +#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_safemalloc +#define my_safemalloc CPerlObj::my_safemalloc +#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 newCONSTSUB +#define newCONSTSUB CPerlObj::Perl_newCONSTSUB +#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 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 newSVpvf +#define newSVpvf CPerlObj::Perl_newSVpvf +#undef newSVpvn +#define newSVpvn CPerlObj::Perl_newSVpvn +#undef newSVrv +#define newSVrv CPerlObj::Perl_newSVrv +#undef newSVsv +#define newSVsv CPerlObj::Perl_newSVsv +#undef newUNOP +#define newUNOP CPerlObj::Perl_newUNOP +#undef newWHILEOP +#define newWHILEOP CPerlObj::Perl_newWHILEOP +#undef new_logop +#define new_logop CPerlObj::new_logop +#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 qsortsv +#define qsortsv CPerlObj::qsortsv +#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_expect +#define restore_expect CPerlObj::restore_expect +#undef restore_lex_expect +#define restore_lex_expect CPerlObj::restore_lex_expect +#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_aelem +#define save_aelem CPerlObj::Perl_save_aelem +#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_helem +#define save_helem CPerlObj::Perl_save_helem +#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 +#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_catpv_mg +#define sv_catpv_mg CPerlObj::Perl_sv_catpv_mg +#undef sv_catpvf +#define sv_catpvf CPerlObj::Perl_sv_catpvf +#undef sv_catpvf_mg +#define sv_catpvf_mg CPerlObj::Perl_sv_catpvf_mg +#undef sv_catpvn +#define sv_catpvn CPerlObj::Perl_sv_catpvn +#undef sv_catpvn_mg +#define sv_catpvn_mg CPerlObj::Perl_sv_catpvn_mg +#undef sv_catsv +#define sv_catsv CPerlObj::Perl_sv_catsv +#undef sv_catsv_mg +#define sv_catsv_mg CPerlObj::Perl_sv_catsv_mg +#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_setiv_mg +#define sv_setiv_mg CPerlObj::Perl_sv_setiv_mg +#undef sv_setnv +#define sv_setnv CPerlObj::Perl_sv_setnv +#undef sv_setnv_mg +#define sv_setnv_mg CPerlObj::Perl_sv_setnv_mg +#undef sv_setuv +#define sv_setuv CPerlObj::Perl_sv_setuv +#undef sv_setuv_mg +#define sv_setuv_mg CPerlObj::Perl_sv_setuv_mg +#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_setpv_mg +#define sv_setpv_mg CPerlObj::Perl_sv_setpv_mg +#undef sv_setpvf +#define sv_setpvf CPerlObj::Perl_sv_setpvf +#undef sv_setpvf_mg +#define sv_setpvf_mg CPerlObj::Perl_sv_setpvf_mg +#undef sv_setpviv +#define sv_setpviv CPerlObj::Perl_sv_setpviv +#undef sv_setpviv_mg +#define sv_setpviv_mg CPerlObj::Perl_sv_setpviv_mg +#undef sv_setpvn +#define sv_setpvn CPerlObj::Perl_sv_setpvn +#undef sv_setpvn_mg +#define sv_setpvn_mg CPerlObj::Perl_sv_setpvn_mg +#undef sv_setsv +#define sv_setsv CPerlObj::Perl_sv_setsv +#undef sv_setsv_mg +#define sv_setsv_mg CPerlObj::Perl_sv_setsv_mg +#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_usepvn_mg +#define sv_usepvn_mg CPerlObj::Perl_sv_usepvn_mg +#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 + +#if defined(WIN32) && !defined(WIN32IO_IS_STDIO) +#undef errno +#define errno CPerlObj::ErrorNo() + +#endif /* WIN32 */ + +#endif /* __Objpp_h__ */ @@ -18,6 +18,12 @@ #include "EXTERN.h" #include "perl.h" +#ifdef PERL_OBJECT +#define CHECKCALL this->*check +#else +#define CHECKCALL *check +#endif + /* * In the following definition, the ", Nullop" is just to make the compiler * think the expression is of the right type: croak actually does a Siglongjmp. @@ -27,13 +33,14 @@ ? ( op_free((OP*)o), \ croak("%s trapped by operation mask", op_desc[type]), \ Nullop ) \ - : (*check[type])((OP*)o)) + : (CHECKCALL[type])((OP*)o)) +static bool scalar_mod_type _((OP *o, I32 type)); +#ifndef PERL_OBJECT static I32 list_assignment _((OP *o)); static void bad_type _((I32 n, char *t, char *name, OP *kid)); static OP *modkids _((OP *o, I32 type)); static OP *no_fh_allowed _((OP *o)); -static bool scalar_mod_type _((OP *o, I32 type)); static OP *scalarboolean _((OP *o)); static OP *too_few_arguments _((OP *o, char* name)); static OP *too_many_arguments _((OP *o, char* name)); @@ -42,8 +49,9 @@ static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)); static OP *newDEFSVOP _((void)); static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp)); +#endif -static char* +STATIC char* gv_ename(GV *gv) { SV* tmpsv = sv_newmortal(); @@ -51,7 +59,7 @@ gv_ename(GV *gv) return SvPV(tmpsv,na); } -static OP * +STATIC OP * no_fh_allowed(OP *o) { yyerror(form("Missing comma after first argument to %s function", @@ -59,21 +67,21 @@ no_fh_allowed(OP *o) return o; } -static OP * +STATIC OP * too_few_arguments(OP *o, char *name) { yyerror(form("Not enough arguments for %s", name)); return o; } -static OP * +STATIC OP * too_many_arguments(OP *o, char *name) { yyerror(form("Too many arguments for %s", name)); return o; } -static void +STATIC void bad_type(I32 n, char *t, char *name, OP *kid) { yyerror(form("Type of arg %d to %s must be %s (not %s)", @@ -157,7 +165,7 @@ pad_allocmy(char *name) return off; } -static PADOFFSET +STATIC PADOFFSET pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) { dTHR; @@ -574,7 +582,8 @@ op_free(OP *o) break; #endif /* USE_THREADS */ default: - if (!(o->op_flags & OPf_REF) || (check[o->op_type] != ck_ftst)) + if (!(o->op_flags & OPf_REF) + || (check[o->op_type] != FUNC_NAME_TO_PTR(ck_ftst))) break; /* FALL THROUGH */ case OP_GVSV: @@ -615,7 +624,7 @@ op_free(OP *o) Safefree(o); } -static void +STATIC void null(OP *o) { if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0) @@ -664,7 +673,7 @@ scalarkids(OP *o) return o; } -static OP * +STATIC OP * scalarboolean(OP *o) { if (dowarn && @@ -1034,7 +1043,7 @@ scalarseq(OP *o) return o; } -static OP * +STATIC OP * modkids(OP *o, I32 type) { OP *kid; @@ -1045,8 +1054,6 @@ modkids(OP *o, I32 type) return o; } -static I32 modcount; - OP * mod(OP *o, I32 type) { @@ -1536,7 +1543,7 @@ block_end(I32 floor, OP *seq) return retval; } -static OP * +STATIC OP * newDEFSVOP(void) { #ifdef USE_THREADS @@ -1670,7 +1677,7 @@ fold_constants(register OP *o) curop = LINKLIST(o); o->op_next = 0; op = curop; - runops(); + CALLRUNOPS(); sv = *(stack_sp--); if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */ pad_swipe(o->op_targ); @@ -1732,7 +1739,7 @@ gen_constant_list(register OP *o) op = curop = LINKLIST(o); o->op_next = 0; pp_pushmark(ARGS); - runops(); + CALLRUNOPS(); op = curop; pp_anonlist(ARGS); tmps_floor = oldtmps_floor; @@ -2369,7 +2376,7 @@ newSLICEOP(I32 flags, OP *subscript, OP *listval) list(force_list(listval)) ); } -static I32 +STATIC I32 list_assignment(register OP *o) { if (!o) @@ -2436,7 +2443,6 @@ newASSIGNOP(I32 flags, OP *left, I32 optype, OP *right) list(force_list(left)) ); o->op_private = 0 | (flags >> 8); if (!(left->op_private & OPpLVAL_INTRO)) { - static int generation = 100; OP *curop; OP *lastop = o; generation++; @@ -2612,7 +2618,7 @@ newLOGOP(I32 type, I32 flags, OP *first, OP *other) return new_logop(type, flags, &first, &other); } -static OP * +STATIC OP * new_logop(I32 type, I32 flags, OP** firstp, OP** otherp) { dTHR; @@ -3061,7 +3067,7 @@ cv_undef(CV *cv) } #ifdef DEBUG_CLOSURES -static void +STATIC void cv_dump(cv) CV* cv; { @@ -3106,7 +3112,7 @@ CV* cv; } #endif /* DEBUG_CLOSURES */ -static CV * +STATIC CV * cv_clone2(CV *proto, CV *outside) { dTHR; @@ -3544,7 +3550,7 @@ newCONSTSUB(HV *stash, char *name, SV *sv) } CV * -newXS(char *name, void (*subaddr) (CV *), char *filename) +newXS(char *name, void (*subaddr) (CPERLproto_ CV *), char *filename) { dTHR; GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV); @@ -35,7 +35,7 @@ typedef U32 PADOFFSET; #define BASEOP \ OP* op_next; \ OP* op_sibling; \ - OP* (*op_ppaddr)_((ARGSproto)); \ + OP* (CPERLscope(*op_ppaddr))_((ARGSproto)); \ PADOFFSET op_targ; \ OPCODE op_type; \ U16 op_seq; \ @@ -1061,6 +1061,7 @@ EXT char *op_desc[] = { }; #endif +#ifndef PERL_OBJECT START_EXTERN_C OP * ck_anoncode _((OP* o)); @@ -1444,11 +1445,13 @@ OP * pp_lock _((ARGSproto)); OP * pp_threadsv _((ARGSproto)); END_EXTERN_C +#endif /* PERL_OBJECT */ #ifndef DOINIT -EXT OP * (*ppaddr[])(ARGSproto); +EXT OP * (CPERLscope(*ppaddr)[])(ARGSproto); #else -EXT OP * (*ppaddr[])(ARGSproto) = { +#ifndef PERL_OBJECT +EXT OP * (CPERLscope(*ppaddr)[])(ARGSproto) = { pp_null, pp_stub, pp_scalar, @@ -1796,12 +1799,14 @@ EXT OP * (*ppaddr[])(ARGSproto) = { pp_lock, pp_threadsv, }; +#endif /* PERL_OBJECT */ #endif -#ifndef DOINIT -EXT OP * (*check[]) _((OP *op)); +#ifndef DOINIT +EXT OP * (CPERLscope(*check)[]) _((OP *op)); #else -EXT OP * (*check[]) _((OP *op)) = { +#ifndef PERL_OBJECT +EXT OP * (CPERLscope(*check)[]) _((OP *op)) = { ck_null, /* null */ ck_null, /* stub */ ck_fun, /* scalar */ @@ -2149,6 +2154,7 @@ EXT OP * (*check[]) _((OP *op)) = { ck_rfun, /* lock */ ck_null, /* threadsv */ }; +#endif /* PERL_OBJECT */ #endif #ifndef DOINIT @@ -69,6 +69,7 @@ dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n"; mess_sv = Nullsv; \ } STMT_END +#ifndef PERL_OBJECT static void find_beginning _((void)); static void forbid_setid _((char *)); static void incpush _((char *, int)); @@ -84,12 +85,22 @@ static void init_postdump_symbols _((int, char **, char **)); static void init_predump_symbols _((void)); static void my_exit_jump _((void)) __attribute__((noreturn)); static void nuke_stacks _((void)); -static void open_script _((char *, bool, SV *)); +static void open_script _((char *, bool, SV *, int *fd)); static void usage _((char *)); -static void validate_suid _((char *, char*)); +static void validate_suid _((char *, char*, int)); +#endif -static int fdscript = -1; +#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) { @@ -99,9 +110,14 @@ perl_alloc(void) New(53, sv_interp, 1, PerlInterpreter); return sv_interp; } +#endif /* PERL_OBJECT */ void +#ifdef PERL_OBJECT +CPerlObj::perl_construct(void) +#else perl_construct(register PerlInterpreter *sv_interp) +#endif { #ifdef USE_THREADS int i; @@ -110,8 +126,10 @@ perl_construct(register PerlInterpreter *sv_interp) #endif /* FAKE_THREADS */ #endif /* USE_THREADS */ +#ifndef PERL_OBJECT if (!(curinterp = sv_interp)) return; +#endif #ifdef MULTIPLICITY Zero(sv_interp, 1, PerlInterpreter); @@ -162,7 +180,12 @@ perl_construct(register PerlInterpreter *sv_interp) nrs = newSVpv("\n", 1); rs = SvREFCNT_inc(nrs); +#ifdef PERL_OBJECT + /* TODO: */ + /* sighandlerp = sighandler; */ +#else sighandlerp = sighandler; +#endif pidstatus = newHV(); #ifdef MSDOS @@ -221,7 +244,11 @@ perl_construct(register PerlInterpreter *sv_interp) } void +#ifdef PERL_OBJECT +CPerlObj::perl_destruct(void) +#else perl_destruct(register PerlInterpreter *sv_interp) +#endif { dTHR; int destruct_level; /* 0=none, 1=full, 2=full with checks */ @@ -231,8 +258,10 @@ perl_destruct(register PerlInterpreter *sv_interp) Thread t; #endif /* USE_THREADS */ +#ifndef PERL_OBJECT if (!(curinterp = sv_interp)) return; +#endif #ifdef USE_THREADS #ifndef FAKE_THREADS @@ -545,15 +574,27 @@ perl_destruct(register PerlInterpreter *sv_interp) } void +#ifdef PERL_OBJECT +CPerlObj::perl_free(void) +#else perl_free(PerlInterpreter *sv_interp) +#endif { +#ifdef PERL_OBJECT + Safefree(this); +#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; @@ -566,6 +607,7 @@ perl_parse(PerlInterpreter *sv_interp, void (*xsinit) (void), int argc, char **a int e_tmpfd = -1; dJMPENV; int ret; + int fdscript = -1; #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW #ifdef IAMSUID @@ -575,8 +617,10 @@ setuid perl scripts securely.\n"); #endif #endif +#ifndef PERL_OBJECT if (!(curinterp = sv_interp)) return 255; +#endif #if defined(NeXT) && defined(__DYNAMIC__) _dyld_lookup_and_bind @@ -879,9 +923,9 @@ print \" \\@INC:\\n @INC\\n\";"); init_perllib(); - open_script(scriptname,dosearch,sv); + open_script(scriptname,dosearch,sv,&fdscript); - validate_suid(validarg, scriptname); + validate_suid(validarg, scriptname,fdscript); if (doextract) find_beginning(); @@ -913,8 +957,9 @@ print \" \\@INC:\\n @INC\\n\";"); CvPADLIST(compcv) = comppadlist; 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 @@ -972,15 +1017,21 @@ print \" \\@INC:\\n @INC\\n\";"); } int +#ifdef PERL_OBJECT +CPerlObj::perl_run(void) +#else perl_run(PerlInterpreter *sv_interp) +#endif { dSP; I32 oldscope; dJMPENV; int ret; +#ifndef PERL_OBJECT if (!(curinterp = sv_interp)) return 255; +#endif oldscope = scopestack_ix; @@ -1040,12 +1091,12 @@ perl_run(PerlInterpreter *sv_interp) if (restartop) { op = restartop; restartop = 0; - runops(); + CALLRUNOPS(); } else if (main_start) { CvDEPTH(main_cv) = 1; op = main_start; - runops(); + CALLRUNOPS(); } my_exit(0); @@ -1163,7 +1214,6 @@ perl_call_sv(SV *sv, I32 flags) I32 oldmark; I32 retval; I32 oldscope; - static CV *DBcv; bool oldcatch = CATCH_GET; dJMPENV; int ret; @@ -1259,7 +1309,7 @@ perl_call_sv(SV *sv, I32 flags) if (op == (OP*)&myop) op = pp_entersub(ARGS); if (op) - runops(); + CALLRUNOPS(); retval = stack_sp - (stack_base + oldmark); if ((flags & G_EVAL) && !(flags & G_KEEPERR)) sv_setpv(ERRSV,""); @@ -1367,7 +1417,7 @@ perl_eval_sv(SV *sv, I32 flags) if (op == (OP*)&myop) op = pp_entereval(ARGS); if (op) - runops(); + CALLRUNOPS(); retval = stack_sp - (stack_base + oldmark); if (!(flags & G_KEEPERR)) sv_setpv(ERRSV,""); @@ -1425,14 +1475,14 @@ magicname(char *sym, char *name, I32 namlen) sv_magic(GvSV(gv), (SV*)gv, 0, name, namlen); } -static void +STATIC void usage(char *name) /* XXX move this out into a module ? */ { /* This message really ought to be max 23 lines. * Removed -h because the user already knows that opton. Others? */ - static char *usage[] = { + static char *usage_msg[] = { "-0[octal] specify record separator (\\0, if no argument)", "-a autosplit mode with -n or -p (splits $_ into @F)", "-c check syntax only (runs BEGIN and END blocks)", @@ -1459,7 +1509,7 @@ usage(char *name) /* XXX move this out into a module ? */ "\n", NULL }; - char **p = usage; + char **p = usage_msg; printf("\nUsage: %s [switches] [--] [programfile] [arguments]", name); while (*p) @@ -1745,7 +1795,7 @@ my_unexec(void) #endif } -static void +STATIC void init_main_stash(void) { dTHR; @@ -1782,8 +1832,8 @@ init_main_stash(void) sv_setpvn(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), "\n", 1); } -static void -open_script(char *scriptname, bool dosearch, SV *sv) +STATIC void +open_script(char *scriptname, bool dosearch, SV *sv, int *fdscript) { dTHR; char *xfound = Nullch; @@ -1984,20 +2034,20 @@ open_script(char *scriptname, bool dosearch, SV *sv) if (strnEQ(scriptname, "/dev/fd/", 8) && isDIGIT(scriptname[8]) ) { char *s = scriptname + 8; - fdscript = atoi(s); + *fdscript = atoi(s); while (isDIGIT(*s)) s++; if (*s) scriptname = s + 1; } else - fdscript = -1; + *fdscript = -1; origfilename = savepv(e_tmpname ? "-e" : scriptname); curcop->cop_filegv = gv_fetchfile(origfilename); if (strEQ(origfilename,"-")) scriptname = ""; - if (fdscript >= 0) { - rsfp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE); + if (*fdscript >= 0) { + rsfp = PerlIO_fdopen(*fdscript,PERL_SCRIPT_MODE); #if defined(HAS_FCNTL) && defined(F_SETFD) if (rsfp) fcntl(PerlIO_fileno(rsfp),F_SETFD,1); /* ensure close-on-exec */ @@ -2064,11 +2114,11 @@ sed %s -e \"/^[^#]/b\" \ #ifdef HAS_SETRESUID (void)setresuid((Uid_t)-1, uid, (Uid_t)-1); #else - setuid(uid); + PerlProc_setuid(uid); #endif #endif #endif - if (geteuid() != uid) + if (PerlProc_geteuid() != uid) croak("Can't do seteuid!\n"); } #endif /* IAMSUID */ @@ -2106,8 +2156,8 @@ sed %s -e \"/^[^#]/b\" \ } } -static void -validate_suid(char *validarg, char *scriptname) +STATIC void +validate_suid(char *validarg, char *scriptname, int fdscript) { int which; @@ -2169,7 +2219,7 @@ validate_suid(char *validarg, char *scriptname) setresuid(euid,uid,(Uid_t)-1) < 0 # endif #endif - || getuid() != euid || geteuid() != uid) + || PerlProc_getuid() != euid || PerlProc_geteuid() != uid) croak("Can't swap uid and euid"); /* really paranoid */ if (PerlLIO_stat(SvPVX(GvSV(curcop->cop_filegv)),&tmpstatbuf) < 0) croak("Permission denied"); /* testing full pathname here */ @@ -2196,7 +2246,7 @@ validate_suid(char *validarg, char *scriptname) setresuid(uid,euid,(Uid_t)-1) < 0 # endif #endif - || getuid() != uid || geteuid() != euid) + || PerlProc_getuid() != uid || PerlProc_geteuid() != euid) croak("Can't reswap uid and euid"); if (!cando(S_IXUSR,FALSE,&statbuf)) /* can real uid exec? */ croak("Permission denied\n"); @@ -2258,11 +2308,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #ifdef HAS_SETRESGID (void)setresgid((Gid_t)-1,statbuf.st_gid,(Gid_t)-1); #else - setgid(statbuf.st_gid); + PerlProc_setgid(statbuf.st_gid); #endif #endif #endif - if (getegid() != statbuf.st_gid) + if (PerlProc_getegid() != statbuf.st_gid) croak("Can't do setegid!\n"); } if (statbuf.st_mode & S_ISUID) { @@ -2276,11 +2326,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #ifdef HAS_SETRESUID (void)setresuid((Uid_t)-1,statbuf.st_uid,(Uid_t)-1); #else - setuid(statbuf.st_uid); + PerlProc_setuid(statbuf.st_uid); #endif #endif #endif - if (geteuid() != statbuf.st_uid) + if (PerlProc_geteuid() != statbuf.st_uid) croak("Can't do seteuid!\n"); } else if (uid) { /* oops, mustn't run as root */ @@ -2293,11 +2343,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #ifdef HAS_SETRESUID (void)setresuid((Uid_t)-1,(Uid_t)uid,(Uid_t)-1); #else - setuid((Uid_t)uid); + PerlProc_setuid((Uid_t)uid); #endif #endif #endif - if (geteuid() != uid) + if (PerlProc_geteuid() != uid) croak("Can't do seteuid!\n"); } init_ids(); @@ -2346,7 +2396,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #endif /* DOSUID */ } -static void +STATIC void find_beginning(void) { register char *s, *s2; @@ -2375,13 +2425,13 @@ find_beginning(void) } } -static void +STATIC void init_ids(void) { - uid = (int)getuid(); - euid = (int)geteuid(); - gid = (int)getgid(); - egid = (int)getegid(); + uid = (int)PerlProc_getuid(); + euid = (int)PerlProc_geteuid(); + gid = (int)PerlProc_getgid(); + egid = (int)PerlProc_getegid(); #ifdef VMS uid |= gid << 16; euid |= egid << 16; @@ -2389,7 +2439,7 @@ init_ids(void) tainting |= (uid && (euid != uid || egid != gid)); } -static void +STATIC void forbid_setid(char *s) { if (euid != uid) @@ -2398,7 +2448,7 @@ forbid_setid(char *s) croak("No %s allowed while running setgid", s); } -static void +STATIC void init_debugger(void) { dTHR; @@ -2484,7 +2534,7 @@ init_stacks(ARGSproto) #undef REASONABLE -static void +STATIC void nuke_stacks(void) { dTHR; @@ -2504,11 +2554,16 @@ nuke_stacks(void) } ) } +#ifndef PERL_OBJECT static PerlIO *tmpfp; /* moved outside init_lexer() because of UNICOS bug */ +#endif -static void +STATIC void init_lexer(void) { +#ifdef PERL_OBJECT + PerlIO *tmpfp; +#endif tmpfp = rsfp; rsfp = Nullfp; lex_start(linestr); @@ -2516,7 +2571,7 @@ init_lexer(void) subname = newSVpv("main",4); } -static void +STATIC void init_predump_symbols(void) { dTHR; @@ -2552,7 +2607,7 @@ init_predump_symbols(void) osname = savepv(OSNAME); } -static void +STATIC void init_postdump_symbols(register int argc, register char **argv, register char **env) { dTHR; @@ -2640,7 +2695,7 @@ init_postdump_symbols(register int argc, register char **argv, register char **e sv_setiv(GvSV(tmpgv), (IV)getpid()); } -static void +STATIC void init_perllib(void) { char *s; @@ -2678,14 +2733,22 @@ init_perllib(void) #ifndef PRIVLIB_EXP #define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl" #endif +#if defined(WIN32) + incpush(PRIVLIB_EXP, TRUE); +#else incpush(PRIVLIB_EXP, FALSE); +#endif #ifdef SITEARCH_EXP incpush(SITEARCH_EXP, FALSE); #endif #ifdef SITELIB_EXP +#if defined(WIN32) + incpush(SITELIB_EXP, TRUE); +#else incpush(SITELIB_EXP, FALSE); #endif +#endif if (!tainting) incpush(".", FALSE); } @@ -2703,11 +2766,10 @@ init_perllib(void) # define PERLLIB_MANGLE(s,n) (s) #endif -static void +STATIC void incpush(char *p, int addsubdirs) { SV *subdir = Nullsv; - static char *archpat_auto; if (!p) return; @@ -2794,7 +2856,7 @@ incpush(char *p, int addsubdirs) } #ifdef USE_THREADS -static struct perl_thread * +STATIC struct perl_thread * init_main_thread() { struct perl_thread *thr; @@ -2859,7 +2921,7 @@ init_main_thread() #endif /* USE_THREADS */ void -call_list(I32 oldscope, AV *list) +call_list(I32 oldscope, AV *paramList) { dTHR; line_t oldline = curcop->cop_line; @@ -2867,8 +2929,8 @@ call_list(I32 oldscope, AV *list) dJMPENV; int ret; - while (AvFILL(list) >= 0) { - CV *cv = (CV*)av_shift(list); + while (AvFILL(paramList) >= 0) { + CV *cv = (CV*)av_shift(paramList); SAVEFREESV(cv); @@ -2883,7 +2945,7 @@ call_list(I32 oldscope, AV *list) JMPENV_POP; curcop = &compiling; curcop->cop_line = oldline; - if (list == beginav) + if (paramList == beginav) sv_catpv(atsv, "BEGIN failed--compilation aborted"); else sv_catpv(atsv, "END failed--cleanup aborted"); @@ -2908,7 +2970,7 @@ call_list(I32 oldscope, AV *list) curcop = &compiling; curcop->cop_line = oldline; if (statusvalue) { - if (list == beginav) + if (paramList == beginav) croak("BEGIN failed--compilation aborted"); else croak("END failed--cleanup aborted"); @@ -2976,7 +3038,7 @@ my_failure_exit(void) my_exit_jump(); } -static void +STATIC void my_exit_jump(void) { dSP; @@ -24,6 +24,33 @@ #define USE_STDIO #endif /* PERL_FOR_X2P */ +#ifdef PERL_OBJECT +class CPerlObj; + +#define STATIC +#define CPERLscope(x) CPerlObj::x +#define CPERLproto CPerlObj * +#define CPERLproto_ CPERLproto, +#define CPERLarg CPerlObj *pPerl +#define CPERLarg_ CPERLarg, +#define THIS this +#define THIS_ this, +#define CALLRUNOPS (this->*runops) + +#else /* !PERL_OBJECT */ + +#define STATIC static +#define CPERLscope(x) x +#define CPERLproto +#define CPERLproto_ +#define CPERLarg void +#define CPERLarg_ +#define THIS +#define THIS_ +#define CALLRUNOPS runops + +#endif /* PERL_OBJECT */ + #define VOIDUSED 1 #include "config.h" @@ -208,6 +235,7 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); #endif #include "perlio.h" +#include "perlmem.h" #include "perllio.h" #include "perlsock.h" #include "perlproc.h" @@ -985,6 +1013,10 @@ typedef I32 (*filter_t) _((int, SV *, int)); # endif #endif +#ifndef FUNC_NAME_TO_PTR +#define FUNC_NAME_TO_PTR(name) name +#endif + /* * USE_THREADS needs to be after unixish.h as <pthread.h> includes * <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h> @@ -1088,7 +1120,7 @@ union any { I32 any_i32; IV any_iv; long any_long; - void (*any_dptr) _((void*)); + void (CPERLscope(*any_dptr)) _((void*)); }; #ifdef USE_THREADS @@ -1118,6 +1150,55 @@ union any { #include "bytecode.h" #include "byterun.h" +/* Current curly descriptor */ +typedef struct curcur CURCUR; +struct curcur { + int parenfloor; /* how far back to strip paren data */ + int cur; /* how many instances of scan we've matched */ + int min; /* the minimal number of scans to match */ + int max; /* the maximal number of scans to match */ + int minmod; /* whether to work our way up or down */ + regnode * scan; /* the thing to match */ + regnode * next; /* what has to match after it */ + char * lastloc; /* where we started matching this scan */ + CURCUR * oldcc; /* current curly before we started this one */ +}; + +typedef struct _sublex_info SUBLEXINFO; +struct _sublex_info { + I32 super_state; /* lexer state to save */ + I32 sub_inwhat; /* "lex_inwhat" to use */ + OP *sub_op; /* "lex_op" to use */ +}; + +#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]; @@ -1395,11 +1476,13 @@ typedef Sighandler_t Sigsave_t; * included until after runops is initialised. */ +#ifndef PERL_OBJECT typedef int runops_proc_t _((void)); int runops_standard _((void)); #ifdef DEBUGGING int runops_debug _((void)); #endif +#endif /* PERL_OBJECT */ /* _ (for $_) must be first in the following list (DEFSV requires it) */ #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@" @@ -1645,6 +1728,24 @@ typedef enum { #define PERLVARI(var,type,init) type var; #define PERLVARIC(var,type,init) type var; +#ifdef PERL_OBJECT +extern "C" CPerlObj* perl_alloc _((IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*)); + +typedef int (CPerlObj::*runops_proc_t) _((void)); +#undef EXT +#define EXT +#undef EXTCONST +#define EXTCONST +#undef INIT +#define INIT(x) + +class CPerlObj { +public: + CPerlObj(IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*); + void Init(void); + void* operator new(size_t nSize, IPerlMem *pvtbl); +#endif /* PERL_OBJECT */ + #ifdef PERL_GLOBAL_STRUCT struct perl_vars { #include "perlvars.h" @@ -1741,6 +1842,17 @@ typedef void *Thread; #include "intrpvar.h" #endif +#ifdef PERL_OBJECT +}; + +#include "objpp.h" +#ifdef DOINIT +#include "INTERN.h" +#else +#include "EXTERN.h" +#endif +#endif /* PERL_OBJECT */ + #undef PERLVAR #undef PERLVARI @@ -1753,7 +1865,9 @@ typedef void *Thread; * It has to go here or #define of printf messes up __attribute__ * stuff in proto.h */ +#ifndef PERL_OBJECT # include <win32iop.h> +#endif /* PERL_OBJECT */ #endif /* WIN32 */ #ifdef DOINIT @@ -1946,7 +2060,7 @@ enum { subtr_amg, subtr_ass_amg, mult_amg, mult_ass_amg, div_amg, div_ass_amg, - mod_amg, mod_ass_amg, + modulo_amg, modulo_ass_amg, pow_amg, pow_ass_amg, lshift_amg, lshift_ass_amg, rshift_amg, rshift_ass_amg, @@ -2,6 +2,18 @@ #define H_PERLDIR 1 #ifdef PERL_OBJECT + +#include "ipdir.h" + +#define PerlDir_mkdir(name, mode) piDir->Makedir((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)) #ifdef VMS @@ -2,6 +2,15 @@ #define H_PERLENV 1 #ifdef PERL_OBJECT + +#include "ipenv.h" + +#define PerlEnv_putenv(str) piENV->Putenv((str), ErrorNo()) +#define PerlEnv_getenv(str) piENV->Getenv((str), ErrorNo()) +#ifdef WIN32 +#define PerlEnv_lib_path(str) piENV->LibPath((str)) +#define PerlEnv_sitelib_path(str) piENV->SiteLibPath((str)) +#endif #else #define PerlEnv_putenv(str) putenv((str)) #define PerlEnv_getenv(str) getenv((str)) @@ -20,7 +20,58 @@ 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_reopen(p, m, f) piStdIO->Reopen((p), (m), (f), 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_setbuf(f,b) piStdIO->SetBuf((f), (b), ErrorNo()) +#define PerlIO_setvbuf(f,b,t,s) piStdIO->SetVBuf((f), (b), (t), (s), ErrorNo()) +#define PerlIO_set_cnt(f,c) piStdIO->SetCnt((f), (c), ErrorNo()) +#define PerlIO_set_ptrcnt(f,p,c) piStdIO->SetPtrCnt((f), (p), (c), ErrorNo()) +#define PerlIO_setlinebuf(f) piStdIO->Setlinebuf((f), ErrorNo()) +#define PerlIO_printf fprintf +#define PerlIO_stdoutf piStdIO->Printf +#define PerlIO_vprintf(f,fmt,a) piStdIO->Vprintf((f), ErrorNo(), (fmt),a) +#define PerlIO_tell(f) piStdIO->Tell((f), ErrorNo()) +#define PerlIO_seek(f,o,w) piStdIO->Seek((f),(o),(w), ErrorNo()) +#define PerlIO_getpos(f,p) piStdIO->Getpos((f),(p), ErrorNo()) +#define PerlIO_setpos(f,p) piStdIO->Setpos((f),(p), ErrorNo()) +#define PerlIO_rewind(f) piStdIO->Rewind((f), ErrorNo()) +#define PerlIO_tmpfile() piStdIO->Tmpfile(ErrorNo()) +#define PerlIO_init() piStdIO->Init(ErrorNo()) +#undef init_os_extras +#define init_os_extras() piStdIO->InitOSExtras(this) + +#else #include "perlsdio.h" +#endif #ifndef PERLIO_IS_STDIO #ifdef USE_SFIO @@ -2,14 +2,45 @@ #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_chown(file, owner, group) piLIO->Chown((file), (owner), (group), 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->FileStat((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->NameStat((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_chown(file, owner, group) chown((file), (owner), (group)) #define PerlLIO_chsize(fd, size) chsize((fd), (size)) #define PerlLIO_close(fd) close((fd)) #define PerlLIO_dup(fd) dup((fd)) #define PerlLIO_dup2(fd1, fd2) dup2((fd1), (fd2)) +#define PerlLIO_flock(fd, op) FLOCK((fd), (op)) #define PerlLIO_fstat(fd, buf) Fstat((fd), (buf)) +#define PerlLIO_ioctl(fd, u, buf) ioctl((fd), (u), (buf)) #define PerlLIO_isatty(fd) isatty((fd)) #define PerlLIO_lseek(fd, offset, mode) lseek((fd), (offset), (mode)) #define PerlLIO_lstat(name, buf) lstat((name), (buf)) @@ -2,6 +2,12 @@ #define H_PERLMEM 1 #ifdef PERL_OBJECT + +#include "ipmem.h" + +#define PerlMem_malloc(size) piMem->Malloc((size)) +#define PerlMem_realloc(buf, size) piMem->Realloc((buf), (size)) +#define PerlMem_free(buf) piMem->Free((buf)) #else #define PerlMem_malloc(size) malloc((size)) #define PerlMem_realloc(buf, size) realloc((buf), (size)) diff --git a/perlproc.h b/perlproc.h index 40218c2814..8e58c2232d 100644 --- a/perlproc.h +++ b/perlproc.h @@ -2,6 +2,42 @@ #define H_PERLPROC 1 #ifdef PERL_OBJECT + +#include "ipproc.h" + +#define PerlProc_abort() piProc->Abort() +#define PerlProc_exit(s) piProc->Exit((s)) +#define PerlProc__exit(s) piProc->_Exit((s)) +#define PerlProc_execl(c, w, x, y, z) piProc->Execl((c), (w), (x), (y), (z)) +#define PerlProc_execv(c, a) piProc->Execv((c), (a)) +#define PerlProc_execvp(c, a) piProc->Execvp((c), (a)) +#define PerlProc_getuid() piProc->Getuid() +#define PerlProc_geteuid() piProc->Geteuid() +#define PerlProc_getgid() piProc->Getgid() +#define PerlProc_getegid() piProc->Getegid() +#define PerlProc_getlogin() piProc->Getlogin() +#define PerlProc_kill(i, a) piProc->Kill((i), (a)) +#define PerlProc_killpg(i, a) piProc->Killpg((i), (a)) +#define PerlProc_pause() piProc->PauseProc() +#define PerlProc_popen(c, m) piProc->Popen((c), (m)) +#define PerlProc_pclose(f) piProc->Pclose((f)) +#define PerlProc_pipe(fd) piProc->Pipe((fd)) +#define PerlProc_setuid(u) piProc->Setuid((u)) +#define PerlProc_setgid(g) piProc->Setgid((g)) +#define PerlProc_sleep(t) piProc->Sleep((t)) +#define PerlProc_times(t) piProc->Times((t)) +#define PerlProc_wait(t) piProc->Wait((t)) +#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) +#define PerlProc_longjmp(b, n) Siglongjmp((b), (n)) +#define PerlProc_signal(n, h) piProc->Signal((n), (h)) +#ifdef WIN32 +#define PerlProc_GetSysMsg(s,l,e) piProc->GetSysMsg((s), (l), (e)) +#define PerlProc_FreeBuf(s) piProc->FreeBuf((s)) +#define PerlProc_Cmd(s) piProc->DoCmd((s)) +#define do_spawn(s) piProc->Spawn((s)) +#define do_spawnvp(m, c, a) piProc->Spawnvp((m), (c), (a)) +#define PerlProc_aspawn(m, c, a) piProc->ASpawn((m), (c), (a)) +#endif #else #define PerlProc_abort() abort() #define PerlProc_exit(s) exit((s)) @@ -9,11 +45,22 @@ #define PerlProc_execl(c, w, x, y, z) execl((c), (w), (x), (y), (z)) #define PerlProc_execv(c, a) execv((c), (a)) #define PerlProc_execvp(c, a) execvp((c), (a)) +#define PerlProc_getuid() getuid() +#define PerlProc_geteuid() geteuid() +#define PerlProc_getgid() getgid() +#define PerlProc_getegid() getegid() +#define PerlProc_getlogin() getlogin() #define PerlProc_kill(i, a) kill((i), (a)) #define PerlProc_killpg(i, a) killpg((i), (a)) +#define PerlProc_pause() Pause() #define PerlProc_popen(c, m) my_popen((c), (m)) #define PerlProc_pclose(f) my_pclose((f)) #define PerlProc_pipe(fd) pipe((fd)) +#define PerlProc_setuid(u) setuid((u)) +#define PerlProc_setgid(g) setgid((g)) +#define PerlProc_sleep(t) sleep((t)) +#define PerlProc_times(t) times((t)) +#define PerlProc_wait(t) wait((t)) #define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) #define PerlProc_longjmp(b, n) Siglongjmp((b), (n)) #define PerlProc_signal(n, h) signal((n), (h)) diff --git a/perlsock.h b/perlsock.h index dc1a374f71..08c04f3615 100644 --- a/perlsock.h +++ b/perlsock.h @@ -2,6 +2,51 @@ #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) @@ -21,7 +66,6 @@ #define PerlSock_getnetbyname(n) getnetbyname(n) #define PerlSock_getnetent getnetent #define PerlSock_endnetent endnetent - #define PerlSock_getpeername(s, n, l) getpeername(s, n, l) #define PerlSock_getprotobyname(n) getprotobyname(n) @@ -36,11 +80,17 @@ #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) @@ -48,3 +98,4 @@ #endif /* PERL_OBJECT */ #endif /* Include guard */ + diff --git a/perlvars.h b/perlvars.h index 69206a5d7a..b480537796 100644 --- a/perlvars.h +++ b/perlvars.h @@ -25,6 +25,11 @@ PERLVARI(Gthreadsv_names, char *, THREADSV_NAMES) PERLVAR(Gcurthr, struct perl_thread *) /* Currently executing (fake) thread */ #endif #endif /* USE_THREADS */ +#ifdef PERL_OBJECT +#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 */ @@ -54,7 +59,11 @@ PERLVAR(Ghe_root, HE *) /* free he list--shared by interpreters */ PERLVAR(Gnice_chunk, char *) /* a nice chunk of memory to reuse */ PERLVAR(Gnice_chunk_size, U32) /* how nice the chunk of memory is */ +#ifdef PERL_OBJECT +PERLVAR(Grunops, runops_proc_t) +#else PERLVARI(Grunops, runops_proc_t *, RUNOPS_DEFAULT) +#endif PERLVAR(Gtokenbuf[256], char) PERLVAR(Gna, STRLEN) /* for use in SvPV when length is Not Applicable */ @@ -6,11 +6,20 @@ static char yysccsid[] = "@(#)yaccpar 1.8 (Berkeley) 01/20/91"; #include "EXTERN.h" #include "perl.h" +#ifdef PERL_OBJECT +static void +Dep(CPerlObj *pPerl) +{ + pPerl->deprecate("\"do\" to call subroutines"); +} +#define dep() Dep(this) +#else static void dep(void) { deprecate("\"do\" to call subroutines"); } +#endif #line 16 "perly.c" #define YYERRCODE 256 diff --git a/perly.c.diff b/perly.c.diff index e082aecd27..55f0a11cca 100644 --- a/perly.c.diff +++ b/perly.c.diff @@ -194,7 +194,7 @@ Index: perly.c --- 1372,1376 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; -! fprintf(stderr, "yydebug: state %d, reading %d (%s)\n", yystate, +! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n", yystate, yychar, yys); } *************** @@ -212,7 +212,7 @@ Index: perly.c --- 1382,1405 ---- #if YYDEBUG if (yydebug) -! fprintf(stderr, "yydebug: state %d, shifting to state %d\n", +! PerlIO_printf(Perl_debug_log, "yydebug: state %d, shifting to state %d\n", yystate, yytable[yyn]); #endif if (yyssp >= yyss + yystacksize - 1) @@ -249,7 +249,7 @@ Index: perly.c --- 1437,1461 ---- #if YYDEBUG if (yydebug) -! fprintf(stderr, +! PerlIO_printf(Perl_debug_log, ! "yydebug: state %d, error recovery shifting to state %d\n", ! *yyssp, yytable[yyn]); #endif @@ -283,7 +283,7 @@ Index: perly.c --- 1467,1473 ---- #if YYDEBUG if (yydebug) -! fprintf(stderr, +! PerlIO_printf(Perl_debug_log, ! "yydebug: error recovery discarding state %d\n", ! *yyssp); #endif @@ -299,7 +299,7 @@ Index: perly.c --- 1486,1492 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; -! fprintf(stderr, +! PerlIO_printf(Perl_debug_log, ! "yydebug: state %d, error recovery discards token %d (%s)\n", ! yystate, yychar, yys); } @@ -314,7 +314,7 @@ Index: perly.c --- 1497,1501 ---- #if YYDEBUG if (yydebug) -! fprintf(stderr, "yydebug: state %d, reducing by rule %d (%s)\n", +! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reducing by rule %d (%s)\n", yystate, yyn, yyrule[yyn]); #endif *************** @@ -328,7 +328,7 @@ Index: perly.c --- 2292,2298 ---- #if YYDEBUG if (yydebug) -! fprintf(stderr, +! PerlIO_printf(Perl_debug_log, ! "yydebug: after reduction, shifting from state 0 to state %d\n", ! YYFINAL); #endif @@ -343,7 +343,7 @@ Index: perly.c --- 2308,2312 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; -! fprintf(stderr, "yydebug: state %d, reading %d (%s)\n", +! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n", YYFINAL, yychar, yys); } *************** @@ -361,7 +361,7 @@ Index: perly.c --- 2323,2347 ---- #if YYDEBUG if (yydebug) -! fprintf(stderr, +! PerlIO_printf(Perl_debug_log, ! "yydebug: after reduction, shifting from state %d to state %d\n", ! *yyssp, yystate); #endif @@ -101,9 +101,11 @@ typedef unsigned UBW; # define CAT32(sv,p) sv_catpvn(sv, (char*)(p), SIZE32) #endif +#ifndef PERL_OBJECT static void doencodes _((SV* sv, char* s, I32 len)); static SV* refto _((SV* sv)); static U32 seed _((void)); +#endif static bool srand_called = FALSE; @@ -451,7 +453,7 @@ PP(pp_refgen) RETURN; } -static SV* +STATIC SV* refto(SV *sv) { SV* rv; @@ -513,40 +515,40 @@ PP(pp_gelem) { GV *gv; SV *sv; - SV *ref; + SV *tmpRef; char *elem; djSP; sv = POPs; elem = SvPV(sv, na); gv = (GV*)POPs; - ref = Nullsv; + tmpRef = Nullsv; sv = Nullsv; switch (elem ? *elem : '\0') { case 'A': if (strEQ(elem, "ARRAY")) - ref = (SV*)GvAV(gv); + tmpRef = (SV*)GvAV(gv); break; case 'C': if (strEQ(elem, "CODE")) - ref = (SV*)GvCVu(gv); + tmpRef = (SV*)GvCVu(gv); break; case 'F': if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */ - ref = (SV*)GvIOp(gv); + tmpRef = (SV*)GvIOp(gv); break; case 'G': if (strEQ(elem, "GLOB")) - ref = (SV*)gv; + tmpRef = (SV*)gv; break; case 'H': if (strEQ(elem, "HASH")) - ref = (SV*)GvHV(gv); + tmpRef = (SV*)GvHV(gv); break; case 'I': if (strEQ(elem, "IO")) - ref = (SV*)GvIOp(gv); + tmpRef = (SV*)GvIOp(gv); break; case 'N': if (strEQ(elem, "NAME")) @@ -558,11 +560,11 @@ PP(pp_gelem) break; case 'S': if (strEQ(elem, "SCALAR")) - ref = GvSV(gv); + tmpRef = GvSV(gv); break; } - if (ref) - sv = newRV(ref); + if (tmpRef) + sv = newRV(tmpRef); if (sv) sv_2mortal(sv); else @@ -894,7 +896,7 @@ PP(pp_divide) PP(pp_modulo) { - djSP; dATARGET; tryAMAGICbin(mod,opASSIGN); + djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { UV left; UV right; @@ -1380,7 +1382,7 @@ PP(pp_i_divide) PP(pp_i_modulo) { - djSP; dATARGET; tryAMAGICbin(mod,opASSIGN); + djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { dPOPTOPiirl; if (!right) @@ -1576,7 +1578,7 @@ PP(pp_srand) RETPUSHYES; } -static U32 +STATIC U32 seed(void) { /* @@ -2831,7 +2833,7 @@ PP(pp_reverse) RETURN; } -static SV * +STATIC SV * mul128(SV *sv, U8 m) { STRLEN len; @@ -3553,7 +3555,7 @@ PP(pp_unpack) RETURN; } -static void +STATIC void doencodes(register SV *sv, register char *s, register I32 len) { char hunk[5]; @@ -3577,7 +3579,7 @@ doencodes(register SV *sv, register char *s, register I32 len) sv_catpvn(sv, "\n", 1); } -static SV * +STATIC SV * is_an_int(char *s, STRLEN l) { SV *result = newSVpv("", l); @@ -3625,7 +3627,7 @@ is_an_int(char *s, STRLEN l) return (result); } -static int +STATIC int div128(SV *pnum, bool *done) /* must be '\0' terminated */ @@ -14,7 +14,11 @@ #define ARGS #define dARGS #endif /* USE_THREADS */ +#ifdef PERL_OBJECT +#define PP(s) OP * CPerlObj::s(ARGSproto) +#else #define PP(s) OP * s(ARGSproto) +#endif #define SP sp #define MARK mark @@ -216,10 +220,11 @@ /* newSVsv does not behave as advertised, so we copy missing * information by hand */ - -#define RvDEEPCP(rv) STMT_START { SV* ref=SvRV(rv); \ - if (SvREFCNT(ref)>1) { \ - SvREFCNT_dec(ref); \ +/* SV* ref causes confusion with the member variable + changed SV* ref to SV* tmpRef */ +#define RvDEEPCP(rv) STMT_START { SV* tmpRef=SvRV(rv); \ + if (SvREFCNT(tmpRef)>1) { \ + SvREFCNT_dec(tmpRef); \ SvRV(rv)=AMG_CALLun(rv,copy); \ } } STMT_END #else @@ -25,6 +25,10 @@ #define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o)) +#ifdef PERL_OBJECT +#define CALLOP this->*op +#else +#define CALLOP *op static OP *docatch _((OP *o)); static OP *dofindlabel _((OP *o, char *label, OP **opstack, OP **oplimit)); static void doparseform _((SV *sv)); @@ -36,8 +40,7 @@ static void save_lines _((AV *array, SV *sv)); static I32 sortcv _((SV *a, SV *b)); static void qsortsv _((SV **array, size_t num_elts, I32 (*fun)(SV *a, SV *b))); static OP *doeval _((int gimme, OP** startop)); - -static I32 sortcxix; +#endif PP(pp_wantarray) { @@ -240,7 +243,7 @@ rxres_free(void **rsp) PP(pp_formline) { djSP; dMARK; dORIGMARK; - register SV *form = *++MARK; + register SV *tmpForm = *++MARK; register U16 *fpc; register char *t; register char *f; @@ -259,17 +262,17 @@ PP(pp_formline) bool gotsome; STRLEN len; - if (!SvMAGICAL(form) || !SvCOMPILED(form)) { - SvREADONLY_off(form); - doparseform(form); + if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) { + SvREADONLY_off(tmpForm); + doparseform(tmpForm); } SvPV_force(formtarget, len); - t = SvGROW(formtarget, len + SvCUR(form) + 1); /* XXX SvCUR bad */ + t = SvGROW(formtarget, len + SvCUR(tmpForm) + 1); /* XXX SvCUR bad */ t += len; - f = SvPV(form, len); + f = SvPV(tmpForm, len); /* need to jump to the next word */ - s = f + len + WORD_ALIGN - SvCUR(form) % WORD_ALIGN; + s = f + len + WORD_ALIGN - SvCUR(tmpForm) % WORD_ALIGN; fpc = (U16*)s; @@ -444,7 +447,7 @@ PP(pp_formline) } SvCUR_set(formtarget, t - SvPVX(formtarget)); sv_catpvn(formtarget, item, itemsize); - SvGROW(formtarget, SvCUR(formtarget) + SvCUR(form) + 1); + SvGROW(formtarget, SvCUR(formtarget) + SvCUR(tmpForm) + 1); t = SvPVX(formtarget) + SvCUR(formtarget); } break; @@ -634,7 +637,6 @@ PP(pp_mapwhile) } } - PP(pp_sort) { djSP; dMARK; dORIGMARK; @@ -733,8 +735,7 @@ PP(pp_sort) (void)SvREFCNT_inc(cv); /* in preparation for POPSUB */ } sortcxix = cxstack_ix; - - qsortsv(myorigmark+1, max, sortcv); + qsortsv((myorigmark+1), max, FUNC_NAME_TO_PTR(sortcv)); POPBLOCK(cx,curpm); POPSTACK(); @@ -746,7 +747,9 @@ PP(pp_sort) if (max > 1) { MEXTEND(SP, 20); /* Can't afford stack realloc on signal. */ qsortsv(ORIGMARK+1, max, - (op->op_private & OPpLOCALE) ? sv_cmp_locale : sv_cmp); + (op->op_private & OPpLOCALE) + ? FUNC_NAME_TO_PTR(sv_cmp_locale) + : FUNC_NAME_TO_PTR(sv_cmp)); } } stack_sp = ORIGMARK + max; @@ -852,7 +855,7 @@ PP(pp_flop) /* Control. */ -static I32 +STATIC I32 dopoptolabel(char *label) { dTHR; @@ -921,7 +924,7 @@ block_gimme(void) } } -static I32 +STATIC I32 dopoptosub(I32 startingblock) { dTHR; @@ -941,7 +944,7 @@ dopoptosub(I32 startingblock) return i; } -static I32 +STATIC I32 dopoptoeval(I32 startingblock) { dTHR; @@ -960,7 +963,7 @@ dopoptoeval(I32 startingblock) return i; } -static I32 +STATIC I32 dopoptoloop(I32 startingblock) { dTHR; @@ -1230,7 +1233,7 @@ PP(pp_caller) RETURN; } -static I32 +STATIC I32 sortcv(SV *a, SV *b) { dTHR; @@ -1241,7 +1244,7 @@ sortcv(SV *a, SV *b) GvSV(secondgv) = b; 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)) @@ -1629,9 +1632,7 @@ PP(pp_redo) return cx->blk_loop.redo_op; } -static OP* lastgotoprobe; - -static OP * +STATIC OP * dofindlabel(OP *o, char *label, OP **opstack, OP **oplimit) { OP *kid; @@ -1761,7 +1762,7 @@ PP(pp_goto) } else { stack_sp--; /* There is no cv arg. */ - (void)(*CvXSUB(cv))(cv); + (void)(*CvXSUB(cv))(THIS_ cv); } LEAVE; return pop_return(); @@ -1969,7 +1970,7 @@ PP(pp_goto) if (op->op_type == OP_ENTERITER) DIE("Can't \"goto\" into the middle of a foreach loop", label); - (*op->op_ppaddr)(ARGS); + (CALLOP->op_ppaddr)(ARGS); } op = oldop; } @@ -2057,7 +2058,7 @@ PP(pp_cswitch) /* Eval. */ -static void +STATIC void save_lines(AV *array, SV *sv) { register char *s = SvPVX(sv); @@ -2081,7 +2082,7 @@ save_lines(AV *array, SV *sv) } } -static OP * +STATIC OP * docatch(OP *o) { dTHR; @@ -2110,7 +2111,7 @@ docatch(OP *o) restartop = 0; /* FALL THROUGH */ case 0: - runops(); + CALLRUNOPS(); break; } JMPENV_POP; @@ -2180,7 +2181,7 @@ sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp) } /* With USE_THREADS, eval_owner must be held on entry to doeval */ -static OP * +STATIC OP * doeval(int gimme, OP** startop) { dSP; @@ -2731,7 +2732,7 @@ PP(pp_leavetry) RETURN; } -static void +STATIC void doparseform(SV *sv) { STRLEN len; @@ -3015,8 +3016,13 @@ struct partition_stack_entry { /* Return < 0 == 0 or > 0 as the value of elt1 is < elt2, == elt2, > elt2 */ +#ifdef PERL_OBJECT +#define qsort_cmp(elt1, elt2) \ + ((this->*compare)(array[elt1], array[elt2])) +#else #define qsort_cmp(elt1, elt2) \ ((*compare)(array[elt1], array[elt2])) +#endif #ifdef QSORT_ORDER_GUESS #define QSORT_NOTICE_SWAP swapped++; @@ -3097,10 +3103,14 @@ doqsort_all_asserts( /* ****************************************************************** qsort */ void +#ifdef PERL_OBJECT +qsortsv(SV ** array, size_t num_elts, SVCOMPARE compare) +#else qsortsv( SV ** array, size_t num_elts, I32 (*compare)(SV *a, SV *b)) +#endif { register SV * temp; @@ -700,12 +700,12 @@ PP(pp_aassign) if (delaymagic & DM_UID) { if (uid != euid) DIE("No setreuid available"); - (void)setuid(uid); + (void)PerlProc_setuid(uid); } # endif /* HAS_SETREUID */ #endif /* HAS_SETRESUID */ - uid = (int)getuid(); - euid = (int)geteuid(); + uid = (int)PerlProc_getuid(); + euid = (int)PerlProc_geteuid(); } if (delaymagic & DM_GID) { #ifdef HAS_SETRESGID @@ -729,12 +729,12 @@ PP(pp_aassign) if (delaymagic & DM_GID) { if (gid != egid) DIE("No setregid available"); - (void)setgid(gid); + (void)PerlProc_setgid(gid); } # endif /* HAS_SETREGID */ #endif /* HAS_SETRESGID */ - gid = (int)getgid(); - egid = (int)getegid(); + gid = (int)PerlProc_getgid(); + egid = (int)PerlProc_getegid(); } tainting |= (uid && (euid != uid || egid != gid)); } @@ -1796,7 +1796,7 @@ PP(pp_leavesub) return pop_return(); } -static CV * +STATIC CV * get_db_sub(SV **svp, CV *cv) { dTHR; @@ -2093,7 +2093,7 @@ PP(pp_entersub) curcopdb = NULL; } /* Do we need to open block here? XXXX */ - (void)(*CvXSUB(cv))(cv); + (void)(*CvXSUB(cv))(THIS_ cv); /* Enforce some sanity in scalar context. */ if (gimme == G_SCALAR && ++markix != stack_sp - stack_base ) { @@ -501,7 +501,7 @@ PP(pp_binmode) * document this anywhere). GSAR 97-5-24 */ PerlIO_seek(fp,0L,0); - fp->flags |= _F_BIN; + ((FILE*)fp)->flags |= _F_BIN; #endif RETPUSHYES; } @@ -924,7 +924,7 @@ PP(pp_read) return pp_sysread(ARGS); } -static OP * +STATIC OP * doform(CV *cv, GV *gv, OP *retop) { dTHR; @@ -1587,7 +1587,7 @@ PP(pp_ioctl) if (optype == OP_IOCTL) #ifdef HAS_IOCTL - retval = ioctl(PerlIO_fileno(IoIFP(io)), func, s); + retval = PerlLIO_ioctl(PerlIO_fileno(IoIFP(io)), func, s); #else DIE("ioctl is not implemented"); #endif @@ -1641,7 +1641,7 @@ PP(pp_flock) fp = Nullfp; if (fp) { (void)PerlIO_flush(fp); - value = (I32)(FLOCK(PerlIO_fileno(fp), argtype) >= 0); + value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0); } else value = 0; @@ -3368,11 +3368,11 @@ PP(pp_tms) EXTEND(SP, 4); #ifndef VMS - (void)times(×buf); + (void)PerlProc_times(×buf); #else - (void)times((tbuffer_t *)×buf); /* time.h uses different name for */ - /* struct tms, though same data */ - /* is returned. */ + (void)PerlProc_times((tbuffer_t *)×buf); /* time.h uses different name for */ + /* struct tms, though same data */ + /* is returned. */ #endif PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_utime)/HZ))); @@ -3470,10 +3470,10 @@ PP(pp_sleep) (void)time(&lasttime); if (MAXARG < 1) - Pause(); + PerlProc_pause(); else { duration = POPi; - sleep((unsigned int)duration); + PerlProc_sleep((unsigned int)duration); } (void)time(&when); XPUSHi(when - lasttime); @@ -3970,7 +3970,7 @@ PP(pp_gservent) } PUSHs(sv = sv_mortalcopy(&sv_no)); #ifdef HAS_NTOHS - sv_setiv(sv, (IV)ntohs(sent->s_port)); + sv_setiv(sv, (IV)PerlSock_ntohs(sent->s_port)); #else sv_setiv(sv, (IV)(sent->s_port)); #endif @@ -3988,7 +3988,7 @@ PP(pp_shostent) { djSP; #ifdef HAS_SETHOSTENT - sethostent(TOPi); + PerlSock_sethostent(TOPi); RETSETYES; #else DIE(no_sock_func, "sethostent"); @@ -3999,7 +3999,7 @@ PP(pp_snetent) { djSP; #ifdef HAS_SETNETENT - setnetent(TOPi); + PerlSock_setnetent(TOPi); RETSETYES; #else DIE(no_sock_func, "setnetent"); @@ -4010,7 +4010,7 @@ PP(pp_sprotoent) { djSP; #ifdef HAS_SETPROTOENT - setprotoent(TOPi); + PerlSock_setprotoent(TOPi); RETSETYES; #else DIE(no_sock_func, "setprotoent"); @@ -4021,7 +4021,7 @@ PP(pp_sservent) { djSP; #ifdef HAS_SETSERVENT - setservent(TOPi); + PerlSock_setservent(TOPi); RETSETYES; #else DIE(no_sock_func, "setservent"); @@ -4287,7 +4287,7 @@ PP(pp_getlogin) #ifdef HAS_GETLOGIN char *tmps; EXTEND(SP, 1); - if (!(tmps = getlogin())) + if (!(tmps = PerlProc_getlogin())) RETPUSHUNDEF; PUSHp(tmps, strlen(tmps)); RETURN; @@ -1,4 +1,16 @@ +#ifdef PERL_OBJECT +#include "ipstdio.h" +#include "ipdir.h" +#include "ipenv.h" +#include "iplio.h" +#include "ipmem.h" +#include "ipproc.h" +#include "ipsock.h" +#define VIRTUAL virtual +#else +#define VIRTUAL START_EXTERN_C +#endif #ifndef NEXT30_NO_ATTRIBUTE #ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */ @@ -9,122 +21,125 @@ START_EXTERN_C #endif #endif #ifdef OVERLOAD -SV* amagic_call _((SV* left,SV* right,int method,int dir)); -bool Gv_AMupdate _((HV* stash)); +VIRTUAL SV* amagic_call _((SV* left,SV* right,int method,int dir)); +VIRTUAL bool Gv_AMupdate _((HV* stash)); #endif /* OVERLOAD */ -OP* append_elem _((I32 optype, OP* head, OP* tail)); -OP* append_list _((I32 optype, LISTOP* first, LISTOP* last)); -I32 apply _((I32 type, SV** mark, SV** sp)); -void assertref _((OP* o)); -SV* avhv_delete _((AV *ar, char* key, U32 klen, I32 flags)); -SV* avhv_delete_ent _((AV *ar, SV* keysv, I32 flags, U32 hash)); -bool avhv_exists _((AV *ar, char* key, U32 klen)); -bool avhv_exists_ent _((AV *ar, SV* keysv, U32 hash)); -SV** avhv_fetch _((AV *ar, char* key, U32 klen, I32 lval)); -SV** avhv_fetch_ent _((AV *ar, SV* keysv, I32 lval, U32 hash)); -I32 avhv_iterinit _((AV *ar)); -HE* avhv_iternext _((AV *ar)); -SV * avhv_iternextsv _((AV *ar, char** key, I32* retlen)); -SV* avhv_iterval _((AV *ar, HE* entry)); -HV* avhv_keys _((AV *ar)); -SV** avhv_store _((AV *ar, char* key, U32 klen, SV* val, U32 hash)); -void av_clear _((AV* ar)); -void av_extend _((AV* ar, I32 key)); -AV* av_fake _((I32 size, SV** svp)); -SV** av_fetch _((AV* ar, I32 key, I32 lval)); -void av_fill _((AV* ar, I32 fill)); -I32 av_len _((AV* ar)); -AV* av_make _((I32 size, SV** svp)); -SV* av_pop _((AV* ar)); -void av_push _((AV* ar, SV* val)); -void av_reify _((AV* ar)); -SV* av_shift _((AV* ar)); -SV** av_store _((AV* ar, I32 key, SV* val)); -void av_undef _((AV* ar)); -void av_unshift _((AV* ar, I32 num)); -OP* bind_match _((I32 type, OP* left, OP* pat)); -OP* block_end _((I32 floor, OP* seq)); -I32 block_gimme _((void)); -int block_start _((int full)); -void boot_core_UNIVERSAL _((void)); -void call_list _((I32 oldscope, AV* list)); -I32 cando _((I32 bit, I32 effective, Stat_t* statbufp)); +VIRTUAL OP* append_elem _((I32 optype, OP* head, OP* tail)); +VIRTUAL OP* append_list _((I32 optype, LISTOP* first, LISTOP* last)); +VIRTUAL I32 apply _((I32 type, SV** mark, SV** sp)); +VIRTUAL void assertref _((OP* o)); +VIRTUAL SV* avhv_delete _((AV *ar, char* key, U32 klen, I32 flags)); +VIRTUAL SV* avhv_delete_ent _((AV *ar, SV* keysv, I32 flags, U32 hash)); +VIRTUAL bool avhv_exists _((AV *ar, char* key, U32 klen)); +VIRTUAL bool avhv_exists_ent _((AV *ar, SV* keysv, U32 hash)); +VIRTUAL SV** avhv_fetch _((AV *ar, char* key, U32 klen, I32 lval)); +VIRTUAL SV** avhv_fetch_ent _((AV *ar, SV* keysv, I32 lval, U32 hash)); +VIRTUAL I32 avhv_iterinit _((AV *ar)); +VIRTUAL HE* avhv_iternext _((AV *ar)); +VIRTUAL SV * avhv_iternextsv _((AV *ar, char** key, I32* retlen)); +VIRTUAL SV* avhv_iterval _((AV *ar, HE* entry)); +VIRTUAL HV* avhv_keys _((AV *ar)); +VIRTUAL SV** avhv_store _((AV *ar, char* key, U32 klen, SV* val, U32 hash)); +VIRTUAL SV** avhv_store_ent _((AV *av, SV *keysv, SV *val, U32 hash)); +VIRTUAL void av_clear _((AV* ar)); +VIRTUAL void av_extend _((AV* ar, I32 key)); +VIRTUAL AV* av_fake _((I32 size, SV** svp)); +VIRTUAL SV** av_fetch _((AV* ar, I32 key, I32 lval)); +VIRTUAL void av_fill _((AV* ar, I32 fill)); +VIRTUAL I32 av_len _((AV* ar)); +VIRTUAL AV* av_make _((I32 size, SV** svp)); +VIRTUAL SV* av_pop _((AV* ar)); +VIRTUAL void av_push _((AV* ar, SV* val)); +VIRTUAL void av_reify _((AV* ar)); +VIRTUAL SV* av_shift _((AV* ar)); +VIRTUAL SV** av_store _((AV* ar, I32 key, SV* val)); +VIRTUAL void av_undef _((AV* ar)); +VIRTUAL void av_unshift _((AV* ar, I32 num)); +VIRTUAL OP* bind_match _((I32 type, OP* left, OP* pat)); +VIRTUAL OP* block_end _((I32 floor, OP* seq)); +VIRTUAL I32 block_gimme _((void)); +VIRTUAL int block_start _((int full)); +VIRTUAL void boot_core_UNIVERSAL _((void)); +VIRTUAL void call_list _((I32 oldscope, AV* list)); +VIRTUAL I32 cando _((I32 bit, I32 effective, Stat_t* statbufp)); #ifndef CASTNEGFLOAT -U32 cast_ulong _((double f)); +VIRTUAL U32 cast_ulong _((double f)); #endif #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP) -I32 my_chsize _((int fd, Off_t length)); +VIRTUAL I32 my_chsize _((int fd, Off_t length)); #endif -OP* ck_gvconst _((OP* o)); -OP* ck_retarget _((OP* o)); +VIRTUAL OP* ck_gvconst _((OP* o)); +VIRTUAL OP* ck_retarget _((OP* o)); #ifdef USE_THREADS -MAGIC * condpair_magic _((SV *sv)); -#endif -OP* convert _((I32 optype, I32 flags, OP* o)); -void croak _((const char* pat,...)) __attribute__((noreturn)); -void cv_ckproto _((CV* cv, GV* gv, char* p)); -CV* cv_clone _((CV* proto)); -SV* cv_const_sv _((CV* cv)); -void cv_undef _((CV* cv)); +VIRTUAL MAGIC * condpair_magic _((SV *sv)); +#endif +VIRTUAL OP* convert _((I32 optype, I32 flags, OP* o)); +VIRTUAL void croak _((const char* pat,...)) __attribute__((noreturn)); +VIRTUAL void cv_ckproto _((CV* cv, GV* gv, char* p)); +VIRTUAL CV* cv_clone _((CV* proto)); +VIRTUAL SV* cv_const_sv _((CV* cv)); +VIRTUAL void cv_undef _((CV* cv)); #ifdef DEBUGGING void cx_dump _((PERL_CONTEXT* cs)); #endif -SV* filter_add _((filter_t funcp, SV* datasv)); -void filter_del _((filter_t funcp)); -I32 filter_read _((int idx, SV* buffer, int maxlen)); -char ** get_op_descs _((void)); -char ** get_op_names _((void)); -I32 cxinc _((void)); -void deb _((const char* pat,...)) __attribute__((format(printf,1,2))); -void deb_growlevel _((void)); -I32 debop _((OP* o)); -I32 debstackptrs _((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)); #ifdef DEBUGGING -void debprofdump _((void)); +VIRTUAL void deb _((const char* pat,...)) __attribute__((format(printf,1,2))); +VIRTUAL void deb_growlevel _((void)); +VIRTUAL void debprofdump _((void)); +VIRTUAL I32 debop _((OP* o)); +VIRTUAL I32 debstack _((void)); +VIRTUAL I32 debstackptrs _((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)); +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)); +#ifdef DEBUGGING void dump_eval _((void)); +#endif #ifdef DUMP_FDS /* See util.c */ int dump_fds _((char* s)); #endif @@ -137,479 +152,1093 @@ void dump_op _((OP* arg)); void dump_pm _((PMOP* pm)); void dump_packsubs _((HV* stash)); void dump_sub _((GV* gv)); -void fbm_compile _((SV* sv, U32 flags)); -char* fbm_instr _((unsigned char* big, unsigned char* bigend, SV* littlesv)); +VIRTUAL void fbm_compile _((SV* sv, U32 flags)); +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)); -U32 magic_sizepack _((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 U32 magic_sizepack _((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)); -I32 mg_size _((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_length _((SV* sv)); +VIRTUAL void mg_magical _((SV* sv)); +VIRTUAL int mg_set _((SV* sv)); +VIRTUAL I32 mg_size _((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 newCONSTSUB _((HV* stash, char* name, SV* sv)); -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)); -#if !defined(__GNUC__) && (defined(CRIPPLED_CC) || defined(USE_THREADS)) -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 newCONSTSUB _((HV* stash, char* name, SV* sv)); +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)); +#if !defined(__GNUC__) && (defined(CRIPPLED_CC) || defined(USE_THREADS) || defined(PERL_OBJECT)) +VIRTUAL SV* newRV_noinc _((SV *)); #endif #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* newSVpvn _((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 -PERL_SI * new_stackinfo _((I32 stitems, I32 cxitems)); -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 PERL_SI * new_stackinfo _((I32 stitems, I32 cxitems)); +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)); +#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)); +#ifdef DEBUGGING 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)); +#endif +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)); +#ifdef DEBUGGING 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 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_aelem _((AV* av, I32 idx, SV **sptr)); -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_aelem _((AV* av, I32 idx, SV **sptr)); +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 +typedef void (CPerlObj::*DESTRUCTORFUNC) _((void*)); +VIRTUAL void save_destructor _((DESTRUCTORFUNC f, 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_helem _((HV* hv, SV *key, SV **sptr)); -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_helem _((HV* hv, SV *key, SV **sptr)); +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_catpvf_mg _((SV* sv, const char* pat, ...)); -void sv_catpv _((SV* sv, char* ptr)); -void sv_catpv_mg _((SV* sv, char* ptr)); -void sv_catpvn _((SV* sv, char* ptr, STRLEN len)); -void sv_catpvn_mg _((SV* sv, char* ptr, STRLEN len)); -void sv_catsv _((SV* dsv, SV* ssv)); -void sv_catsv_mg _((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)); +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)); +#ifdef DEBUGGING 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_setpvf_mg _((SV* sv, const char* pat, ...)); -void sv_setiv _((SV* sv, IV num)); -void sv_setiv_mg _((SV* sv, IV num)); -void sv_setpviv _((SV* sv, IV num)); -void sv_setpviv_mg _((SV* sv, IV num)); -void sv_setuv _((SV* sv, UV num)); -void sv_setuv_mg _((SV* sv, UV num)); -void sv_setnv _((SV* sv, double num)); -void sv_setnv_mg _((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_setpv_mg _((SV* sv, const char* ptr)); -void sv_setpvn _((SV* sv, const char* ptr, STRLEN len)); -void sv_setpvn_mg _((SV* sv, const char* ptr, STRLEN len)); -void sv_setsv _((SV* dsv, SV* ssv)); -void sv_setsv_mg _((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_usepvn_mg _((SV* sv, char* ptr, STRLEN len)); -void sv_vcatpvfn _((SV* sv, const char* pat, STRLEN patlen, +#endif +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,...)); +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,...)); +#ifdef DEBUGGING void watch _((char** addr)); -I32 whichsig _((char* sig)); -int yyerror _((char* s)); -int yylex _((void)); -int yyparse _((void)); -int yywarn _((char* s)); +#endif +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)); + +SV *newSVpvn _((char *s, STRLEN len)); + +void sv_catpv_mg _((SV *sv, char *ptr)); +void sv_catpvf_mg _((SV *sv, const char* pat, ...)); +void sv_catpvn_mg _((SV *sv, char *ptr, STRLEN len)); +void sv_catsv_mg _((SV *dstr, SV *sstr)); +void sv_setiv_mg _((SV *sv, IV i)); +void sv_setnv_mg _((SV *sv, double num)); +void sv_setsv_mg _((SV *dstr, SV *sstr)); +void sv_setuv_mg _((SV *sv, UV u)); +void sv_setpv_mg _((SV *sv, const char *ptr)); +void sv_setpvf_mg _((SV *sv, const char* pat, ...)); +void sv_setpviv_mg _((SV *sv, IV iv)); +void sv_setpvn_mg _((SV *sv, const char *ptr, STRLEN len)); +void sv_usepvn_mg _((SV *sv, char *ptr, STRLEN len)); + +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)); +void* my_safemalloc _((MEM_SIZE size)); + +typedef void (CPerlObj::*SVFUNC) _((SV*)); +void visit _((SVFUNC f)); + +typedef I32 (CPerlObj::*SVCOMPARE) _((SV*, SV*)); +void qsortsv _((SV ** array, size_t num_elts, SVCOMPARE f)); +I32 sortcv _((SV *a, SV *b)); +void save_magic _((MGS *mgs, SV *sv)); +int magic_methpack _((SV *sv, MAGIC *mg, char *meth)); +int magic_methcall _((MAGIC *mg, char *meth, I32 flags, int n, SV *val)); +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 *, int *fd)); +void usage _((char *)); +void validate_suid _((char *, char*, int)); +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 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)); +void debprof _((OP *o)); +#endif + +void *bset_obj_store _((void *obj, I32 ix)); +#ifdef INDIRECT_BGET_MACROS +void byterun _((struct bytestream bs)); +#else +void byterun _((PerlIO *fp)); +#endif /* INDIRECT_BGET_MACROS */ + +OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp)); + +#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 restore_expect _((void *e)); +void restore_lex_expect _((void *e)); +void yydestruct _((void *ptr)); +VIRTUAL int fprintf _((PerlIO *, const char *, ...)); + +#ifdef WIN32 +VIRTUAL int& ErrorNo(); +#endif /* WIN32 */ +#else /* !PERL_OBJECT */ END_EXTERN_C +#endif /* PERL_OBJECT */ + @@ -64,20 +64,6 @@ #undef op #endif /* op */ -static regnode regdummy; -static char * regparse; /* Input-scan pointer. */ -static char * regxend; /* End of input for compile */ -static regnode * regcode; /* Code-emit pointer; ®dummy = don't. */ -static I32 regnaughty; /* How bad is this pattern? */ -static I32 regsawback; /* Did we see \1, ...? */ - -/* This guys appear both in regcomp.c and regexec.c, but there is no - other reason to have them global. */ -static char * regprecomp; /* uncompiled string. */ -static I32 regnpar; /* () count. */ -static I32 regsize; /* Code size. */ -static U16 regflags; /* are we folding, multilining? */ - #ifdef MSDOS # if defined(BUGGY_MSC6) /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */ @@ -116,6 +102,8 @@ static U16 regflags; /* are we folding, multilining? */ * Forward declarations for pregcomp()'s friends. */ +static char* regwhite _((char *, char *)); +#ifndef PERL_OBJECT static regnode *reg _((I32, I32 *)); static regnode *reganode _((U8, U32)); static regnode *regatom _((I32 *)); @@ -129,21 +117,14 @@ static void reginsert _((U8, regnode *)); static void regoptail _((regnode *, regnode *)); static void regset _((char *, I32)); static void regtail _((regnode *, regnode *)); -static char* regwhite _((char *, char *)); static char* nextchar _((void)); -static void re_croak2 _((const char* pat1,const char* pat2,...)) __attribute__((noreturn)); -static U32 regseen; -static I32 seen_zerolen; -static regexp *rx; -static I32 extralen; - -#ifdef DEBUGGING -static int colorset; -#endif +static void re_croak2 _((const char* pat1,const char* pat2,...)) __attribute__((noreturn)); +#endif /* Length of a variant. */ +#ifndef PERL_OBJECT typedef struct { I32 len_min; I32 len_delta; @@ -161,6 +142,7 @@ typedef struct { I32 offset_float_max; I32 flags; } scan_data_t; +#endif static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }; @@ -189,7 +171,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }; #define SF_HAS_EVAL 0x200 #define SCF_DO_SUBSTR 0x400 -static void +STATIC void scan_commit(scan_data_t *data) { STRLEN l = SvCUR(data->last_found); @@ -224,7 +206,7 @@ scan_commit(scan_data_t *data) /* Stops at toplevel WHILEM as well as at `last'. At end *scanp is set to the position after last scanned or to NULL. */ -static I32 +STATIC I32 study_chunk(regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 flags) /* scanp: Start here (read-write). */ /* deltap: Write maxlen-minlen here. */ @@ -675,7 +657,7 @@ study_chunk(regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 return min; } -static I32 +STATIC I32 add_data(I32 n, char *s) { if (rx->data) { @@ -989,7 +971,7 @@ pregcomp(char *exp, char *xend, PMOP *pm) * is a trifle forced, but the need to tie the tails of the branches to what * follows makes it hard to avoid. */ -static regnode * +STATIC regnode * reg(I32 paren, I32 *flagp) /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */ { @@ -1267,7 +1249,7 @@ reg(I32 paren, I32 *flagp) * * Implements the concatenation operator. */ -static regnode * +STATIC regnode * regbranch(I32 *flagp, I32 first) { register regnode *ret; @@ -1331,7 +1313,7 @@ regbranch(I32 *flagp, I32 first) * It might seem that this node could be dispensed with entirely, but the * endmarker role is not redundant. */ -static regnode * +STATIC regnode * regpiece(I32 *flagp) { register regnode *ret; @@ -1487,7 +1469,7 @@ regpiece(I32 *flagp) * * [Yes, it is worth fixing, some scripts can run twice the speed.] */ -static regnode * +STATIC regnode * regatom(I32 *flagp) { register regnode *ret = 0; @@ -1831,7 +1813,7 @@ regwhite(char *p, char *e) return p; } -static void +STATIC void regset(char *opnd, register I32 c) { if (SIZE_ONLY) @@ -1840,7 +1822,7 @@ regset(char *opnd, register I32 c) opnd[1 + (c >> 3)] |= (1 << (c & 7)); } -static regnode * +STATIC regnode * regclass(void) { register char *opnd, *s; @@ -2022,7 +2004,7 @@ regclass(void) return ret; } -static char* +STATIC char* nextchar(void) { char* retval = regparse++; @@ -2054,7 +2036,7 @@ nextchar(void) /* - reg_node - emit a node */ -static regnode * /* Location. */ +STATIC regnode * /* Location. */ reg_node(U8 op) { register regnode *ret; @@ -2082,7 +2064,7 @@ reg_node(U8 op) /* - reganode - emit a node with an argument */ -static regnode * /* Location. */ +STATIC regnode * /* Location. */ reganode(U8 op, U32 arg) { register regnode *ret; @@ -2110,7 +2092,7 @@ reganode(U8 op, U32 arg) /* - regc - emit (if appropriate) a byte of code */ -static void +STATIC void regc(U8 b, char* s) { if (!SIZE_ONLY) @@ -2122,7 +2104,7 @@ regc(U8 b, char* s) * * Means relocating the operand. */ -static void +STATIC void reginsert(U8 op, regnode *opnd) { register regnode *src; @@ -2155,7 +2137,7 @@ reginsert(U8 op, regnode *opnd) /* - regtail - set the next-pointer at the end of a node chain of p to val. */ -static void +STATIC void regtail(regnode *p, regnode *val) { register regnode *scan; @@ -2200,7 +2182,7 @@ regtail(regnode *p, regnode *val) /* - regoptail - regtail on operand of first argument; nop if operandless */ -static void +STATIC void regoptail(regnode *p, regnode *val) { /* "Operandless" and "op != BRANCH" are synonymous in practice. */ @@ -2237,7 +2219,7 @@ regcurly(register char *s) #ifdef DEBUGGING -static regnode * +STATIC regnode * dumpuntil(regnode *start, regnode *node, regnode *last, SV* sv, I32 l) { register char op = EXACT; /* Arbitrary non-END op. */ @@ -2634,7 +2616,7 @@ regnext(register regnode *p) } #ifdef I_STDARG -static void +STATIC void re_croak2(const char* pat1,const char* pat2,...) #else /*VARARGS0*/ @@ -55,26 +55,6 @@ #include "perl.h" #include "regcomp.h" -static char * reginput; /* String-input pointer. */ -static char * regbol; /* Beginning of input, for ^ check. */ -static char * regeol; /* End of input, for $ check. */ -static char ** regstartp; /* Pointer to startp array. */ -static char ** regendp; /* Ditto for endp. */ -static U32 * reglastparen; /* Similarly for lastparen. */ -static char * regtill; /* How far we are required to go. */ -static char regprev; /* char before regbol, \n if none */ - -static char * regprecomp; /* uncompiled string. */ -static I32 regnpar; /* () count. */ -static I32 regsize; /* Largest OPEN seens. */ -static char ** reg_start_tmp; -static U32 reg_start_tmpl; -static struct reg_data *data; -static char *bostr; - -static U32 reg_flags; /* tainted/warned */ -static I32 reg_eval_set; - #define RF_tainted 1 /* tainted information used? */ #define RF_warned 2 /* warned about big count? */ #define RF_evaled 4 /* Did an EVAL? */ @@ -83,27 +63,7 @@ static I32 reg_eval_set; #define STATIC static #endif -#ifdef DEBUGGING -static I32 regnarrate = 0; -static regnode* regprogram = 0; -#endif - -/* Current curly descriptor */ -typedef struct curcur CURCUR; -struct curcur { - int parenfloor; /* how far back to strip paren data */ - int cur; /* how many instances of scan we've matched */ - int min; /* the minimal number of scans to match */ - int max; /* the maximal number of scans to match */ - int minmod; /* whether to work our way up or down */ - regnode * scan; /* the thing to match */ - regnode * next; /* what has to match after it */ - char * lastloc; /* where we started matching this scan */ - CURCUR * oldcc; /* current curly before we started this one */ -}; - -static CURCUR* regcc; - +#ifndef PERL_OBJECT typedef I32 CHECKPOINT; /* @@ -117,8 +77,9 @@ static I32 regtry _((regexp *prog, char *startpos)); static bool reginclass _((char *p, I32 c)); static CHECKPOINT regcppush _((I32 parenfloor)); static char * regcppop _((void)); +#endif -static CHECKPOINT +STATIC CHECKPOINT regcppush(I32 parenfloor) { dTHR; @@ -145,7 +106,7 @@ regcppush(I32 parenfloor) # define REGCP_SET DEBUG_r(PerlIO_printf(Perl_debug_log, " Setting an EVAL scope, savestack=%i\n", savestack_ix)); lastcp = savestack_ix # define REGCP_UNWIND DEBUG_r(lastcp != savestack_ix ? PerlIO_printf(Perl_debug_log," Clearing an EVAL scope, savestack=%i..%i\n", lastcp, savestack_ix) : 0); regcpblow(lastcp) -static char * +STATIC char * regcppop(void) { dTHR; @@ -678,7 +639,7 @@ phooey: /* - regtry - try match at specific point */ -static I32 /* 0 failure, 1 success */ +STATIC I32 /* 0 failure, 1 success */ regtry(regexp *prog, char *startpos) { dTHR; @@ -703,7 +664,7 @@ regtry(regexp *prog, char *startpos) sp = prog->startp; ep = prog->endp; - data = prog->data; + regdata = prog->data; if (prog->nparens) { for (i = prog->nparens; i >= 0; i--) { *sp++ = NULL; @@ -734,14 +695,14 @@ regtry(regexp *prog, char *startpos) * maybe save a little bit of pushing and popping on the stack. It also takes * advantage of machines that use a register save mask on subroutine entry. */ -static I32 /* 0 failure, 1 success */ +STATIC I32 /* 0 failure, 1 success */ regmatch(regnode *prog) { dTHR; register regnode *scan; /* Current node. */ regnode *next; /* Next node. */ regnode *inner; /* Next node in internal branch. */ - register I32 nextchar; + register I32 nextchr; /* renamed nextchr - nextchar colides with function of same name */ register I32 n; /* no or next */ register I32 ln; /* len or last */ register char *s; /* operand or save */ @@ -749,11 +710,10 @@ regmatch(regnode *prog) register I32 c1, c2, paren; /* case fold search, parenth */ int minmod = 0, sw = 0, logical = 0; #ifdef DEBUGGING - static int regindent = 0; regindent++; #endif - nextchar = UCHARAT(locinput); + nextchr = UCHARAT(locinput); scan = prog; while (scan != NULL) { #define sayNO_L (logical ? (logical = 0, sw = 0, goto cont) : sayNO) @@ -804,7 +764,7 @@ regmatch(regnode *prog) if (locinput == regbol ? regprev == '\n' : (multiline && - (nextchar || locinput < regeol) && locinput[-1] == '\n') ) + (nextchr || locinput < regeol) && locinput[-1] == '\n') ) { /* regtill = regbol; */ break; @@ -813,7 +773,7 @@ regmatch(regnode *prog) case MBOL: if (locinput == regbol ? regprev == '\n' - : ((nextchar || locinput < regeol) && locinput[-1] == '\n') ) + : ((nextchr || locinput < regeol) && locinput[-1] == '\n') ) { break; } @@ -833,38 +793,38 @@ regmatch(regnode *prog) goto seol; case MEOL: meol: - if ((nextchar || locinput < regeol) && nextchar != '\n') + if ((nextchr || locinput < regeol) && nextchr != '\n') sayNO; break; case SEOL: seol: - if ((nextchar || locinput < regeol) && nextchar != '\n') + if ((nextchr || locinput < regeol) && nextchr != '\n') sayNO; if (regeol - locinput > 1) sayNO; break; case SANY: - if (!nextchar && locinput >= regeol) + if (!nextchr && locinput >= regeol) sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case ANY: - if (!nextchar && locinput >= regeol || nextchar == '\n') + if (!nextchr && locinput >= regeol || nextchr == '\n') sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case EXACT: s = (char *) OPERAND(scan); ln = UCHARAT(s++); /* Inline the first character, for speed. */ - if (UCHARAT(s) != nextchar) + if (UCHARAT(s) != nextchr) sayNO; if (regeol - locinput < ln) sayNO; if (ln > 1 && memNE(s, locinput, ln)) sayNO; locinput += ln; - nextchar = UCHARAT(locinput); + nextchr = UCHARAT(locinput); break; case EXACTFL: reg_flags |= RF_tainted; @@ -873,9 +833,9 @@ regmatch(regnode *prog) s = (char *) OPERAND(scan); ln = UCHARAT(s++); /* Inline the first character, for speed. */ - if (UCHARAT(s) != nextchar && + if (UCHARAT(s) != nextchr && UCHARAT(s) != ((OP(scan) == EXACTF) - ? fold : fold_locale)[nextchar]) + ? fold : fold_locale)[nextchr]) sayNO; if (regeol - locinput < ln) sayNO; @@ -884,39 +844,39 @@ regmatch(regnode *prog) : ibcmp_locale(s, locinput, ln))) sayNO; locinput += ln; - nextchar = UCHARAT(locinput); + nextchr = UCHARAT(locinput); break; case ANYOF: s = (char *) OPERAND(scan); - if (nextchar < 0) - nextchar = UCHARAT(locinput); - if (!reginclass(s, nextchar)) + if (nextchr < 0) + nextchr = UCHARAT(locinput); + if (!reginclass(s, nextchr)) sayNO; - if (!nextchar && locinput >= regeol) + if (!nextchr && locinput >= regeol) sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case ALNUML: reg_flags |= RF_tainted; /* FALL THROUGH */ case ALNUM: - if (!nextchar) + if (!nextchr) sayNO; if (!(OP(scan) == ALNUM - ? isALNUM(nextchar) : isALNUM_LC(nextchar))) + ? isALNUM(nextchr) : isALNUM_LC(nextchr))) sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case NALNUML: reg_flags |= RF_tainted; /* FALL THROUGH */ case NALNUM: - if (!nextchar && locinput >= regeol) + if (!nextchr && locinput >= regeol) sayNO; if (OP(scan) == NALNUM - ? isALNUM(nextchar) : isALNUM_LC(nextchar)) + ? isALNUM(nextchr) : isALNUM_LC(nextchr)) sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case BOUNDL: case NBOUNDL: @@ -928,11 +888,11 @@ regmatch(regnode *prog) ln = (locinput != regbol) ? UCHARAT(locinput - 1) : regprev; if (OP(scan) == BOUND || OP(scan) == NBOUND) { ln = isALNUM(ln); - n = isALNUM(nextchar); + n = isALNUM(nextchr); } else { ln = isALNUM_LC(ln); - n = isALNUM_LC(nextchar); + n = isALNUM_LC(nextchr); } if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL)) sayNO; @@ -941,35 +901,35 @@ regmatch(regnode *prog) reg_flags |= RF_tainted; /* FALL THROUGH */ case SPACE: - if (!nextchar && locinput >= regeol) + if (!nextchr && locinput >= regeol) sayNO; if (!(OP(scan) == SPACE - ? isSPACE(nextchar) : isSPACE_LC(nextchar))) + ? isSPACE(nextchr) : isSPACE_LC(nextchr))) sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case NSPACEL: reg_flags |= RF_tainted; /* FALL THROUGH */ case NSPACE: - if (!nextchar) + if (!nextchr) sayNO; if (OP(scan) == SPACE - ? isSPACE(nextchar) : isSPACE_LC(nextchar)) + ? isSPACE(nextchr) : isSPACE_LC(nextchr)) sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case DIGIT: - if (!isDIGIT(nextchar)) + if (!isDIGIT(nextchr)) sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case NDIGIT: - if (!nextchar && locinput >= regeol) + if (!nextchr && locinput >= regeol) sayNO; - if (isDIGIT(nextchar)) + if (isDIGIT(nextchr)) sayNO; - nextchar = UCHARAT(++locinput); + nextchr = UCHARAT(++locinput); break; case REFFL: reg_flags |= RF_tainted; @@ -983,10 +943,10 @@ regmatch(regnode *prog) if (s == regendp[n]) break; /* Inline the first character, for speed. */ - if (UCHARAT(s) != nextchar && + if (UCHARAT(s) != nextchr && (OP(scan) == REF || (UCHARAT(s) != ((OP(scan) == REFF - ? fold : fold_locale)[nextchar])))) + ? fold : fold_locale)[nextchr])))) sayNO; ln = regendp[n] - s; if (locinput + ln > regeol) @@ -998,7 +958,7 @@ regmatch(regnode *prog) : ibcmp_locale(s, locinput, ln)))) sayNO; locinput += ln; - nextchar = UCHARAT(locinput); + nextchr = UCHARAT(locinput); break; case NOTHING: @@ -1015,9 +975,9 @@ regmatch(regnode *prog) SV *ret; n = ARG(scan); - op = (OP_4tree*)data->data[n]; + op = (OP_4tree*)regdata->data[n]; DEBUG_r( PerlIO_printf(Perl_debug_log, " re_eval 0x%x\n", op) ); - curpad = AvARRAY((AV*)data->data[n + 1]); + curpad = AvARRAY((AV*)regdata->data[n + 1]); if (!reg_eval_set) { /* Preserve whatever is on stack now, otherwise OP_NEXTSTATE will overwrite it. */ @@ -1035,7 +995,7 @@ regmatch(regnode *prog) cxstack[cxstack_ix].blk_gimme = G_SCALAR; */ } - runops(); /* Scalar context. */ + CALLRUNOPS(); /* Scalar context. */ SPAGAIN; ret = POPs; PUTBACK; @@ -1578,7 +1538,7 @@ regmatch(regnode *prog) } if (OP(scan) == SUSPEND) { locinput = reginput; - nextchar = UCHARAT(locinput); + nextchr = UCHARAT(locinput); } /* FALL THROUGH. */ case LONGJMP: @@ -1624,7 +1584,7 @@ no: * That was true before, but now we assume scan - reginput is the count, * rather than incrementing count on every character.] */ -static I32 +STATIC I32 regrepeat(regnode *p, I32 max) { register char *scan; @@ -1736,7 +1696,7 @@ regrepeat(regnode *p, I32 max) * The repeater is supposed to have constant length. */ -static I32 +STATIC I32 regrepeat_hard(regnode *p, I32 max, I32 *lp) { register char *scan; @@ -1767,7 +1727,7 @@ regrepeat_hard(regnode *p, I32 max, I32 *lp) - regclass - determine if a character falls into a character class */ -static bool +STATIC bool reginclass(register char *p, register I32 c) { char flags = *p; @@ -16,12 +16,17 @@ * know. Run now! Hope is in speed!" --Gandalf */ +#ifdef PERL_OBJECT +#define CALLOP this->*op +#else +#define CALLOP *op +#endif int runops_standard(void) { dTHR; - while ( op = (*op->op_ppaddr)(ARGS) ) ; + while ( op = (CALLOP->op_ppaddr)(ARGS) ) ; TAINT_NOT; return 0; @@ -32,7 +37,9 @@ runops_standard(void) { dEXT char **watchaddr = 0; dEXT char *watchok; +#ifndef PERL_OBJECT static void debprof _((OP*o)); +#endif int runops_debug(void) { @@ -51,7 +58,7 @@ runops_debug(void) { DEBUG_t(debop(op)); DEBUG_P(debprof(op)); } - } while ( op = (*op->op_ppaddr)(ARGS) ); + } while ( op = (CALLOP->op_ppaddr)(ARGS) ); TAINT_NOT; return 0; @@ -93,7 +100,7 @@ watch(char **addr) (long)watchaddr, (long)watchok); } -static void +STATIC void debprof(OP *o) { if (!profiledata) @@ -152,7 +152,7 @@ free_tmps(void) } } -static SV * +STATIC SV * save_scalar_at(SV **sptr) { dTHR; @@ -483,7 +483,11 @@ save_list(register SV **sarg, I32 maxsarg) } void +#ifdef PERL_OBJECT +save_destructor(DESTRUCTORFUNC f, void* p) +#else save_destructor(void (*f) (void *), void *p) +#endif { dTHR; SSCHECK(3); @@ -747,7 +751,7 @@ leave_scope(I32 base) break; case SAVEt_DESTRUCTOR: ptr = SSPOPPTR; - (*SSPOPDPTR)(ptr); + (CALLDESTRUCTOR)(ptr); break; case SAVEt_REGCONTEXT: i = SSPOPINT; @@ -77,8 +77,17 @@ #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 CALLDESTRUCTOR this->*SSPOPDPTR #define SAVEDESTRUCTOR(f,p) \ - save_destructor(SOFT_CAST(void(*)_((void*)))(f),SOFT_CAST(void*)(p)) + save_destructor((DESTRUCTORFUNC)(FUNC_NAME_TO_PTR(f)), \ + SOFT_CAST(void*)(p)) +#else +#define CALLDESTRUCTOR *SSPOPDPTR +#define SAVEDESTRUCTOR(f,p) \ + save_destructor(SOFT_CAST(void(*)_((void*)))(FUNC_NAME_TO_PTR(f)), \ + SOFT_CAST(void*)(p)) +#endif #define SAVESTACK_POS() STMT_START { \ SSCHECK(2); \ SSPUSHINT(stack_sp - stack_base); \ @@ -40,6 +40,12 @@ # define FAST_SV_GETS #endif +#ifdef PERL_OBJECT +#define FCALL this->*f +#define VTBL this->*vtbl + +#else /* !PERL_OBJECT */ + static IV asIV _((SV* sv)); static UV asUV _((SV* sv)); static SV *more_sv _((void)); @@ -59,13 +65,17 @@ static void sv_mortalgrow _((void)); static void sv_unglob _((SV* sv)); static void sv_check_thinkfirst _((SV *sv)); -#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_check_thinkfirst(sv) - #ifndef PURIFY static void *my_safemalloc(MEM_SIZE size); #endif typedef void (*SVFUNC) _((SV*)); +#define VTBL *vtbl +#define FCALL *f + +#endif /* PERL_OBJECT */ + +#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_check_thinkfirst(sv) #ifdef PURIFY @@ -208,7 +218,7 @@ U32 flags; UNLOCK_SV_MUTEX; \ } while (0) -static void +STATIC void del_sv(SV *p) { if (debug & 32768) { @@ -264,7 +274,7 @@ sv_add_arena(char *ptr, U32 size, U32 flags) } /* sv_mutex must be held while calling more_sv() */ -static SV* +STATIC SV* more_sv(void) { register SV* sv; @@ -282,7 +292,7 @@ more_sv(void) return sv; } -static void +STATIC void visit(SVFUNC f) { SV* sva; @@ -293,14 +303,14 @@ visit(SVFUNC f) svend = &sva[SvREFCNT(sva)]; for (sv = sva + 1; sv < svend; ++sv) { if (SvTYPE(sv) != SVTYPEMASK) - (*f)(sv); + (FCALL)(sv); } } } #endif /* PURIFY */ -static void +STATIC void do_report_used(SV *sv) { if (SvTYPE(sv) != SVTYPEMASK) { @@ -313,10 +323,10 @@ do_report_used(SV *sv) void sv_report_used(void) { - visit(do_report_used); + visit(FUNC_NAME_TO_PTR(do_report_used)); } -static void +STATIC void do_clean_objs(SV *sv) { SV* rv; @@ -332,7 +342,7 @@ do_clean_objs(SV *sv) } #ifndef DISABLE_DESTRUCTOR_KLUDGE -static void +STATIC void do_clean_named_objs(SV *sv) { if (SvTYPE(sv) == SVt_PVGV) { @@ -351,20 +361,18 @@ do_clean_named_objs(SV *sv) } #endif -static bool in_clean_objs = FALSE; - void sv_clean_objs(void) { in_clean_objs = TRUE; #ifndef DISABLE_DESTRUCTOR_KLUDGE - visit(do_clean_named_objs); + visit(FUNC_NAME_TO_PTR(do_clean_named_objs)); #endif - visit(do_clean_objs); + visit(FUNC_NAME_TO_PTR(do_clean_objs)); 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));) @@ -372,13 +380,11 @@ do_clean_all(SV *sv) SvREFCNT_dec(sv); } -static bool in_clean_all = FALSE; - void sv_clean_all(void) { in_clean_all = TRUE; - visit(do_clean_all); + visit(FUNC_NAME_TO_PTR(do_clean_all)); in_clean_all = FALSE; } @@ -408,7 +414,7 @@ sv_free_arenas(void) sv_root = 0; } -static XPVIV* +STATIC XPVIV* new_xiv(void) { IV** xiv; @@ -423,7 +429,7 @@ new_xiv(void) return more_xiv(); } -static void +STATIC void del_xiv(XPVIV *p) { IV** xiv = (IV**)((char*)(p) + sizeof(XPV)); @@ -431,7 +437,7 @@ del_xiv(XPVIV *p) xiv_root = xiv; } -static XPVIV* +STATIC XPVIV* more_xiv(void) { register IV** xiv; @@ -453,7 +459,7 @@ more_xiv(void) return new_xiv(); } -static XPVNV* +STATIC XPVNV* new_xnv(void) { double* xnv; @@ -465,7 +471,7 @@ new_xnv(void) return more_xnv(); } -static void +STATIC void del_xnv(XPVNV *p) { double* xnv = (double*)((char*)(p) + sizeof(XPVIV)); @@ -473,7 +479,7 @@ del_xnv(XPVNV *p) xnv_root = xnv; } -static XPVNV* +STATIC XPVNV* more_xnv(void) { register double* xnv; @@ -490,7 +496,7 @@ more_xnv(void) return new_xnv(); } -static XRV* +STATIC XRV* new_xrv(void) { XRV* xrv; @@ -502,14 +508,14 @@ new_xrv(void) return more_xrv(); } -static void +STATIC void del_xrv(XRV *p) { p->xrv_rv = (SV*)xrv_root; xrv_root = p; } -static XRV* +STATIC XRV* more_xrv(void) { register XRV* xrv; @@ -525,7 +531,7 @@ more_xrv(void) return new_xrv(); } -static XPV* +STATIC XPV* new_xpv(void) { XPV* xpv; @@ -537,14 +543,14 @@ new_xpv(void) return more_xpv(); } -static void +STATIC void del_xpv(XPV *p) { p->xpv_pv = (char*)xpv_root; xpv_root = p; } -static XPV* +STATIC XPV* more_xpv(void) { register XPV* xpv; @@ -596,7 +602,7 @@ more_xpv(void) # define my_safemalloc(s) safemalloc(s) # define my_safefree(s) free(s) #else -static void* +STATIC void* my_safemalloc(MEM_SIZE size) { char *p; @@ -1231,7 +1237,7 @@ sv_setnv_mg(register SV *sv, double num) SvSETMAGIC(sv); } -static void +STATIC void not_a_number(SV *sv) { dTHR; @@ -1526,7 +1532,7 @@ sv_2nv(register SV *sv) return SvNVX(sv); } -static IV +STATIC IV asIV(SV *sv) { I32 numtype = looks_like_number(sv); @@ -1544,7 +1550,7 @@ asIV(SV *sv) return (IV) U_V(d); } -static UV +STATIC UV asUV(SV *sv) { I32 numtype = looks_like_number(sv); @@ -2314,7 +2320,7 @@ sv_usepvn_mg(register SV *sv, register char *ptr, register STRLEN len) SvSETMAGIC(sv); } -static void +STATIC void sv_check_thinkfirst(register SV *sv) { if (SvREADONLY(sv)) { @@ -2604,8 +2610,8 @@ sv_unmagic(SV *sv, int type) if (mg->mg_type == type) { MGVTBL* vtbl = mg->mg_virtual; *mgp = mg->mg_moremagic; - if (vtbl && vtbl->svt_free) - (*vtbl->svt_free)(sv, mg); + if (vtbl && (vtbl->svt_free != NULL)) + (VTBL->svt_free)(sv, mg); if (mg->mg_ptr && mg->mg_type != 'g') if (mg->mg_len >= 0) Safefree(mg->mg_ptr); @@ -2742,13 +2748,13 @@ sv_clear(register SV *sv) if (defstash) { /* Still have a symbol table? */ djSP; GV* destructor; - SV ref; + SV tmpref; - Zero(&ref, 1, SV); - sv_upgrade(&ref, SVt_RV); - SvROK_on(&ref); - SvREADONLY_on(&ref); /* DESTROY() could be naughty */ - SvREFCNT(&ref) = 1; + Zero(&tmpref, 1, SV); + sv_upgrade(&tmpref, SVt_RV); + SvROK_on(&tmpref); + SvREADONLY_on(&tmpref); /* DESTROY() could be naughty */ + SvREFCNT(&tmpref) = 1; do { stash = SvSTASH(sv); @@ -2756,10 +2762,10 @@ sv_clear(register SV *sv) if (destructor) { ENTER; PUSHSTACK(SI_DESTROY); - SvRV(&ref) = SvREFCNT_inc(sv); + SvRV(&tmpref) = SvREFCNT_inc(sv); EXTEND(SP, 2); PUSHMARK(SP); - PUSHs(&ref); + PUSHs(&tmpref); PUTBACK; perl_call_sv((SV*)GvCV(destructor), G_DISCARD|G_EVAL|G_KEEPERR); @@ -2769,7 +2775,7 @@ sv_clear(register SV *sv) } } while (SvOBJECT(sv) && SvSTASH(sv) != stash); - del_XRV(SvANY(&ref)); + del_XRV(SvANY(&tmpref)); } if (SvOBJECT(sv)) { @@ -2951,7 +2957,7 @@ sv_len(register SV *sv) return 0; if (SvGMAGICAL(sv)) - len = mg_len(sv); + len = mg_length(sv); else junk = SvPV(sv, len); return len; @@ -3483,7 +3489,7 @@ sv_dec(register SV *sv) * hopefully we won't free it until it has been assigned to a * permanent location. */ -static void +STATIC void sv_mortalgrow(void) { dTHR; @@ -3558,9 +3564,7 @@ newSVpv(char *s, STRLEN len) } SV * -newSVpvn(s,len) -char *s; -STRLEN len; +newSVpvn(char *s, STRLEN len) { register SV *sv; @@ -3628,7 +3632,7 @@ newSViv(IV i) } SV * -newRV(SV *ref) +newRV(SV *tmpRef) { dTHR; register SV *sv; @@ -3638,8 +3642,8 @@ newRV(SV *ref) SvREFCNT(sv) = 1; SvFLAGS(sv) = 0; sv_upgrade(sv, SVt_RV); - SvTEMP_off(ref); - SvRV(sv) = SvREFCNT_inc(ref); + SvTEMP_off(tmpRef); + SvRV(sv) = SvREFCNT_inc(tmpRef); SvROK_on(sv); return sv; } @@ -3647,12 +3651,12 @@ newRV(SV *ref) SV * -Perl_newRV_noinc(SV *ref) +Perl_newRV_noinc(SV *tmpRef) { register SV *sv; - sv = newRV(ref); - SvREFCNT_dec(ref); + sv = newRV(tmpRef); + SvREFCNT_dec(tmpRef); return sv; } @@ -4083,24 +4087,24 @@ SV* sv_bless(SV *sv, HV *stash) { dTHR; - SV *ref; + SV *tmpRef; if (!SvROK(sv)) croak("Can't bless non-reference value"); - ref = SvRV(sv); - if (SvFLAGS(ref) & (SVs_OBJECT|SVf_READONLY)) { - if (SvREADONLY(ref)) + tmpRef = SvRV(sv); + if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) { + if (SvREADONLY(tmpRef)) croak(no_modify); - if (SvOBJECT(ref)) { - if (SvTYPE(ref) != SVt_PVIO) + if (SvOBJECT(tmpRef)) { + if (SvTYPE(tmpRef) != SVt_PVIO) --sv_objcount; - SvREFCNT_dec(SvSTASH(ref)); + SvREFCNT_dec(SvSTASH(tmpRef)); } } - SvOBJECT_on(ref); - if (SvTYPE(ref) != SVt_PVIO) + SvOBJECT_on(tmpRef); + if (SvTYPE(tmpRef) != SVt_PVIO) ++sv_objcount; - (void)SvUPGRADE(ref, SVt_PVMG); - SvSTASH(ref) = (HV*)SvREFCNT_inc(stash); + (void)SvUPGRADE(tmpRef, SVt_PVMG); + SvSTASH(tmpRef) = (HV*)SvREFCNT_inc(stash); #ifdef OVERLOAD if (Gv_AMG(stash)) @@ -4112,7 +4116,7 @@ sv_bless(SV *sv, HV *stash) return sv; } -static void +STATIC void sv_unglob(SV *sv) { assert(SvTYPE(sv) == SVt_PVGV); @@ -637,7 +637,7 @@ struct xpvio { # undef newRV_noinc # define newRV_noinc(sv) ({SV *nsv=newRV((sv)); --SvREFCNT(SvRV(nsv)); nsv;}) #else -# if defined(CRIPPLED_CC) || defined(USE_THREADS) +# if defined(CRIPPLED_CC) || defined(USE_THREADS) || defined(PERL_OBJECT) # else # undef newRV_noinc # define newRV_noinc(sv) ((Sv = newRV(sv)), --SvREFCNT(SvRV(Sv)), Sv) diff --git a/t/lib/thread.t b/t/lib/thread.t index b8e1b387ba..b8e1b387ba 100755..100644 --- a/t/lib/thread.t +++ b/t/lib/thread.t diff --git a/t/op/nothread.t b/t/op/nothread.t index a0d444d90b..a0d444d90b 100755..100644 --- a/t/op/nothread.t +++ b/t/op/nothread.t @@ -224,5 +224,9 @@ typedef struct condpair { #define THR /* Rats: if dTHR is just blank then the subsequent ";" throws an error */ +#ifdef WIN32 +#define dTHR +#else #define dTHR extern int errno +#endif #endif /* USE_THREADS */ @@ -14,11 +14,12 @@ #include "EXTERN.h" #include "perl.h" +#ifndef PERL_OBJECT static void check_uni _((void)); static void force_next _((I32 type)); static char *force_version _((char *start)); static char *force_word _((char *start, int token, int check_keyword, int allow_pack, int allow_tick)); -static SV *q _((SV *sv)); +static SV *tokeq _((SV *sv)); static char *scan_const _((char *start)); static char *scan_formline _((char *s)); static char *scan_heredoc _((char *s)); @@ -51,19 +52,10 @@ static char * filter_gets _((SV *sv, PerlIO *fp, STRLEN append)); static void restore_rsfp _((void *f)); static void restore_expect _((void *e)); static void restore_lex_expect _((void *e)); +#endif /* PERL_OBJECT */ static char ident_too_long[] = "Identifier too long"; -static char *linestart; /* beg. of most recently read line */ - -static char pending_ident; /* pending identifier lookup */ - -static struct { - I32 super_state; /* lexer state to save */ - I32 sub_inwhat; /* "lex_inwhat" to use */ - OP *sub_op; /* "lex_op" to use */ -} sublex_info; - /* The following are arranged oddly so that the guard on the switch statement * can get by with a single comparison (if the compiler is smart enough). */ @@ -145,7 +137,7 @@ static struct { /* grandfather return to old style */ #define OLDLOP(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LSTOP) -static int +STATIC int ao(int toketype) { if (*bufptr == '=') { @@ -159,7 +151,7 @@ ao(int toketype) return toketype; } -static void +STATIC void no_op(char *what, char *s) { char *oldbp = bufptr; @@ -182,7 +174,7 @@ no_op(char *what, char *s) bufptr = oldbp; } -static void +STATIC void missingterm(char *s) { char tmpbuf[3]; @@ -215,7 +207,7 @@ deprecate(char *s) warn("Use of %s is deprecated", s); } -static void +STATIC void depcom(void) { deprecate("comma-less variable list"); @@ -223,7 +215,7 @@ depcom(void) #ifdef WIN32 -static I32 +STATIC I32 win32_textfilter(int idx, SV *sv, int maxlen) { I32 count = FILTER_READ(idx+1, sv, maxlen); @@ -305,7 +297,7 @@ lex_end(void) doextract = FALSE; } -static void +STATIC void restore_rsfp(void *f) { PerlIO *fp = (PerlIO*)f; @@ -317,23 +309,21 @@ restore_rsfp(void *f) rsfp = fp; } -static void -restore_expect(e) -void *e; +STATIC void +restore_expect(void *e) { /* a safe way to store a small integer in a pointer */ expect = (expectation)((char *)e - tokenbuf); } -static void -restore_lex_expect(e) -void *e; +STATIC void +restore_lex_expect(void *e) { /* a safe way to store a small integer in a pointer */ lex_expect = (expectation)((char *)e - tokenbuf); } -static void +STATIC void incline(char *s) { dTHR; @@ -374,7 +364,7 @@ incline(char *s) curcop->cop_line = atoi(n)-1; } -static char * +STATIC char * skipspace(register char *s) { dTHR; @@ -432,7 +422,7 @@ skipspace(register char *s) } } -static void +STATIC void check_uni(void) { char *s; char ch; @@ -456,7 +446,7 @@ check_uni(void) { #undef UNI #define UNI(f) return uni(f,s) -static int +STATIC int uni(I32 f, char *s) { yylval.ival = f; @@ -477,7 +467,7 @@ uni(I32 f, char *s) #define LOP(f,x) return lop(f,x,s) -static I32 +STATIC I32 lop(I32 f, expectation x, char *s) { dTHR; @@ -498,7 +488,7 @@ lop(I32 f, expectation x, char *s) return LSTOP; } -static void +STATIC void force_next(I32 type) { nexttype[nexttoke] = type; @@ -510,7 +500,7 @@ force_next(I32 type) } } -static char * +STATIC char * force_word(register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick) { register char *s; @@ -542,7 +532,7 @@ force_word(register char *start, int token, int check_keyword, int allow_pack, i return s; } -static void +STATIC void force_ident(register char *s, int kind) { if (s && *s) { @@ -565,7 +555,7 @@ force_ident(register char *s, int kind) } } -static char * +STATIC char * force_version(char *s) { OP *version = Nullop; @@ -592,8 +582,8 @@ force_version(char *s) return (s); } -static SV * -q(SV *sv) +STATIC SV * +tokeq(SV *sv) { register char *s; register char *send; @@ -625,7 +615,7 @@ q(SV *sv) return sv; } -static I32 +STATIC I32 sublex_start(void) { register I32 op_type = yylval.ival; @@ -636,7 +626,7 @@ sublex_start(void) return THING; } if (op_type == OP_CONST || op_type == OP_READLINE) { - SV *sv = q(lex_stuff); + SV *sv = tokeq(lex_stuff); STRLEN len; char *p = SvPV(sv, len); yylval.opval = (OP*)newSVOP(op_type, 0, newSVpv(p, len)); @@ -660,7 +650,7 @@ sublex_start(void) return FUNC; } -static I32 +STATIC I32 sublex_push(void) { dTHR; @@ -713,7 +703,7 @@ sublex_push(void) return '('; } -static I32 +STATIC I32 sublex_done(void) { if (!lex_starts++) { @@ -825,7 +815,7 @@ sublex_done(void) */ -static char * +STATIC char * scan_const(char *start) { register char *send = bufend; /* end of the constant */ @@ -1041,7 +1031,7 @@ scan_const(char *start) } /* This is the one truly awful dwimmer necessary to conflate C and sed. */ -static int +STATIC int intuit_more(register char *s) { if (lex_brackets) @@ -1169,7 +1159,7 @@ intuit_more(register char *s) return TRUE; } -static int +STATIC int intuit_method(char *start, GV *gv) { char *s = start + (*start == '$'); @@ -1228,7 +1218,7 @@ intuit_method(char *start, GV *gv) return 0; } -static char* +STATIC char* incl_perldb(void) { if (perldb) { @@ -1360,7 +1350,7 @@ filter_read(int idx, SV *buf_sv, int maxlen) return (*funcp)(idx, buf_sv, maxlen); } -static char * +STATIC char * filter_gets(register SV *sv, register PerlIO *fp, STRLEN append) { #ifdef WIN32FILTER @@ -1666,7 +1656,7 @@ yylex(void) if (SvIVX(linestr) == '\'') { SV *sv = newSVsv(linestr); if (!lex_inpat) - sv = q(sv); + sv = tokeq(sv); yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv); s = bufend; } @@ -3604,7 +3594,7 @@ yylex(void) } } force_next(')'); - nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, q(lex_stuff)); + nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, tokeq(lex_stuff)); lex_stuff = Nullsv; force_next(THING); force_next(','); @@ -4658,7 +4648,7 @@ keyword(register char *d, I32 len) return 0; } -static void +STATIC void checkcomma(register char *s, char *name, char *what) { char *w; @@ -4700,7 +4690,7 @@ checkcomma(register char *s, char *name, char *what) } } -static char * +STATIC char * scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp) { register char *d = dest; @@ -4727,7 +4717,7 @@ scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLE } } -static char * +STATIC char * scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I32 ck_uni) { register char *d; @@ -4862,7 +4852,7 @@ void pmflag(U16 *pmfl, int ch) *pmfl |= PMf_EXTENDED; } -static char * +STATIC char * scan_pat(char *start) { PMOP *pm; @@ -4888,7 +4878,7 @@ scan_pat(char *start) return s; } -static char * +STATIC char * scan_subst(char *start) { register char *s; @@ -4953,7 +4943,7 @@ scan_subst(char *start) return s; } -static char * +STATIC char * scan_trans(char *start) { register char* s; @@ -5006,7 +4996,7 @@ scan_trans(char *start) return s; } -static char * +STATIC char * scan_heredoc(register char *s) { dTHR; @@ -5150,7 +5140,7 @@ scan_heredoc(register char *s) */ -static char * +STATIC char * scan_inputsymbol(char *start) { register char *s = start; /* current position in buffer */ @@ -5286,7 +5276,7 @@ scan_inputsymbol(char *start) */ -static char * +STATIC char * scan_str(char *start) { dTHR; @@ -5675,7 +5665,7 @@ scan_num(char *start) return s; } -static char * +STATIC char * scan_formline(register char *s) { dTHR; @@ -5745,7 +5735,7 @@ scan_formline(register char *s) return s; } -static void +STATIC void set_csh(void) { #ifdef CSH diff --git a/universal.c b/universal.c index 67f96c381b..72da1e4937 100644 --- a/universal.c +++ b/universal.c @@ -1,13 +1,12 @@ #include "EXTERN.h" #include "perl.h" -#include "XSUB.h" /* * Contributed by Graham Barr <Graham.Barr@tiuk.ti.com> * The main guts of traverse_isa was actually copied from gv_fetchmeth */ -static SV * +STATIC SV * isa_lookup(HV *stash, char *name, int len, int level) { AV* av; @@ -101,6 +100,11 @@ sv_derived_from(SV *sv, char *name) } +#ifdef PERL_OBJECT +#define NO_XSLOCKS +#endif /* PERL_OBJECT */ + +#include "XSUB.h" static XS(XS_UNIVERSAL_isa) @@ -197,6 +201,12 @@ XS(XS_UNIVERSAL_VERSION) XSRETURN(1); } +#ifdef PERL_OBJECT +#undef boot_core_UNIVERSAL +#define boot_core_UNIVERSAL CPerlObj::Perl_boot_core_UNIVERSAL +#define pPerl this +#endif + void boot_core_UNIVERSAL(void) { @@ -844,13 +844,13 @@ char * mem_collxfrm(const char *s, STRLEN len, STRLEN *xlen) { char *xbuf; - STRLEN xalloc, xin, xout; + STRLEN xAlloc, xin, xout; /* xalloc is a reserved word in VC */ /* the first sizeof(collationix) bytes are used by sv_collxfrm(). */ /* the +1 is for the terminating NUL. */ - xalloc = sizeof(collation_ix) + collxfrm_base + (collxfrm_mult * len) + 1; - New(171, xbuf, xalloc, char); + xAlloc = sizeof(collation_ix) + collxfrm_base + (collxfrm_mult * len) + 1; + New(171, xbuf, xAlloc, char); if (! xbuf) goto bad; @@ -860,13 +860,13 @@ mem_collxfrm(const char *s, STRLEN len, STRLEN *xlen) SSize_t xused; for (;;) { - xused = strxfrm(xbuf + xout, s + xin, xalloc - xout); + xused = strxfrm(xbuf + xout, s + xin, xAlloc - xout); if (xused == -1) goto bad; - if (xused < xalloc - xout) + if (xused < xAlloc - xout) break; - xalloc = (2 * xalloc) + 1; - Renew(xbuf, xalloc, char); + xAlloc = (2 * xAlloc) + 1; + Renew(xbuf, xAlloc, char); if (! xbuf) goto bad; } @@ -1178,7 +1178,7 @@ savepvn(char *sv, register I32 len) /* the SV for form() and mess() is not kept in an arena */ -static SV * +STATIC SV * mess_alloc(void) { SV *sv; @@ -2182,7 +2182,7 @@ wait4pid(int pid, int *statusp, int flags) if (flags) croak("Can't do waitpid with flags"); else { - while ((result = wait(statusp)) != pid && pid > 0 && result >= 0) + while ((result = PerlProc_wait(statusp)) != pid && pid > 0 && result >= 0) pidgone(result,*statusp); if (result < 0) *statusp = -1; @@ -3312,7 +3312,7 @@ struct passwd *my_getpwuid(Uid_t uid) else { uic.uic$l_uic= uid; if (!uic.uic$v_group) - uic.uic$v_group= getgid(); + uic.uic$v_group= PerlProc_getgid(); if (valid_uic(uic)) status = sys$idtoasc(uic.uic$l_uic, &lname, &name_desc, 0, 0, 0); else status = SS$_IVIDENT; diff --git a/win32/Makefile b/win32/Makefile index 951c15a84d..ea5dd12e38 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -1,79 +1,88 @@ -# +# # Makefile to build perl on Windowns NT using Microsoft NMAKE. -# +# Works with MS command line compilers from VC++ etc. # # This is set up to build a perl.exe that runs off a shared library # (perl.dll). Also makes individual DLLs for the XS extensions. -# - +# NB: Miniperl has a different set of objects it depends on than +# perl.exe +# Also, Miniperl will not build with -DPERL_OBJECT defined # # Set these to wherever you want "nmake install" to put your # newly built perl. -INST_DRV=c: -INST_TOP=$(INST_DRV)\perl5004.5x +INST_DRV = c: +INST_TOP = $(INST_DRV)\perl5004.5x # # uncomment to enable threads-capabilities -#USE_THREADS=define +#USE_THREADS = define # # uncomment next line if you are using Visual C++ 2.x -#CCTYPE=MSVC20 +#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 +#CFG = Debug # # if you have the source for des_fcrypt(), uncomment this and make sure the # file exists (see README.win32) -#CRYPT_SRC=des_fcrypt.c +#CRYPT_SRC = des_fcrypt.c # # if you didn't set CRYPT_SRC and if you have des_fcrypt() available in a # library, uncomment this, and make sure the library exists (see README.win32) -#CRYPT_LIB=des_fcrypt.lib +#CRYPT_LIB = des_fcrypt.lib # # set this if you wish to use perl's malloc # WARNING: Turning this on/off WILL break binary compatibility with extensions # you may have compiled with/without it. Be prepared to recompile all extensions # if you change the default. -PERL_MALLOC = define +#PERL_MALLOC = define # # set the install locations of the compiler include/libraries -#CCHOME = f:\msvc20 -CCHOME = $(MSVCDIR) -CCINCDIR = $(CCHOME)\include -CCLIBDIR = $(CCHOME)\lib +#CCHOME = f:\msvc20 +CCHOME = $(MSVCDIR) +CCINCDIR = $(CCHOME)\include +CCLIBDIR = $(CCHOME)\lib # # set this to your email address (perl will guess a value from # from your loginname and your hostname, which may not be right) -#EMAIL = +#EMAIL = ##################### CHANGE THESE ONLY IF YOU MUST ##################### !IF "$(CRYPT_SRC)$(CRYPT_LIB)" == "" -D_CRYPT=undef +D_CRYPT = undef !ELSE -D_CRYPT=define -CRYPT_FLAG=-DHAVE_DES_FCRYPT +D_CRYPT = define +CRYPT_FLAG = -DHAVE_DES_FCRYPT +!ENDIF + +!IF "$(OBJECT)" != "" +PERL_MALLOC = undef !ENDIF !IF "$(PERL_MALLOC)" == "" PERL_MALLOC = undef !ENDIF +!IF "$(USE_THREADS)" == "" +USE_THREADS = undef +!ENDIF + #BUILDOPT = -DMULTIPLICITY #BUILDOPT = -DPERL_GLOBAL_STRUCT -DMULTIPLICITY # -DUSE_PERLIO -D__STDC__=1 -DUSE_SFIO -DI_SFIO -I\sfio97\include -!IF "$(USE_THREADS)" == "" -USE_THREADS = undef -!ENDIF - !IF "$(PROCESSOR_ARCHITECTURE)" == "" PROCESSOR_ARCHITECTURE = x86 !ENDIF @@ -86,60 +95,74 @@ ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE) ARCHDIR = ..\lib\$(ARCHNAME) COREDIR = ..\lib\CORE +AUTODIR = ..\lib\auto # # Programs to compile, build .lib files and link # -CC=cl.exe -LINK32=link.exe -LIB32=$(LINK32) -lib +CC = cl.exe +LINK32 = link.exe +LIB32 = $(LINK32) -lib + # # Options # -!IF "$(RUNTIME)" == "" -RUNTIME = -MD +!IF "$(OBJECT)" == "-DPERL_OBJECT" +RUNTIME = -MT +# XXX building with -MD fails many tests, but cannot investigate +# because building with debug crashes compiler :-( GSAR )-: +#RUNTIME = -MD +!ELSE +RUNTIME = -MD !ENDIF -INCLUDES = -I.\include -I. -I.. -#PCHFLAGS = -Fpc:\temp\modules.pch -YX -DEFINES = -DWIN32 -D_CONSOLE $(BUILDOPT) $(CRYPT_FLAG) -LOCDEFS = -DPERLDLL -DPERL_CORE -SUBSYS = console + +INCLUDES = -I.\include -I. -I.. +#PCHFLAGS = -Fp"$(INTDIR)/modules.pch" -YX +DEFINES = -DWIN32 -D_CONSOLE $(BUILDOPT) $(CRYPT_FLAG) +LOCDEFS = -DPERLDLL -DPERL_CORE +SUBSYS = console +CXX_FLAG = -TP -GX !IF "$(RUNTIME)" == "-MD" -LIBC = msvcrt.lib -WINIOMAYBE = +LIBC = msvcrt.lib !ELSE -LIBC = libcmt.lib -WINIOMAYBE = +LIBC = libcmt.lib !ENDIF !IF "$(CFG)" == "Debug" ! IF "$(CCTYPE)" == "MSVC20" -OPTIMIZE = -Od $(RUNTIME) -Z7 -D_DEBUG -DDEBUGGING +OPTIMIZE = -Od $(RUNTIME) -Z7 -D_DEBUG -DDEBUGGING ! ELSE -OPTIMIZE = -Od $(RUNTIME)d -Z7 -D_DEBUG -DDEBUGGING +OPTIMIZE = -Od $(RUNTIME)d -Z7 -D_DEBUG -DDEBUGGING ! ENDIF -LINK_DBG = -debug -pdb:none +LINK_DBG = -debug -pdb:none !ELSE ! IF "$(CCTYPE)" == "MSVC20" -OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG +OPTIMIZE = -Od $(RUNTIME) -DNDEBUG ! ELSE -OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG +OPTIMIZE = -Od $(RUNTIME) -DNDEBUG ! ENDIF -LINK_DBG = -release +LINK_DBG = -release !ENDIF -# we don't add LIBC here, the compiler do it based on -MD/-MT -LIBFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \ - winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \ - oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ - version.lib odbc32.lib odbccp32.lib +!IF "$(OBJECT)" != "" +OPTIMIZE = $(OPTIMIZE) $(CXX_FLAG) +!ENDIF + +# we don't add LIBC here, the compiler does it based on -MD/-MT +LIBFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \ + winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \ + oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ + version.lib odbc32.lib odbccp32.lib + +CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) \ + $(PCHFLAGS) $(OPTIMIZE) +LINK_FLAGS = -nologo $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE) +OBJOUT_FLAG = -Fo +EXEOUT_FLAG = -Fe -CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) $(PCHFLAGS) $(OPTIMIZE) -LINK_FLAGS = -nologo $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE) -OBJOUT_FLAG = -Fo -EXEOUT_FLAG = -Fe +CFLAGS_O = $(CFLAGS) $(OBJECT) #################### do not edit below this line ####################### ############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ############## @@ -153,258 +176,273 @@ o = .obj .SUFFIXES : .c $(o) .dll .lib .exe .c$(o): - $(CC) -c -I$(<D) $(CFLAGS) $(OBJOUT_FLAG)$@ $< + $(CC) -c $(CFLAGS_O) $(OBJOUT_FLAG)$@ $< + +.y.c: + $(NOOP) $(o).dll: $(LINK32) -dll -subsystem:windows -implib:$(*B).lib -def:$(*B).def \ -out:$@ $(LINK_FLAGS) $(LIBFILES) $< $(LIBPERL) -.y.c: - $(NOOP) - # -INST_BIN=$(INST_TOP)\bin -INST_LIB=$(INST_TOP)\lib -INST_POD=$(INST_LIB)\pod -INST_HTML=$(INST_POD)\html -LIBDIR=..\lib -EXTDIR=..\ext -PODDIR=..\pod -EXTUTILSDIR=$(LIBDIR)\extutils +INST_BIN = $(INST_TOP)\bin +INST_LIB = $(INST_TOP)\lib +INST_POD = $(INST_LIB)\pod +INST_HTML = $(INST_POD)\html +LIBDIR = ..\lib +EXTDIR = ..\ext +PODDIR = ..\pod +EXTUTILSDIR = $(LIBDIR)\extutils # # various targets -PERLIMPLIB=..\perl.lib -MINIPERL=..\miniperl.exe -PERLDLL=..\perl.dll -PERLEXE=..\perl.exe -GLOBEXE=..\perlglob.exe -CONFIGPM=..\lib\Config.pm -MINIMOD=..\lib\ExtUtils\Miniperl.pm -X2P=..\x2p\a2p.exe - -PL2BAT=bin\pl2bat.pl -GLOBBAT = bin\perlglob.bat - -CFGSH_TMPL = config.vc -CFGH_TMPL = config_H.vc -PERL95EXE=..\perl95.exe -XCOPY=xcopy /f /r /i /d -RCOPY=xcopy /f /r /i /e /d -NOOP=@echo -NULL= - -!IF "$(CRYPT_SRC)" != "" -CRYPT_OBJ=$(CRYPT_SRC:.c=.obj) +!IF "$(OBJECT)" == "-DPERL_OBJECT" +PERLIMPLIB = ..\perlcore.lib +PERLDLL = ..\perlcore.dll +!ELSE +PERLIMPLIB = ..\perl.lib +PERLDLL = ..\perl.dll !ENDIF -!IF "$(PERL_MALLOC)" == "define" -MALLOC_SRC = ..\malloc.c -MALLOC_OBJ = ..\malloc$(o) -!ENDIF +MINIPERL = ..\miniperl.exe +MINIDIR = .\mini +PERLEXE = ..\perl.exe +GLOBEXE = ..\perlglob.exe +CONFIGPM = ..\lib\Config.pm +MINIMOD = ..\lib\ExtUtils\Miniperl.pm +X2P = ..\x2p\a2p.exe + +PL2BAT = bin\pl2bat.pl +GLOBBAT = bin\perlglob.bat + +MAKE = nmake -nologo + +CFGSH_TMPL = config.vc +CFGH_TMPL = config_H.vc +PERL95EXE = ..\perl95.exe + +XCOPY = xcopy /f /r /i /d +RCOPY = xcopy /f /r /i /e /d +NOOP = @echo +NULL = # # filenames given to xsubpp must have forward slashes (since it puts # full pathnames in #line strings) -XSUBPP=..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp -C++ -prototypes - -CORE_C= ..\av.c \ - ..\byterun.c \ - ..\deb.c \ - ..\doio.c \ - ..\doop.c \ - ..\dump.c \ - ..\globals.c \ - ..\gv.c \ - ..\hv.c \ - ..\mg.c \ - ..\op.c \ - ..\perl.c \ - ..\perlio.c \ - ..\perly.c \ - ..\pp.c \ - ..\pp_ctl.c \ - ..\pp_hot.c \ - ..\pp_sys.c \ - ..\regcomp.c \ - ..\regexec.c \ - ..\run.c \ - ..\scope.c \ - ..\sv.c \ - ..\taint.c \ - ..\toke.c \ - ..\universal.c \ - ..\util.c \ - $(MALLOC_SRC) \ - $(CRYPT_SRC) - -CORE_OBJ= ..\av$(o) \ - ..\byterun$(o) \ - ..\deb$(o) \ - ..\doio$(o) \ - ..\doop$(o) \ - ..\dump$(o) \ - ..\globals$(o) \ - ..\gv$(o) \ - ..\hv$(o) \ - ..\mg$(o) \ - ..\op$(o) \ - ..\perl$(o) \ - ..\perlio$(o) \ - ..\perly$(o) \ - ..\pp$(o) \ - ..\pp_ctl$(o) \ - ..\pp_hot$(o) \ - ..\pp_sys$(o) \ - ..\regcomp$(o) \ - ..\regexec$(o) \ - ..\run$(o) \ - ..\scope$(o) \ - ..\sv$(o) \ - ..\taint$(o) \ - ..\toke$(o) \ - ..\universal$(o)\ - ..\util$(o) \ - $(MALLOC_OBJ) \ - $(CRYPT_OBJ) - -WIN32_C = perllib.c \ - win32.c \ - win32sck.c \ - win32thread.c - -WIN32_OBJ = win32$(o) \ - win32sck$(o) \ - win32thread$(o) - -PERL95_OBJ = perl95$(o) \ - win32mt$(o) \ - win32sckmt$(o) \ - $(CRYPT_OBJ) - -DLL_OBJ = perllib$(o) $(DYNALOADER)$(o) - -X2P_OBJ = ..\x2p\a2p$(o) \ - ..\x2p\hash$(o) \ - ..\x2p\str$(o) \ - ..\x2p\util$(o) \ - ..\x2p\walk$(o) - -CORE_H = ..\av.h \ - ..\byterun.h \ - ..\bytecode.h \ - ..\cop.h \ - ..\cv.h \ - ..\dosish.h \ - ..\embed.h \ - ..\form.h \ - ..\gv.h \ - ..\handy.h \ - ..\hv.h \ - ..\mg.h \ - ..\nostdio.h \ - ..\op.h \ - ..\opcode.h \ - ..\perl.h \ - ..\perlio.h \ - ..\perlsdio.h \ - ..\perlsfio.h \ - ..\perly.h \ - ..\pp.h \ - ..\proto.h \ - ..\regexp.h \ - ..\scope.h \ - ..\sv.h \ - ..\thread.h \ - ..\unixish.h \ - ..\util.h \ - ..\XSUB.h \ - .\config.h \ - ..\EXTERN.h \ - ..\perlvars.h \ - ..\intrpvar.h \ - ..\thrdvar.h \ - .\include\dirent.h \ - .\include\netdb.h \ - .\include\sys\socket.h \ - .\win32.h - -DYNAMIC_EXT=Socket IO Fcntl Opcode SDBM_File attrs Thread B -STATIC_EXT=DynaLoader - -DYNALOADER=$(EXTDIR)\DynaLoader\DynaLoader -SOCKET=$(EXTDIR)\Socket\Socket -FCNTL=$(EXTDIR)\Fcntl\Fcntl -OPCODE=$(EXTDIR)\Opcode\Opcode -SDBM_FILE=$(EXTDIR)\SDBM_File\SDBM_File -IO=$(EXTDIR)\IO\IO -ATTRS=$(EXTDIR)\attrs\attrs -THREAD=$(EXTDIR)\Thread\Thread -B=$(EXTDIR)\B\B - -SOCKET_DLL=..\lib\auto\Socket\Socket.dll -FCNTL_DLL=..\lib\auto\Fcntl\Fcntl.dll -OPCODE_DLL=..\lib\auto\Opcode\Opcode.dll -SDBM_FILE_DLL=..\lib\auto\SDBM_File\SDBM_File.dll -IO_DLL=..\lib\auto\IO\IO.dll -ATTRS_DLL=..\lib\auto\attrs\attrs.dll -THREAD_DLL=..\lib\auto\Thread\Thread.dll -B_DLL=..\lib\auto\B\B.dll - -STATICLINKMODULES=DynaLoader -DYNALOADMODULES= \ - $(SOCKET_DLL) \ - $(FCNTL_DLL) \ - $(OPCODE_DLL) \ - $(SDBM_FILE_DLL)\ - $(IO_DLL) \ - $(ATTRS_DLL) \ - $(THREAD_DLL) \ - $(B_DLL) - -POD2HTML=$(PODDIR)\pod2html -POD2MAN=$(PODDIR)\pod2man -POD2LATEX=$(PODDIR)\pod2latex -POD2TEXT=$(PODDIR)\pod2text - -CFG_VARS= "INST_DRV=$(INST_DRV)" \ - "INST_TOP=$(INST_TOP)" \ - "archname=$(ARCHNAME)" \ - "cc=$(CC)" \ - "ccflags=$(OPTIMIZE) $(DEFINES)" \ - "cf_email=$(EMAIL)" \ - "d_crypt=$(D_CRYPT)" \ - "d_mymalloc=$(PERL_MALLOC)" \ - "libs=$(LIBFILES)" \ - "incpath=$(CCINCDIR)" \ - "libpth=$(CCLIBDIR)" \ - "libc=$(LIBC)" \ - "make=nmake" \ - "static_ext=$(STATIC_EXT)" \ - "dynamic_ext=$(DYNAMIC_EXT)" \ - "usethreads=$(USE_THREADS)" \ - "LINK_FLAGS=$(LINK_FLAGS)" \ - "optimize=$(OPTIMIZE)" +XSUBPP = ..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp \ + -C++ -prototypes + +CORE_SRC = \ + ..\av.c \ + ..\byterun.c \ + ..\deb.c \ + ..\doio.c \ + ..\doop.c \ + ..\dump.c \ + ..\globals.c \ + ..\gv.c \ + ..\hv.c \ + ..\mg.c \ + ..\op.c \ + ..\perl.c \ + ..\perly.c \ + ..\pp.c \ + ..\pp_ctl.c \ + ..\pp_hot.c \ + ..\pp_sys.c \ + ..\regcomp.c \ + ..\regexec.c \ + ..\run.c \ + ..\scope.c \ + ..\sv.c \ + ..\taint.c \ + ..\toke.c \ + ..\universal.c \ + ..\util.c + +CORE_SRC = $(CORE_SRC) $(CRYPT_SRC) + +!IF "$(PERL_MALLOC)" == "define" +CORE_SRC = $(CORE_SRC) ..\malloc.c +!ENDIF + +!IF "$(OBJECT)" == "" +CORE_SRC = $(CORE_SRC) ..\perlio.c +!ENDIF + +WIN32_SRC = \ + .\win32.c \ + .\win32sck.c + +!IF "$(USE_THREADS)" == "define" || "$(OBJECT)" == "" +WIN32_SRC = $(WIN32_SRC) .\win32thread.c +!ENDIF + +PERL95_SRC = \ + perl95.c \ + win32mt.c \ + win32sckmt.c + +DLL_SRC = $(DYNALOADER).c + + +!IF "$(OBJECT)" == "" +DLL_SRC = $(DLL_SRC) perllib.c +!ENDIF + +X2P_SRC = \ + ..\x2p\a2p.c \ + ..\x2p\hash.c \ + ..\x2p\str.c \ + ..\x2p\util.c \ + ..\x2p\walk.c + +CORE_H = \ + ..\av.h \ + ..\byterun.h \ + ..\bytecode.h \ + ..\cop.h \ + ..\cv.h \ + ..\dosish.h \ + ..\embed.h \ + ..\form.h \ + ..\gv.h \ + ..\handy.h \ + ..\hv.h \ + ..\mg.h \ + ..\nostdio.h \ + ..\op.h \ + ..\opcode.h \ + ..\perl.h \ + ..\perlio.h \ + ..\perlsdio.h \ + ..\perlsfio.h \ + ..\perly.h \ + ..\pp.h \ + ..\proto.h \ + ..\regexp.h \ + ..\scope.h \ + ..\sv.h \ + ..\thread.h \ + ..\unixish.h \ + ..\util.h \ + ..\XSUB.h \ + .\config.h \ + ..\EXTERN.h \ + ..\perlvars.h \ + ..\intrpvar.h \ + ..\thrdvar.h \ + .\include\dirent.h \ + .\include\netdb.h \ + .\include\sys\socket.h \ + .\win32.h + +CORE_OBJ = $(CORE_SRC:.c=.obj) +WIN32_OBJ = $(WIN32_SRC:.c=.obj) +MINICORE_OBJ = $(CORE_OBJ:..\=.\mini\) \ + $(MINIDIR)\perlio$(o) \ + $(MINIDIR)\miniperlmain$(o) +MINIWIN32_OBJ = $(WIN32_OBJ:.\=.\mini\) +MINI_OBJ = $(MINICORE_OBJ) $(MINIWIN32_OBJ) +PERL95_OBJ = $(PERL95_SRC:.c=.obj) DynaLoadmt$(o) +DLL_OBJ = $(DLL_SRC:.c=.obj) +X2P_OBJ = $(X2P_SRC:.c=.obj) + +PERLDLL_OBJ = $(CORE_OBJ) +PERLEXE_OBJ = perlmain$(o) + +!IF "$(OBJECT)" == "" +PERLDLL_OBJ = $(PERLDLL_OBJ) $(WIN32_OBJ) $(DLL_OBJ) +!ELSE +PERLEXE_OBJ = $(PERLEXE_OBJ) $(WIN32_OBJ) $(DLL_OBJ) +!ENDIF + +DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File attrs Thread B +STATIC_EXT = DynaLoader + +DYNALOADER = $(EXTDIR)\DynaLoader\DynaLoader +SOCKET = $(EXTDIR)\Socket\Socket +FCNTL = $(EXTDIR)\Fcntl\Fcntl +OPCODE = $(EXTDIR)\Opcode\Opcode +SDBM_FILE = $(EXTDIR)\SDBM_File\SDBM_File +IO = $(EXTDIR)\IO\IO +ATTRS = $(EXTDIR)\attrs\attrs +THREAD = $(EXTDIR)\Thread\Thread +B = $(EXTDIR)\B\B + +SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll +FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll +OPCODE_DLL = $(AUTODIR)\Opcode\Opcode.dll +SDBM_FILE_DLL = $(AUTODIR)\SDBM_File\SDBM_File.dll +IO_DLL = $(AUTODIR)\IO\IO.dll +ATTRS_DLL = $(AUTODIR)\attrs\attrs.dll +THREAD_DLL = $(AUTODIR)\Thread\Thread.dll +B_DLL = $(AUTODIR)\B\B.dll + +EXTENSION_C = \ + $(SOCKET).c \ + $(FCNTL).c \ + $(OPCODE).c \ + $(SDBM_FILE).c \ + $(IO).c \ + $(ATTRS).c \ + $(THREAD).c \ + $(B).c + +EXTENSION_DLL = \ + $(SOCKET_DLL) \ + $(FCNTL_DLL) \ + $(OPCODE_DLL) \ + $(SDBM_FILE_DLL)\ + $(IO_DLL) \ + $(ATTRS_DLL) +# $(THREAD_DLL) \ +# $(B_DLL) + +POD2HTML = $(PODDIR)\pod2html +POD2MAN = $(PODDIR)\pod2man +POD2LATEX = $(PODDIR)\pod2latex +POD2TEXT = $(PODDIR)\pod2text + +CFG_VARS = \ + "INST_DRV=$(INST_DRV)" \ + "INST_TOP=$(INST_TOP)" \ + "archname=$(ARCHNAME)" \ + "cc=$(CC)" \ + "ccflags=$(OPTIMIZE) $(DEFINES) $(OBJECT)" \ + "cf_email=$(EMAIL)" \ + "d_crypt=$(D_CRYPT)" \ + "d_mymalloc=$(PERL_MALLOC)" \ + "libs=$(LIBFILES)" \ + "incpath=$(CCINCDIR)" \ + "libperl=$(PERLIMPLIB)" \ + "libpth=$(CCLIBDIR)" \ + "libc=$(LIBC)" \ + "make=nmake" \ + "static_ext=$(STATIC_EXT)" \ + "dynamic_ext=$(DYNAMIC_EXT)" \ + "usethreads=$(USE_THREADS)" \ + "LINK_FLAGS=$(LINK_FLAGS)" \ + "optimize=$(OPTIMIZE)" # # Top targets # -all: $(PERLEXE) $(PERL95EXE) $(GLOBEXE) $(DYNALOADMODULES) $(MINIMOD) \ - $(X2P) +all : $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) $(X2P) \ + $(EXTENSION_DLL) $(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c #------------------------------------------------------------ -$(GLOBEXE): perlglob$(o) +$(GLOBEXE) : perlglob$(o) $(LINK32) $(LINK_FLAGS) $(LIBFILES) -out:$@ -subsystem:$(SUBSYS) \ perlglob$(o) setargv$(o) perlglob$(o) : perlglob.c -..\miniperlmain$(o) : ..\miniperlmain.c $(CORE_H) - config.w32 : $(CFGSH_TMPL) copy $(CFGSH_TMPL) config.w32 @@ -415,6 +453,20 @@ config.w32 : $(CFGSH_TMPL) ..\config.sh : config.w32 $(MINIPERL) config_sh.PL $(MINIPERL) -I..\lib config_sh.PL $(CFG_VARS) config.w32 > ..\config.sh +# this target is for when changes to the main config.sh happen +# edit config.{b,v,g}c and make this target once for each supported +# compiler (e.g. `dmake CCTYPE=BORLAND regen_config_h`) +regen_config_h: + perl config_sh.PL $(CFG_VARS) $(CFGSH_TMPL) > ..\config.sh + cd .. + -del /f perl.exe + perl configpm + cd win32 + -del /f $(CFGH_TMPL) + -mkdir ..\lib\CORE + -perl -I..\lib config_h.PL + rename config.h $(CFGH_TMPL) + $(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl cd .. && miniperl configpm if exist lib\* $(RCOPY) lib\*.* ..\lib\$(NULL) @@ -422,25 +474,35 @@ $(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl $(XCOPY) *.h $(COREDIR)\*.* $(RCOPY) include $(COREDIR)\*.* $(MINIPERL) -I..\lib config_h.PL || $(MAKE) $(MAKEFLAGS) $(CONFIGPM) - -$(MINIPERL) : ..\miniperlmain$(o) $(CORE_OBJ) $(WIN32_OBJ) + +$(MINIPERL) : $(MINIDIR) $(MINI_OBJ) $(LINK32) -subsystem:console -out:$@ @<< - $(LINK_FLAGS) $(LIBFILES) ..\miniperlmain$(o) $(CORE_OBJ) $(WIN32_OBJ) + $(LINK_FLAGS) $(LIBFILES) $(MINI_OBJ) << -$(WIN32_OBJ) : $(CORE_H) -$(CORE_OBJ) : $(CORE_H) -$(DLL_OBJ) : $(CORE_H) -$(PERL95_OBJ) : $(CORE_H) -$(X2P_OBJ) : $(CORE_H) +$(MINIDIR) : + if not exist "$(MINIDIR)" mkdir "$(MINIDIR)" + +$(MINICORE_OBJ) : $(CORE_H) + $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ ..\$(*F).c + +$(MINIWIN32_OBJ) : $(CORE_H) + $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $(*F).c + +$(WIN32_OBJ) : $(CORE_H) +$(CORE_OBJ) : $(CORE_H) +$(MINI_OBJ) : $(CORE_H) +$(DLL_OBJ) : $(CORE_H) +$(PERL95_OBJ) : $(CORE_H) +$(X2P_OBJ) : $(CORE_H) perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym makedef.pl - $(MINIPERL) -w makedef.pl $(OPTIMIZE) $(DEFINES) \ + $(MINIPERL) -w makedef.pl $(OPTIMIZE) $(DEFINES) $(OBJECT) \ CCTYPE=$(CCTYPE) > perldll.def -$(PERLDLL): perldll.def $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ) +$(PERLDLL): perldll.def $(PERLDLL_OBJ) $(LINK32) -dll -def:perldll.def -out:$@ @<< - $(LINK_FLAGS) $(LIBFILES) $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ) + $(LINK_FLAGS) $(LIBFILES) $(PERLDLL_OBJ) << $(XCOPY) $(PERLIMPLIB) $(COREDIR) @@ -450,45 +512,64 @@ perl.def : $(MINIPERL) makeperldef.pl $(MINIMOD) : $(MINIPERL) ..\minimod.pl cd .. && miniperl minimod.pl > lib\ExtUtils\Miniperl.pm -$(X2P) : $(X2P_OBJ) +..\x2p\a2p$(o) : ..\x2p\a2p.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\a2p.c + +..\x2p\hash$(o) : ..\x2p\hash.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\hash.c + +..\x2p\str$(o) : ..\x2p\str.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\str.c + +..\x2p\util$(o) : ..\x2p\util.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\util.c + +..\x2p\walk$(o) : ..\x2p\walk.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\walk.c + +$(X2P) : $(MINIPERL) $(X2P_OBJ) + $(MINIPERL) ..\x2p\find2perl.PL + $(MINIPERL) ..\x2p\s2p.PL $(LINK32) -subsystem:console -out:$@ @<< - $(LINK_FLAGS) $(LIBFILES) $(X2P_OBJ) + $(LINK_FLAGS) $(LIBFILES) $(X2P_OBJ) << perlmain.c : runperl.c copy runperl.c perlmain.c perlmain$(o) : perlmain.c - $(CC) $(CFLAGS) -UPERLDLL -c perlmain.c + $(CC) $(CFLAGS_O) -UPERLDLL $(EXEOUT_FLAG)$@ -c perlmain.c -$(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain$(o) - $(LINK32) -subsystem:console -out:perl.exe $(LINK_FLAGS) $(LIBFILES) \ - perlmain$(o) $(WINIOMAYBE) $(PERLIMPLIB) - copy perl.exe $@ - del perl.exe +$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ) + $(LINK32) -subsystem:console -out:$@ $(LINK_FLAGS) $(LIBFILES) \ + $(PERLEXE_OBJ) $(PERLIMPLIB) copy splittree.pl .. - $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" + $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR) perl95.c : runperl.c copy runperl.c perl95.c perl95$(o) : perl95.c - $(CC) $(CFLAGS) -MT -UPERLDLL -DWIN95FIX -c perl95.c + $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c perl95.c win32sckmt$(o) : win32sck.c - $(CC) $(CFLAGS) -MT -UPERLDLL -DWIN95FIX -c $(OBJOUT_FLAG)win32sckmt$(o) win32sck.c + $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \ + $(OBJOUT_FLAG)win32sckmt$(o) win32sck.c win32mt$(o) : win32.c - $(CC) $(CFLAGS) -MT -UPERLDLL -DWIN95FIX -c $(OBJOUT_FLAG)win32mt$(o) win32.c + $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \ + $(OBJOUT_FLAG)win32mt$(o) win32.c + +DynaLoadmt$(o) : $(DYNALOADER).c + $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \ + $(OBJOUT_FLAG)DynaLoadmt$(o) $(DYNALOADER).c $(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ) - $(LINK32) -subsystem:console -out:perl95.exe $(LINK_FLAGS) $(LIBFILES) \ - $(PERL95_OBJ) $(PERLIMPLIB) - copy perl95.exe $@ - del perl95.exe + $(LINK32) -subsystem:console -nodefaultlib -out:$@ $(LINK_FLAGS) \ + $(LIBFILES) $(PERL95_OBJ) $(PERLIMPLIB) libcmt.lib $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) - if not exist ..\lib\auto mkdir ..\lib\auto + if not exist $(AUTODIR) mkdir $(AUTODIR) $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) cd $(EXTDIR)\$(*B) $(XSUBPP) dl_win32.xs > $(*B).c @@ -515,7 +596,7 @@ $(ATTRS_DLL): $(PERLEXE) $(ATTRS).xs $(MAKE) cd ..\..\win32 -$(IO_DLL): $(PERLEXE) $(CONFIGPM) $(IO).xs +$(IO_DLL): $(PERLEXE) $(IO).xs cd $(EXTDIR)\$(*B) ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl $(MAKE) @@ -558,32 +639,32 @@ doc: $(PERLEXE) utils: $(PERLEXE) cd ..\utils - nmake PERL=$(MINIPERL) + $(MAKE) PERL=$(PERLEXE) $(PERLEXE) -I..\lib ..\win32\$(PL2BAT) h2ph splain perlbug pl2pm c2ph $(PERLEXE) ..\win32\$(PL2BAT) h2xs perldoc pstruct $(XCOPY) *.bat ..\win32\bin\*.* cd ..\win32 - $(PERLEXE) $(PL2BAT) bin\network.pl bin\www.pl bin\runperl.pl \ + $(PERLEXE) -I..\lib $(PL2BAT) bin\network.pl bin\www.pl bin\runperl.pl \ bin\pl2bat.pl bin\perlglob.pl distclean: clean -del /f $(MINIPERL) $(PERLEXE) $(PERL95EXE) $(PERLDLL) $(GLOBEXE) \ $(PERLIMPLIB) ..\miniperl.lib $(MINIMOD) -del /f *.def *.map - -del /f $(SOCKET_DLL) $(IO_DLL) $(SDBM_FILE_DLL) $(FCNTL_DLL) \ - $(OPCODE_DLL) $(ATTRS_DLL) $(THREAD_DLL) $(B_DLL) - -del /f $(SOCKET).c $(IO).c $(SDBM_FILE).c $(FCNTL).c $(OPCODE).c \ - $(DYNALOADER).c $(ATTRS).c $(THREAD).c $(B).c + -del /f $(EXTENSION_DLL) + -del /f $(EXTENSION_C) -del /f $(PODDIR)\*.html -del /f $(PODDIR)\*.bat - -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c \ - config.h.new perl95.c + -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new + -del /f ..\lib\Config.pm + -del /f perl95.c -del /f bin\*.bat - -rmdir /s /q ..\lib\auto || rmdir /s ..\lib\auto - -rmdir /s /q $(COREDIR) || rmdir /s $(COREDIR) cd $(EXTDIR) -del /s *.lib *.def *.map *.bs Makefile *$(o) pm_to_blib cd ..\win32 + -rmdir /s /q $(AUTODIR) || rmdir /s $(AUTODIR) + -rmdir /s /q $(COREDIR) || rmdir /s $(COREDIR) + -rmdir /s /q $(MINIDIR) || rmdir /s $(MINIDIR) install : all doc utils $(PERLEXE) ..\installperl @@ -595,7 +676,7 @@ install : all doc utils inst_lib : $(CONFIGPM) copy splittree.pl .. - $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" + $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR) $(RCOPY) ..\lib $(INST_LIB)\*.* minitest : $(MINIPERL) $(GLOBEXE) $(CONFIGPM) utils @@ -634,6 +715,7 @@ clean : -@erase $(PERLEXE) -@erase $(PERLDLL) -@erase $(CORE_OBJ) + -rmdir /s /q "$(MINIDIR)" -@erase $(WIN32_OBJ) -@erase $(DLL_OBJ) -@erase $(X2P_OBJ) @@ -642,5 +724,3 @@ clean : -@erase ..\x2p\*.exe ..\x2p\*.bat -@erase *.ilk -@erase *.pdb - - diff --git a/win32/config.bc b/win32/config.bc index f0429bb0da..c395f6a882 100644 --- a/win32/config.bc +++ b/win32/config.bc @@ -21,8 +21,8 @@ afs='false' alignbytes='8' aphostname='' ar='tlib /P128' -archlib='~INST_TOP~\lib\~archname~' -archlibexp='~INST_TOP~\lib\~archname~' +archlib='' +archlibexp='' archname='MSWin32' archobjs='' awk='awk' @@ -64,7 +64,7 @@ csh='undef' d_Gconvert='gcvt((x),(n),(b))' d_access='define' d_alarm='undef' -d_archlib='define' +d_archlib='undef' d_attribut='undef' d_bcmp='undef' d_bcopy='undef' @@ -362,13 +362,13 @@ i_varhdr='varargs.h' i_vfork='undef' incpath='' inews='' -installarchlib='~INST_TOP~\lib\~archname~' +installarchlib='' installbin='~INST_TOP~\bin' installman1dir='~INST_TOP~\man\man1' installman3dir='~INST_TOP~\man\man3' installprivlib='~INST_TOP~\lib' installscript='~INST_TOP~\bin' -installsitearch='~INST_TOP~\lib\site\~archname~' +installsitearch='' installsitelib='~INST_TOP~\lib\site' intsize='4' known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket IO attrs Thread' @@ -480,8 +480,8 @@ sig_name='ZERO INT QUIT ILL FPE KILL SEGV PIPE ALRM TERM USR1 USR2 CHLD USR3 BRE sig_name_init='"ZERO", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "USR1", "USR2", "CHLD", "USR3", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0' sig_num='0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 16, 17, 18, 20, 21, 22, 23, 25, 18, 0' signal_t='void' -sitearch='~INST_TOP~\lib\site\~archname~' -sitearchexp='~INST_TOP~\lib\site\~archname~' +sitearch='' +sitearchexp='' sitelib='~INST_TOP~\lib\site' sitelibexp='~INST_TOP~\lib\site' sizetype='size_t' diff --git a/win32/config.gc b/win32/config.gc index d571dff337..13f02c70d7 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -21,8 +21,8 @@ afs='false' alignbytes='8' aphostname='' ar='ar' -archlib='~INST_TOP~\lib\~archname~' -archlibexp='~INST_TOP~\lib\~archname~' +archlib='' +archlibexp='' archname='MSWin32' archobjs='' awk='awk' @@ -64,7 +64,7 @@ csh='undef' d_Gconvert='sprintf((b),"%.*g",(n),(x))' d_access='define' d_alarm='undef' -d_archlib='define' +d_archlib='undef' d_attribut='define' d_bcmp='undef' d_bcopy='undef' @@ -362,13 +362,13 @@ i_varhdr='varargs.h' i_vfork='undef' incpath='' inews='' -installarchlib='~INST_TOP~\lib\~archname~' +installarchlib='' installbin='~INST_TOP~\bin' installman1dir='~INST_TOP~\man\man1' installman3dir='~INST_TOP~\man\man3' installprivlib='~INST_TOP~\lib' installscript='~INST_TOP~\bin' -installsitearch='~INST_TOP~\lib\site\~archname~' +installsitearch='' installsitelib='~INST_TOP~\lib\site' intsize='4' known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket IO attrs Thread' @@ -480,8 +480,8 @@ sig_name='ZERO INT QUIT ILL FPE KILL SEGV PIPE ALRM TERM CHLD BREAK ABRT STOP CO sig_name_init='"ZERO", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "CHLD", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0' sig_num='0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 20, 21, 22, 23, 25, 20, 0' signal_t='void' -sitearch='~INST_TOP~\lib\site\~archname~' -sitearchexp='~INST_TOP~\lib\site\~archname~' +sitearch='' +sitearchexp='' sitelib='~INST_TOP~\lib\site' sitelibexp='~INST_TOP~\lib\site' sizetype='size_t' diff --git a/win32/config.vc b/win32/config.vc index a59cedeb37..3a3f81e90b 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -21,7 +21,7 @@ afs='false' alignbytes='8' aphostname='' ar='lib' -archlib='~INST_TOP~\lib\~archname~' +archlib='' archlibexp='~INST_TOP~\lib\~archname~' archname='MSWin32' archobjs='' @@ -64,7 +64,7 @@ csh='undef' d_Gconvert='sprintf((b),"%.*g",(n),(x))' d_access='define' d_alarm='undef' -d_archlib='define' +d_archlib='undef' d_attribut='undef' d_bcmp='undef' d_bcopy='undef' @@ -363,13 +363,13 @@ i_vfork='undef' incpath='' inews='' installarchlib='~INST_TOP~\lib\~archname~' -installbin='~INST_TOP~\bin' +installbin='~INST_TOP~\bin\~archname~' installman1dir='~INST_TOP~\man\man1' installman3dir='~INST_TOP~\man\man3' installprivlib='~INST_TOP~\lib' installscript='~INST_TOP~\bin' -installsitearch='~INST_TOP~\lib\site\~archname~' -installsitelib='~INST_TOP~\lib\site' +installsitearch='~INST_TOP~\..\site\~VERSION~\lib\~archname~' +installsitelib='~INST_TOP~\..\site\~VERSION~\lib' intsize='4' known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket IO attrs Thread' ksh='' @@ -445,7 +445,7 @@ patchlevel='2' path_sep=';' perl='perl' perladmin='' -perlpath='~INST_TOP~\bin\perl.exe' +perlpath='~INST_TOP~\bin\~archname~\perl.exe' pg='' phostname='hostname' pidtype='int' @@ -480,10 +480,10 @@ sig_name='ZERO INT QUIT ILL FPE KILL SEGV PIPE ALRM TERM CHLD BREAK ABRT STOP CO sig_name_init='"ZERO", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "CHLD", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0' sig_num='0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 20, 21, 22, 23, 25, 20, 0' signal_t='void' -sitearch='~INST_TOP~\lib\site\~archname~' -sitearchexp='~INST_TOP~\lib\site\~archname~' -sitelib='~INST_TOP~\lib\site' -sitelibexp='~INST_TOP~\lib\site' +sitearch='' +sitearchexp='' +sitelib='~INST_TOP~\..\site\~VERSION~\lib' +sitelibexp='~INST_TOP~\..\site\~VERSION~\lib' sizetype='size_t' sleep='' smail='' diff --git a/win32/config_H.bc b/win32/config_H.bc index e1b8543b1b..9a8043d4a4 100644 --- a/win32/config_H.bc +++ b/win32/config_H.bc @@ -1096,7 +1096,7 @@ /* MYMALLOC: * This symbol, if defined, indicates that we're using our own malloc. */ -#define MYMALLOC /**/ +/*#define MYMALLOC /**/ /* CAN_PROTOTYPE: * If defined, this macro indicates that the C compiler can handle @@ -1486,8 +1486,8 @@ * 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:\\perl5004.5x\\lib\\MSWin32-x86" /**/ -#define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL)) /**/ +/* #define ARCHLIB "c:\\perl5004.5x\\lib\\MSWin32-x86" /**/ +/* #define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL)) /**/ /* CAT2: * This macro catenates 2 tokens together. @@ -1738,7 +1738,7 @@ * in programs that are not prepared to deal with ~ expansion at run-time. */ #define PRIVLIB "c:\\perl5004.5x\\lib" /**/ -#define PRIVLIB_EXP (win32_perllib_path(NULL)) /**/ +#define PRIVLIB_EXP (win32_get_stdlib(patchlevel)) /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1753,8 +1753,8 @@ * 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:\\perl5004.5x\\lib\\site\\MSWin32-x86" /**/ -#define SITEARCH_EXP (win32_perllib_path("site",ARCHNAME,NULL)) /**/ +/* #define SITEARCH "c:\\perl5004.5x\\lib\\site\\MSWin32-x86" /**/ +/* #define SITEARCH_EXP (win32_perllib_path("site",ARCHNAME,NULL)) /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -1770,7 +1770,7 @@ * in programs that are not prepared to deal with ~ expansion at run-time. */ #define SITELIB "c:\\perl5004.5x\\lib\\site" /**/ -#define SITELIB_EXP (win32_perllib_path("site",NULL)) /**/ +#define SITELIB_EXP (win32_get_sitelib(patchlevel)) /**/ /* DLSYM_NEEDS_UNDERSCORE: * This symbol, if defined, indicates that we need to prepend an diff --git a/win32/config_H.gc b/win32/config_H.gc index 40cdea5741..b9486c8616 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -1096,7 +1096,7 @@ /* MYMALLOC: * This symbol, if defined, indicates that we're using our own malloc. */ -#define MYMALLOC /**/ +/*#define MYMALLOC /**/ /* CAN_PROTOTYPE: * If defined, this macro indicates that the C compiler can handle @@ -1486,8 +1486,8 @@ * 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:\\perl5004.5x\\lib\\MSWin32-x86" /**/ -#define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL)) /**/ +/* #define ARCHLIB "c:\\perl5004.5x\\lib\\MSWin32-x86" /**/ +/* #define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL)) /**/ /* CAT2: * This macro catenates 2 tokens together. @@ -1738,7 +1738,7 @@ * in programs that are not prepared to deal with ~ expansion at run-time. */ #define PRIVLIB "c:\\perl5004.5x\\lib" /**/ -#define PRIVLIB_EXP (win32_perllib_path(NULL)) /**/ +#define PRIVLIB_EXP (win32_get_stdlib(patchlevel)) /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1753,8 +1753,8 @@ * 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:\\perl5004.5x\\lib\\site\\MSWin32-x86" /**/ -#define SITEARCH_EXP (win32_perllib_path("site",ARCHNAME,NULL)) /**/ +/* #define SITEARCH "c:\\perl5004.5x\\lib\\site\\MSWin32-x86" /**/ +/* #define SITEARCH_EXP (win32_perllib_path("site",ARCHNAME,NULL)) /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -1770,7 +1770,7 @@ * in programs that are not prepared to deal with ~ expansion at run-time. */ #define SITELIB "c:\\perl5004.5x\\lib\\site" /**/ -#define SITELIB_EXP (win32_perllib_path("site",NULL)) /**/ +#define SITELIB_EXP (win32_get_sitelib(patchlevel)) /**/ /* DLSYM_NEEDS_UNDERSCORE: * This symbol, if defined, indicates that we need to prepend an diff --git a/win32/config_H.vc b/win32/config_H.vc index 1652fa5c92..bdce05ee95 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -1096,7 +1096,7 @@ /* MYMALLOC: * This symbol, if defined, indicates that we're using our own malloc. */ -#define MYMALLOC /**/ +/*#define MYMALLOC /**/ /* CAN_PROTOTYPE: * If defined, this macro indicates that the C compiler can handle @@ -1486,8 +1486,8 @@ * 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:\\perl5004.5x\\lib\\MSWin32-x86" /**/ -#define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL)) /**/ +/* #define ARCHLIB "c:\\perl5004.5x\\lib\\MSWin32-x86" /**/ +/* #define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL)) /**/ /* CAT2: * This macro catenates 2 tokens together. @@ -1738,7 +1738,7 @@ * in programs that are not prepared to deal with ~ expansion at run-time. */ #define PRIVLIB "c:\\perl5004.5x\\lib" /**/ -#define PRIVLIB_EXP (win32_perllib_path(NULL)) /**/ +#define PRIVLIB_EXP (win32_get_stdlib(patchlevel)) /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1753,8 +1753,8 @@ * 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:\\perl5004.5x\\lib\\site\\MSWin32-x86" /**/ -#define SITEARCH_EXP (win32_perllib_path("site",ARCHNAME,NULL)) /**/ +/* #define SITEARCH "c:\\perl5004.5x\\lib\\site\\MSWin32-x86" /**/ +/* #define SITEARCH_EXP (win32_perllib_path("site",ARCHNAME,NULL)) /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -1770,7 +1770,7 @@ * in programs that are not prepared to deal with ~ expansion at run-time. */ #define SITELIB "c:\\perl5004.5x\\lib\\site" /**/ -#define SITELIB_EXP (win32_perllib_path("site",NULL)) /**/ +#define SITELIB_EXP (win32_get_sitelib(patchlevel)) /**/ /* DLSYM_NEEDS_UNDERSCORE: * This symbol, if defined, indicates that we need to prepend an diff --git a/win32/config_h.PL b/win32/config_h.PL index f317e5a407..0a4e6cee51 100644 --- a/win32/config_h.PL +++ b/win32/config_h.PL @@ -2,6 +2,7 @@ use Config; use File::Compare qw(compare); use File::Copy qw(copy); +my $OBJ = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i; my $name = $0; $name =~ s#^(.*)\.PL$#../$1.SH#; open(SH,"<$name") || die "Cannot open $name:$!"; @@ -36,21 +37,21 @@ while (<SH>) munge(); s/\\\$/\$/g; s#/[ *\*]*\*/#/**/#; - if (/^\s*#define\s+ARCHLIB_EXP/) - { - $_ = "#define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL))\t/**/\n"; - } + # if (/^\s*#define\s+ARCHLIB_EXP/) + # { + # $_ = "#define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL))\t/**/\n"; + # } if (/^\s*#define\s+PRIVLIB_EXP/) { - $_ = "#define PRIVLIB_EXP (win32_perllib_path(NULL))\t/**/\n" - } - if (/^\s*#define\s+SITEARCH_EXP/) - { - $_ = "#define SITEARCH_EXP (win32_perllib_path(\"site\",ARCHNAME,NULL))\t/**/\n"; + $_ = "#define PRIVLIB_EXP (win32_get_stdlib(patchlevel))\t/**/\n" } + # if (/^\s*#define\s+SITEARCH_EXP/) + # { + # $_ = "#define SITEARCH_EXP (win32_perllib_path(\"site\",ARCHNAME,NULL))\t/**/\n"; + # } if (/^\s*#define\s+SITELIB_EXP/) { - $_ = "#define SITELIB_EXP (win32_perllib_path(\"site\",NULL))\t/**/\n"; + $_ = "#define SITELIB_EXP (win32_get_sitelib(patchlevel))\t/**/\n"; } print H; } @@ -64,7 +65,7 @@ chmod(0666,"../lib/CORE/config.h"); copy("$file.new","../lib/CORE/config.h") || die "Cannot copy:$!"; chmod(0444,"../lib/CORE/config.h"); -if (compare("$file.new",$file)) +if (!$OBJ && compare("$file.new",$file)) { warn "$file has changed\n"; chmod(0666,$file); @@ -73,6 +74,11 @@ if (compare("$file.new",$file)) #chmod(0444,$file); exit(1); } +else + { + unlink ("$file.new"); + exit(0); + } sub Config { diff --git a/win32/config_sh.PL b/win32/config_sh.PL index 0c3713cb2e..8194988f28 100644 --- a/win32/config_sh.PL +++ b/win32/config_sh.PL @@ -10,6 +10,7 @@ if ($] =~ /\.(\d\d\d)?(\d\d)?$/) { # should always be true $opt{SUBVERSION} = $2 || '00'; } +$opt{VERSION} = $]; $opt{'cf_by'} = $ENV{USERNAME} unless $opt{'cf_by'}; $opt{'cf_email'} = $opt{'cf_by'} . '@' . (gethostbyname('localhost'))[0] unless $opt{'cf_email'}; diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs index 0f869e1f85..2f330b4e1e 100644 --- a/win32/dl_win32.xs +++ b/win32/dl_win32.xs @@ -26,22 +26,53 @@ calls. #include "EXTERN.h" #include "perl.h" + +#ifdef PERL_OBJECT +#define NO_XSLOCKS +#endif /* PERL_OBJECT */ + #include "XSUB.h" #include "dlutils.c" /* SaveError() etc */ static void -dl_private_init(void) +dl_private_init(CPERLarg) { - (void)dl_generic_private_init(); + (void)dl_generic_private_init(THIS); } +/* + This function assumes the list staticlinkmodules + will be formed from package names with '::' replaced + with '/'. Thus Win32::OLE is in the list as Win32/OLE +*/ static int dl_static_linked(char *filename) { char **p; + char* ptr; + static char subStr[] = "/auto/"; + char szBuffer[MAX_PATH]; + + /* change all the '\\' to '/' */ + strcpy(szBuffer, filename); + for(ptr = szBuffer; ptr = strchr(ptr, '\\'); ++ptr) + *ptr = '/'; + + /* delete the file name */ + ptr = strrchr(szBuffer, '/'); + if(ptr != NULL) + *ptr = '\0'; + + /* remove leading lib path */ + ptr = strstr(szBuffer, subStr); + if(ptr != NULL) + ptr += sizeof(subStr)-1; + else + ptr = szBuffer; + for (p = staticlinkmodules; *p;p++) { - if (strstr(filename, *p)) return 1; + if (strstr(ptr, *p)) return 1; }; return 0; } @@ -49,7 +80,7 @@ dl_static_linked(char *filename) MODULE = DynaLoader PACKAGE = DynaLoader BOOT: - (void)dl_private_init(); + (void)dl_private_init(THIS); void * dl_load_file(filename,flags=0) @@ -57,15 +88,15 @@ dl_load_file(filename,flags=0) int flags PREINIT: CODE: - DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename)); if (dl_static_linked(filename) == 0) RETVAL = (void*) LoadLibraryEx(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ; else RETVAL = (void*) GetModuleHandle(NULL); - DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) - SaveError("%d",GetLastError()) ; + SaveError(THIS_ "%d",GetLastError()) ; else sv_setiv( ST(0), (IV)RETVAL); @@ -75,13 +106,13 @@ dl_find_symbol(libhandle, symbolname) void * libhandle char * symbolname CODE: - DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n", libhandle, symbolname)); RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname); - DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref = %x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) - SaveError("%d",GetLastError()) ; + SaveError(THIS_ "%d",GetLastError()) ; else sv_setiv( ST(0), (IV)RETVAL); @@ -100,9 +131,9 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); - ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CV*))symref, filename))); + ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CPERLarg_ CV*))symref, filename))); char * diff --git a/win32/include/sys/socket.h b/win32/include/sys/socket.h index 40a5485343..6ffb0ac269 100644 --- a/win32/include/sys/socket.h +++ b/win32/include/sys/socket.h @@ -142,6 +142,7 @@ void win32_endprotoent(void); void win32_endservent(void); #ifndef WIN32SCK_IS_STDSCK +#ifndef PERL_OBJECT // // direct to our version // @@ -203,6 +204,7 @@ void win32_endservent(void); #define FD_ZERO(p) PERL_FD_ZERO(p) #endif /* USE_SOCKETS_AS_HANDLES */ +#endif /* PERL_OBJECT */ #endif /* WIN32SCK_IS_STDSCK */ #ifdef __cplusplus diff --git a/win32/makedef.pl b/win32/makedef.pl index c6af1a0f3c..e688eb5075 100644 --- a/win32/makedef.pl +++ b/win32/makedef.pl @@ -33,6 +33,14 @@ close(CFG); warn join(' ',keys %define)."\n"; +if ($define{PERL_OBJECT}) { + print "LIBRARY PerlCore\n"; + print "DESCRIPTION 'Perl interpreter'\n"; + print "EXPORTS\n"; + output_symbol("perl_alloc"); + exit(0); +} + if ($CCTYPE ne 'GCC') { print "LIBRARY Perl\n"; @@ -71,15 +79,20 @@ sub emit_symbols skip_symbols [qw( Perl_statusvalue_vms +Perl_archpat_auto Perl_block_type +Perl_bostr Perl_additem Perl_cast_ulong Perl_check_uni Perl_checkcomma Perl_chsize Perl_ck_aelem +Perl_colors +Perl_colorset Perl_cryptseen Perl_cx_dump +Perl_DBcv Perl_do_ipcctl Perl_do_ipcget Perl_do_msgrcv @@ -99,15 +112,23 @@ Perl_dump_packsubs Perl_dump_pm Perl_dump_sub Perl_expectterm +Perl_error_no +Perl_extralen Perl_fetch_gv Perl_fetch_io Perl_force_ident Perl_force_next Perl_force_word +Perl_generation Perl_hv_stashpv +Perl_in_clean_all +Perl_in_clean_objs Perl_intuit_more Perl_init_thread_intern Perl_know_next +Perl_lastgotoprobe +Perl_linestart +Perl_modcount Perl_modkids Perl_mstats Perl_my_bzero @@ -120,6 +141,7 @@ Perl_no_fh_allowed Perl_no_op Perl_nointrp Perl_nomem +Perl_pending_ident Perl_pp_cswitch Perl_pp_entersubr Perl_pp_evalonce @@ -129,13 +151,41 @@ Perl_pp_nswitch Perl_q Perl_rcsid Perl_reall_srchlen +Perl_reg_eval_set +Perl_reg_flags +Perl_reg_start_tmp +Perl_reg_start_tmpl +Perl_regbol +Perl_regcc +Perl_regcode +Perl_regdata +Perl_regdummy Perl_regdump Perl_regfold +Perl_regendp +Perl_regeol +Perl_regflags +Perl_regindent +Perl_reginput +Perl_reglastparen Perl_regmyendp Perl_regmyp_size Perl_regmystartp Perl_regnarrate +Perl_regnaughty +Perl_regnpar +Perl_regparse +Perl_regprecomp +Perl_regprev +Perl_regprogram Perl_regprop +Perl_regsawback +Perl_regseen +Perl_regsize +Perl_regstartp +Perl_regtill +Perl_regxend +Perl_rx Perl_same_dirent Perl_saw_return Perl_scan_const @@ -149,9 +199,13 @@ Perl_scan_str Perl_scan_subst Perl_scan_trans Perl_scan_word +Perl_seen_zerolen Perl_setenv_getix Perl_skipspace +Perl_sort_mutex +Perl_sortcxix Perl_sublex_done +Perl_sublex_info Perl_sublex_start Perl_sv_ref Perl_sv_setptrobj @@ -340,25 +394,7 @@ while (<DATA>) { foreach my $symbol (sort keys %export) { - if ($CCTYPE eq "BORLAND") { - # workaround Borland quirk by exporting both the straight - # name and a name with leading underscore. Note the - # alias *must* come after the symbol itself, if both - # are to be exported. (Linker bug?) - print "\t_$symbol\n"; - print "\t$symbol = _$symbol\n"; - } - elsif ($CCTYPE eq 'GCC') { - # Symbols have leading _ whole process is $%£"% slow - # so skip aliases for now - print "\t$symbol\n"; - } - else { - # for binary coexistence, export both the symbol and - # alias with leading underscore - print "\t$symbol\n"; - print "\t_$symbol = $symbol\n"; - } + output_symbol($symbol); } sub emit_symbol { @@ -367,6 +403,29 @@ sub emit_symbol { $export{$symbol} = 1; } +sub output_symbol { + my $symbol = shift; + if ($CCTYPE eq "BORLAND") { + # workaround Borland quirk by exporting both the straight + # name and a name with leading underscore. Note the + # alias *must* come after the symbol itself, if both + # are to be exported. (Linker bug?) + print "\t_$symbol\n"; + print "\t$symbol = _$symbol\n"; + } + elsif ($CCTYPE eq 'GCC') { + # Symbols have leading _ whole process is $%£"% slow + # so skip aliases for now + print "\t$symbol\n"; + } + else { + # for binary coexistence, export both the symbol and + # alias with leading underscore + print "\t$symbol\n"; + print "\t_$symbol = $symbol\n"; + } +} + 1; __DATA__ # extra globals not included above. diff --git a/win32/makefile.mk b/win32/makefile.mk index 6fc900572e..9e59de7c52 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -27,6 +27,10 @@ CCTYPE *= BORLAND #CCTYPE *= GCC # +# 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 @@ -45,7 +49,7 @@ CCTYPE *= BORLAND # WARNING: Turning this on/off WILL break binary compatibility with extensions # you may have compiled with/without it. Be prepared to recompile all extensions # if you change the default. -PERL_MALLOC *= define +#PERL_MALLOC *= define # # set the install locations of the compiler include/libraries @@ -63,29 +67,29 @@ CCLIBDIR *= $(CCHOME)\lib # # set this to your email address (perl will guess a value from # from your loginname and your hostname, which may not be right) -#EMAIL *= +#EMAIL *= ##################### CHANGE THESE ONLY IF YOU MUST ##################### .IF "$(CRYPT_SRC)$(CRYPT_LIB)" == "" -D_CRYPT=undef +D_CRYPT = undef .ELSE -D_CRYPT=define -CRYPT_FLAG=-DHAVE_DES_FCRYPT +D_CRYPT = define +CRYPT_FLAG = -DHAVE_DES_FCRYPT .ENDIF -.IF "$(PERL_MALLOC)" == "" -PERL_MALLOC *= undef +.IF "$(OBJECT)" != "" +PERL_MALLOC != undef .ENDIF +PERL_MALLOC *= undef + +USE_THREADS *= undef + #BUILDOPT *= -DMULTIPLICITY #BUILDOPT *= -DPERL_GLOBAL_STRUCT -DMULTIPLICITY # -DUSE_PERLIO -D__STDC__=1 -DUSE_SFIO -DI_SFIO -I\sfio97\include -.IF "$(USE_THREADS)" == "" -USE_THREADS = undef -.ENDIF - .IMPORT .IGNORE : PROCESSOR_ARCHITECTURE PROCESSOR_ARCHITECTURE *= x86 @@ -98,6 +102,7 @@ ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE) ARCHDIR = ..\lib\$(ARCHNAME) COREDIR = ..\lib\CORE +AUTODIR = ..\lib\auto # # Programs to compile, build .lib files and link @@ -107,133 +112,150 @@ COREDIR = ..\lib\CORE .IF "$(CCTYPE)" == "BORLAND" -CC = bcc32 -LINK32 = tlink32 -LIB32 = tlib -IMPLIB = implib -c +CC = bcc32 +LINK32 = tlink32 +LIB32 = tlib +IMPLIB = implib -c # # Options # -RUNTIME = -D_RTLDLL -INCLUDES = -I.\include -I. -I.. -I$(CCINCDIR) -#PCHFLAGS = -H -Hc -H=c:\temp\bcmoduls.pch -DEFINES = -DWIN32 $(BUILDOPT) $(CRYPT_FLAG) -LOCDEFS = -DPERLDLL -DPERL_CORE -SUBSYS = console -LIBC = cw32mti.lib -LIBFILES = $(CRYPT_LIB) import32.lib $(LIBC) odbc32.lib odbccp32.lib +RUNTIME = -D_RTLDLL +INCLUDES = -I.\include -I. -I.. -I$(CCINCDIR) +#PCHFLAGS = -H -H$(INTDIR)\bcmoduls.pch +DEFINES = -DWIN32 $(BUILDOPT) $(CRYPT_FLAG) +LOCDEFS = -DPERLDLL -DPERL_CORE +SUBSYS = console +CXX_FLAG = -P -WINIOMAYBE = +LIBC = cw32mti.lib +LIBFILES = $(CRYPT_LIB) import32.lib $(LIBC) odbc32.lib odbccp32.lib .IF "$(CFG)" == "Debug" -OPTIMIZE = -v $(RUNTIME) -DDEBUGGING -LINK_DBG = -v +OPTIMIZE = -v $(RUNTIME) -DDEBUGGING +LINK_DBG = -v .ELSE -OPTIMIZE = -5 -O2 $(RUNTIME) -LINK_DBG = +OPTIMIZE = -5 -O2 $(RUNTIME) +LINK_DBG = .ENDIF -CFLAGS = -w -d -tWM -tWD $(INCLUDES) $(DEFINES) $(LOCDEFS) $(PCHFLAGS) $(OPTIMIZE) -LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR) -OBJOUT_FLAG = -o -EXEOUT_FLAG = -e +CFLAGS = -w -d -tWM -tWD $(INCLUDES) $(DEFINES) $(LOCDEFS) \ + $(PCHFLAGS) $(OPTIMIZE) +LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR) +OBJOUT_FLAG = -o +EXEOUT_FLAG = -e .ELIF "$(CCTYPE)" == "GCC" -CC = gcc -pipe -LINK32 = gcc -pipe -LIB32 = ar -IMPLIB = dlltool +CC = gcc -pipe +LINK32 = gcc -pipe +LIB32 = ar +IMPLIB = dlltool o = .o # # Options # -RUNTIME = -INCLUDES = -I.\include -I. -I.. -DEFINES = -DWIN32 $(BUILDOPT) $(CRYPT_FLAG) -LOCDEFS = -DPERLDLL -DPERL_CORE -SUBSYS = console -LIBC = -lcrtdll -LIBFILES = $(CRYPT_LIB) -ladvapi32 -luser32 -lnetapi32 -lwsock32 -lmingw32 \ - -lgcc -lmoldname $(LIBC) -lkernel32 +RUNTIME = +INCLUDES = -I.\include -I. -I.. +DEFINES = -DWIN32 $(BUILDOPT) $(CRYPT_FLAG) +LOCDEFS = -DPERLDLL -DPERL_CORE +SUBSYS = console +CXX_FLAG = -xc++ -WINIOMAYBE = +LIBC = -lcrtdll +LIBFILES = $(CRYPT_LIB) -ladvapi32 -luser32 -lwsock32 -lmingw32 -lgcc \ + -lmoldname $(LIBC) -lkernel32 .IF "$(CFG)" == "Debug" -OPTIMIZE = -g -O2 $(RUNTIME) -DDEBUGGING -LINK_DBG = -g +OPTIMIZE = -g -O2 $(RUNTIME) -DDEBUGGING +LINK_DBG = -g .ELSE -OPTIMIZE = -g -O2 $(RUNTIME) -LINK_DBG = +OPTIMIZE = -g -O2 $(RUNTIME) +LINK_DBG = .ENDIF -CFLAGS = $(INCLUDES) $(DEFINES) $(LOCDEFS) $(OPTIMIZE) -LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR) -OBJOUT_FLAG = -o -EXEOUT_FLAG = -o +CFLAGS = $(INCLUDES) $(DEFINES) $(LOCDEFS) $(OPTIMIZE) +LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR) +OBJOUT_FLAG = -o +EXEOUT_FLAG = -o .ELSE -CC=cl.exe -LINK32=link.exe -LIB32=$(LINK32) -lib +CC = cl.exe +LINK32 = link.exe +LIB32 = $(LINK32) -lib + # # Options # -.IF "$(RUNTIME)" == "" -RUNTIME = -MD +.IF "$(OBJECT)" == "-DPERL_OBJECT" +RUNTIME = -MT +# XXX building with -MD fails many tests, but cannot investigate +# because building with debug crashes compiler :-( GSAR )-: +#RUNTIME = -MD +.ELSE +RUNTIME = -MD .ENDIF -INCLUDES = -I.\include -I. -I.. -#PCHFLAGS = -Fpc:\temp\vcmoduls.pch -YX -DEFINES = -DWIN32 -D_CONSOLE $(BUILDOPT) $(CRYPT_FLAG) -LOCDEFS = -DPERLDLL -DPERL_CORE -SUBSYS = console + +INCLUDES = -I.\include -I. -I.. +#PCHFLAGS = -Fp$(INTDIR)\vcmoduls.pch -YX +DEFINES = -DWIN32 -D_CONSOLE $(BUILDOPT) $(CRYPT_FLAG) +LOCDEFS = -DPERLDLL -DPERL_CORE +SUBSYS = console +CXX_FLAG = -TP -GX .IF "$(RUNTIME)" == "-MD" -LIBC = msvcrt.lib -WINIOMAYBE = +LIBC = msvcrt.lib .ELSE -LIBC = libcmt.lib -WINIOMAYBE = +LIBC = libcmt.lib .ENDIF .IF "$(CFG)" == "Debug" .IF "$(CCTYPE)" == "MSVC20" -OPTIMIZE = -Od $(RUNTIME) -Z7 -D_DEBUG -DDEBUGGING +OPTIMIZE = -Od $(RUNTIME) -Z7 -D_DEBUG -DDEBUGGING .ELSE -OPTIMIZE = -Od $(RUNTIME)d -Z7 -D_DEBUG -DDEBUGGING +OPTIMIZE = -Od $(RUNTIME)d -Z7 -D_DEBUG -DDEBUGGING .ENDIF -LINK_DBG = -debug -pdb:none +LINK_DBG = -debug -pdb:none .ELSE .IF "$(CCTYPE)" == "MSVC20" -OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG +OPTIMIZE = -Od $(RUNTIME) -DNDEBUG .ELSE -OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG +OPTIMIZE = -Od $(RUNTIME) -DNDEBUG .ENDIF -LINK_DBG = -release +LINK_DBG = -release .ENDIF -# we don't add LIBC here, the compiler do it based on -MD/-MT -LIBFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \ - winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \ - oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ - version.lib odbc32.lib odbccp32.lib +# we don't add LIBC here, the compiler does it based on -MD/-MT +LIBFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \ + winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \ + oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ + version.lib odbc32.lib odbccp32.lib + +CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) \ + $(PCHFLAGS) $(OPTIMIZE) +LINK_FLAGS = -nologo $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE) +OBJOUT_FLAG = -Fo +EXEOUT_FLAG = -Fe -CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) $(PCHFLAGS) $(OPTIMIZE) -LINK_FLAGS = -nologo $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE) -OBJOUT_FLAG = -Fo -EXEOUT_FLAG = -Fe +.ENDIF +.IF "$(OBJECT)" != "" +OPTIMIZE += $(CXX_FLAG) .ENDIF +CFLAGS_O = $(CFLAGS) $(OBJECT) + #################### do not edit below this line ####################### ############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ############## o *= .obj +LKPRE = INPUT ( +LKPOST = ) + # # Rules # @@ -241,7 +263,7 @@ o *= .obj .SUFFIXES : .c $(o) .dll .lib .exe .a .c$(o): - $(CC) -c $(null,$(<:d) $(NULL) -I$(<:d)) $(CFLAGS) $(OBJOUT_FLAG)$@ $< + $(CC) -c $(null,$(<:d) $(NULL) -I$(<:d)) $(CFLAGS_O) $(OBJOUT_FLAG)$@ $< .y.c: $(NOOP) @@ -259,256 +281,266 @@ $(o).dll: .ENDIF # -INST_BIN=$(INST_TOP)\bin -INST_LIB=$(INST_TOP)\lib -INST_POD=$(INST_LIB)\pod -INST_HTML=$(INST_POD)\html -LIBDIR=..\lib -EXTDIR=..\ext -PODDIR=..\pod -EXTUTILSDIR=$(LIBDIR)\extutils +INST_BIN = $(INST_TOP)\bin +INST_LIB = $(INST_TOP)\lib +INST_POD = $(INST_LIB)\pod +INST_HTML = $(INST_POD)\html +LIBDIR = ..\lib +EXTDIR = ..\ext +PODDIR = ..\pod +EXTUTILSDIR = $(LIBDIR)\extutils # # various targets -PERLIMPLIB=..\perl.lib -MINIPERL=..\miniperl.exe -PERLDLL=..\perl.dll -PERLEXE=..\perl.exe -GLOBEXE=..\perlglob.exe -CONFIGPM=..\lib\Config.pm -MINIMOD=..\lib\ExtUtils\Miniperl.pm -X2P=..\x2p\a2p.exe - -PL2BAT=bin\pl2bat.pl -GLOBBAT = bin\perlglob.bat +.IF "$(OBJECT)" == "-DPERL_OBJECT" +PERLIMPLIB = ..\perlcore.lib +PERLDLL = ..\perlcore.dll +.ELSE +PERLIMPLIB = ..\perl.lib +PERLDLL = ..\perl.dll +.ENDIF + +MINIPERL = ..\miniperl.exe +MINIDIR = .\mini +PERLEXE = ..\perl.exe +GLOBEXE = ..\perlglob.exe +CONFIGPM = ..\lib\Config.pm +MINIMOD = ..\lib\ExtUtils\Miniperl.pm +X2P = ..\x2p\a2p.exe + +PL2BAT = bin\pl2bat.pl +GLOBBAT = bin\perlglob.bat .IF "$(CCTYPE)" == "BORLAND" -CFGSH_TMPL = config.bc -CFGH_TMPL = config_H.bc +CFGSH_TMPL = config.bc +CFGH_TMPL = config_H.bc .ELIF "$(CCTYPE)" == "GCC" -CFGSH_TMPL = config.gc -CFGH_TMPL = config_H.gc +CFGSH_TMPL = config.gc +CFGH_TMPL = config_H.gc .ELSE -CFGSH_TMPL = config.vc -CFGH_TMPL = config_H.vc -PERL95EXE=..\perl95.exe +CFGSH_TMPL = config.vc +CFGH_TMPL = config_H.vc +PERL95EXE = ..\perl95.exe .ENDIF -XCOPY=xcopy /f /r /i /d -RCOPY=xcopy /f /r /i /e /d -NOOP=@echo -#NULL= +XCOPY = xcopy /f /r /i /d +RCOPY = xcopy /f /r /i /e /d +NOOP = @echo -.IF "$(CRYPT_SRC)" != "" -CRYPT_OBJ=$(CRYPT_SRC:db:+$(o)) -.ENDIF +# filenames given to xsubpp must have forward slashes (since it puts +# full pathnames in #line strings) +XSUBPP = ..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp \ + -C++ -prototypes + +CORE_SRC = \ + ..\av.c \ + ..\byterun.c \ + ..\deb.c \ + ..\doio.c \ + ..\doop.c \ + ..\dump.c \ + ..\globals.c \ + ..\gv.c \ + ..\hv.c \ + ..\mg.c \ + ..\op.c \ + ..\perl.c \ + ..\perly.c \ + ..\pp.c \ + ..\pp_ctl.c \ + ..\pp_hot.c \ + ..\pp_sys.c \ + ..\regcomp.c \ + ..\regexec.c \ + ..\run.c \ + ..\scope.c \ + ..\sv.c \ + ..\taint.c \ + ..\toke.c \ + ..\universal.c \ + ..\util.c + +CORE_SRC += $(CRYPT_SRC) .IF "$(PERL_MALLOC)" == "define" -MALLOC_SRC = ..\malloc.c -MALLOC_OBJ = ..\malloc$(o) +CORE_SRC += ..\malloc.c .ENDIF -# -# filenames given to xsubpp must have forward slashes (since it puts -# full pathnames in #line strings) -XSUBPP=..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp -C++ -prototypes - -CORE_C= ..\av.c \ - ..\byterun.c \ - ..\deb.c \ - ..\doio.c \ - ..\doop.c \ - ..\dump.c \ - ..\globals.c \ - ..\gv.c \ - ..\hv.c \ - ..\mg.c \ - ..\op.c \ - ..\perl.c \ - ..\perlio.c \ - ..\perly.c \ - ..\pp.c \ - ..\pp_ctl.c \ - ..\pp_hot.c \ - ..\pp_sys.c \ - ..\regcomp.c \ - ..\regexec.c \ - ..\run.c \ - ..\scope.c \ - ..\sv.c \ - ..\taint.c \ - ..\toke.c \ - ..\universal.c \ - ..\util.c \ - $(MALLOC_SRC) \ - $(CRYPT_SRC) - -CORE_OBJ= ..\av$(o) \ - ..\byterun$(o) \ - ..\deb$(o) \ - ..\doio$(o) \ - ..\doop$(o) \ - ..\dump$(o) \ - ..\globals$(o) \ - ..\gv$(o) \ - ..\hv$(o) \ - ..\mg$(o) \ - ..\op$(o) \ - ..\perl$(o) \ - ..\perlio$(o) \ - ..\perly$(o) \ - ..\pp$(o) \ - ..\pp_ctl$(o) \ - ..\pp_hot$(o) \ - ..\pp_sys$(o) \ - ..\regcomp$(o) \ - ..\regexec$(o) \ - ..\run$(o) \ - ..\scope$(o) \ - ..\sv$(o) \ - ..\taint$(o) \ - ..\toke$(o) \ - ..\universal$(o)\ - ..\util$(o) \ - $(MALLOC_OBJ) \ - $(CRYPT_OBJ) - -WIN32_C = perllib.c \ - win32.c \ - win32sck.c \ - win32thread.c - -WIN32_OBJ = win32$(o) \ - win32sck$(o) \ - win32thread$(o) - -PERL95_OBJ = perl95$(o) \ - win32mt$(o) \ - win32sckmt$(o) \ - $(CRYPT_OBJ) - -DLL_OBJ = perllib$(o) $(DYNALOADER)$(o) - -X2P_OBJ = ..\x2p\a2p$(o) \ - ..\x2p\hash$(o) \ - ..\x2p\str$(o) \ - ..\x2p\util$(o) \ - ..\x2p\walk$(o) - -CORE_H = ..\av.h \ - ..\byterun.h \ - ..\bytecode.h \ - ..\cop.h \ - ..\cv.h \ - ..\dosish.h \ - ..\embed.h \ - ..\form.h \ - ..\gv.h \ - ..\handy.h \ - ..\hv.h \ - ..\mg.h \ - ..\nostdio.h \ - ..\op.h \ - ..\opcode.h \ - ..\perl.h \ - ..\perlio.h \ - ..\perlsdio.h \ - ..\perlsfio.h \ - ..\perly.h \ - ..\pp.h \ - ..\proto.h \ - ..\regexp.h \ - ..\scope.h \ - ..\sv.h \ - ..\thread.h \ - ..\unixish.h \ - ..\util.h \ - ..\XSUB.h \ - .\config.h \ - ..\EXTERN.h \ - ..\perlvars.h \ - ..\intrpvar.h \ - ..\thrdvar.h \ - .\include\dirent.h \ - .\include\netdb.h \ - .\include\sys\socket.h \ - .\win32.h - -DYNAMIC_EXT=Socket IO Fcntl Opcode SDBM_File attrs Thread B -STATIC_EXT=DynaLoader - -DYNALOADER=$(EXTDIR)\DynaLoader\DynaLoader -SOCKET=$(EXTDIR)\Socket\Socket -FCNTL=$(EXTDIR)\Fcntl\Fcntl -OPCODE=$(EXTDIR)\Opcode\Opcode -SDBM_FILE=$(EXTDIR)\SDBM_File\SDBM_File -IO=$(EXTDIR)\IO\IO -ATTRS=$(EXTDIR)\attrs\attrs -THREAD=$(EXTDIR)\Thread\Thread -B=$(EXTDIR)\B\B - -SOCKET_DLL=..\lib\auto\Socket\Socket.dll -FCNTL_DLL=..\lib\auto\Fcntl\Fcntl.dll -OPCODE_DLL=..\lib\auto\Opcode\Opcode.dll -SDBM_FILE_DLL=..\lib\auto\SDBM_File\SDBM_File.dll -IO_DLL=..\lib\auto\IO\IO.dll -ATTRS_DLL=..\lib\auto\attrs\attrs.dll -THREAD_DLL=..\lib\auto\Thread\Thread.dll -B_DLL=..\lib\auto\B\B.dll - -STATICLINKMODULES=DynaLoader -DYNALOADMODULES= \ - $(SOCKET_DLL) \ - $(FCNTL_DLL) \ - $(OPCODE_DLL) \ - $(SDBM_FILE_DLL)\ - $(IO_DLL) \ - $(ATTRS_DLL) \ - $(THREAD_DLL) \ - $(B_DLL) - -POD2HTML=$(PODDIR)\pod2html -POD2MAN=$(PODDIR)\pod2man -POD2LATEX=$(PODDIR)\pod2latex -POD2TEXT=$(PODDIR)\pod2text - -CFG_VARS= "INST_DRV=$(INST_DRV)" \ - "INST_TOP=$(INST_TOP)" \ - "archname=$(ARCHNAME)" \ - "cc=$(CC)" \ - "ccflags=$(OPTIMIZE) $(DEFINES)" \ - "cf_email=$(EMAIL)" \ - "d_crypt=$(D_CRYPT)" \ - "d_mymalloc=$(PERL_MALLOC)" \ - "libs=$(LIBFILES:f)" \ - "incpath=$(CCINCDIR)" \ - "libpth=$(strip $(CCLIBDIR) $(LIBFILES:d))" \ - "libc=$(LIBC)" \ - "make=dmake" \ - "static_ext=$(STATIC_EXT)" \ - "dynamic_ext=$(DYNAMIC_EXT)" \ - "usethreads=$(USE_THREADS)" \ - "LINK_FLAGS=$(LINK_FLAGS)" \ - "optimize=$(OPTIMIZE)" +.IF "$(OBJECT)" == "" +CORE_SRC += ..\perlio.c +.ENDIF + +WIN32_SRC = \ + .\win32.c \ + .\win32sck.c + +.IF "$(USE_THREADS)" == "define" || "$(OBJECT)" == "" +WIN32_SRC += .\win32thread.c +.ENDIF + +PERL95_SRC = \ + perl95.c \ + win32mt.c \ + win32sckmt.c + +DLL_SRC = $(DYNALOADER).c + + +.IF "$(OBJECT)" == "" +DLL_SRC += perllib.c +.ENDIF + +X2P_SRC = \ + ..\x2p\a2p.c \ + ..\x2p\hash.c \ + ..\x2p\str.c \ + ..\x2p\util.c \ + ..\x2p\walk.c + +CORE_H = \ + ..\av.h \ + ..\byterun.h \ + ..\bytecode.h \ + ..\cop.h \ + ..\cv.h \ + ..\dosish.h \ + ..\embed.h \ + ..\form.h \ + ..\gv.h \ + ..\handy.h \ + ..\hv.h \ + ..\mg.h \ + ..\nostdio.h \ + ..\op.h \ + ..\opcode.h \ + ..\perl.h \ + ..\perlio.h \ + ..\perlsdio.h \ + ..\perlsfio.h \ + ..\perly.h \ + ..\pp.h \ + ..\proto.h \ + ..\regexp.h \ + ..\scope.h \ + ..\sv.h \ + ..\thread.h \ + ..\unixish.h \ + ..\util.h \ + ..\XSUB.h \ + .\config.h \ + ..\EXTERN.h \ + ..\perlvars.h \ + ..\intrpvar.h \ + ..\thrdvar.h \ + .\include\dirent.h \ + .\include\netdb.h \ + .\include\sys\socket.h \ + .\win32.h + +CORE_OBJ = $(CORE_SRC:db:+$(o)) +WIN32_OBJ = $(WIN32_SRC:db:+$(o)) +MINICORE_OBJ = $(MINIDIR)\{$(CORE_OBJ:f) perlio$(o) miniperlmain$(o)} +MINIWIN32_OBJ = $(MINIDIR)\{$(WIN32_OBJ:f)} +MINI_OBJ = $(MINICORE_OBJ) $(MINIWIN32_OBJ) +PERL95_OBJ = $(PERL95_SRC:db:+$(o)) DynaLoadmt$(o) +DLL_OBJ = $(DLL_SRC:db:+$(o)) +X2P_OBJ = $(X2P_SRC:db:+$(o)) + +PERLDLL_OBJ = $(CORE_OBJ) +PERLEXE_OBJ = perlmain$(o) + +.IF "$(OBJECT)" == "" +PERLDLL_OBJ += $(WIN32_OBJ) $(DLL_OBJ) +.ELSE +PERLEXE_OBJ += $(WIN32_OBJ) $(DLL_OBJ) +.ENDIF + +DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File attrs Thread B +STATIC_EXT = DynaLoader + +DYNALOADER = $(EXTDIR)\DynaLoader\DynaLoader +SOCKET = $(EXTDIR)\Socket\Socket +FCNTL = $(EXTDIR)\Fcntl\Fcntl +OPCODE = $(EXTDIR)\Opcode\Opcode +SDBM_FILE = $(EXTDIR)\SDBM_File\SDBM_File +IO = $(EXTDIR)\IO\IO +ATTRS = $(EXTDIR)\attrs\attrs +THREAD = $(EXTDIR)\Thread\Thread +B = $(EXTDIR)\B\B + +SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll +FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll +OPCODE_DLL = $(AUTODIR)\Opcode\Opcode.dll +SDBM_FILE_DLL = $(AUTODIR)\SDBM_File\SDBM_File.dll +IO_DLL = $(AUTODIR)\IO\IO.dll +ATTRS_DLL = $(AUTODIR)\attrs\attrs.dll +THREAD_DLL = $(AUTODIR)\Thread\Thread.dll +B_DLL = $(AUTODIR)\B\B.dll + +EXTENSION_C = \ + $(SOCKET).c \ + $(FCNTL).c \ + $(OPCODE).c \ + $(SDBM_FILE).c \ + $(IO).c \ + $(ATTRS).c \ + $(THREAD).c \ + $(B).c + +EXTENSION_DLL = \ + $(SOCKET_DLL) \ + $(FCNTL_DLL) \ + $(OPCODE_DLL) \ + $(SDBM_FILE_DLL)\ + $(IO_DLL) \ + $(ATTRS_DLL) +# $(THREAD_DLL) \ +# $(B_DLL) + +POD2HTML = $(PODDIR)\pod2html +POD2MAN = $(PODDIR)\pod2man +POD2LATEX = $(PODDIR)\pod2latex +POD2TEXT = $(PODDIR)\pod2text + +CFG_VARS = \ + "INST_DRV=$(INST_DRV)" \ + "INST_TOP=$(INST_TOP)" \ + "archname=$(ARCHNAME)" \ + "cc=$(CC)" \ + "ccflags=$(OPTIMIZE) $(DEFINES) $(OBJECT)" \ + "cf_email=$(EMAIL)" \ + "d_crypt=$(D_CRYPT)" \ + "d_mymalloc=$(PERL_MALLOC)" \ + "libs=$(LIBFILES:f)" \ + "incpath=$(CCINCDIR)" \ + "libperl=$(PERLIMPLIB)" \ + "libpth=$(strip $(CCLIBDIR) $(LIBFILES:d))" \ + "libc=$(LIBC)" \ + "make=dmake" \ + "static_ext=$(STATIC_EXT)" \ + "dynamic_ext=$(DYNAMIC_EXT)" \ + "usethreads=$(USE_THREADS)" \ + "LINK_FLAGS=$(LINK_FLAGS)" \ + "optimize=$(OPTIMIZE)" # # Top targets # -all: $(PERLEXE) $(PERL95EXE) $(GLOBEXE) $(DYNALOADMODULES) $(MINIMOD) \ - $(X2P) +all : $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) $(X2P) \ + $(EXTENSION_DLL) $(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c #------------------------------------------------------------ -$(GLOBEXE): perlglob$(o) +$(GLOBEXE) : perlglob$(o) .IF "$(CCTYPE)" == "BORLAND" $(CC) -c -w -v -tWM -I$(CCINCDIR) perlglob.c $(LINK32) -Tpe -ap $(LINK_FLAGS) c0x32$(o) perlglob$(o) \ @@ -522,8 +554,6 @@ $(GLOBEXE): perlglob$(o) perlglob$(o) : perlglob.c -..\miniperlmain$(o) : ..\miniperlmain.c $(CORE_H) - config.w32 : $(CFGSH_TMPL) copy $(CFGSH_TMPL) config.w32 @@ -554,58 +584,60 @@ $(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl $(RCOPY) include $(COREDIR)\*.* $(MINIPERL) -I..\lib config_h.PL || $(MAKE) $(MAKEMACROS) $(CONFIGPM) -LKPRE = INPUT ( -LKPOST = ) - -$(MINIPERL) : ..\miniperlmain$(o) $(CORE_OBJ) $(WIN32_OBJ) +$(MINIPERL) : $(MINIDIR) $(MINI_OBJ) .IF "$(CCTYPE)" == "BORLAND" $(LINK32) -Tpe -ap $(LINK_FLAGS) \ - @$(mktmp c0x32$(o) ..\miniperlmain$(o) \ - $(CORE_OBJ:s,\,\\) $(WIN32_OBJ:s,\,\\),$(@:s,\,\\),,$(LIBFILES),) + @$(mktmp c0x32$(o) $(MINI_OBJ:s,\,\\),$(@:s,\,\\),,$(LIBFILES),) .ELIF "$(CCTYPE)" == "GCC" $(LINK32) -v -o $@ $(LINK_FLAGS) \ - $(mktmp $(LKPRE) ..\miniperlmain$(o) \ - $(CORE_OBJ:s,\,\\) $(WIN32_OBJ:s,\,\\) $(LIBFILES) $(LKPOST)) + $(mktmp $(LKPRE) $(MINI_OBJ:s,\,\\) $(LIBFILES) $(LKPOST)) .ELSE $(LINK32) -subsystem:console -out:$@ \ - @$(mktmp $(LINK_FLAGS) $(LIBFILES) ..\miniperlmain$(o) \ - $(CORE_OBJ:s,\,\\) $(WIN32_OBJ:s,\,\\)) + @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(MINI_OBJ:s,\,\\)) .ENDIF -$(WIN32_OBJ) : $(CORE_H) -$(CORE_OBJ) : $(CORE_H) -$(DLL_OBJ) : $(CORE_H) -$(X2P_OBJ) : $(CORE_H) +$(MINIDIR) : + if not exist "$(MINIDIR)" mkdir "$(MINIDIR)" + +$(MINICORE_OBJ) : $(CORE_H) + $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ ..\$(*B).c + +$(MINIWIN32_OBJ) : $(CORE_H) + $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $(*B).c + +$(WIN32_OBJ) : $(CORE_H) +$(CORE_OBJ) : $(CORE_H) +$(MINI_OBJ) : $(CORE_H) +$(DLL_OBJ) : $(CORE_H) +$(PERL95_OBJ) : $(CORE_H) +$(X2P_OBJ) : $(CORE_H) perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym makedef.pl - $(MINIPERL) -w makedef.pl $(OPTIMIZE) $(DEFINES) \ + $(MINIPERL) -w makedef.pl $(OPTIMIZE) $(DEFINES) $(OBJECT) \ CCTYPE=$(CCTYPE) > perldll.def -$(PERLDLL): perldll.def $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ) +$(PERLDLL): perldll.def $(PERLDLL_OBJ) .IF "$(CCTYPE)" == "BORLAND" $(LINK32) -Tpd -ap $(LINK_FLAGS) \ - @$(mktmp c0d32$(o) $(CORE_OBJ:s,\,\\) \ - $(WIN32_OBJ:s,\,\\) $(DLL_OBJ:s,\,\\)\n \ + @$(mktmp c0d32$(o) $(PERLDLL_OBJ:s,\,\\)\n \ $@,\n \ $(LIBFILES)\n \ perldll.def\n) $(IMPLIB) $*.lib $@ .ELIF "$(CCTYPE)" == "GCC" $(LINK32) -mdll -o $@ -Wl,--base-file -Wl,perl.base $(LINK_FLAGS) \ - $(mktmp $(LKPRE) $(CORE_OBJ:s,\,\\) $(WIN32_OBJ:s,\,\\) \ - $(DLL_OBJ:s,\,\\) $(LIBFILES) $(LKPOST)) + $(mktmp $(LKPRE) $(PERLDLL_OBJ:s,\,\\) $(LIBFILES) $(LKPOST)) dlltool --output-lib $(PERLIMPLIB) \ --dllname perl.dll \ --def perldll.def \ --base-file perl.base \ --output-exp perl.exp $(LINK32) -mdll -o $@ $(LINK_FLAGS) \ - $(mktmp $(LKPRE) $(CORE_OBJ:s,\,\\) $(WIN32_OBJ:s,\,\\) \ - $(DLL_OBJ:s,\,\\) $(LIBFILES) perl.exp $(LKPOST)) + $(mktmp $(LKPRE) $(PERLDLL_OBJ:s,\,\\) $(LIBFILES) \ + perl.exp $(LKPOST)) .ELSE $(LINK32) -dll -def:perldll.def -out:$@ \ - @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(CORE_OBJ:s,\,\\) \ - $(WIN32_OBJ:s,\,\\) $(DLL_OBJ:s,\,\\)) + @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(PERLDLL_OBJ:s,\,\\)) .ENDIF $(XCOPY) $(PERLIMPLIB) $(COREDIR) @@ -615,7 +647,22 @@ perl.def : $(MINIPERL) makeperldef.pl $(MINIMOD) : $(MINIPERL) ..\minimod.pl cd .. && miniperl minimod.pl > lib\ExtUtils\Miniperl.pm -$(X2P) : $(X2P_OBJ) +..\x2p\a2p$(o) : ..\x2p\a2p.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\a2p.c + +..\x2p\hash$(o) : ..\x2p\hash.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\hash.c + +..\x2p\str$(o) : ..\x2p\str.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\str.c + +..\x2p\util$(o) : ..\x2p\util.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\util.c + +..\x2p\walk$(o) : ..\x2p\walk.c + $(CC) -I..\x2p $(CFLAGS) $(OBJOUT_FLAG)$@ -c ..\x2p\walk.c + +$(X2P) : $(MINIPERL) $(X2P_OBJ) $(MINIPERL) ..\x2p\find2perl.PL $(MINIPERL) ..\x2p\s2p.PL .IF "$(CCTYPE)" == "BORLAND" @@ -633,23 +680,23 @@ perlmain.c : runperl.c copy runperl.c perlmain.c perlmain$(o) : perlmain.c - $(CC) $(CFLAGS) -UPERLDLL $(EXEOUT_FLAG)$@ -c perlmain.c + $(CC) $(CFLAGS_O) -UPERLDLL $(EXEOUT_FLAG)$@ -c perlmain.c -$(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain$(o) +$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ) .IF "$(CCTYPE)" == "BORLAND" $(LINK32) -Tpe -ap $(LINK_FLAGS) \ - @$(mktmp c0x32$(o) perlmain$(o) $(WINIOMAYBE)\n \ + @$(mktmp c0x32$(o) $(PERLEXE_OBJ)\n \ $@,\n \ $(PERLIMPLIB) $(LIBFILES)\n) .ELIF "$(CCTYPE)" == "GCC" $(LINK32) -o $@ $(LINK_FLAGS) \ - perlmain.o $(WINIOMAYBE) $(PERLIMPLIB) $(LIBFILES) + $(PERLEXE_OBJ) $(PERLIMPLIB) $(LIBFILES) .ELSE $(LINK32) -subsystem:console -out:$@ $(LINK_FLAGS) $(LIBFILES) \ - perlmain$(o) $(WINIOMAYBE) $(PERLIMPLIB) + $(PERLEXE_OBJ) $(PERLIMPLIB) .ENDIF copy splittree.pl .. - $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" + $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR) .IF "$(CCTYPE)" != "BORLAND" .IF "$(CCTYPE)" != "GCC" @@ -658,23 +705,29 @@ perl95.c : runperl.c copy runperl.c perl95.c perl95$(o) : perl95.c - $(CC) $(CFLAGS) -MT -UPERLDLL -DWIN95FIX -c perl95.c + $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c perl95.c win32sckmt$(o) : win32sck.c - $(CC) $(CFLAGS) -MT -UPERLDLL -DWIN95FIX -c $(OBJOUT_FLAG)win32sckmt$(o) win32sck.c + $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \ + $(OBJOUT_FLAG)win32sckmt$(o) win32sck.c win32mt$(o) : win32.c - $(CC) $(CFLAGS) -MT -UPERLDLL -DWIN95FIX -c $(OBJOUT_FLAG)win32mt$(o) win32.c + $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \ + $(OBJOUT_FLAG)win32mt$(o) win32.c + +DynaLoadmt$(o) : $(DYNALOADER).c + $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \ + $(OBJOUT_FLAG)DynaLoadmt$(o) $(DYNALOADER).c $(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ) - $(LINK32) -subsystem:console -out:$@ $(LINK_FLAGS) $(LIBFILES) \ - $(PERL95_OBJ) $(PERLIMPLIB) + $(LINK32) -subsystem:console -nodefaultlib -out:$@ $(LINK_FLAGS) \ + $(LIBFILES) $(PERL95_OBJ) $(PERLIMPLIB) libcmt.lib .ENDIF .ENDIF $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) - if not exist ..\lib\auto mkdir ..\lib\auto + if not exist $(AUTODIR) mkdir $(AUTODIR) $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) cd $(EXTDIR)\$(*B) && $(XSUBPP) dl_win32.xs > $(*B).c $(XCOPY) $(EXTDIR)\$(*B)\dlutils.c . @@ -732,7 +785,7 @@ doc: $(PERLEXE) --libpod=perlfunc:perlguts:perlvar:perlrun:perlop --recurse utils: $(PERLEXE) - cd ..\utils && $(MAKE) PERL=$(MINIPERL) + cd ..\utils && $(MAKE) PERL=$(PERLEXE) cd ..\utils && $(PERLEXE) ..\win32\$(PL2BAT) h2ph splain perlbug \ pl2pm c2ph h2xs perldoc pstruct $(XCOPY) ..\utils\*.bat bin\*.* @@ -743,20 +796,20 @@ distclean: clean -del /f $(MINIPERL) $(PERLEXE) $(PERL95EXE) $(PERLDLL) $(GLOBEXE) \ $(PERLIMPLIB) ..\miniperl.lib $(MINIMOD) -del /f *.def *.map - -del /f $(SOCKET_DLL) $(IO_DLL) $(SDBM_FILE_DLL) $(FCNTL_DLL) \ - $(OPCODE_DLL) $(ATTRS_DLL) $(THREAD_DLL) $(B_DLL) - -del /f $(SOCKET).c $(IO).c $(SDBM_FILE).c $(FCNTL).c $(OPCODE).c \ - $(DYNALOADER).c $(ATTRS).c $(THREAD).c $(B).c + -del /f $(EXTENSION_DLL) + -del /f $(EXTENSION_C) -del /f $(PODDIR)\*.html -del /f $(PODDIR)\*.bat -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new + -del /f ..\lib\Config.pm .IF "$(PERL95EXE)" != "" -del /f perl95.c .ENDIF -del /f bin\*.bat -cd $(EXTDIR) && del /s *.lib *.def *.map *.bs Makefile *$(o) pm_to_blib - -rmdir /s /q ..\lib\auto || rmdir /s ..\lib\auto + -rmdir /s /q $(AUTODIR) || rmdir /s $(AUTODIR) -rmdir /s /q $(COREDIR) || rmdir /s $(COREDIR) + -rmdir /s /q $(MINIDIR) || rmdir /s $(MINIDIR) install : all doc utils $(PERLEXE) ..\installperl @@ -770,7 +823,7 @@ install : all doc utils inst_lib : $(CONFIGPM) copy splittree.pl .. - $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" + $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR) $(RCOPY) ..\lib $(INST_LIB)\*.* minitest : $(MINIPERL) $(GLOBEXE) $(CONFIGPM) utils @@ -812,6 +865,7 @@ clean : -@erase $(PERLEXE) -@erase $(PERLDLL) -@erase $(CORE_OBJ) + -rmdir /s /q "$(MINIDIR)" -@erase $(WIN32_OBJ) -@erase $(DLL_OBJ) -@erase $(X2P_OBJ) @@ -820,5 +874,3 @@ clean : -@erase ..\x2p\*.exe ..\x2p\*.bat -@erase *.ilk -@erase *.pdb - - diff --git a/win32/runperl.c b/win32/runperl.c index 954460739f..755b386358 100644 --- a/win32/runperl.c +++ b/win32/runperl.c @@ -1,3 +1,1018 @@ + +#ifdef PERL_OBJECT +#define USE_SOCKETS_AS_HANDLES +#include "EXTERN.h" +#include "perl.h" + +#define NO_XSLOCKS +#include "XSUB.H" +#include "Win32iop.h" + +#define errno (*win32_errno()) +#define stdout (win32_stdout()) +#define stderr (win32_stderr()) + +CPerlObj *pPerl; + +#include <fcntl.h> +#include <ipdir.h> +#include <ipenv.h> +#include <ipsock.h> +#include <iplio.h> +#include <ipmem.h> +#include <ipproc.h> +#include <ipstdio.h> + +class IPerlStdIOWin : public IPerlStdIO +{ +public: + virtual int OpenOSfhandle(long osfhandle, int flags) = 0; + virtual int GetOSfhandle(int filenum) = 0; +}; + +extern int g_closedir(DIR *dirp); +extern DIR *g_opendir(char *filename); +extern struct direct *g_readdir(DIR *dirp); +extern void g_rewinddir(DIR *dirp); +extern void g_seekdir(DIR *dirp, long loc); +extern long g_telldir(DIR *dirp); +class CPerlDir : public IPerlDir +{ +public: + CPerlDir() {}; + virtual int Makedir(const char *dirname, int mode, int &err) + { + return win32_mkdir(dirname, mode); + }; + virtual int Chdir(const char *dirname, int &err) + { + return win32_chdir(dirname); + }; + virtual int Rmdir(const char *dirname, int &err) + { + return win32_rmdir(dirname); + }; + virtual int Close(DIR *dirp, int &err) + { + return g_closedir(dirp); + }; + virtual DIR *Open(char *filename, int &err) + { + return g_opendir(filename); + }; + virtual struct direct *Read(DIR *dirp, int &err) + { + return g_readdir(dirp); + }; + virtual void Rewind(DIR *dirp, int &err) + { + g_rewinddir(dirp); + }; + virtual void Seek(DIR *dirp, long loc, int &err) + { + g_seekdir(dirp, loc); + }; + virtual long Tell(DIR *dirp, int &err) + { + return g_telldir(dirp); + }; +}; + + +extern char * g_win32_get_stdlib(char *pl); +extern char * g_win32_get_sitelib(char *pl); +class CPerlEnv : public IPerlEnv +{ +public: + CPerlEnv() {}; + virtual char *Getenv(const char *varname, int &err) + { + return win32_getenv(varname); + }; + virtual int Putenv(const char *envstring, int &err) + { + return putenv(envstring); + }; + virtual char* LibPath(char *pl) + { + return g_win32_get_stdlib(pl); + }; + virtual char* SiteLibPath(char *pl) + { + return g_win32_get_sitelib(pl); + }; +}; + +#define PROCESS_AND_RETURN \ + if(errno) \ + err = errno; \ + return r + +class CPerlSock : public IPerlSock +{ +public: + CPerlSock() {}; + virtual u_long Htonl(u_long hostlong) + { + return win32_htonl(hostlong); + }; + virtual u_short Htons(u_short hostshort) + { + return win32_htons(hostshort); + }; + virtual u_long Ntohl(u_long netlong) + { + return win32_ntohl(netlong); + }; + virtual u_short Ntohs(u_short netshort) + { + return win32_ntohs(netshort); + } + + virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err) + { + SOCKET r = win32_accept(s, addr, addrlen); + PROCESS_AND_RETURN; + }; + virtual int Bind(SOCKET s, const struct sockaddr* name, int namelen, int &err) + { + int r = win32_bind(s, name, namelen); + PROCESS_AND_RETURN; + }; + virtual int Connect(SOCKET s, const struct sockaddr* name, int namelen, int &err) + { + int r = win32_connect(s, name, namelen); + PROCESS_AND_RETURN; + }; + virtual void Endhostent(int &err) + { + win32_endhostent(); + }; + virtual void Endnetent(int &err) + { + win32_endnetent(); + }; + virtual void Endprotoent(int &err) + { + win32_endprotoent(); + }; + virtual void Endservent(int &err) + { + win32_endservent(); + }; + virtual struct hostent* Gethostbyaddr(const char* addr, int len, int type, int &err) + { + struct hostent *r = win32_gethostbyaddr(addr, len, type); + PROCESS_AND_RETURN; + }; + virtual struct hostent* Gethostbyname(const char* name, int &err) + { + struct hostent *r = win32_gethostbyname(name); + PROCESS_AND_RETURN; + }; + virtual struct hostent* Gethostent(int &err) + { + croak("gethostent not implemented!\n"); + return NULL; + }; + virtual int Gethostname(char* name, int namelen, int &err) + { + int r = win32_gethostname(name, namelen); + PROCESS_AND_RETURN; + }; + virtual struct netent *Getnetbyaddr(long net, int type, int &err) + { + struct netent *r = win32_getnetbyaddr(net, type); + PROCESS_AND_RETURN; + }; + virtual struct netent *Getnetbyname(const char *name, int &err) + { + struct netent *r = win32_getnetbyname((char*)name); + PROCESS_AND_RETURN; + }; + virtual struct netent *Getnetent(int &err) + { + struct netent *r = win32_getnetent(); + PROCESS_AND_RETURN; + }; + virtual int Getpeername(SOCKET s, struct sockaddr* name, int* namelen, int &err) + { + int r = win32_getpeername(s, name, namelen); + PROCESS_AND_RETURN; + }; + virtual struct protoent* Getprotobyname(const char* name, int &err) + { + struct protoent *r = win32_getprotobyname(name); + PROCESS_AND_RETURN; + }; + virtual struct protoent* Getprotobynumber(int number, int &err) + { + struct protoent *r = win32_getprotobynumber(number); + PROCESS_AND_RETURN; + }; + virtual struct protoent* Getprotoent(int &err) + { + struct protoent *r = win32_getprotoent(); + PROCESS_AND_RETURN; + }; + virtual struct servent* Getservbyname(const char* name, const char* proto, int &err) + { + struct servent *r = win32_getservbyname(name, proto); + PROCESS_AND_RETURN; + }; + virtual struct servent* Getservbyport(int port, const char* proto, int &err) + { + struct servent *r = win32_getservbyport(port, proto); + PROCESS_AND_RETURN; + }; + virtual struct servent* Getservent(int &err) + { + struct servent *r = win32_getservent(); + PROCESS_AND_RETURN; + }; + virtual int Getsockname(SOCKET s, struct sockaddr* name, int* namelen, int &err) + { + int r = win32_getsockname(s, name, namelen); + PROCESS_AND_RETURN; + }; + virtual int Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err) + { + int r = win32_getsockopt(s, level, optname, optval, optlen); + PROCESS_AND_RETURN; + }; + virtual unsigned long InetAddr(const char* cp, int &err) + { + unsigned long r = win32_inet_addr(cp); + PROCESS_AND_RETURN; + }; + virtual char* InetNtoa(struct in_addr in, int &err) + { + char *r = win32_inet_ntoa(in); + PROCESS_AND_RETURN; + }; + virtual int IoctlSocket(SOCKET s, long cmd, u_long *argp, int& err) + { + int r = win32_ioctlsocket(s, cmd, argp); + PROCESS_AND_RETURN; + }; + virtual int Listen(SOCKET s, int backlog, int &err) + { + int r = win32_listen(s, backlog); + PROCESS_AND_RETURN; + }; + virtual int Recvfrom(SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen, int &err) + { + int r = win32_recvfrom(s, buffer, len, flags, from, fromlen); + PROCESS_AND_RETURN; + }; + virtual int Select(int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout, int &err) + { + int r = win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout); + PROCESS_AND_RETURN; + }; + virtual int Send(SOCKET s, const char* buffer, int len, int flags, int &err) + { + int r = win32_send(s, buffer, len, flags); + PROCESS_AND_RETURN; + }; + virtual int Sendto(SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen, int &err) + { + int r = win32_sendto(s, buffer, len, flags, to, tolen); + PROCESS_AND_RETURN; + }; + virtual void Sethostent(int stayopen, int &err) + { + win32_sethostent(stayopen); + }; + virtual void Setnetent(int stayopen, int &err) + { + win32_setnetent(stayopen); + }; + virtual void Setprotoent(int stayopen, int &err) + { + win32_setprotoent(stayopen); + }; + virtual void Setservent(int stayopen, int &err) + { + win32_setservent(stayopen); + }; + virtual int Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err) + { + int r = win32_setsockopt(s, level, optname, optval, optlen); + PROCESS_AND_RETURN; + }; + virtual int Shutdown(SOCKET s, int how, int &err) + { + int r = win32_shutdown(s, how); + PROCESS_AND_RETURN; + }; + virtual SOCKET Socket(int af, int type, int protocol, int &err) + { + SOCKET r = win32_socket(af, type, protocol); + PROCESS_AND_RETURN; + }; + virtual int Socketpair(int domain, int type, int protocol, int* fds, int &err) + { + croak("socketpair not implemented!\n"); + return 0; + }; +}; + + +#define CALLFUNCRET(x)\ + int ret = x;\ + if(ret)\ + err = errno;\ + return ret; + +#define CALLFUNCERR(x)\ + int ret = x;\ + if(errno)\ + err = errno;\ + return ret; + +#define LCALLFUNCERR(x)\ + long ret = x;\ + if(errno)\ + err = errno;\ + return ret; + +class CPerlLIO : public IPerlLIO +{ +public: + CPerlLIO() {}; + virtual int Access(const char *path, int mode, int &err) + { + CALLFUNCRET(access(path, mode)) + }; + virtual int Chmod(const char *filename, int pmode, int &err) + { + CALLFUNCRET(chmod(filename, pmode)) + }; + virtual int Chown(const char *filename, uid_t owner, gid_t group, int &err) + { + CALLFUNCERR(chown(filename, owner, group)) + }; + virtual int Chsize(int handle, long size, int &err) + { + CALLFUNCRET(chsize(handle, size)) + }; + virtual int Close(int handle, int &err) + { + CALLFUNCRET(win32_close(handle)) + }; + virtual int Dup(int handle, int &err) + { + CALLFUNCERR(win32_dup(handle)) + }; + virtual int Dup2(int handle1, int handle2, int &err) + { + CALLFUNCERR(win32_dup2(handle1, handle2)) + }; + virtual int Flock(int fd, int oper, int &err) + { + CALLFUNCERR(win32_flock(fd, oper)) + }; + virtual int FileStat(int handle, struct stat *buffer, int &err) + { + CALLFUNCERR(fstat(handle, buffer)) + }; + virtual int IOCtl(int i, unsigned int u, char *data, int &err) + { + CALLFUNCERR(win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data)) + }; + virtual int Isatty(int fd, int &err) + { + return isatty(fd); + }; + virtual long Lseek(int handle, long offset, int origin, int &err) + { + LCALLFUNCERR(win32_lseek(handle, offset, origin)) + }; + virtual int Lstat(const char *path, struct stat *buffer, int &err) + { + return NameStat(path, buffer, err); + }; + virtual char *Mktemp(char *Template, int &err) + { + return mktemp(Template); + }; + virtual int Open(const char *filename, int oflag, int &err) + { + CALLFUNCERR(win32_open(filename, oflag)) + }; + virtual int Open(const char *filename, int oflag, int pmode, int &err) + { + int ret; + if(stricmp(filename, "/dev/null") == 0) + ret = open("NUL", oflag, pmode); + else + ret = open(filename, oflag, pmode); + + if(errno) + err = errno; + return ret; + }; + virtual int Read(int handle, void *buffer, unsigned int count, int &err) + { + CALLFUNCERR(win32_read(handle, buffer, count)) + }; + virtual int Rename(const char *OldFileName, const char *newname, int &err) + { + char szNewWorkName[MAX_PATH+1]; + WIN32_FIND_DATA fdOldFile, fdNewFile; + HANDLE handle; + char *ptr; + + if((strchr(OldFileName, '\\') || strchr(OldFileName, '/')) + && strchr(newname, '\\') == NULL + && strchr(newname, '/') == NULL) + { + strcpy(szNewWorkName, OldFileName); + if((ptr = strrchr(szNewWorkName, '\\')) == NULL) + ptr = strrchr(szNewWorkName, '/'); + strcpy(++ptr, newname); + } + else + strcpy(szNewWorkName, newname); + + if(stricmp(OldFileName, szNewWorkName) != 0) + { // check that we're not being fooled by relative paths + // and only delete the new file + // 1) if it exists + // 2) it is not the same file as the old file + // 3) old file exist + // GetFullPathName does not return the long file name on some systems + handle = FindFirstFile(OldFileName, &fdOldFile); + if(handle != INVALID_HANDLE_VALUE) + { + FindClose(handle); + + handle = FindFirstFile(szNewWorkName, &fdNewFile); + + if(handle != INVALID_HANDLE_VALUE) + FindClose(handle); + else + fdNewFile.cFileName[0] = '\0'; + + if(strcmp(fdOldFile.cAlternateFileName, fdNewFile.cAlternateFileName) != 0 + && strcmp(fdOldFile.cFileName, fdNewFile.cFileName) != 0) + { // file exists and not same file + DeleteFile(szNewWorkName); + } + } + } + int ret = rename(OldFileName, szNewWorkName); + if(ret) + err = errno; + + return ret; + }; + virtual int Setmode(int handle, int mode, int &err) + { + CALLFUNCRET(win32_setmode(handle, mode)) + }; + virtual int NameStat(const char *path, struct stat *buffer, int &err) + { + return win32_stat(path, buffer); + }; + virtual char *Tmpnam(char *string, int &err) + { + return tmpnam(string); + }; + virtual int Umask(int pmode, int &err) + { + return umask(pmode); + }; + virtual int Unlink(const char *filename, int &err) + { + chmod(filename, S_IREAD | S_IWRITE); + CALLFUNCRET(unlink(filename)) + }; + virtual int Utime(char *filename, struct utimbuf *times, int &err) + { + CALLFUNCRET(win32_utime(filename, times)) + }; + virtual int Write(int handle, const void *buffer, unsigned int count, int &err) + { + CALLFUNCERR(win32_write(handle, buffer, count)) + }; +}; + +class CPerlMem : public IPerlMem +{ +public: + CPerlMem() {}; + virtual void* Malloc(size_t size) + { + return win32_malloc(size); + }; + virtual void* Realloc(void* ptr, size_t size) + { + return win32_realloc(ptr, size); + }; + virtual void Free(void* ptr) + { + win32_free(ptr); + }; +}; + +#define EXECF_EXEC 1 +#define EXECF_SPAWN 2 + +extern char *g_getlogin(void); +extern int do_spawn2(char *cmd, int exectype); +extern int g_do_aspawn(void *vreally, void **vmark, void **vsp); +class CPerlProc : public IPerlProc +{ +public: + CPerlProc() {}; + virtual void Abort(void) + { + win32_abort(); + }; + virtual void Exit(int status) + { + exit(status); + }; + virtual void _Exit(int status) + { + _exit(status); + }; + virtual int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3) + { + return execl(cmdname, arg0, arg1, arg2, arg3); + }; + virtual int Execv(const char *cmdname, const char *const *argv) + { + return win32_execvp(cmdname, argv); + }; + virtual int Execvp(const char *cmdname, const char *const *argv) + { + return win32_execvp(cmdname, argv); + }; + virtual uid_t Getuid(void) + { + return getuid(); + }; + virtual uid_t Geteuid(void) + { + return geteuid(); + }; + virtual gid_t Getgid(void) + { + return getgid(); + }; + virtual gid_t Getegid(void) + { + return getegid(); + }; + virtual char *Getlogin(void) + { + return g_getlogin(); + }; + virtual int Kill(int pid, int sig) + { + return kill(pid, sig); + }; + virtual int Killpg(int pid, int sig) + { + croak("killpg not implemented!\n"); + return 0; + }; + virtual int PauseProc(void) + { + return win32_sleep((32767L << 16) + 32767); + }; + virtual PerlIO* Popen(const char *command, const char *mode) + { +#ifdef __BORLANDC__ + win32_fflush(stdout); + win32_fflush(stderr); +#endif + return (PerlIO*)win32_popen(command, mode); + }; + virtual int Pclose(PerlIO *stream) + { + return win32_pclose((FILE*)stream); + }; + virtual int Pipe(int *phandles) + { + return win32_pipe(phandles, 512, O_BINARY); + }; + virtual int Setuid(uid_t u) + { + return setuid(u); + }; + virtual int Setgid(gid_t g) + { + return setgid(g); + }; + virtual int Sleep(unsigned int s) + { + return win32_sleep(s); + }; + virtual int Times(struct tms *timebuf) + { + return win32_times(timebuf); + }; + virtual int Wait(int *status) + { + return win32_wait(status); + }; + virtual Sighandler_t Signal(int sig, Sighandler_t subcode) + { + return 0; + }; + virtual void GetSysMsg(char*& sMsg, DWORD& dwLen, DWORD dwErr) + { + dwLen = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER + |FORMAT_MESSAGE_IGNORE_INSERTS + |FORMAT_MESSAGE_FROM_SYSTEM, NULL, + dwErr, 0, (char *)&sMsg, 1, NULL); + if (0 < dwLen) { + while (0 < dwLen && isspace(sMsg[--dwLen])) + ; + if ('.' != sMsg[dwLen]) + dwLen++; + sMsg[dwLen]= '\0'; + } + if (0 == dwLen) { + sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/); + dwLen = sprintf(sMsg, + "Unknown error #0x%lX (lookup 0x%lX)", + dwErr, GetLastError()); + } + }; + virtual void FreeBuf(char* sMsg) + { + LocalFree(sMsg); + }; + virtual BOOL DoCmd(char *cmd) + { + do_spawn2(cmd, EXECF_EXEC); + return FALSE; + }; + virtual int Spawn(char* cmds) + { + return do_spawn2(cmds, EXECF_SPAWN); + }; + virtual int Spawnvp(int mode, const char *cmdname, const char *const *argv) + { + return win32_spawnvp(mode, cmdname, argv); + }; + virtual int ASpawn(void *vreally, void **vmark, void **vsp) + { + return g_do_aspawn(vreally, vmark, vsp); + }; +}; + + +class CPerlStdIO : public IPerlStdIOWin +{ +public: + CPerlStdIO() {}; + virtual PerlIO* Stdin(void) + { + return (PerlIO*)win32_stdin(); + }; + virtual PerlIO* Stdout(void) + { + return (PerlIO*)win32_stdout(); + }; + virtual PerlIO* Stderr(void) + { + return (PerlIO*)win32_stderr(); + }; + virtual PerlIO* Open(const char *path, const char *mode, int &err) + { + PerlIO*pf = (PerlIO*)win32_fopen(path, mode); + if(errno) + err = errno; + return pf; + }; + virtual int Close(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_fclose(((FILE*)pf))) + }; + virtual int Eof(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_feof((FILE*)pf)) + }; + virtual int Error(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_ferror((FILE*)pf)) + }; + virtual void Clearerr(PerlIO* pf, int &err) + { + win32_clearerr((FILE*)pf); + }; + virtual int Getc(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_getc((FILE*)pf)) + }; + virtual char* GetBase(PerlIO* pf, int &err) + { + FILE *f = (FILE*)pf; + return FILE_base(f); + }; + virtual int GetBufsiz(PerlIO* pf, int &err) + { + FILE *f = (FILE*)pf; + return FILE_bufsiz(f); + }; + virtual int GetCnt(PerlIO* pf, int &err) + { + FILE *f = (FILE*)pf; + return FILE_cnt(f); + }; + virtual char* GetPtr(PerlIO* pf, int &err) + { + FILE *f = (FILE*)pf; + return FILE_ptr(f); + }; + virtual int Putc(PerlIO* pf, int c, int &err) + { + CALLFUNCERR(win32_fputc(c, (FILE*)pf)) + }; + virtual int Puts(PerlIO* pf, const char *s, int &err) + { + CALLFUNCERR(win32_fputs(s, (FILE*)pf)) + }; + virtual int Flush(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_fflush((FILE*)pf)) + }; + virtual int Ungetc(PerlIO* pf,int c, int &err) + { + CALLFUNCERR(win32_ungetc(c, (FILE*)pf)) + }; + virtual int Fileno(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_fileno((FILE*)pf)) + }; + virtual PerlIO* Fdopen(int fd, const char *mode, int &err) + { + PerlIO* pf = (PerlIO*)win32_fdopen(fd, mode); + if(errno) + err = errno; + return pf; + }; + virtual PerlIO* Reopen(const char*path, const char*mode, PerlIO* pf, int &err) + { + PerlIO* newPf = (PerlIO*)win32_freopen(path, mode, (FILE*)pf); + if(errno) + err = errno; + return newPf; + }; + virtual SSize_t Read(PerlIO* pf, void *buffer, Size_t size, int &err) + { + SSize_t i = win32_fread(buffer, 1, size, (FILE*)pf); + if(errno) + err = errno; + return i; + }; + virtual SSize_t Write(PerlIO* pf, const void *buffer, Size_t size, int &err) + { + SSize_t i = win32_fwrite(buffer, 1, size, (FILE*)pf); + if(errno) + err = errno; + return i; + }; + virtual void SetBuf(PerlIO* pf, char* buffer, int &err) + { + win32_setbuf((FILE*)pf, buffer); + }; + virtual int SetVBuf(PerlIO* pf, char* buffer, int type, Size_t size, int &err) + { + int i = win32_setvbuf((FILE*)pf, buffer, type, size); + if(errno) + err = errno; + return i; + }; + virtual void SetCnt(PerlIO* pf, int n, int &err) + { + FILE *f = (FILE*)pf; + FILE_cnt(f) = n; + }; + virtual void SetPtrCnt(PerlIO* pf, char * ptr, int n, int& err) + { + FILE *f = (FILE*)pf; + FILE_ptr(f) = ptr; + FILE_cnt(f) = n; + }; + virtual void Setlinebuf(PerlIO* pf, int &err) + { + win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0); + }; + virtual int Printf(PerlIO* pf, int &err, const char *format,...) + { + va_list(arglist); + va_start(arglist, format); + int i = win32_vfprintf((FILE*)pf, format, arglist); + if(errno) + err = errno; + return i; + }; + virtual int Vprintf(PerlIO* pf, int &err, const char *format, va_list arglist) + { + int i = win32_vfprintf((FILE*)pf, format, arglist); + if(errno) + err = errno; + return i; + }; + virtual long Tell(PerlIO* pf, int &err) + { + long l = win32_ftell((FILE*)pf); + if(errno) + err = errno; + return l; + }; + virtual int Seek(PerlIO* pf, off_t offset, int origin, int &err) + { + int i = win32_fseek((FILE*)pf, offset, origin); + if(errno) + err = errno; + return i; + }; + virtual void Rewind(PerlIO* pf, int &err) + { + win32_rewind((FILE*)pf); + }; + virtual PerlIO* Tmpfile(int &err) + { + PerlIO* pf = (PerlIO*)win32_tmpfile(); + if(errno) + err = errno; + return pf; + }; + virtual int Getpos(PerlIO* pf, Fpos_t *p, int &err) + { + int i = win32_fgetpos((FILE*)pf, p); + if(errno) + err = errno; + return i; + }; + virtual int Setpos(PerlIO* pf, const Fpos_t *p, int &err) + { + int i = win32_fsetpos((FILE*)pf, p); + if(errno) + err = errno; + return i; + }; + virtual void Init(int &err) + { + }; + virtual void InitOSExtras(void* p) + { + Perl_init_os_extras(); + }; + virtual int OpenOSfhandle(long osfhandle, int flags) + { + return win32_open_osfhandle(osfhandle, flags); + } + virtual int GetOSfhandle(int filenum) + { + return win32_get_osfhandle(filenum); + } +}; + + +static void xs_init _((CPERLarg)); + +class CPerlHost +{ +public: + CPerlHost() { pPerl = NULL; }; + inline BOOL PerlCreate(void) + { + try + { + pPerl = perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO, &perlDir, &perlSock, &perlProc); + if(pPerl != NULL) + { + try + { + pPerl->perl_construct(); + } + catch(...) + { + win32_fprintf(stderr, "%s\n", "Error: Unable to construct data structures"); + pPerl->perl_free(); + pPerl = NULL; + } + } + } + catch(...) + { + win32_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(...) + { + win32_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(...) + { + win32_fprintf(stderr, "Error: Runtime exception\n"); + retVal = -1; + } + return retVal; + }; + inline void PerlDestroy(void) + { + try + { + pPerl->perl_destruct(); + pPerl->perl_free(); + } + catch(...) + { + } + }; + +protected: + 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; +} + +char *staticlinkmodules[] = { + "DynaLoader", + NULL, +}; + +EXTERN_C void boot_DynaLoader _((CPERLarg_ CV* cv)); + +static void +xs_init(CPERLarg) +{ + char *file = __FILE__; + dXSUB_SYS; + newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); +} + +#else /* PERL_OBJECT */ + /* Say NO to CPP! Hallelujah! */ #ifdef __GNUC__ /* @@ -22,3 +1037,5 @@ main(int argc, char **argv, char **env) { return RunPerl(argc, argv, env, (void*)0); } + +#endif /* PERL_OBJECT */ diff --git a/win32/win32.c b/win32/win32.c index 82b45b98b1..7208e6bd08 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -13,6 +13,10 @@ #include <tchar.h> #ifdef __GNUC__ #define Win32_Winsock +# ifdef __cplusplus +#undef __attribute__ /* seems broken in 2.8.0 */ +#define __attribute__(p) +# endif #endif #include <windows.h> @@ -37,7 +41,14 @@ #include "EXTERN.h" #include "perl.h" + +#define NO_XSLOCKS +#ifdef PERL_OBJECT +extern CPerlObj* pPerl; +#endif #include "XSUB.h" + +#include "Win32iop.h" #include <fcntl.h> #include <sys/stat.h> #ifndef __GNUC__ @@ -65,14 +76,42 @@ int _CRT_glob = 0; #define EXECF_SPAWN 2 #define EXECF_SPAWN_NOWAIT 3 +#if defined(PERL_OBJECT) +#undef win32_get_stdlib +#define win32_get_stdlib g_win32_get_stdlib +#undef win32_get_sitelib +#define win32_get_sitelib g_win32_get_sitelib +#undef do_aspawn +#define do_aspawn g_do_aspawn +#undef do_spawn +#define do_spawn g_do_spawn +#undef do_exec +#define do_exec g_do_exec +#undef opendir +#define opendir g_opendir +#undef readdir +#define readdir g_readdir +#undef telldir +#define telldir g_telldir +#undef seekdir +#define seekdir g_seekdir +#undef rewinddir +#define rewinddir g_rewinddir +#undef closedir +#define closedir g_closedir +#undef getlogin +#define getlogin g_getlogin +#endif + static DWORD os_id(void); static void get_shell(void); static long tokenize(char *str, char **dest, char ***destv); -static int do_spawn2(char *cmd, int exectype); + int do_spawn2(char *cmd, int exectype); static BOOL has_redirection(char *ptr); static long filetime_to_clock(PFILETIME ft); static BOOL filetime_from_time(PFILETIME ft, time_t t); + char * w32_perlshell_tokens = Nullch; char ** w32_perlshell_vec; long w32_perlshell_items = -1; @@ -128,29 +167,213 @@ IsWinNT(void) { return (os_id() == VER_PLATFORM_WIN32_NT); } +char* +GetRegStrFromKey(HKEY hkey, const char *lpszValueName, char** ptr, DWORD* lpDataLen) +{ /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */ + HKEY handle; + DWORD type; + const char *subkey = "Software\\Perl"; + long retval; + + retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle); + if (retval == ERROR_SUCCESS){ + retval = RegQueryValueEx(handle, lpszValueName, 0, &type, NULL, lpDataLen); + if (retval == ERROR_SUCCESS && type == REG_SZ) { + if (*ptr != NULL) { + Renew(*ptr, *lpDataLen, char); + } + else { + New(1312, *ptr, *lpDataLen, char); + } + retval = RegQueryValueEx(handle, lpszValueName, 0, NULL, (PBYTE)*ptr, lpDataLen); + if (retval != ERROR_SUCCESS) { + Safefree(ptr); + ptr = NULL; + } + } + RegCloseKey(handle); + } + return *ptr; +} + +char* +GetRegStr(const char *lpszValueName, char** ptr, DWORD* lpDataLen) +{ + *ptr = GetRegStrFromKey(HKEY_CURRENT_USER, lpszValueName, ptr, lpDataLen); + if (*ptr == NULL) + { + *ptr = GetRegStrFromKey(HKEY_LOCAL_MACHINE, lpszValueName, ptr, lpDataLen); + } + return *ptr; +} + +char * +win32_get_stdlib(char *pl) +{ + static char szStdLib[] = "lib"; + int len = 0, newSize; + char szBuffer[MAX_PATH+1]; + char szModuleName[MAX_PATH]; + int result; + DWORD dwDataLen; + char *lpPath = NULL; + char *ptr; + + /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */ + sprintf(szBuffer, "%s-%s", szStdLib, pl); + lpPath = GetRegStr(szBuffer, &lpPath, &dwDataLen); + if (lpPath == NULL) + lpPath = GetRegStr(szStdLib, &lpPath, &dwDataLen); + + /* $stdlib .= ";$EMD/../../lib" */ + GetModuleFileName(GetModuleHandle(NULL), szModuleName, sizeof(szModuleName)); + ptr = strrchr(szModuleName, '\\'); + if (ptr != NULL) + { + *ptr = '\0'; + ptr = strrchr(szModuleName, '\\'); + if (ptr != NULL) + { + *ptr = '\0'; + ptr = strrchr(szModuleName, '\\'); + } + } + if (ptr == NULL) + { + ptr = szModuleName; + *ptr = '\\'; + } + strcpy(++ptr, szStdLib); + + /* check that this path exists */ + GetCurrentDirectory(sizeof(szBuffer), szBuffer); + result = SetCurrentDirectory(szModuleName); + SetCurrentDirectory(szBuffer); + if (result == 0) + { + GetModuleFileName(GetModuleHandle(NULL), szModuleName, sizeof(szModuleName)); + ptr = strrchr(szModuleName, '\\'); + if (ptr != NULL) + strcpy(++ptr, szStdLib); + } + + newSize = strlen(szModuleName) + 1; + if (lpPath != NULL) + { + len = strlen(lpPath); + newSize += len + 1; /* plus 1 for ';' */ + lpPath = Renew(lpPath, newSize, char); + } + else + New(1310, lpPath, newSize, char); + + if (lpPath != NULL) + { + if (len != 0) + lpPath[len++] = ';'; + strcpy(&lpPath[len], szModuleName); + } + return lpPath; +} + +char * +get_sitelib_part(char* lpRegStr, char* lpPathStr) +{ + char szBuffer[MAX_PATH+1]; + char szModuleName[MAX_PATH]; + DWORD dwDataLen; + int len = 0; + int result; + char *lpPath = NULL; + char *ptr; + + lpPath = GetRegStr(lpRegStr, &lpPath, &dwDataLen); + + /* $sitelib .= ";$EMD/../../../<lpPathStr>" */ + GetModuleFileName(GetModuleHandle(NULL), szModuleName, sizeof(szModuleName)); + ptr = strrchr(szModuleName, '\\'); + if (ptr != NULL) + { + *ptr = '\0'; + ptr = strrchr(szModuleName, '\\'); + if (ptr != NULL) + { + *ptr = '\0'; + ptr = strrchr(szModuleName, '\\'); + if (ptr != NULL) + { + *ptr = '\0'; + ptr = strrchr(szModuleName, '\\'); + } + } + } + if (ptr == NULL) + { + ptr = szModuleName; + *ptr = '\\'; + } + strcpy(++ptr, lpPathStr); + + /* check that this path exists */ + GetCurrentDirectory(sizeof(szBuffer), szBuffer); + result = SetCurrentDirectory(szModuleName); + SetCurrentDirectory(szBuffer); + + if (result) + { + int newSize = strlen(szModuleName) + 1; + if (lpPath != NULL) + { + len = strlen(lpPath); + newSize += len + 1; /* plus 1 for ';' */ + lpPath = Renew(lpPath, newSize, char); + } + else + New(1311, lpPath, newSize, char); + + if (lpPath != NULL) + { + if (len != 0) + lpPath[len++] = ';'; + strcpy(&lpPath[len], szModuleName); + } + } + return lpPath; +} + char * -win32_perllib_path(char *sfx,...) +win32_get_sitelib(char *pl) { - 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); + static char szSiteLib[] = "sitelib"; + char szRegStr[40]; + char szPathStr[MAX_PATH]; + char *lpPath1; + char *lpPath2; + + /* $HKCU{"sitelib-$]"} || $HKLM{"sitelib-$]"} . ---; */ + sprintf(szRegStr, "%s-%s", szSiteLib, pl); + sprintf(szPathStr, "site\\%s\\lib", pl); + lpPath1 = get_sitelib_part(szRegStr, szPathStr); + + /* $HKCU{'sitelib'} || $HKLM{'sitelib'} . ---; */ + lpPath2 = get_sitelib_part(szSiteLib, "site\\lib"); + if (lpPath1 == NULL) + return lpPath2; + + if (lpPath2 == NULL) + return lpPath1; + + int len = strlen(lpPath1); + int newSize = len + strlen(lpPath2) + 2; /* plus one for ';' */ + + lpPath1 = Renew(lpPath1, newSize, char); + if (lpPath1 != NULL) + { + lpPath1[len++] = ';'; + strcpy(&lpPath1[len], lpPath2); + } + Safefree(lpPath2); + return lpPath1; } @@ -192,6 +415,7 @@ has_redirection(char *ptr) return FALSE; } +#if !defined(PERL_OBJECT) /* since the current process environment is being updated in util.c * the library functions will get the correct environment */ @@ -224,6 +448,7 @@ my_pclose(PerlIO *fp) { return win32_pclose(fp); } +#endif static DWORD os_id(void) @@ -342,7 +567,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) argv[index++] = 0; status = win32_spawnvp(flag, - (really ? SvPV(really,na) : argv[0]), + (const char*)(really ? SvPV(really,na) : argv[0]), (const char* const*)argv); if (status < 0 && errno == ENOEXEC) { @@ -355,7 +580,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) argv[sh_items] = w32_perlshell_vec[sh_items]; status = win32_spawnvp(flag, - (really ? SvPV(really,na) : argv[0]), + (const char*)(really ? SvPV(really,na) : argv[0]), (const char* const*)argv); } @@ -373,7 +598,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) return (status); } -static int +int do_spawn2(char *cmd, int exectype) { char **a; @@ -706,7 +931,7 @@ kill(int pid, int sig) } return 0; } - + /* * File system stuff */ @@ -778,6 +1003,11 @@ win32_getenv(const char *name) curlen = needlen; needlen = GetEnvironmentVariable(name,curitem,curlen); } + if (curitem == NULL) + { + if (strcmp("PERL5DB", name) == 0) + curitem = GetRegStr(name, &curitem, &curlen); + } return curitem; } @@ -1216,7 +1446,7 @@ win32_str_os_error(void *sv, DWORD dwErr) sMsg[dwLen]= '\0'; } if (0 == dwLen) { - sMsg = LocalAlloc(0, 64/**sizeof(TCHAR)*/); + sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/); dwLen = sprintf(sMsg, "Unknown error #0x%lX (lookup 0x%lX)", dwErr, GetLastError()); @@ -2105,6 +2335,713 @@ XS(w32_Sleep) XSRETURN_YES; } +#define TMPBUFSZ 1024 +#define MAX_LENGTH 2048 +#define SUCCESSRETURNED(x) (x == ERROR_SUCCESS) +#define REGRETURN(x) XSRETURN_IV(SUCCESSRETURNED(x)) +#define SvHKEY(index) (HKEY)((unsigned long)SvIV(index)) +#define SETIV(index,value) sv_setiv(ST(index), value) +#define SETNV(index,value) sv_setnv(ST(index), value) +#define SETPV(index,string) sv_setpv(ST(index), string) +#define SETPVN(index, buffer, length) sv_setpvn(ST(index), (char*)buffer, length) +#define SETHKEY(index, hkey) SETIV(index,(long)hkey) + +static time_t ft2timet(FILETIME *ft) +{ + SYSTEMTIME st; + struct tm tm; + + FileTimeToSystemTime(ft, &st); + tm.tm_sec = st.wSecond; + tm.tm_min = st.wMinute; + tm.tm_hour = st.wHour; + tm.tm_mday = st.wDay; + tm.tm_mon = st.wMonth - 1; + tm.tm_year = st.wYear - 1900; + tm.tm_wday = st.wDayOfWeek; + tm.tm_yday = -1; + tm.tm_isdst = -1; + return mktime (&tm); +} + +static +XS(w32_RegCloseKey) +{ + dXSARGS; + + if (items != 1) + { + croak("usage: Win32::RegCloseKey($hkey);\n"); + } + + REGRETURN(RegCloseKey(SvHKEY(ST(0)))); +} + +static +XS(w32_RegConnectRegistry) +{ + dXSARGS; + HKEY handle; + + if (items != 3) + { + croak("usage: Win32::RegConnectRegistry($machine, $hkey, $handle);\n"); + } + + if (SUCCESSRETURNED(RegConnectRegistry((char *)SvPV(ST(0), na), SvHKEY(ST(1)), &handle))) + { + SETHKEY(2,handle); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegCreateKey) +{ + dXSARGS; + HKEY handle; + DWORD disposition; + long retval; + + if (items != 3) + { + croak("usage: Win32::RegCreateKey($hkey, $subkey, $handle);\n"); + } + + retval = RegCreateKeyEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, NULL, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, + NULL, &handle, &disposition); + + if (SUCCESSRETURNED(retval)) + { + SETHKEY(2,handle); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegCreateKeyEx) +{ + dXSARGS; + + unsigned int length; + long retval; + HKEY hkey, handle; + char *subkey; + char *keyclass; + DWORD options, disposition; + REGSAM sam; + SECURITY_ATTRIBUTES sa, *psa; + + if (items != 9) + { + croak("usage: Win32::RegCreateKeyEx($hkey, $subkey, $reserved, $class, $options, $sam, " + "$security, $handle, $disposition);\n"); + } + + hkey = SvHKEY(ST(0)); + subkey = (char *)SvPV(ST(1), na); + keyclass = (char *)SvPV(ST(3), na); + options = (DWORD) ((unsigned long)SvIV(ST(4))); + sam = (REGSAM) ((unsigned long)SvIV(ST(5))); + psa = (SECURITY_ATTRIBUTES*)SvPV(ST(6), length); + if (length != sizeof(SECURITY_ATTRIBUTES)) + { + psa = &sa; + memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES)); + sa.nLength = sizeof(SECURITY_ATTRIBUTES); + } + + retval = RegCreateKeyEx(hkey, subkey, 0, keyclass, options, sam, + psa, &handle, &disposition); + + if (SUCCESSRETURNED(retval)) + { + if (psa == &sa) + SETPVN(6, &sa, sizeof(sa)); + + SETHKEY(7,handle); + SETIV(8,disposition); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegDeleteKey) +{ + dXSARGS; + + if (items != 2) + { + croak("usage: Win32::RegDeleteKey($hkey, $subkey);\n"); + } + + REGRETURN(RegDeleteKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na))); +} + +static +XS(w32_RegDeleteValue) +{ + dXSARGS; + + if (items != 2) + { + croak("usage: Win32::RegDeleteValue($hkey, $valname);\n"); + } + + REGRETURN(RegDeleteValue(SvHKEY(ST(0)), (char *)SvPV(ST(1), na))); +} + +static +XS(w32_RegEnumKey) +{ + dXSARGS; + + char keybuffer[TMPBUFSZ]; + + if (items != 3) + { + croak("usage: Win32::RegEnumKey($hkey, $idx, $subkeyname);\n"); + } + + if (SUCCESSRETURNED(RegEnumKey(SvHKEY(ST(0)), SvIV(ST(1)), keybuffer, sizeof(keybuffer)))) + { + SETPV(2, keybuffer); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegEnumKeyEx) +{ + dXSARGS; + int length; + + DWORD keysz, classsz; + char keybuffer[TMPBUFSZ]; + char classbuffer[TMPBUFSZ]; + long retval; + FILETIME filetime; + + if (items != 6) + { + croak("usage: Win32::RegEnumKeyEx($hkey, $idx, $subkeyname, $reserved, $class, $time);\n"); + } + + keysz = sizeof(keybuffer); + classsz = sizeof(classbuffer); + retval = RegEnumKeyEx(SvHKEY(ST(0)), SvIV(ST(1)), keybuffer, &keysz, 0, + classbuffer, &classsz, &filetime); + if (SUCCESSRETURNED(retval)) + { + SETPV(2, keybuffer); + SETPV(4, classbuffer); + SETIV(5, ft2timet(&filetime)); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegEnumValue) +{ + dXSARGS; + HKEY hkey; + DWORD type, namesz, valsz; + long retval; + static HKEY last_hkey; + char myvalbuf[MAX_LENGTH]; + char mynambuf[MAX_LENGTH]; + + if (items != 6) + { + croak("usage: Win32::RegEnumValue($hkey, $i, $name, $reserved, $type, $value);\n"); + } + + hkey = SvHKEY(ST(0)); + + // If this is a new key, find out how big the maximum name and value sizes are and + // allocate space for them. Free any old storage and set the old key value to the + // current key. + + if (hkey != (HKEY)last_hkey) + { + char keyclass[TMPBUFSZ]; + DWORD classsz, subkeys, maxsubkey, maxclass, values, salen, maxnamesz, maxvalsz; + FILETIME ft; + classsz = sizeof(keyclass); + retval = RegQueryInfoKey(hkey, keyclass, &classsz, 0, &subkeys, &maxsubkey, &maxclass, + &values, &maxnamesz, &maxvalsz, &salen, &ft); + + if (!SUCCESSRETURNED(retval)) + { + XSRETURN_NO; + } + memset(myvalbuf, 0, MAX_LENGTH); + memset(mynambuf, 0, MAX_LENGTH); + last_hkey = hkey; + } + + namesz = MAX_LENGTH; + valsz = MAX_LENGTH; + retval = RegEnumValue(hkey, SvIV(ST(1)), mynambuf, &namesz, 0, &type, (LPBYTE) myvalbuf, &valsz); + if (!SUCCESSRETURNED(retval)) + { + XSRETURN_NO; + } + else + { + SETPV(2, mynambuf); + SETIV(4, type); + + // return includes the null terminator so delete it if REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ + switch(type) + { + case REG_SZ: + case REG_MULTI_SZ: + case REG_EXPAND_SZ: + if (valsz) + --valsz; + case REG_BINARY: + SETPVN(5, myvalbuf, valsz); + break; + + case REG_DWORD_BIG_ENDIAN: + { + BYTE tmp = myvalbuf[0]; + myvalbuf[0] = myvalbuf[3]; + myvalbuf[3] = tmp; + tmp = myvalbuf[1]; + myvalbuf[1] = myvalbuf[2]; + myvalbuf[2] = tmp; + } + case REG_DWORD_LITTLE_ENDIAN: // same as REG_DWORD + SETNV(5, (double)*((DWORD*)myvalbuf)); + break; + + default: + break; + } + + XSRETURN_YES; + } +} + +static +XS(w32_RegFlushKey) +{ + dXSARGS; + + if (items != 1) + { + croak("usage: Win32::RegFlushKey($hkey);\n"); + } + + REGRETURN(RegFlushKey(SvHKEY(ST(0)))); +} + +static +XS(w32_RegGetKeySecurity) +{ + dXSARGS; + SECURITY_DESCRIPTOR sd; + DWORD sdsz; + + if (items != 3) + { + croak("usage: Win32::RegGetKeySecurity($hkey, $security_info, $security_descriptor);\n"); + } + + if (SUCCESSRETURNED(RegGetKeySecurity(SvHKEY(ST(0)), SvIV(ST(1)), &sd, &sdsz))) + { + SETPVN(2, &sd, sdsz); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegLoadKey) +{ + dXSARGS; + + if (items != 3) + { + croak("usage: Win32::RegLoadKey($hkey, $subkey, $filename);\n"); + } + + REGRETURN(RegLoadKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), (char *)SvPV(ST(2), na))); +} + +static +XS(w32_RegNotifyChangeKeyValue) +{ + croak("Win32::RegNotifyChangeKeyValue not yet implemented!\n"); +} + +static +XS(w32_RegOpenKey) +{ + dXSARGS; + HKEY handle; + + if (items != 3) + { + croak("usage: Win32::RegOpenKey($hkey, $subkey, $handle);\n"); + } + + if (SUCCESSRETURNED(RegOpenKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), &handle))) + { + SETHKEY(2,handle); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegOpenKeyEx) +{ + dXSARGS; + HKEY handle; + + if (items != 5) + { + croak("usage: Win32::RegOpenKeyEx($hkey, $subkey, $reserved, $sam, $handle);\n"); + } + + if (SUCCESSRETURNED(RegOpenKeyEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), + 0, (REGSAM) ((unsigned long)SvIV(ST(3))), &handle))) + { + SETHKEY(4,handle); + XSRETURN_YES; + } + XSRETURN_NO; +} + +#pragma optimize("", off) +static +XS(w32_RegQueryInfoKey) +{ + dXSARGS; + int length; + + char keyclass[TMPBUFSZ]; + DWORD subkeys, maxsubkey, maxclass, values, maxvalname, maxvaldata; + DWORD seclen, classsz; + FILETIME ft; + long retval; + + if (items != 10) + { + croak("usage: Win32::RegQueryInfoKey($hkey, $class, $numsubkeys, $maxsubkey," + "$maxclass, $values, $maxvalname, $maxvaldata, $secdesclen," + "$lastwritetime);\n"); + } + + classsz = sizeof(keyclass); + retval = RegQueryInfoKey(SvHKEY(ST(0)), keyclass, &classsz, 0, &subkeys, &maxsubkey, + &maxclass, &values, &maxvalname, &maxvaldata, + &seclen, &ft); + if (SUCCESSRETURNED(retval)) + { + SETPV(1, keyclass); + SETIV(2, subkeys); + SETIV(3, maxsubkey); + SETIV(4, maxclass); + SETIV(5, values); + SETIV(6, maxvalname); + SETIV(7, maxvaldata); + SETIV(8, seclen); + SETIV(9, ft2timet(&ft)); + XSRETURN_YES; + } + XSRETURN_NO; +} +#pragma optimize("", on) + +static +XS(w32_RegQueryValue) +{ + dXSARGS; + + unsigned char databuffer[TMPBUFSZ*2]; + long datasz = sizeof(databuffer); + + if (items != 3) + { + croak("usage: Win32::RegQueryValue($hkey, $valuename, $data);\n"); + } + + if (SUCCESSRETURNED(RegQueryValue(SvHKEY(ST(0)), SvPV(ST(1), na), (char*)databuffer, &datasz))) + { + // return includes the null terminator so delete it + SETPVN(2, databuffer, --datasz); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegQueryValueEx) +{ + dXSARGS; + + unsigned char databuffer[TMPBUFSZ*2]; + DWORD datasz = sizeof(databuffer); + DWORD type; + LONG result; + LPBYTE ptr = databuffer; + + if (items != 5) + { + croak("usage: Win32::RegQueryValueEx($hkey, $valuename, $reserved, $type, $data);\n"); + } + + result = RegQueryValueEx(SvHKEY(ST(0)), SvPV(ST(1), na), 0, &type, ptr, &datasz); + if (result == ERROR_MORE_DATA) + { + New(0, ptr, datasz+1, BYTE); + result = RegQueryValueEx(SvHKEY(ST(0)), SvPV(ST(1), na), 0, &type, ptr, &datasz); + } + if (SUCCESSRETURNED(result)) + { + SETIV(3, type); + + // return includes the null terminator so delete it if REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ + switch(type) + { + case REG_SZ: + case REG_MULTI_SZ: + case REG_EXPAND_SZ: + --datasz; + case REG_BINARY: + SETPVN(4, ptr, datasz); + break; + + case REG_DWORD_BIG_ENDIAN: + { + BYTE tmp = ptr[0]; + ptr[0] = ptr[3]; + ptr[3] = tmp; + tmp = ptr[1]; + ptr[1] = ptr[2]; + ptr[2] = tmp; + } + case REG_DWORD_LITTLE_ENDIAN: // same as REG_DWORD + SETNV(4, (double)*((DWORD*)ptr)); + break; + + default: + break; + } + + if (ptr != databuffer) + safefree(ptr); + + XSRETURN_YES; + } + if (ptr != databuffer) + safefree(ptr); + + XSRETURN_NO; +} + +static +XS(w32_RegReplaceKey) +{ + dXSARGS; + + if (items != 4) + { + croak("usage: Win32::RegReplaceKey($hkey, $subkey, $newfile, $oldfile);\n"); + } + + REGRETURN(RegReplaceKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), (char *)SvPV(ST(2), na), (char *)SvPV(ST(3), na))); +} + +static +XS(w32_RegRestoreKey) +{ + dXSARGS; + + if (items < 2 || items > 3) + { + croak("usage: Win32::RegRestoreKey($hkey, $filename [, $flags]);\n"); + } + + REGRETURN(RegRestoreKey(SvHKEY(ST(0)), (char*)SvPV(ST(1), na), (DWORD)((items == 3) ? SvIV(ST(2)) : 0))); +} + +static +XS(w32_RegSaveKey) +{ + dXSARGS; + + if (items != 2) + { + croak("usage: Win32::RegSaveKey($hkey, $filename);\n"); + } + + REGRETURN(RegSaveKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), NULL)); +} + +static +XS(w32_RegSetKeySecurity) +{ + dXSARGS; + + if (items != 3) + { + croak("usage: Win32::RegSetKeySecurity($hkey, $security_info, $security_descriptor);\n"); + } + + REGRETURN(RegSetKeySecurity(SvHKEY(ST(0)), SvIV(ST(1)), (SECURITY_DESCRIPTOR*)SvPV(ST(2), na))); +} + +static +XS(w32_RegSetValue) +{ + dXSARGS; + + unsigned int size; + char *buffer; + + if (items != 4) + { + croak("usage: Win32::RegSetValue($hkey, $subKey, $type, $data);\n"); + } + + DWORD type = SvIV(ST(2)); + if (type != REG_SZ && type != REG_EXPAND_SZ) + { + croak("Win32::RegSetValue: Type was not REG_SZ or REG_EXPAND_SZ, cannot set %s\n", (char *)SvPV(ST(1), na)); + } + + buffer = (char *)SvPV(ST(3), size); + REGRETURN(RegSetValue(SvHKEY(ST(0)), SvPV(ST(1), na), REG_SZ, buffer, size)); +} + +static +XS(w32_RegSetValueEx) +{ + dXSARGS; + + DWORD type; + DWORD val; + unsigned int size; + char *buffer; + + if (items != 5) + { + croak("usage: Win32::RegSetValueEx($hkey, $valname, $reserved, $type, $data);\n"); + } + + type = (DWORD)SvIV(ST(3)); + switch(type) + { + case REG_SZ: + case REG_BINARY: + case REG_MULTI_SZ: + case REG_EXPAND_SZ: + buffer = (char *)SvPV(ST(4), size); + if (type != REG_BINARY) + size++; // include null terminator in size + + REGRETURN(RegSetValueEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, type, (PBYTE) buffer, size)); + break; + + case REG_DWORD_BIG_ENDIAN: + case REG_DWORD_LITTLE_ENDIAN: // Same as REG_DWORD + val = (DWORD)SvIV(ST(4)); + REGRETURN(RegSetValueEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, type, (PBYTE) &val, sizeof(DWORD))); + break; + + default: + croak("Win32::RegSetValueEx: Type not specified, cannot set %s\n", (char *)SvPV(ST(1), na)); + } +} + +static +XS(w32_RegUnloadKey) +{ + dXSARGS; + + if (items != 2) + { + croak("usage: Win32::RegUnLoadKey($hkey, $subkey);\n"); + } + + REGRETURN(RegUnLoadKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na))); +} + +static +XS(w32_RegisterServer) +{ + dXSARGS; + BOOL bSuccess = FALSE; + HINSTANCE hInstance; + unsigned int length; + FARPROC sFunc; + + if (items != 1) + { + croak("usage: Win32::RegisterServer($LibraryName)\n"); + } + + hInstance = LoadLibrary((char *)SvPV(ST(0), length)); + if (hInstance != NULL) + { + sFunc = GetProcAddress(hInstance, "DllRegisterServer"); + if (sFunc != NULL) + { + bSuccess = (sFunc() == 0); + } + FreeLibrary(hInstance); + } + + if (bSuccess) + { + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_UnregisterServer) +{ + dXSARGS; + BOOL bSuccess = FALSE; + HINSTANCE hInstance; + unsigned int length; + FARPROC sFunc; + + if (items != 1) + { + croak("usage: Win32::UnregisterServer($LibraryName)\n"); + } + + hInstance = LoadLibrary((char *)SvPV(ST(0), length)); + if (hInstance != NULL) + { + sFunc = GetProcAddress(hInstance, "DllUnregisterServer"); + if (sFunc != NULL) + { + bSuccess = (sFunc() == 0); + } + FreeLibrary(hInstance); + } + + if (bSuccess) + { + XSRETURN_YES; + } + XSRETURN_NO; +} + + void Perl_init_os_extras() { @@ -2129,6 +3066,40 @@ Perl_init_os_extras() newXS("Win32::GetShortPathName", w32_GetShortPathName, file); newXS("Win32::Sleep", w32_Sleep, file); + /* the following extensions are used interally and may be changed at any time */ + /* therefore no documentation is provided */ + newXS("Win32::RegCloseKey", w32_RegCloseKey, file); + newXS("Win32::RegConnectRegistry", w32_RegConnectRegistry, file); + newXS("Win32::RegCreateKey", w32_RegCreateKey, file); + newXS("Win32::RegCreateKeyEx", w32_RegCreateKeyEx, file); + newXS("Win32::RegDeleteKey", w32_RegDeleteKey, file); + newXS("Win32::RegDeleteValue", w32_RegDeleteValue, file); + + newXS("Win32::RegEnumKey", w32_RegEnumKey, file); + newXS("Win32::RegEnumKeyEx", w32_RegEnumKeyEx, file); + newXS("Win32::RegEnumValue", w32_RegEnumValue, file); + + newXS("Win32::RegFlushKey", w32_RegFlushKey, file); + newXS("Win32::RegGetKeySecurity", w32_RegGetKeySecurity, file); + + newXS("Win32::RegLoadKey", w32_RegLoadKey, file); + newXS("Win32::RegOpenKey", w32_RegOpenKey, file); + newXS("Win32::RegOpenKeyEx", w32_RegOpenKeyEx, file); + newXS("Win32::RegQueryInfoKey", w32_RegQueryInfoKey, file); + newXS("Win32::RegQueryValue", w32_RegQueryValue, file); + newXS("Win32::RegQueryValueEx", w32_RegQueryValueEx, file); + + newXS("Win32::RegReplaceKey", w32_RegReplaceKey, file); + newXS("Win32::RegRestoreKey", w32_RegRestoreKey, file); + newXS("Win32::RegSaveKey", w32_RegSaveKey, file); + newXS("Win32::RegSetKeySecurity", w32_RegSetKeySecurity, file); + newXS("Win32::RegSetValue", w32_RegSetValue, file); + newXS("Win32::RegSetValueEx", w32_RegSetValueEx, file); + newXS("Win32::RegUnloadKey", w32_RegUnloadKey, file); + + newXS("Win32::RegisterServer", w32_RegisterServer, file); + newXS("Win32::UnregisterServer", w32_UnregisterServer, file); + /* XXX Bloat Alert! The following Activeware preloads really * ought to be part of Win32::Sys::*, so they're not included * here. diff --git a/win32/win32.h b/win32/win32.h index 781c720ed0..1930e391da 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -9,9 +9,24 @@ #ifndef _INC_WIN32_PERL5 #define _INC_WIN32_PERL5 +#ifdef PERL_OBJECT +#define ENV_HV_NAME "ENV_HV_NAME" +#define DYNAMIC_ENV_FETCH +#define prime_env_iter() +#ifdef PERL_GLOBAL_STRUCT +#error PERL_GLOBAL_STRUCT cannot be defined with PERL_OBJECT +#endif +#define win32_get_stdlib PerlEnv_lib_path +#define win32_get_sitelib PerlEnv_sitelib_path +#endif + #ifdef __GNUC__ typedef long long __int64; #define Win32_Winsock +# ifdef __cplusplus +#undef __attribute__ /* seems broken in 2.8.0 */ +#define __attribute__(p) +# endif /* GCC does not do __declspec() - render it a nop * and turn on options to avoid importing data */ @@ -29,11 +44,15 @@ typedef long long __int64; * otherwise import it. */ +#if defined(PERL_OBJECT) +#define DllExport +#else #if defined(PERLDLL) || defined(WIN95FIX) #define DllExport __declspec(dllexport) #else #define DllExport __declspec(dllimport) #endif +#endif #define WIN32_LEAN_AND_MEAN #include <windows.h> @@ -119,6 +138,11 @@ struct tms { #pragma warn -csu /* "comparing signed and unsigned values" */ #pragma warn -pro /* "call to function with no prototype" */ +/* Borland is picky about a bare member function name used as its ptr */ +#ifdef PERL_OBJECT +#define FUNC_NAME_TO_PTR(name) &(name) +#endif + #endif #ifdef _MSC_VER /* Microsoft Visual C++ */ @@ -144,6 +168,13 @@ typedef long gid_t; # endif #endif +#ifndef _O_NOINHERIT +# define _O_NOINHERIT 0x0080 +# ifndef _NO_OLDNAMES +# define O_NOINHERIT _O_NOINHERIT +# endif +#endif + #endif /* __MINGW32__ */ /* compatibility stuff for other compilers goes here */ @@ -182,7 +213,8 @@ extern int do_aspawn(void *really, void **mark, void **sp); extern int do_spawn(char *cmd); extern int do_spawn_nowait(char *cmd); extern char do_exec(char *cmd); -extern char * win32_perllib_path(char *sfx,...); +extern char * win32_get_stdlib(char *pl); +extern char * win32_get_sitelib(char *pl); extern int IsWin95(void); extern int IsWinNT(void); diff --git a/win32/win32iop.h b/win32/win32iop.h index ee2c2dbfa1..a17134b0ff 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -159,6 +159,7 @@ END_EXTERN_C #undef fileno #endif +#ifndef PERL_OBJECT #define stderr win32_stderr() #define stdout win32_stdout() #define stdin win32_stdin() @@ -171,6 +172,7 @@ END_EXTERN_C /* * redirect to our own version */ +#undef fprintf #define fprintf win32_fprintf #define vfprintf win32_vfprintf #define printf win32_printf @@ -185,6 +187,7 @@ END_EXTERN_C #define fputs(s,f) win32_fputs(s,f) #define fputc(c,f) win32_fputc(c,f) #define ungetc(c,f) win32_ungetc(c,f) +#undef getc #define getc(f) win32_getc(f) #define fileno(f) win32_fileno(f) #define clearerr(f) win32_clearerr(f) @@ -226,9 +229,12 @@ END_EXTERN_C #define fgets win32_fgets #define gets win32_gets #define fgetc win32_fgetc +#undef putc #define putc win32_putc #define puts win32_puts +#undef getchar #define getchar win32_getchar +#undef putchar #define putchar win32_putchar #if !defined(MYMALLOC) || !defined(PERL_CORE) @@ -250,6 +256,7 @@ END_EXTERN_C #define ioctl win32_ioctl #define utime win32_utime #define wait win32_wait +#endif /* PERL_OBJECT */ #ifdef HAVE_DES_FCRYPT #undef crypt @@ -257,8 +264,10 @@ END_EXTERN_C #endif #ifndef USE_WIN32_RTL_ENV +#ifndef PERL_OBJECT #undef getenv #define getenv win32_getenv +#endif /* PERL_OBJECT */ #endif #endif /* WIN32IO_IS_STDIO */ diff --git a/win32/win32sck.c b/win32/win32sck.c index b07d1f1918..bcf180ad62 100644 --- a/win32/win32sck.c +++ b/win32/win32sck.c @@ -13,10 +13,21 @@ #define WIN32_LEAN_AND_MEAN #ifdef __GNUC__ #define Win32_Winsock +# ifdef __cplusplus +#undef __attribute__ /* seems broken in 2.8.0 */ +#define __attribute__(p) +# endif #endif #include <windows.h> #include "EXTERN.h" #include "perl.h" + +#if defined(PERL_OBJECT) +#define NO_XSLOCKS +extern CPerlObj* pPerl; +#include "XSUB.h" +#endif + #include <sys/socket.h> #include <fcntl.h> #include <sys/stat.h> @@ -638,7 +649,7 @@ win32_savecopyservent(struct servent*d, struct servent*s, const char *proto) d->s_proto = s->s_proto; else #endif - if (proto && strlen(proto)) + if (proto && strlen(proto)) d->s_proto = (char *)proto; else d->s_proto = "tcp"; diff --git a/win32/win32thread.c b/win32/win32thread.c index 44f32e27fd..e91830d38d 100644 --- a/win32/win32thread.c +++ b/win32/win32thread.c @@ -1,6 +1,12 @@ #include "EXTERN.h" #include "perl.h" +#if defined(PERL_OBJECT) +#define NO_XSLOCKS +extern CPerlObj* pPerl; +#include "XSUB.h" +#endif + #ifdef USE_DECLSPEC_THREAD __declspec(thread) struct perl_thread *Perl_current_thread = NULL; #endif diff --git a/x2p/a2py.c b/x2p/a2py.c index fefa81da7e..a4753ab864 100644 --- a/x2p/a2py.c +++ b/x2p/a2py.c @@ -9,6 +9,9 @@ */ #if defined(OS2) || defined(WIN32) +#if defined(WIN32) +#include <io.h> +#endif #include "../patchlevel.h" #endif #include "util.h" diff --git a/x2p/util.c b/x2p/util.c index f8e342cb54..0c6f99f795 100644 --- a/x2p/util.c +++ b/x2p/util.c @@ -42,6 +42,7 @@ safemalloc(MEM_SIZE size) exit(1); } /*NOTREACHED*/ + return 0; } /* paranoid version of realloc */ @@ -66,6 +67,7 @@ saferealloc(Malloc_t where, MEM_SIZE size) exit(1); } /*NOTREACHED*/ + return 0; } /* safe version of free */ |