Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

somewhat untested PERL_OBJECT cleanups (C++isms mostly

gone from the public API); PERL_OBJECT builds again on
windows

TODO: namespace-clean the typedefs in iperlsys.h and
elsewhere; remove C++ remnants from public headers

p4raw-id: //depot/perl@3553
  • Loading branch information...
commit 0cb9638729211ea71a75ae8756c03ba21553bd53 1 parent 4f4e629
Gurusamy Sarathy authored
Showing with 9,168 additions and 3,863 deletions.
  1. +11 −13 XSUB.h
  2. +15 −2 bytecode.pl
  3. +1 −1  cv.h
  4. +2,572 −1,320 embed.h
  5. +74 −40 embed.pl
  6. +3 −3 ext/B/B.xs
  7. +3 −7 ext/ByteLoader/ByteLoader.xs
  8. +1 −1  ext/ByteLoader/bytecode.h
  9. +13 −2 ext/ByteLoader/byterun.c
  10. +2 −0  ext/ByteLoader/byterun.h
  11. +2 −2 ext/DynaLoader/dlutils.c
  12. +12 −6 global.sym
  13. +24 −2 globals.c
  14. +740 −370 iperlsys.h
  15. +2 −3 lib/ExtUtils/Embed.pm
  16. +1 −1  lib/ExtUtils/xsubpp
  17. +1 −9 mg.c
  18. +3,033 −1,005 objXSUB.h
  19. +0 −13 opcode.h
  20. +0 −13 opcode.pl
  21. +13 −11 perl.c
  22. +125 −96 perl.h
  23. +2 −0  pod/perlhist.pod
  24. +1 −1  pp_ctl.c
  25. +1 −1  pp_hot.c
  26. +673 −655 proto.h
  27. +1 −1  scope.h
  28. +1 −1  sv.h
  29. +1 −1  toke.c
  30. +14 −15 universal.c
  31. +8 −2 util.c
  32. +106 −59 win32/GenCAPI.pl
  33. +33 −22 win32/Makefile
  34. +10 −10 win32/config.bc
  35. +10 −10 win32/config.gc
  36. +10 −10 win32/config.vc
  37. +11 −18 win32/dl_win32.xs
  38. +10 −0 win32/makedef.pl
  39. +14 −2 win32/makefile.mk
  40. +1,465 −21 win32/perllib.c
  41. +3 −75 win32/runperl.c
  42. +109 −30 win32/win32.c
  43. +19 −8 win32/win32.h
  44. +3 −0  win32/win32iop.h
  45. +15 −1 win32/win32sck.c
24 XSUB.h
View
@@ -1,13 +1,9 @@
#define ST(off) PL_stack_base[ax + (off)]
-#ifdef PERL_OBJECT
-# define XS(name) void name(CV* cv, CPerlObj* pPerl)
+#if defined(CYGWIN32) && defined(USE_DYNAMIC_LOADING)
+# define XS(name) __declspec(dllexport) void name(pTHXo_ CV* cv)
#else
-# if defined(CYGWIN32) && defined(USE_DYNAMIC_LOADING)
-# define XS(name) __declspec(dllexport) void name(pTHX_ CV* cv)
-# else
-# define XS(name) void name(pTHX_ CV* cv)
-# endif
+# define XS(name) void name(pTHXo_ CV* cv)
#endif
#define dXSARGS \
@@ -148,10 +144,12 @@
#ifdef PERL_OBJECT
# include "objXSUB.h"
-# undef PERL_OBJECT_THIS
-# define PERL_OBJECT_THIS pPerl
-# undef PERL_OBJECT_THIS_
-# define PERL_OBJECT_THIS_ pPerl,
+# undef aTHXo
+# define aTHXo pPerl
+# undef aTHXo_
+# define aTHXo_ aTHXo,
+# undef _aTHXo
+# define _aTHXo ,aTHXo
# undef SAVEDESTRUCTOR
# define SAVEDESTRUCTOR(f,p) \
@@ -162,8 +160,6 @@
# undef errno
# define errno ErrorNo()
# endif
-# undef ErrorNo
-# define ErrorNo pPerl->ErrorNo
# undef NtCrypt
# define NtCrypt pPerl->NtCrypt
# undef NtGetLib
@@ -176,6 +172,8 @@
# define NtGetBin pPerl->NtGetBin
# undef NtGetDebugScriptStr
# define NtGetDebugScriptStr pPerl->NtGetDebugScriptStr
+# undef fprintf
+# define fprintf pPerl->fprintf
# endif /* WIN32 */
# ifndef NO_XSLOCKS
17 bytecode.pl
View
@@ -67,9 +67,20 @@ package B::Asmdata;
#include "EXTERN.h"
#include "perl.h"
+#define NO_XSLOCKS
+#include "XSUB.h"
+
+#ifdef PERL_OBJECT
+#undef CALL_FPTR
+#define CALL_FPTR(fptr) (pPerl->*fptr)
+#undef PL_ppaddr
+#define PL_ppaddr (*get_ppaddr())
+#endif
+
#include "byterun.h"
#include "bytecode.h"
+
static int optype_size[] = {
EOT
my $i = 0;
@@ -89,7 +100,7 @@ package B::Asmdata;
static I32 bytecode_obj_list_fill = -1;
void *
-bset_obj_store(void *obj, I32 ix)
+bset_obj_store(pTHXo_ void *obj, I32 ix)
{
if (ix > bytecode_obj_list_fill) {
if (bytecode_obj_list_fill == -1)
@@ -103,7 +114,7 @@ package B::Asmdata;
}
void
-byterun(pTHX_ struct bytestream bs)
+byterun(pTHXo_ struct bytestream bs)
{
dTHR;
int insn;
@@ -237,6 +248,8 @@ package B::Asmdata;
EOT
print BYTERUN_H <<'EOT';
+EXT void byterun(pTHXo_ struct bytestream bs);
+
#define INIT_SPECIALSV_LIST STMT_START { \
EOT
for ($i = 0; $i < @specialsv; $i++) {
2  cv.h
View
@@ -21,7 +21,7 @@ struct xpvcv {
HV * xcv_stash;
OP * xcv_start;
OP * xcv_root;
- void (*xcv_xsub) (pTHX_ CV*);
+ void (*xcv_xsub) (pTHXo_ CV*);
ANY xcv_xsubany;
GV * xcv_gv;
GV * xcv_filegv;
3,892 embed.h
View
2,572 additions, 1,320 deletions not shown
114 embed.pl
View
@@ -100,11 +100,14 @@ ()
#munge_c_files();
# generate proto.h
+my $wrote_protected = 0;
+
sub write_protos {
my $ret = "";
if (@_ == 1) {
my $arg = shift;
- $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifdef|else|endif)\b/;
+ $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifdef|else|endif)\b/
+ or $arg =~ /^\s*(public|protected|private):/;
}
else {
my ($flags,$retval,$func,@args) = @_;
@@ -112,8 +115,11 @@ sub write_protos {
$retval = "STATIC $retval";
$func = "S_$func";
}
- elsif ($flags =~ /p/) {
- $func = "Perl_$func";
+ else {
+ $retval = "VIRTUAL $retval";
+ if ($flags =~ /p/) {
+ $func = "Perl_$func";
+ }
}
$ret .= "$retval\t$func(";
unless ($flags =~ /n/) {
@@ -388,13 +394,16 @@ END
}
else {
my ($flags,$retval,$func,@args) = @_;
- unless ($flags =~ /o/) {
- if ($flags =~ /s/) {
- $ret .= hide("S_$func","CPerlObj::$func");
- }
- elsif ($flags =~ /p/) {
- $ret .= hide("Perl_$func","CPerlObj::$func");
- }
+ if ($flags =~ /s/) {
+ $ret .= hide("S_$func","CPerlObj::S_$func");
+ $ret .= hide($func,"S_$func");
+ }
+ elsif ($flags =~ /p/) {
+ $ret .= hide("Perl_$func","CPerlObj::Perl_$func");
+ $ret .= hide($func,"Perl_$func");
+ }
+ else {
+ $ret .= hide($func,"CPerlObj::$func");
}
}
$ret;
@@ -402,7 +411,8 @@ END
for $sym (sort keys %ppsym) {
$sym =~ s/^Perl_//;
- print EM hide("Perl_$sym", "CPerlObj::$sym");
+ print EM hide("Perl_$sym", "CPerlObj::Perl_$sym");
+ print EM hide($sym, "Perl_$sym");
}
print EM <<'END';
@@ -684,8 +694,12 @@ END
}
else {
my ($flags,$retval,$func,@args) = @_;
- unless ($flags =~ /o/) {
+ unless ($flags =~ /s/) {
if ($flags =~ /p/) {
+ $ret .= undefine("Perl_$func") . hide("Perl_$func","pPerl->Perl_$func");
+ $ret .= undefine($func) . hide($func,"Perl_$func");
+ }
+ else {
$ret .= undefine($func) . hide($func,"pPerl->$func");
}
}
@@ -695,7 +709,8 @@ END
for $sym (sort keys %ppsym) {
$sym =~ s/^Perl_//;
- print OBX undefine($sym) . hide($sym, "pPerl->$sym");
+ print OBX undefine("Perl_$sym") . hide("Perl_$sym", "pPerl->Perl_$sym");
+ print OBX undefine($sym) . hide($sym, "Perl_$sym");
}
print OBX <<'EOT';
@@ -731,6 +746,9 @@ END
# may be autogenerated.
#
+#if defined(PERL_OBJECT)
+public:
+#endif
p |SV* |amagic_call |SV* left|SV* right|int method|int dir
p |bool |Gv_AMupdate |HV* stash
p |OP* |append_elem |I32 optype|OP* head|OP* tail
@@ -799,6 +817,7 @@ END
p |char** |get_op_names
p |char* |get_no_modify
p |U32* |get_opargs
+p |PPADDR_t*|get_ppaddr
p |I32 |cxinc
p |void |deb |const char* pat|...
p |void |deb_growlevel
@@ -1019,7 +1038,6 @@ END
p |U32 |magic_sizepack |SV* sv|MAGIC* mg
p |int |magic_wipepack |SV* sv|MAGIC* mg
p |void |magicname |char* sym|char* name|I32 namlen
-no |int |main |int argc|char** argv|char** env
#if defined(MYMALLOC)
np |MEM_SIZE|malloced_size |void *p
#endif
@@ -1141,17 +1159,29 @@ END
p |void |pad_reset
p |void |pad_swipe |PADOFFSET po
p |void |peep |OP* o
+#if defined(PERL_OBJECT)
+no |void |perl_construct
+no |void |perl_destruct
+no |void |perl_free
+no |int |perl_run
+no |int |perl_parse |XSINIT_t xsinit \
+ |int argc|char** argv|char** env
+#else
no |PerlInterpreter* |perl_alloc
+no |void |perl_construct |PerlInterpreter* sv_interp
+no |void |perl_destruct |PerlInterpreter* sv_interp
+no |void |perl_free |PerlInterpreter* sv_interp
+no |int |perl_run |PerlInterpreter* sv_interp
+no |int |perl_parse |PerlInterpreter* sv_interp|XSINIT_t xsinit \
+ |int argc|char** argv|char** env
+#endif
p |void |call_atexit |ATEXIT_t fn|void *ptr
p |I32 |call_argv |const char* sub_name|I32 flags|char** argv
p |I32 |call_method |const char* methname|I32 flags
p |I32 |call_pv |const char* sub_name|I32 flags
p |I32 |call_sv |SV* sv|I32 flags
-no |void |perl_construct |PerlInterpreter* sv_interp
-no |void |perl_destruct |PerlInterpreter* sv_interp
p |SV* |eval_pv |const char* p|I32 croak_on_error
p |I32 |eval_sv |SV* sv|I32 flags
-no |void |perl_free |PerlInterpreter* sv_interp
p |SV* |get_sv |const char* name|I32 create
p |AV* |get_av |const char* name|I32 create
p |HV* |get_hv |const char* name|I32 create
@@ -1164,10 +1194,7 @@ END
p |void |set_numeric_local
p |void |set_numeric_radix
p |void |set_numeric_standard
-no |int |perl_parse |PerlInterpreter* sv_interp|XSINIT_t xsinit \
- |int argc|char** argv|char** env
p |void |require_pv |const char* pv
-no |int |perl_run |PerlInterpreter* sv_interp
p |void |pidgone |int pid|int status
p |void |pmflag |U16* pmfl|int ch
p |OP* |pmruntime |OP* pm|OP* expr|OP* repl
@@ -1406,8 +1433,12 @@ END
p |int |runops_debug
#if defined(WIN32)
+#if defined(PERL_OBJECT)
+p |int& |ErrorNo
+#else
p |int* |ErrorNo
#endif
+#endif
p |void |sv_catpvf_mg |SV *sv|const char* pat|...
p |void |sv_catpv_mg |SV *sv|const char *ptr
p |void |sv_catpvn_mg |SV *sv|const char *ptr|STRLEN len
@@ -1444,11 +1475,14 @@ END
p |SV* |sv_rvweaken |SV *sv
p |int |magic_killbackrefs|SV *sv|MAGIC *mg
-#if defined(PERL_IN_AV_C)
+#if defined(PERL_OBJECT)
+protected:
+#endif
+#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
s |I32 |avhv_index_sv |SV* sv
#endif
-#if defined(PERL_IN_DOOP_C)
+#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
s |I32 |do_trans_CC_simple |SV *sv
s |I32 |do_trans_CC_count |SV *sv
s |I32 |do_trans_CC_complex |SV *sv
@@ -1461,11 +1495,11 @@ END
s |I32 |do_trans_CU_trivial |SV *sv
#endif
-#if defined(PERL_IN_GV_C)
+#if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT)
s |void |gv_init_sv |GV *gv|I32 sv_type
#endif
-#if defined(PERL_IN_HV_C)
+#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT)
s |void |hsplit |HV *hv
s |void |hfreeentries |HV *hv
s |void |more_he
@@ -1475,7 +1509,7 @@ END
s |void |hv_magic_check |HV *hv|bool *needs_copy|bool *needs_store
#endif
-#if defined(PERL_IN_MG_C)
+#if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT)
s |void |save_magic |I32 mgs_ix|SV *sv
s |int |magic_methpack |SV *sv|MAGIC *mg|char *meth
s |int |magic_methcall |SV *sv|MAGIC *mg|char *meth|I32 f \
@@ -1484,7 +1518,7 @@ END
s |void |restore_magic |void *p
#endif
-#if defined(PERL_IN_OP_C)
+#if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT)
s |I32 |list_assignment|OP *o
s |void |bad_type |I32 n|char *t|char *name|OP *kid
s |OP* |modkids |OP *o|I32 type
@@ -1508,7 +1542,7 @@ END
# endif
#endif
-#if defined(PERL_IN_PERL_C)
+#if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
s |void |find_beginning
s |void |forbid_setid |char *
s |void |incpush |char *|int
@@ -1525,7 +1559,6 @@ END
s |void |open_script |char *|bool|SV *|int *fd
s |void |usage |char *
s |void |validate_suid |char *|char*|int
-s |I32 |read_e_script |int idx|SV *buf_sv|int maxlen
# if defined(IAMSUID)
s |int |fd_on_nosuid_fs|int fd
# endif
@@ -1539,7 +1572,7 @@ END
# endif
#endif
-#if defined(PERL_IN_PP_C)
+#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
s |void |doencodes |SV* sv|char* s|I32 len
s |SV* |refto |SV* sv
s |U32 |seed
@@ -1548,7 +1581,7 @@ END
s |int |div128 |SV *pnum|bool *done
#endif
-#if defined(PERL_IN_PP_CTL_C)
+#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
s |OP* |docatch |OP *o
s |void* |docatch_body |va_list args
s |OP* |dofindlabel |OP *o|char *label|OP **opstack|OP **oplimit
@@ -1572,14 +1605,14 @@ END
s |I32 |amagic_cmp_locale|SV *str1|SV *str2
#endif
-#if defined(PERL_IN_PP_HOT_C)
+#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
s |CV* |get_db_sub |SV **svp|CV *cv
# if defined(USE_THREADS)
s |void |unset_cvowner |void *cvarg
# endif
#endif
-#if defined(PERL_IN_PP_SYS_C)
+#if defined(PERL_IN_PP_SYS_C) || defined(PERL_DECL_PROT)
s |OP* |doform |CV *cv|GV *gv|OP *retop
s |int |emulate_eaccess|const char* path|int mode
# if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
@@ -1587,7 +1620,7 @@ END
# endif
#endif
-#if defined(PERL_IN_REGCOMP_C)
+#if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT)
s |regnode*|reg |I32|I32 *
s |regnode*|reganode |U8|U32
s |regnode*|regatom |I32 *
@@ -1615,7 +1648,7 @@ END
s |void |clear_re |void *r
#endif
-#if defined(PERL_IN_REGEXEC_C)
+#if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT)
s |I32 |regmatch |regnode *prog
s |I32 |regrepeat |regnode *p|I32 max
s |I32 |regrepeat_hard |regnode *p|I32 max|I32 *lp
@@ -1631,15 +1664,15 @@ END
s |U8* |reghopmaybe |U8 *pos|I32 off
#endif
-#if defined(PERL_IN_RUN_C)
+#if defined(PERL_IN_RUN_C) || defined(PERL_DECL_PROT)
s |void |debprof |OP *o
#endif
-#if defined(PERL_IN_SCOPE_C)
+#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
s |SV* |save_scalar_at |SV **sptr
#endif
-#if defined(PERL_IN_SV_C)
+#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
s |IV |asIV |SV* sv
s |UV |asUV |SV* sv
s |SV* |more_sv
@@ -1675,7 +1708,7 @@ END
# endif
#endif
-#if defined(PERL_IN_TOKE_C)
+#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
s |void |check_uni
s |void |force_next |I32 type
s |char* |force_version |char *start
@@ -1726,14 +1759,15 @@ END
# endif
#endif
-#if defined(PERL_IN_UNIVERSAL_C)
+#if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT)
s |SV*|isa_lookup |HV *stash|const char *name|int len|int level
#endif
-#if defined(PERL_IN_UTIL_C)
+#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
s |SV* |mess_alloc
rs |void |do_croak |const char *pat|va_list *args
s |void |do_warn |const char *pat|va_list *args
+s |OP* |do_die |const char *pat|va_list *args
# if defined(LEAKTEST)
s |void |xstat |int
# endif
6 ext/B/B.xs
View
@@ -15,9 +15,9 @@
#undef PL_op_name
#undef PL_opargs
#undef PL_op_desc
-#define PL_op_name (pPerl->Perl_get_op_names())
-#define PL_opargs (pPerl->Perl_get_opargs())
-#define PL_op_desc (pPerl->Perl_get_op_descs())
+#define PL_op_name (get_op_names())
+#define PL_opargs (get_opargs())
+#define PL_op_desc (get_op_descs())
#endif
#ifdef PerlIO
10 ext/ByteLoader/ByteLoader.xs
View
@@ -7,17 +7,13 @@ static void
freadpv(U32 len, void *data, XPV *pv)
{
New(666, pv->xpv_pv, len, char);
- fread(pv->xpv_pv, 1, len, (FILE*)data);
+ PerlIO_read((PerlIO*)data, (void*)pv->xpv_pv, len);
pv->xpv_len = len;
pv->xpv_cur = len - 1;
}
static I32
-#ifdef PERL_OBJECT
-byteloader_filter(CPerlObj *pPerl, int idx, SV *buf_sv, int maxlen)
-#else
-byteloader_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
-#endif
+byteloader_filter(pTHXo_ int idx, SV *buf_sv, int maxlen)
{
dTHR;
OP *saveroot = PL_main_root;
@@ -29,7 +25,7 @@ byteloader_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
bs.pfread = (int(*) (char*,size_t,size_t,void*))fread;
bs.pfreadpv = freadpv;
- byterun(bs);
+ byterun(aTHXo_ bs);
if (PL_in_eval) {
OP *o;
2  ext/ByteLoader/bytecode.h
View
@@ -140,4 +140,4 @@ typedef IV IV64;
#define BSET_OBJ_STORE(obj, ix) \
(I32)ix > bytecode_obj_list_fill ? \
- bset_obj_store(obj, (I32)ix) : (bytecode_obj_list[ix] = obj)
+ bset_obj_store(aTHXo_ obj, (I32)ix) : (bytecode_obj_list[ix] = obj)
15 ext/ByteLoader/byterun.c
View
@@ -11,9 +11,20 @@
#include "EXTERN.h"
#include "perl.h"
+#define NO_XSLOCKS
+#include "XSUB.h"
+
+#ifdef PERL_OBJECT
+#undef CALL_FPTR
+#define CALL_FPTR(fptr) (pPerl->*fptr)
+#undef PL_ppaddr
+#define PL_ppaddr (*get_ppaddr())
+#endif
+
#include "byterun.h"
#include "bytecode.h"
+
static int optype_size[] = {
sizeof(OP),
sizeof(UNOP),
@@ -38,7 +49,7 @@ static void **bytecode_obj_list;
static I32 bytecode_obj_list_fill = -1;
void *
-bset_obj_store(void *obj, I32 ix)
+bset_obj_store(pTHXo_ void *obj, I32 ix)
{
if (ix > bytecode_obj_list_fill) {
if (bytecode_obj_list_fill == -1)
@@ -52,7 +63,7 @@ bset_obj_store(void *obj, I32 ix)
}
void
-byterun(pTHX_ struct bytestream bs)
+byterun(pTHXo_ struct bytestream bs)
{
dTHR;
int insn;
2  ext/ByteLoader/byterun.h
View
@@ -173,6 +173,8 @@ EXT int PL_optype_size[]
#endif /* DOINIT */
;
+EXT void byterun(pTHXo_ struct bytestream bs);
+
#define INIT_SPECIALSV_LIST STMT_START { \
PL_specialsv_list[0] = Nullsv; \
PL_specialsv_list[1] = &PL_sv_undef; \
4 ext/DynaLoader/dlutils.c
View
@@ -26,7 +26,7 @@ static int dl_debug = 0; /* value copied from $DynaLoader::dl_error */
static void
-dl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */
+dl_generic_private_init(pTHXo) /* called by dl_*.xs dl_private_init() */
{
char *perl_dl_nonlazy;
#ifdef DEBUGGING
@@ -45,7 +45,7 @@ dl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */
/* SaveError() takes printf style args and saves the result in LastError */
static void
-SaveError(pTHX_ char* pat, ...)
+SaveError(pTHXo_ char* pat, ...)
{
va_list args;
SV *msv;
18 global.sym
View
@@ -66,6 +66,7 @@ Perl_get_op_descs
Perl_get_op_names
Perl_get_no_modify
Perl_get_opargs
+Perl_get_ppaddr
Perl_cxinc
Perl_deb
Perl_deb_growlevel
@@ -263,7 +264,6 @@ Perl_magic_set_all_env
Perl_magic_sizepack
Perl_magic_wipepack
Perl_magicname
-main
Perl_malloced_size
Perl_markstack_grow
Perl_mem_collxfrm
@@ -362,17 +362,24 @@ Perl_pad_free
Perl_pad_reset
Perl_pad_swipe
Perl_peep
+perl_construct
+perl_destruct
+perl_free
+perl_run
+perl_parse
perl_alloc
+perl_construct
+perl_destruct
+perl_free
+perl_run
+perl_parse
Perl_call_atexit
Perl_call_argv
Perl_call_method
Perl_call_pv
Perl_call_sv
-perl_construct
-perl_destruct
Perl_eval_pv
Perl_eval_sv
-perl_free
Perl_get_sv
Perl_get_av
Perl_get_hv
@@ -385,9 +392,7 @@ Perl_new_numeric
Perl_set_numeric_local
Perl_set_numeric_radix
Perl_set_numeric_standard
-perl_parse
Perl_require_pv
-perl_run
Perl_pidgone
Perl_pmflag
Perl_pmruntime
@@ -592,6 +597,7 @@ Perl_yydestruct
Perl_runops_standard
Perl_runops_debug
Perl_ErrorNo
+Perl_ErrorNo
Perl_sv_catpvf_mg
Perl_sv_catpv_mg
Perl_sv_catpvn_mg
26 globals.c
View
@@ -34,13 +34,13 @@ void*
CPerlObj::operator new(size_t nSize, IPerlMem *pvtbl)
{
if(pvtbl != NULL)
- return pvtbl->Malloc(nSize);
+ return pvtbl->pMalloc(pvtbl, nSize);
return NULL;
}
int&
-CPerlObj::ErrorNo(void)
+Perl_ErrorNo(void)
{
return errno;
}
@@ -50,4 +50,26 @@ CPerlObj::Init(void)
{
}
+int
+CPerlObj::fprintf(PerlIO *stream, const char *format, ...)
+{
+ va_list(arglist);
+ va_start(arglist, format);
+ return PerlIO_vprintf(stream, format, arglist);
+}
+
+#ifdef WIN32 /* XXX why are these needed? */
+bool
+Perl_do_exec(char *cmd)
+{
+ return PerlProc_Cmd(cmd);
+}
+
+int
+CPerlObj::do_aspawn(void *vreally, void **vmark, void **vsp)
+{
+ return PerlProc_aspawn(vreally, vmark, vsp);
+}
+#endif /* WIN32 */
+
#endif /* PERL_OBJECT */
1,110 iperlsys.h
View
@@ -80,54 +80,102 @@ extern void PerlIO_init (void);
typedef struct _PerlIO PerlIO;
#endif
-class IPerlStdIO
+/* IPerlStdIO */
+struct IPerlStdIO;
+typedef PerlIO* (*LPStdin)(struct IPerlStdIO*);
+typedef PerlIO* (*LPStdout)(struct IPerlStdIO*);
+typedef PerlIO* (*LPStderr)(struct IPerlStdIO*);
+typedef PerlIO* (*LPOpen)(struct IPerlStdIO*, const char*,
+ const char*);
+typedef int (*LPClose)(struct IPerlStdIO*, PerlIO*);
+typedef int (*LPEof)(struct IPerlStdIO*, PerlIO*);
+typedef int (*LPError)(struct IPerlStdIO*, PerlIO*);
+typedef void (*LPClearerr)(struct IPerlStdIO*, PerlIO*);
+typedef int (*LPGetc)(struct IPerlStdIO*, PerlIO*);
+typedef char* (*LPGetBase)(struct IPerlStdIO*, PerlIO*);
+typedef int (*LPGetBufsiz)(struct IPerlStdIO*, PerlIO*);
+typedef int (*LPGetCnt)(struct IPerlStdIO*, PerlIO*);
+typedef char* (*LPGetPtr)(struct IPerlStdIO*, PerlIO*);
+typedef char* (*LPGets)(struct IPerlStdIO*, PerlIO*, char*, int);
+typedef int (*LPPutc)(struct IPerlStdIO*, PerlIO*, int);
+typedef int (*LPPuts)(struct IPerlStdIO*, PerlIO*, const char*);
+typedef int (*LPFlush)(struct IPerlStdIO*, PerlIO*);
+typedef int (*LPUngetc)(struct IPerlStdIO*, PerlIO*,int);
+typedef int (*LPFileno)(struct IPerlStdIO*, PerlIO*);
+typedef PerlIO* (*LPFdopen)(struct IPerlStdIO*, int, const char*);
+typedef PerlIO* (*LPReopen)(struct IPerlStdIO*, const char*,
+ const char*, PerlIO*);
+typedef SSize_t (*LPRead)(struct IPerlStdIO*, PerlIO*, void*, Size_t);
+typedef SSize_t (*LPWrite)(struct IPerlStdIO*, PerlIO*, const void*,
+ Size_t);
+typedef void (*LPSetBuf)(struct IPerlStdIO*, PerlIO*, char*);
+typedef int (*LPSetVBuf)(struct IPerlStdIO*, PerlIO*, char*, int,
+ Size_t);
+typedef void (*LPSetCnt)(struct IPerlStdIO*, PerlIO*, int);
+typedef void (*LPSetPtrCnt)(struct IPerlStdIO*, PerlIO*, char*,
+ int);
+typedef void (*LPSetlinebuf)(struct IPerlStdIO*, PerlIO*);
+typedef int (*LPPrintf)(struct IPerlStdIO*, PerlIO*, const char*,
+ ...);
+typedef int (*LPVprintf)(struct IPerlStdIO*, PerlIO*, const char*,
+ va_list);
+typedef long (*LPTell)(struct IPerlStdIO*, PerlIO*);
+typedef int (*LPSeek)(struct IPerlStdIO*, PerlIO*, Off_t, int);
+typedef void (*LPRewind)(struct IPerlStdIO*, PerlIO*);
+typedef PerlIO* (*LPTmpfile)(struct IPerlStdIO*);
+typedef int (*LPGetpos)(struct IPerlStdIO*, PerlIO*, Fpos_t*);
+typedef int (*LPSetpos)(struct IPerlStdIO*, PerlIO*,
+ const Fpos_t*);
+typedef void (*LPInit)(struct IPerlStdIO*);
+typedef void (*LPInitOSExtras)(struct IPerlStdIO*);
+
+struct 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 char * Gets(PerlIO*, char*, int, 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;
-#ifdef WIN32
- virtual int OpenOSfhandle(long osfhandle, int flags) = 0;
- virtual int GetOSfhandle(int filenum) = 0;
-#endif
+ LPStdin pStdin;
+ LPStdout pStdout;
+ LPStderr pStderr;
+ LPOpen pOpen;
+ LPClose pClose;
+ LPEof pEof;
+ LPError pError;
+ LPClearerr pClearerr;
+ LPGetc pGetc;
+ LPGetBase pGetBase;
+ LPGetBufsiz pGetBufsiz;
+ LPGetCnt pGetCnt;
+ LPGetPtr pGetPtr;
+ LPGets pGets;
+ LPPutc pPutc;
+ LPPuts pPuts;
+ LPFlush pFlush;
+ LPUngetc pUngetc;
+ LPFileno pFileno;
+ LPFdopen pFdopen;
+ LPReopen pReopen;
+ LPRead pRead;
+ LPWrite pWrite;
+ LPSetBuf pSetBuf;
+ LPSetVBuf pSetVBuf;
+ LPSetCnt pSetCnt;
+ LPSetPtrCnt pSetPtrCnt;
+ LPSetlinebuf pSetlinebuf;
+ LPPrintf pPrintf;
+ LPVprintf pVprintf;
+ LPTell pTell;
+ LPSeek pSeek;
+ LPRewind pRewind;
+ LPTmpfile pTmpfile;
+ LPGetpos pGetpos;
+ LPSetpos pSetpos;
+ LPInit pInit;
+ LPInitOSExtras pInitOSExtras;
};
-
+struct IPerlStdIOInfo
+{
+ unsigned long nCount; /* number of entries expected */
+ struct IPerlStdIO perlStdIOList;
+};
#ifdef USE_STDIO_PTR
# define PerlIO_has_cntptr(f) 1
@@ -154,49 +202,83 @@ class IPerlStdIO
#define PerlIO_has_base(f) 0
#endif
-#define PerlIO_stdin() PL_piStdIO->Stdin()
-#define PerlIO_stdout() PL_piStdIO->Stdout()
-#define PerlIO_stderr() PL_piStdIO->Stderr()
-#define PerlIO_open(x,y) PL_piStdIO->Open((x),(y), ErrorNo())
-#define PerlIO_close(f) PL_piStdIO->Close((f), ErrorNo())
-#define PerlIO_eof(f) PL_piStdIO->Eof((f), ErrorNo())
-#define PerlIO_error(f) PL_piStdIO->Error((f), ErrorNo())
-#define PerlIO_clearerr(f) PL_piStdIO->Clearerr((f), ErrorNo())
-#define PerlIO_getc(f) PL_piStdIO->Getc((f), ErrorNo())
-#define PerlIO_get_base(f) PL_piStdIO->GetBase((f), ErrorNo())
-#define PerlIO_get_bufsiz(f) PL_piStdIO->GetBufsiz((f), ErrorNo())
-#define PerlIO_get_cnt(f) PL_piStdIO->GetCnt((f), ErrorNo())
-#define PerlIO_get_ptr(f) PL_piStdIO->GetPtr((f), ErrorNo())
-#define PerlIO_putc(f,c) PL_piStdIO->Putc((f),(c), ErrorNo())
-#define PerlIO_puts(f,s) PL_piStdIO->Puts((f),(s), ErrorNo())
-#define PerlIO_flush(f) PL_piStdIO->Flush((f), ErrorNo())
-#define PerlIO_gets(s, n, fp) PL_piStdIO->Gets((fp), s, n, ErrorNo())
-#define PerlIO_ungetc(f,c) PL_piStdIO->Ungetc((f),(c), ErrorNo())
-#define PerlIO_fileno(f) PL_piStdIO->Fileno((f), ErrorNo())
-#define PerlIO_fdopen(f, s) PL_piStdIO->Fdopen((f),(s), ErrorNo())
-#define PerlIO_reopen(p, m, f) PL_piStdIO->Reopen((p), (m), (f), ErrorNo())
+#define PerlIO_stdin() \
+ (*PL_piStdIO->pStdin)(PL_piStdIO)
+#define PerlIO_stdout() \
+ (*PL_piStdIO->pStdout)(PL_piStdIO)
+#define PerlIO_stderr() \
+ (*PL_piStdIO->pStderr)(PL_piStdIO)
+#define PerlIO_open(x,y) \
+ (*PL_piStdIO->pOpen)(PL_piStdIO, (x),(y))
+#define PerlIO_close(f) \
+ (*PL_piStdIO->pClose)(PL_piStdIO, (f))
+#define PerlIO_eof(f) \
+ (*PL_piStdIO->pEof)(PL_piStdIO, (f))
+#define PerlIO_error(f) \
+ (*PL_piStdIO->pError)(PL_piStdIO, (f))
+#define PerlIO_clearerr(f) \
+ (*PL_piStdIO->pClearerr)(PL_piStdIO, (f))
+#define PerlIO_getc(f) \
+ (*PL_piStdIO->pGetc)(PL_piStdIO, (f))
+#define PerlIO_get_base(f) \
+ (*PL_piStdIO->pGetBase)(PL_piStdIO, (f))
+#define PerlIO_get_bufsiz(f) \
+ (*PL_piStdIO->pGetBufsiz)(PL_piStdIO, (f))
+#define PerlIO_get_cnt(f) \
+ (*PL_piStdIO->pGetCnt)(PL_piStdIO, (f))
+#define PerlIO_get_ptr(f) \
+ (*PL_piStdIO->pGetPtr)(PL_piStdIO, (f))
+#define PerlIO_putc(f,c) \
+ (*PL_piStdIO->pPutc)(PL_piStdIO, (f),(c))
+#define PerlIO_puts(f,s) \
+ (*PL_piStdIO->pPuts)(PL_piStdIO, (f),(s))
+#define PerlIO_flush(f) \
+ (*PL_piStdIO->pFlush)(PL_piStdIO, (f))
+#define PerlIO_gets(s, n, fp) \
+ (*PL_piStdIO->pGets)(PL_piStdIO, (fp), s, n)
+#define PerlIO_ungetc(f,c) \
+ (*PL_piStdIO->pUngetc)(PL_piStdIO, (f),(c))
+#define PerlIO_fileno(f) \
+ (*PL_piStdIO->pFileno)(PL_piStdIO, (f))
+#define PerlIO_fdopen(f, s) \
+ (*PL_piStdIO->pFdopen)(PL_piStdIO, (f),(s))
+#define PerlIO_reopen(p, m, f) \
+ (*PL_piStdIO->pReopen)(PL_piStdIO, (p), (m), (f))
#define PerlIO_read(f,buf,count) \
- (SSize_t)PL_piStdIO->Read((f), (buf), (count), ErrorNo())
+ (SSize_t)(*PL_piStdIO->pRead)(PL_piStdIO, (f), (buf), (count))
#define PerlIO_write(f,buf,count) \
- PL_piStdIO->Write((f), (buf), (count), ErrorNo())
-#define PerlIO_setbuf(f,b) PL_piStdIO->SetBuf((f), (b), ErrorNo())
-#define PerlIO_setvbuf(f,b,t,s) PL_piStdIO->SetVBuf((f), (b), (t), (s), ErrorNo())
-#define PerlIO_set_cnt(f,c) PL_piStdIO->SetCnt((f), (c), ErrorNo())
+ (*PL_piStdIO->pWrite)(PL_piStdIO, (f), (buf), (count))
+#define PerlIO_setbuf(f,b) \
+ (*PL_piStdIO->pSetBuf)(PL_piStdIO, (f), (b))
+#define PerlIO_setvbuf(f,b,t,s) \
+ (*PL_piStdIO->pSetVBuf)(PL_piStdIO, (f),(b),(t),(s))
+#define PerlIO_set_cnt(f,c) \
+ (*PL_piStdIO->pSetCnt)(PL_piStdIO, (f), (c))
#define PerlIO_set_ptrcnt(f,p,c) \
- PL_piStdIO->SetPtrCnt((f), (p), (c), ErrorNo())
-#define PerlIO_setlinebuf(f) PL_piStdIO->Setlinebuf((f), ErrorNo())
+ (*PL_piStdIO->pSetPtrCnt)(PL_piStdIO, (f), (p), (c))
+#define PerlIO_setlinebuf(f) \
+ (*PL_piStdIO->pSetlinebuf)(PL_piStdIO, (f))
#define PerlIO_printf fprintf
-#define PerlIO_stdoutf PL_piStdIO->Printf
-#define PerlIO_vprintf(f,fmt,a) PL_piStdIO->Vprintf((f), ErrorNo(), (fmt),a)
-#define PerlIO_tell(f) PL_piStdIO->Tell((f), ErrorNo())
-#define PerlIO_seek(f,o,w) PL_piStdIO->Seek((f),(o),(w), ErrorNo())
-#define PerlIO_getpos(f,p) PL_piStdIO->Getpos((f),(p), ErrorNo())
-#define PerlIO_setpos(f,p) PL_piStdIO->Setpos((f),(p), ErrorNo())
-#define PerlIO_rewind(f) PL_piStdIO->Rewind((f), ErrorNo())
-#define PerlIO_tmpfile() PL_piStdIO->Tmpfile(ErrorNo())
-#define PerlIO_init() PL_piStdIO->Init(ErrorNo())
+#define PerlIO_stdoutf *PL_piStdIO->pPrintf
+#define PerlIO_vprintf(f,fmt,a) \
+ (*PL_piStdIO->pVprintf)(PL_piStdIO, (f),(fmt),a)
+#define PerlIO_tell(f) \
+ (*PL_piStdIO->pTell)(PL_piStdIO, (f))
+#define PerlIO_seek(f,o,w) \
+ (*PL_piStdIO->pSeek)(PL_piStdIO, (f),(o),(w))
+#define PerlIO_getpos(f,p) \
+ (*PL_piStdIO->pGetpos)(PL_piStdIO, (f),(p))
+#define PerlIO_setpos(f,p) \
+ (*PL_piStdIO->pSetpos)(PL_piStdIO, (f),(p))
+#define PerlIO_rewind(f) \
+ (*PL_piStdIO->pRewind)(PL_piStdIO, (f))
+#define PerlIO_tmpfile() \
+ (*PL_piStdIO->pTmpfile)(PL_piStdIO)
+#define PerlIO_init() \
+ (*PL_piStdIO->pInit)(PL_piStdIO)
#undef init_os_extras
-#define init_os_extras() PL_piStdIO->InitOSExtras(this)
+#define init_os_extras(x) \
+ (*PL_piStdIO->pInitOSExtras)(PL_piStdIO)
#else /* PERL_OBJECT */
@@ -386,38 +468,55 @@ extern int PerlIO_setpos (PerlIO *,const Fpos_t *);
#ifdef PERL_OBJECT
-class IPerlDir
+/* IPerlDir */
+struct IPerlDir;
+typedef int (*LPMakedir)(struct IPerlDir*, const char*, int);
+typedef int (*LPChdir)(struct IPerlDir*, const char*);
+typedef int (*LPRmdir)(struct IPerlDir*, const char*);
+typedef int (*LPDirClose)(struct IPerlDir*, DIR*);
+typedef DIR* (*LPDirOpen)(struct IPerlDir*, char*);
+typedef struct direct* (*LPDirRead)(struct IPerlDir*, DIR*);
+typedef void (*LPDirRewind)(struct IPerlDir*, DIR*);
+typedef void (*LPDirSeek)(struct IPerlDir*, DIR*, long);
+typedef long (*LPDirTell)(struct IPerlDir*, DIR*);
+
+struct 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;
+ LPMakedir pMakedir;
+ LPChdir pChdir;
+ LPRmdir pRmdir;
+ LPDirClose pClose;
+ LPDirOpen pOpen;
+ LPDirRead pRead;
+ LPDirRewind pRewind;
+ LPDirSeek pSeek;
+ LPDirTell pTell;
+};
+
+struct IPerlDirInfo
+{
+ unsigned long nCount; /* number of entries expected */
+ struct IPerlDir perlDirList;
};
#define PerlDir_mkdir(name, mode) \
- PL_piDir->Makedir((name), (mode), ErrorNo())
+ (*PL_piDir->pMakedir)(PL_piDir, (name), (mode))
#define PerlDir_chdir(name) \
- PL_piDir->Chdir((name), ErrorNo())
+ (*PL_piDir->pChdir)(PL_piDir, (name))
#define PerlDir_rmdir(name) \
- PL_piDir->Rmdir((name), ErrorNo())
+ (*PL_piDir->pRmdir)(PL_piDir, (name))
#define PerlDir_close(dir) \
- PL_piDir->Close((dir), ErrorNo())
+ (*PL_piDir->pClose)(PL_piDir, (dir))
#define PerlDir_open(name) \
- PL_piDir->Open((name), ErrorNo())
+ (*PL_piDir->pOpen)(PL_piDir, (name))
#define PerlDir_read(dir) \
- PL_piDir->Read((dir), ErrorNo())
+ (*PL_piDir->pRead)(PL_piDir, (dir))
#define PerlDir_rewind(dir) \
- PL_piDir->Rewind((dir), ErrorNo())
+ (*PL_piDir->pRewind)(PL_piDir, (dir))
#define PerlDir_seek(dir, loc) \
- PL_piDir->Seek((dir), (loc), ErrorNo())
+ (*PL_piDir->pSeek)(PL_piDir, (dir), (loc))
#define PerlDir_tell(dir) \
- PL_piDir->Tell((dir), ErrorNo())
+ (*PL_piDir->pTell)(PL_piDir, (dir))
#else /* PERL_OBJECT */
@@ -443,35 +542,79 @@ class IPerlDir
#ifdef PERL_OBJECT
-class IPerlEnv
+/* IPerlEnv */
+struct IPerlEnv;
+typedef char* (*LPEnvGetenv)(struct IPerlEnv*, const char*);
+typedef int (*LPEnvPutenv)(struct IPerlEnv*, const char*);
+typedef char * (*LPEnvGetenv_len)(struct IPerlEnv*,
+ const char *varname, unsigned long *len);
+typedef int (*LPEnvUname)(struct IPerlEnv*, struct utsname *name);
+typedef void (*LPEnvClearenv)(struct IPerlEnv*);
+typedef unsigned long (*LPEnvOsID)(struct IPerlEnv*);
+#ifdef HAS_ENVGETENV
+typedef char * (*LPENVGetenv)(struct IPerlEnv*, const char *varname);
+typedef char * (*LPENVGetenv_len)(struct IPerlEnv*,
+ const char *varname, unsigned long *len);
+#endif
+#ifdef WIN32
+typedef char* (*LPEnvLibPath)(struct IPerlEnv*, char*);
+typedef char* (*LPEnvSiteLibPath)(struct IPerlEnv*, char*);
+#endif
+
+struct 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;
- virtual int Uname(struct utsname *name, int &err) =0;
- virtual char * Getenv_len(const char *varname, unsigned long *len, int &err) = 0;
+ LPEnvGetenv pGetenv;
+ LPEnvPutenv pPutenv;
+ LPEnvGetenv_len pGetenv_len;
+ LPEnvUname pEnvUname;
+ LPEnvClearenv pClearenv;
#ifdef HAS_ENVGETENV
- virtual char * ENVGetenv(const char *varname, int &err) = 0;
- virtual char * ENVGetenv_len(const char *varname, unsigned long *len, int &err) = 0;
+ LPENVGetenv pENVGetenv;
+ LPENVGetenv_len pENVGetenv_len;
+#endif
+#ifdef WIN32
+ LPEnvOsID pEnvOsID;
+ LPEnvLibPath pLibPath;
+ LPEnvSiteLibPath pSiteLibPath;
#endif
};
-#define PerlEnv_putenv(str) PL_piENV->Putenv((str), ErrorNo())
-#define PerlEnv_getenv(str) PL_piENV->Getenv((str), ErrorNo())
-#define PerlEnv_getenv_len(str,l) PL_piENV->Getenv_len((str), (l), ErrorNo())
+struct IPerlEnvInfo
+{
+ unsigned long nCount; /* number of entries expected */
+ struct IPerlEnv perlEnvList;
+};
+
+#define PerlEnv_putenv(str) \
+ (*PL_piENV->pPutenv)(PL_piENV,(str))
+#define PerlEnv_getenv(str) \
+ (*PL_piENV->pGetenv)(PL_piENV,(str))
+#define PerlEnv_getenv_len(str,l) \
+ (*PL_piENV->pGetenv_len)(PL_piENV,(str), (l))
+#define PerlEnv_Clear() \
+ (*PL_piENV->pClearenv)(PL_piENV)
+#define PerlEnv_Clear() \
+ (*PL_piENV->pClearenv)(PL_piENV)
#ifdef HAS_ENVGETENV
-# define PerlEnv_ENVgetenv(str) PL_piENV->ENVGetenv((str), ErrorNo())
-# define PerlEnv_ENVgetenv_len(str,l) PL_piENV->ENVGetenv_len((str), (l), ErrorNo())
+# define PerlEnv_ENVgetenv(str) \
+ (*PL_piENV->pENVGetenv)(PL_piENV,(str))
+# define PerlEnv_ENVgetenv_len(str,l) \
+ (*PL_piENV->pENVGetenv_len)(PL_piENV,(str), (l))
#else
-# define PerlEnv_ENVgetenv(str) PerlEnv_getenv((str))
-# define PerlEnv_ENVgetenv_len(str,l) PerlEnv_getenv_len((str),(l))
+# define PerlEnv_ENVgetenv(str) \
+ PerlEnv_getenv((str))
+# define PerlEnv_ENVgetenv_len(str,l) \
+ PerlEnv_getenv_len((str),(l))
#endif
-#define PerlEnv_uname(name) PL_piENV->Uname((name), ErrorNo())
+#define PerlEnv_uname(name) \
+ (*PL_piENV->pEnvUname)(PL_piENV,(name))
#ifdef WIN32
-#define PerlEnv_lib_path(str) PL_piENV->LibPath((str))
-#define PerlEnv_sitelib_path(str) PL_piENV->SiteLibPath((str))
+#define PerlEnv_os_id() \
+ (*PL_piENV->pEnvOsID)(PL_piENV)
+#define PerlEnv_lib_path(str) \
+ (*PL_piENV->pLibPath)(PL_piENV,(str))
+#define PerlEnv_sitelib_path(str) \
+ (*PL_piENV->pSiteLibPath)(PL_piENV,(str))
#endif
#else /* PERL_OBJECT */
@@ -488,6 +631,10 @@ class IPerlEnv
#endif
#define PerlEnv_uname(name) uname((name))
+#ifdef WIN32
+#define PerlEnv_os_id() win32_os_id()
+#endif
+
#endif /* PERL_OBJECT */
/*
@@ -496,92 +643,125 @@ class IPerlEnv
#ifdef PERL_OBJECT
-class IPerlLIO
+/* IPerlLIO */
+struct IPerlLIO;
+typedef int (*LPLIOAccess)(struct IPerlLIO*, const char*, int);
+typedef int (*LPLIOChmod)(struct IPerlLIO*, const char*, int);
+typedef int (*LPLIOChown)(struct IPerlLIO*, const char*, uid_t,
+ gid_t);
+typedef int (*LPLIOChsize)(struct IPerlLIO*, int, long);
+typedef int (*LPLIOClose)(struct IPerlLIO*, int);
+typedef int (*LPLIODup)(struct IPerlLIO*, int);
+typedef int (*LPLIODup2)(struct IPerlLIO*, int, int);
+typedef int (*LPLIOFlock)(struct IPerlLIO*, int, int);
+typedef int (*LPLIOFileStat)(struct IPerlLIO*, int, struct stat*);
+typedef int (*LPLIOIOCtl)(struct IPerlLIO*, int, unsigned int,
+ char*);
+typedef int (*LPLIOIsatty)(struct IPerlLIO*, int);
+typedef long (*LPLIOLseek)(struct IPerlLIO*, int, long, int);
+typedef int (*LPLIOLstat)(struct IPerlLIO*, const char*,
+ struct stat*);
+typedef char* (*LPLIOMktemp)(struct IPerlLIO*, char*);
+typedef int (*LPLIOOpen)(struct IPerlLIO*, const char*, int);
+typedef int (*LPLIOOpen3)(struct IPerlLIO*, const char*, int, int);
+typedef int (*LPLIORead)(struct IPerlLIO*, int, void*, unsigned int);
+typedef int (*LPLIORename)(struct IPerlLIO*, const char*,
+ const char*);
+typedef int (*LPLIOSetmode)(struct IPerlLIO*, int, int);
+typedef int (*LPLIONameStat)(struct IPerlLIO*, const char*,
+ struct stat*);
+typedef char* (*LPLIOTmpnam)(struct IPerlLIO*, char*);
+typedef int (*LPLIOUmask)(struct IPerlLIO*, int);
+typedef int (*LPLIOUnlink)(struct IPerlLIO*, const char*);
+typedef int (*LPLIOUtime)(struct IPerlLIO*, char*, struct utimbuf*);
+typedef int (*LPLIOWrite)(struct IPerlLIO*, int, const void*,
+ unsigned int);
+
+struct IPerlLIO
+{
+ LPLIOAccess pAccess;
+ LPLIOChmod pChmod;
+ LPLIOChown pChown;
+ LPLIOChsize pChsize;
+ LPLIOClose pClose;
+ LPLIODup pDup;
+ LPLIODup2 pDup2;
+ LPLIOFlock pFlock;
+ LPLIOFileStat pFileStat;
+ LPLIOIOCtl pIOCtl;
+ LPLIOIsatty pIsatty;
+ LPLIOLseek pLseek;
+ LPLIOLstat pLstat;
+ LPLIOMktemp pMktemp;
+ LPLIOOpen pOpen;
+ LPLIOOpen3 pOpen3;
+ LPLIORead pRead;
+ LPLIORename pRename;
+ LPLIOSetmode pSetmode;
+ LPLIONameStat pNameStat;
+ LPLIOTmpnam pTmpnam;
+ LPLIOUmask pUmask;
+ LPLIOUnlink pUnlink;
+ LPLIOUtime pUtime;
+ LPLIOWrite pWrite;
+};
+
+struct IPerlLIOInfo
{
-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 *oname,
- 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;
+ unsigned long nCount; /* number of entries expected */
+ struct IPerlLIO perlLIOList;
};
#define PerlLIO_access(file, mode) \
- PL_piLIO->Access((file), (mode), ErrorNo())
+ (*PL_piLIO->pAccess)(PL_piLIO, (file), (mode))
#define PerlLIO_chmod(file, mode) \
- PL_piLIO->Chmod((file), (mode), ErrorNo())
+ (*PL_piLIO->pChmod)(PL_piLIO, (file), (mode))
#define PerlLIO_chown(file, owner, group) \
- PL_piLIO->Chown((file), (owner), (group), ErrorNo())
+ (*PL_piLIO->pChown)(PL_piLIO, (file), (owner), (group))
#define PerlLIO_chsize(fd, size) \
- PL_piLIO->Chsize((fd), (size), ErrorNo())
+ (*PL_piLIO->pChsize)(PL_piLIO, (fd), (size))
#define PerlLIO_close(fd) \
- PL_piLIO->Close((fd), ErrorNo())
+ (*PL_piLIO->pClose)(PL_piLIO, (fd))
#define PerlLIO_dup(fd) \
- PL_piLIO->Dup((fd), ErrorNo())
+ (*PL_piLIO->pDup)(PL_piLIO, (fd))
#define PerlLIO_dup2(fd1, fd2) \
- PL_piLIO->Dup2((fd1), (fd2), ErrorNo())
+ (*PL_piLIO->pDup2)(PL_piLIO, (fd1), (fd2))
#define PerlLIO_flock(fd, op) \
- PL_piLIO->Flock((fd), (op), ErrorNo())
+ (*PL_piLIO->pFlock)(PL_piLIO, (fd), (op))
#define PerlLIO_fstat(fd, buf) \
- PL_piLIO->FileStat((fd), (buf), ErrorNo())
+ (*PL_piLIO->pFileStat)(PL_piLIO, (fd), (buf))
#define PerlLIO_ioctl(fd, u, buf) \
- PL_piLIO->IOCtl((fd), (u), (buf), ErrorNo())
+ (*PL_piLIO->pIOCtl)(PL_piLIO, (fd), (u), (buf))
#define PerlLIO_isatty(fd) \
- PL_piLIO->Isatty((fd), ErrorNo())
+ (*PL_piLIO->pIsatty)(PL_piLIO, (fd))
#define PerlLIO_lseek(fd, offset, mode) \
- PL_piLIO->Lseek((fd), (offset), (mode), ErrorNo())
+ (*PL_piLIO->pLseek)(PL_piLIO, (fd), (offset), (mode))
#define PerlLIO_lstat(name, buf) \
- PL_piLIO->Lstat((name), (buf), ErrorNo())
+ (*PL_piLIO->pLstat)(PL_piLIO, (name), (buf))
#define PerlLIO_mktemp(file) \
- PL_piLIO->Mktemp((file), ErrorNo())
+ (*PL_piLIO->pMktemp)(PL_piLIO, (file))
#define PerlLIO_open(file, flag) \
- PL_piLIO->Open((file), (flag), ErrorNo())
+ (*PL_piLIO->pOpen)(PL_piLIO, (file), (flag))
#define PerlLIO_open3(file, flag, perm) \
- PL_piLIO->Open((file), (flag), (perm), ErrorNo())
+ (*PL_piLIO->pOpen3)(PL_piLIO, (file), (flag), (perm))
#define PerlLIO_read(fd, buf, count) \
- PL_piLIO->Read((fd), (buf), (count), ErrorNo())
+ (*PL_piLIO->pRead)(PL_piLIO, (fd), (buf), (count))
#define PerlLIO_rename(oname, newname) \
- PL_piLIO->Rename((oname), (newname), ErrorNo())
+ (*PL_piLIO->pRename)(PL_piLIO, (oname), (newname))
#define PerlLIO_setmode(fd, mode) \
- PL_piLIO->Setmode((fd), (mode), ErrorNo())
+ (*PL_piLIO->pSetmode)(PL_piLIO, (fd), (mode))
#define PerlLIO_stat(name, buf) \
- PL_piLIO->NameStat((name), (buf), ErrorNo())
+ (*PL_piLIO->pNameStat)(PL_piLIO, (name), (buf))
#define PerlLIO_tmpnam(str) \
- PL_piLIO->Tmpnam((str), ErrorNo())
+ (*PL_piLIO->pTmpnam)(PL_piLIO, (str))
#define PerlLIO_umask(mode) \
- PL_piLIO->Umask((mode), ErrorNo())
+ (*PL_piLIO->pUmask)(PL_piLIO, (mode))
#define PerlLIO_unlink(file) \
- PL_piLIO->Unlink((file), ErrorNo())
+ (*PL_piLIO->pUnlink)(PL_piLIO, (file))
#define PerlLIO_utime(file, time) \
- PL_piLIO->Utime((file), (time), ErrorNo())
+ (*PL_piLIO->pUtime)(PL_piLIO, (file), (time))
#define PerlLIO_write(fd, buf, count) \
- PL_piLIO->Write((fd), (buf), (count), ErrorNo())
+ (*PL_piLIO->pWrite)(PL_piLIO, (fd), (buf), (count))
#else /* PERL_OBJECT */
@@ -624,17 +804,31 @@ class IPerlLIO
#ifdef PERL_OBJECT
-class IPerlMem
+/* IPerlMem */
+struct IPerlMem;
+typedef void* (*LPMemMalloc)(struct IPerlMem*, size_t);
+typedef void* (*LPMemRealloc)(struct IPerlMem*, void*, size_t);
+typedef void (*LPMemFree)(struct IPerlMem*, void*);
+
+struct IPerlMem
{
-public:
- virtual void * Malloc(size_t) = 0;
- virtual void * Realloc(void*, size_t) = 0;
- virtual void Free(void*) = 0;
+ LPMemMalloc pMalloc;
+ LPMemRealloc pRealloc;
+ LPMemFree pFree;
};
-#define PerlMem_malloc(size) PL_piMem->Malloc((size))
-#define PerlMem_realloc(buf, size) PL_piMem->Realloc((buf), (size))
-#define PerlMem_free(buf) PL_piMem->Free((buf))
+struct IPerlMemInfo
+{
+ unsigned long nCount; /* number of entries expected */
+ struct IPerlMem perlMemList;
+};
+
+#define PerlMem_malloc(size) \
+ (*PL_piMem->pMalloc)(PL_piMem, (size))
+#define PerlMem_realloc(buf, size) \
+ (*PL_piMem->pRealloc)(PL_piMem, (buf), (size))
+#define PerlMem_free(buf) \
+ (*PL_piMem->pFree)(PL_piMem, (buf))
#else /* PERL_OBJECT */
@@ -658,86 +852,160 @@ typedef Signal_t (*Sighandler_t) (int);
#include <setjmp.h>
#endif
-class IPerlProc
+/* IPerlProc */
+struct IPerlProc;
+typedef void (*LPProcAbort)(struct IPerlProc*);
+typedef char* (*LPProcCrypt)(struct IPerlProc*, const char*,
+ const char*);
+typedef void (*LPProcExit)(struct IPerlProc*, int);
+typedef void (*LPProc_Exit)(struct IPerlProc*, int);
+typedef int (*LPProcExecl)(struct IPerlProc*, const char*,
+ const char*, const char*, const char*,
+ const char*);
+typedef int (*LPProcExecv)(struct IPerlProc*, const char*,
+ const char*const*);
+typedef int (*LPProcExecvp)(struct IPerlProc*, const char*,
+ const char*const*);
+typedef uid_t (*LPProcGetuid)(struct IPerlProc*);
+typedef uid_t (*LPProcGeteuid)(struct IPerlProc*);
+typedef gid_t (*LPProcGetgid)(struct IPerlProc*);
+typedef gid_t (*LPProcGetegid)(struct IPerlProc*);
+typedef char* (*LPProcGetlogin)(struct IPerlProc*);
+typedef int (*LPProcKill)(struct IPerlProc*, int, int);
+typedef int (*LPProcKillpg)(struct IPerlProc*, int, int);
+typedef int (*LPProcPauseProc)(struct IPerlProc*);
+typedef PerlIO* (*LPProcPopen)(struct IPerlProc*, const char*,
+ const char*);
+typedef int (*LPProcPclose)(struct IPerlProc*, PerlIO*);
+typedef int (*LPProcPipe)(struct IPerlProc*, int*);
+typedef int (*LPProcSetuid)(struct IPerlProc*, uid_t);
+typedef int (*LPProcSetgid)(struct IPerlProc*, gid_t);
+typedef int (*LPProcSleep)(struct IPerlProc*, unsigned int);
+typedef int (*LPProcTimes)(struct IPerlProc*, struct tms*);
+typedef int (*LPProcWait)(struct IPerlProc*, int*);
+typedef int (*LPProcWaitpid)(struct IPerlProc*, int, int*, int);
+typedef Sighandler_t (*LPProcSignal)(struct IPerlProc*, int, Sighandler_t);
+typedef void* (*LPProcDynaLoader)(struct IPerlProc*, const char*);
+#ifdef WIN32
+typedef void (*LPProcGetOSError)(struct IPerlProc*,
+ SV* sv, DWORD dwErr);
+typedef void (*LPProcFreeBuf)(struct IPerlProc*, char*);
+typedef BOOL (*LPProcDoCmd)(struct IPerlProc*, char*);
+typedef int (*LPProcSpawn)(struct IPerlProc*, char*);
+typedef int (*LPProcSpawnvp)(struct IPerlProc*, int, const char*,
+ const char*const*);
+typedef int (*LPProcASpawn)(struct IPerlProc*, void*, void**, void**);
+#endif
+
+struct IPerlProc
{
-public:
- virtual void Abort(void) = 0;
- virtual char * Crypt(const char* clear, const char* salt) = 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 int Waitpid(int pid, int *status, int flags) = 0;
- virtual Sighandler_t Signal(int sig, Sighandler_t subcode) = 0;
+ LPProcAbort pAbort;
+ LPProcCrypt pCrypt;
+ LPProcExit pExit;
+ LPProc_Exit p_Exit;
+ LPProcExecl pExecl;
+ LPProcExecv pExecv;
+ LPProcExecvp pExecvp;
+ LPProcGetuid pGetuid;
+ LPProcGeteuid pGeteuid;
+ LPProcGetgid pGetgid;
+ LPProcGetegid pGetegid;
+ LPProcGetlogin pGetlogin;
+ LPProcKill pKill;
+ LPProcKillpg pKillpg;
+ LPProcPauseProc pPauseProc;
+ LPProcPopen pPopen;
+ LPProcPclose pPclose;
+ LPProcPipe pPipe;
+ LPProcSetuid pSetuid;
+ LPProcSetgid pSetgid;
+ LPProcSleep pSleep;
+ LPProcTimes pTimes;
+ LPProcWait pWait;
+ LPProcWaitpid pWaitpid;
+ LPProcSignal pSignal;
#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;
+ LPProcDynaLoader pDynaLoader;
+ LPProcGetOSError pGetOSError;
+ LPProcDoCmd pDoCmd;
+ LPProcSpawn pSpawn;
+ LPProcSpawnvp pSpawnvp;
+ LPProcASpawn pASpawn;
#endif
};
-#define PerlProc_abort() PL_piProc->Abort()
-#define PerlProc_crypt(c,s) PL_piProc->Crypt((c), (s))
-#define PerlProc_exit(s) PL_piProc->Exit((s))
-#define PerlProc__exit(s) PL_piProc->_Exit((s))
+struct IPerlProcInfo
+{
+ unsigned long nCount; /* number of entries expected */
+ struct IPerlProc perlProcList;
+};
+
+#define PerlProc_abort() \
+ (*PL_piProc->pAbort)(PL_piProc)
+#define PerlProc_crypt(c,s) \
+ (*PL_piProc->pCrypt)(PL_piProc, (c), (s))
+#define PerlProc_exit(s) \
+ (*PL_piProc->pExit)(PL_piProc, (s))
+#define PerlProc__exit(s) \
+ (*PL_piProc->p_Exit)(PL_piProc, (s))
#define PerlProc_execl(c, w, x, y, z) \
- PL_piProc->Execl((c), (w), (x), (y), (z))
-
-#define PerlProc_execv(c, a) PL_piProc->Execv((c), (a))
-#define PerlProc_execvp(c, a) PL_piProc->Execvp((c), (a))
-#define PerlProc_getuid() PL_piProc->Getuid()
-#define PerlProc_geteuid() PL_piProc->Geteuid()
-#define PerlProc_getgid() PL_piProc->Getgid()
-#define PerlProc_getegid() PL_piProc->Getegid()
-#define PerlProc_getlogin() PL_piProc->Getlogin()
-#define PerlProc_kill(i, a) PL_piProc->Kill((i), (a))
-#define PerlProc_killpg(i, a) PL_piProc->Killpg((i), (a))
-#define PerlProc_pause() PL_piProc->PauseProc()
-#define PerlProc_popen(c, m) PL_piProc->Popen((c), (m))
-#define PerlProc_pclose(f) PL_piProc->Pclose((f))
-#define PerlProc_pipe(fd) PL_piProc->Pipe((fd))
-#define PerlProc_setuid(u) PL_piProc->Setuid((u))
-#define PerlProc_setgid(g) PL_piProc->Setgid((g))
-#define PerlProc_sleep(t) PL_piProc->Sleep((t))
-#define PerlProc_times(t) PL_piProc->Times((t))
-#define PerlProc_wait(t) PL_piProc->Wait((t))
-#define PerlProc_waitpid(p,s,f) PL_piProc->Waitpid((p), (s), (f))
-#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n))
-#define PerlProc_longjmp(b, n) Siglongjmp((b), (n))
-#define PerlProc_signal(n, h) PL_piProc->Signal((n), (h))
+ (*PL_piProc->pExecl)(PL_piProc, (c), (w), (x), (y), (z))
+#define PerlProc_execv(c, a) \
+ (*PL_piProc->pExecv)(PL_piProc, (c), (a))
+#define PerlProc_execvp(c, a) \
+ (*PL_piProc->pExecvp)(PL_piProc, (c), (a))
+#define PerlProc_getuid() \
+ (*PL_piProc->pGetuid)(PL_piProc)
+#define PerlProc_geteuid() \
+ (*PL_piProc->pGeteuid)(PL_piProc)
+#define PerlProc_getgid() \
+ (*PL_piProc->pGetgid)(PL_piProc)
+#define PerlProc_getegid() \
+ (*PL_piProc->pGetegid)(PL_piProc)
+#define PerlProc_getlogin() \
+ (*PL_piProc->pGetlogin)(PL_piProc)
+#define PerlProc_kill(i, a) \
+ (*PL_piProc->pKill)(PL_piProc, (i), (a))
+#define PerlProc_killpg(i, a) \
+ (*PL_piProc->pKillpg)(PL_piProc, (i), (a))
+#define PerlProc_pause() \
+ (*PL_piProc->pPauseProc)(PL_piProc)
+#define PerlProc_popen(c, m) \
+ (*PL_piProc->pPopen)(PL_piProc, (c), (m))
+#define PerlProc_pclose(f) \
+ (*PL_piProc->pPclose)(PL_piProc, (f))
+#define PerlProc_pipe(fd) \
+ (*PL_piProc->pPipe)(PL_piProc, (fd))
+#define PerlProc_setuid(u) \
+ (*PL_piProc->pSetuid)(PL_piProc, (u))
+#define PerlProc_setgid(g) \
+ (*PL_piProc->pSetgid)(PL_piProc, (g))
+#define PerlProc_sleep(t) \
+ (*PL_piProc->pSleep)(PL_piProc, (t))
+#define PerlProc_times(t) \
+ (*PL_piProc->pTimes)(PL_piProc, (t))
+#define PerlProc_wait(t) \
+ (*PL_piProc->pWait)(PL_piProc, (t))
+#define PerlProc_waitpid(p,s,f) \
+ (*PL_piProc->pWaitpid)(PL_piProc, (p), (s), (f))
+#define PerlProc_signal(n, h) \
+ (*PL_piProc->pSignal)(PL_piProc, (n), (h))
+#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n))
+#define PerlProc_longjmp(b, n) Siglongjmp((b), (n))
#ifdef WIN32
-#define PerlProc_GetSysMsg(s,l,e) \
- PL_piProc->GetSysMsg((s), (l), (e))
-
-#define PerlProc_FreeBuf(s) PL_piProc->FreeBuf((s))
-#define PerlProc_Cmd(s) PL_piProc->DoCmd((s))
-#define do_spawn(s) PL_piProc->Spawn((s))
-#define do_spawnvp(m, c, a) PL_piProc->Spawnvp((m), (c), (a))
-#define PerlProc_aspawn(m,c,a) PL_piProc->ASpawn((m), (c), (a))
+#define PerlProc_DynaLoad(f) \
+ (*PL_piProc->pDynaLoader)(PL_piProc, (f))
+#define PerlProc_GetOSError(s,e) \
+ (*PL_piProc->pGetOSError)(PL_piProc, (s), (e))
+#define PerlProc_Cmd(s) \
+ (*PL_piProc->pDoCmd)(PL_piProc, (s))
+#define do_spawn(s) \
+ (*PL_piProc->pSpawn)(PL_piProc, (s))
+#define do_spawnvp(m, c, a) \
+ (*PL_piProc->pSpawnvp)(PL_piProc, (m), (c), (a))
+#define PerlProc_aspawn(m,c,a) \
+ (*PL_piProc->pASpawn)(PL_piProc, (m), (c), (a))
#endif
#else /* PERL_OBJECT */
@@ -771,7 +1039,12 @@ class IPerlProc
#define PerlProc_longjmp(b, n) Siglongjmp((b), (n))
#define PerlProc_signal(n, h) signal((n), (h))
-
+#ifdef WIN32
+#define PerlProc_DynaLoad(f) \
+ win32_dynaload(aTHX_ const char*filename)
+#define PerlProc_GetOSError(s,e) \
+ win32_str_os_error(aTHX_ (s), (e))
+#endif
#endif /* PERL_OBJECT */
/*
@@ -780,123 +1053,217 @@ class IPerlProc
#ifdef PERL_OBJECT
-class IPerlSock
+/* PerlSock */
+struct IPerlSock;
+typedef u_long (*LPHtonl)(struct IPerlSock*, u_long);
+typedef u_short (*LPHtons)(struct IPerlSock*, u_short);
+typedef u_long (*LPNtohl)(struct IPerlSock*, u_long);
+typedef u_short (*LPNtohs)(struct IPerlSock*, u_short);
+typedef SOCKET (*LPAccept)(struct IPerlSock*, SOCKET,
+ struct sockaddr*, int*);
+typedef int (*LPBind)(struct IPerlSock*, SOCKET,
+ const struct sockaddr*, int);
+typedef int (*LPConnect)(struct IPerlSock*, SOCKET,
+ const struct sockaddr*, int);
+typedef void (*LPEndhostent)(struct IPerlSock*);
+typedef void (*LPEndnetent)(struct IPerlSock*);
+typedef void (*LPEndprotoent)(struct IPerlSock*);
+typedef void (*LPEndservent)(struct IPerlSock*);
+typedef int (*LPGethostname)(struct IPerlSock*, char*, int);
+typedef int (*LPGetpeername)(struct IPerlSock*, SOCKET,
+ struct sockaddr*, int*);
+typedef struct hostent* (*LPGethostbyaddr)(struct IPerlSock*, const char*,
+ int, int);
+typedef struct hostent* (*LPGethostbyname)(struct IPerlSock*, const char*);
+typedef struct hostent* (*LPGethostent)(struct IPerlSock*);
+typedef struct netent* (*LPGetnetbyaddr)(struct IPerlSock*, long, int);
+typedef struct netent* (*LPGetnetbyname)(struct IPerlSock*, const char*);
+typedef struct netent* (*LPGetnetent)(struct IPerlSock*);
+typedef struct protoent*(*LPGetprotobyname)(struct IPerlSock*, const char*);
+typedef struct protoent*(*LPGetprotobynumber)(struct IPerlSock*, int);
+typedef struct protoent*(*LPGetprotoent)(struct IPerlSock*);
+typedef struct servent* (*LPGetservbyname)(struct IPerlSock*, const char*,
+ const char*);
+typedef struct servent* (*LPGetservbyport)(struct IPerlSock*, int,
+ const char*);
+typedef struct servent* (*LPGetservent)(struct IPerlSock*);
+typedef int (*LPGetsockname)(struct IPerlSock*, SOCKET,
+ struct sockaddr*, int*);
+typedef int (*LPGetsockopt)(struct IPerlSock*, SOCKET, int, int,
+ char*, int*);
+typedef unsigned long (*LPInetAddr)(struct IPerlSock*, const char*);
+typedef char* (*LPInetNtoa)(struct IPerlSock*, struct in_addr);
+typedef int (*LPListen)(struct IPerlSock*, SOCKET, int);
+typedef int (*LPRecv)(struct IPerlSock*, SOCKET, char*, int, int);
+typedef int (*LPRecvfrom)(struct IPerlSock*, SOCKET, char*, int,
+ int, struct sockaddr*, int*);
+typedef int (*LPSelect)(struct IPerlSock*, int, char*, char*,
+ char*, const struct timeval*);
+typedef int (*LPSend)(struct IPerlSock*, SOCKET, const char*, int,
+ int);
+typedef int (*LPSendto)(struct IPerlSock*, SOCKET, const char*,
+ int, int, const struct sockaddr*, int);
+typedef void (*LPSethostent)(struct IPerlSock*, int);
+typedef void (*LPSetnetent)(struct IPerlSock*, int);
+typedef void (*LPSetprotoent)(struct IPerlSock*, int);
+typedef void (*LPSetservent)(struct IPerlSock*, int);
+typedef int (*LPSetsockopt)(struct IPerlSock*, SOCKET, int, int,
+ const char*, int);
+typedef int (*LPShutdown)(struct IPerlSock*, SOCKET, int);
+typedef SOCKET (*LPSocket)(struct IPerlSock*, int, int, int);
+typedef int (*LPSocketpair)(struct IPerlSock*, int, int, int,
+ int*);
+#ifdef WIN32
+typedef int (*LPClosesocket)(struct IPerlSock*, SOCKET s);
+#endif
+
+struct 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 int Gethostname(char* name, int namelen, int &err) = 0;
- virtual int Getpeername(SOCKET s, struct sockaddr* name,
- int* namelen, 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 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 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 Recv(SOCKET s, char* buf, int len,
- int flags, 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;
+ LPHtonl pHtonl;
+ LPHtons pHtons;
+ LPNtohl pNtohl;
+ LPNtohs pNtohs;
+ LPAccept pAccept;
+ LPBind pBind;
+ LPConnect pConnect;
+ LPEndhostent pEndhostent;
+ LPEndnetent pEndnetent;
+ LPEndprotoent pEndprotoent;
+ LPEndservent pEndservent;
+ LPGethostname pGethostname;
+ LPGetpeername pGetpeername;
+ LPGethostbyaddr pGethostbyaddr;
+ LPGethostbyname pGethostbyname;
+ LPGethostent pGethostent;
+ LPGetnetbyaddr pGetnetbyaddr;
+ LPGetnetbyname pGetnetbyname;
+ LPGetnetent pGetnetent;
+ LPGetprotobyname pGetprotobyname;
+ LPGetprotobynumber pGetprotobynumber;
+ LPGetprotoent pGetprotoent;
+ LPGetservbyname pGetservbyname;
+ LPGetservbyport pGetservbyport;
+ LPGetservent pGetservent;
+ LPGetsockname pGetsockname;
+ LPGetsockopt pGetsockopt;
+ LPInetAddr pInetAddr;
+ LPInetNtoa pInetNtoa;
+ LPListen pListen;
+ LPRecv pRecv;
+ LPRecvfrom pRecvfrom;
+ LPSelect pSelect;
+ LPSend pSend;
+ LPSendto pSendto;
+ LPSethostent pSethostent;
+ LPSetnetent pSetnetent;
+ LPSetprotoent pSetprotoent;
+ LPSetservent pSetservent;
+ LPSetsockopt pSetsockopt;
+ LPShutdown pShutdown;
+ LPSocket pSocket;
+ LPSocketpair pSocketpair;
#ifdef WIN32
- virtual int Closesocket(SOCKET s, int& err) = 0;
- virtual int Ioctlsocket(SOCKET s, long cmd, u_long *argp,
- int& err) = 0;
+ LPClosesocket pClosesocket;
#endif
};
-#define PerlSock_htonl(x) PL_piSock->Htonl(x)
-#define PerlSock_htons(x) PL_piSock->Htons(x)
-#define PerlSock_ntohl(x) PL_piSock->Ntohl(x)
-#define PerlSock_ntohs(x) PL_piSock->Ntohs(x)
-#define PerlSock_accept(s, a, l) PL_piSock->Accept(s, a, l, ErrorNo())
-#define PerlSock_bind(s, n, l) PL_piSock->Bind(s, n, l, ErrorNo())
-#define PerlSock_connect(s, n, l) PL_piSock->Connect(s, n, l, ErrorNo())
-#define PerlSock_endhostent() PL_piSock->Endhostent(ErrorNo())
-#define PerlSock_endnetent() PL_piSock->Endnetent(ErrorNo())
-#define PerlSock_endprotoent() PL_piSock->Endprotoent(ErrorNo())
-#define PerlSock_endservent() PL_piSock->Endservent(ErrorNo())
-#define PerlSock_gethostbyaddr(a, l, t) PL_piSock->Gethostbyaddr(a, l, t, ErrorNo())
-#define PerlSock_gethostbyname(n) PL_piSock->Gethostbyname(n, ErrorNo())
-#define PerlSock_gethostent() PL_piSock->Gethostent(ErrorNo())
-#define PerlSock_gethostname(n, l) PL_piSock->Gethostname(n, l, ErrorNo())
-#define PerlSock_getnetbyaddr(n, t) PL_piSock->Getnetbyaddr(n, t, ErrorNo())
-#define PerlSock_getnetbyname(c) PL_piSock->Getnetbyname(c, ErrorNo())
-#define PerlSock_getnetent() PL_piSock->Getnetent(ErrorNo())
-#define PerlSock_getpeername(s, n, l) PL_piSock->Getpeername(s, n, l, ErrorNo())
-#define PerlSock_getprotobyname(n) PL_piSock->Getprotobyname(n, ErrorNo())
-#define PerlSock_getprotobynumber(n) PL_piSock->Getprotobynumber(n, ErrorNo())
-#define PerlSock_getprotoent() PL_piSock->Getprotoent(ErrorNo())
-#define PerlSock_getservbyname(n, p) PL_piSock->Getservbyname(n, p, ErrorNo())
-#define PerlSock_getservbyport(port, p) PL_piSock->Getservbyport(port, p, ErrorNo())
-#define PerlSock_getservent() PL_piSock->Getservent(ErrorNo())
-#define PerlSock_getsockname(s, n, l) PL_piSock->Getsockname(s, n, l, ErrorNo())
-#define PerlSock_getsockopt(s,l,n,v,i) PL_piSock->Getsockopt(s, l, n, v, i, ErrorNo())
-#define PerlSock_inet_addr(c) PL_piSock->InetAddr(c, ErrorNo())
-#define PerlSock_inet_ntoa(i) PL_piSock->InetNtoa(i, ErrorNo())
-#define PerlSock_listen(s, b) PL_piSock->Listen(s, b, ErrorNo())
-#define PerlSock_recv(s, b, l, f) PL_piSock->Recv(s, b, l, f, ErrorNo())
+struct IPerlSockInfo
+{
+ unsigned long nCount; /* number of entries expected */
+ struct IPerlSock perlSockList;
+};
+
+#define PerlSock_htonl(x) \
+ (*PL_piSock->pHtonl)(PL_piSock, x)
+#define PerlSock_htons(x) \
+ (*PL_piSock->pHtons)(PL_piSock, x)
+#define PerlSock_ntohl(x) \
+ (*PL_piSock->pNtohl)(PL_piSock, x)
+#define PerlSock_ntohs(x) \
+ (*PL_piSock->pNtohs)(PL_piSock, x)
+#define PerlSock_accept(s, a, l) \
+ (*PL_piSock->pAccept)(PL_piSock, s, a, l)
+#define PerlSock_bind(s, n, l) \
+ (*PL_piSock->pBind)(PL_piSock, s, n, l)
+#define PerlSock_connect(s, n, l) \
+ (*PL_piSock->pConnect)(PL_piSock, s, n, l)
+#define PerlSock_endhostent() \
+ (*PL_piSock->pEndhostent)(PL_piSock)
+#define PerlSock_endnetent() \
+ (*PL_piSock->pEndnetent)(PL_piSock)
+#define PerlSock_endprotoent() \
+ (*PL_piSock->pEndprotoent)(PL_piSock)
+#define PerlSock_endservent() \
+ (*PL_piSock->pEndservent)(PL_piSock)
+#define PerlSock_gethostbyaddr(a, l, t) \
+ (*PL_piSock->pGethostbyaddr)(PL_piSock, a, l, t)
+#define PerlSock_gethostbyname(n) \
+ (*PL_piSock->pGethostbyname)(PL_piSock, n)
+#define PerlSock_gethostent() \
+ (*PL_piSock->pGethostent)(PL_piSock)
+#define PerlSock_gethostname(n, l) \
+ (*PL_piSock->pGethostname)(PL_piSock, n, l)
+#define PerlSock_getnetbyaddr(n, t) \
+ (*PL_piSock->pGetnetbyaddr)(PL_piSock, n, t)
+#define PerlSock_getnetbyname(c) \
+ (*PL_piSock->pGetnetbyname)(PL_piSock, c)
+#define PerlSock_getnetent() \
+ (*PL_piSock->pGetnetent)(PL_piSock)
+#define PerlSock_getpeername(s, n, l) \
+ (*PL_piSock->pGetpeername)(PL_piSock, s, n, l)
+#define PerlSock_getprotobyname(n) \
+ (*PL_piSock->pGetprotobyname)(PL_piSock, n)
+#define PerlSock_getprotobynumber(n) \
+ (*PL_piSock->pGetprotobynumber)(PL_piSock, n)
+#define PerlSock_getprotoent() \
+ (*PL_piSock->pGetprotoent)(PL_piSock)
+#define PerlSock_getservbyname(n, p) \
+ (*PL_piSock->pGetservbyname)(PL_piSock, n, p)
+#define PerlSock_getservbyport(port, p) \
+ (*PL_piSock->pGetservbyport)(PL_piSock, port, p)
+#define PerlSock_getservent() \
+ (*PL_piSock->pGetservent)(PL_piSock)
+#define PerlSock_getsockname(s, n, l) \
+ (*PL_piSock->pGetsockname)(PL_piSock, s, n, l)
+#define PerlSock_getsockopt(s,l,n,v,i) \
+ (*PL_piSock->pGetsockopt)(PL_piSock, s, l, n, v, i)
+#define PerlSock_inet_addr(c) \
+ (*PL_piSock->pInetAddr)(PL_piSock, c)
+#define PerlSock_inet_ntoa(i) \
+ (*PL_piSock->pInetNtoa)(PL_piSock, i)
+#define PerlSock_listen(s, b) \
+ (*PL_piSock->pListen)(PL_piSock, s, b)
+#define PerlSock_recv(s, b, l, f) \
+ (*PL_piSock->pRecv)(PL_piSock, s, b, l, f)
#define PerlSock_recvfrom(s,b,l,f,from,fromlen) \
- PL_piSock->Recvfrom(s, b, l, f, from, fromlen, ErrorNo())
+ (*PL_piSock->pRecvfrom)(PL_piSock, s, b, l, f, from, fromlen)
#define PerlSock_select(n, r, w, e, t) \
- PL_piSock->Select(n, (char*)r, (char*)w, (char*)e, t, ErrorNo())
-#define PerlSock_send(s, b, l, f) PL_piSock->Send(s, b, l, f, ErrorNo())
+ (*PL_piSock->pSelect)(PL_piSock, n, (char*)r, (char*)w, (char*)e, t)
+#define PerlSock_send(s, b, l, f) \
+ (*PL_piSock->pSend)(PL_piSock, s, b, l, f)
#define PerlSock_sendto(s, b, l, f, t, tlen) \
- PL_piSock->Sendto(s, b, l, f, t, tlen, ErrorNo())
-#define PerlSock_sethostent(f) PL_piSock->Sethostent(f, ErrorNo())
-#define PerlSock_setnetent(f) PL_piSock->Setnetent(f, ErrorNo())
-#define PerlSock_setprotoent(f) PL_piSock->Setprotoent(f, ErrorNo())
-#define PerlSock_setservent(f) PL_piSock->Setservent(f, ErrorNo())
+ (*PL_piSock->pSendto)(PL_piSock, s, b, l, f, t, tlen)
+#define PerlSock_sethostent(f) \
+ (*PL_piSock->pSethostent)(PL_piSock, f)
+#define PerlSock_setnetent(f) \
+ (*PL_piSock->pSetnetent)(PL_piSock, f)
+#define PerlSock_setprotoent(f) \
+ (*PL_piSock->pSetprotoent)(PL_piSock, f)
+#define PerlSock_setservent(f) \
+ (*PL_piSock->pSetservent)(PL_piSock, f)
#define PerlSock_setsockopt(s, l, n, v, len) \
- PL_piSock->Setsockopt(s, l, n, v, len, ErrorNo())
-#define PerlSock_shutdown(s, h) PL_piSock->Shutdown(s, h, ErrorNo())
-#define PerlSock_socket(a, t, p) PL_piSock->Socket(a, t, p, ErrorNo())
-#define PerlSock_socketpair(a, t, p, f) PL_piSock->Socketpair(a, t, p, f, ErrorNo())
+ (*PL_piSock->pSetsockopt)(PL_piSock, s, l, n, v, len)
+#define PerlSock_shutdown(s, h) \
+ (*PL_piSock->pShutdown)(PL_piSock, s, h)
+#define PerlSock_socket(a, t, p) \
+ (*PL_piSock->pSocket)(PL_piSock, a, t, p)
+#define PerlSock_socketpair(a, t, p, f) \
+ (*PL_piSock->pSocketpair)(PL_piSock, a, t, p, f)
+
+#ifdef WIN32
+#define PerlSock_closesocket(s) \
+ (*PL_piSock->pClosesocket)(PL_piSock, s)
+#endif
#else /* PERL_OBJECT */
@@ -952,6 +1319,9 @@ class IPerlSock
#define PerlSock_socket(a, t, p) socket(a, t, p)
#define PerlSock_socketpair(a, t, p, f) socketpair(a, t, p, f)
+#ifdef WIN32
+#define PerlSock_closesocket(s) closesocket(s)
+#endif
#endif /* PERL_OBJECT */
5 lib/ExtUtils/Embed.pm
View
@@ -51,7 +51,7 @@ sub xsinit {
my($file, $std, $mods) = @_;
my($fh,@mods,%seen);
$file ||= "perlxsi.c";
- my $xsinit_proto = is_perl_object() ? "CPERLarg" : "void";
+ my $xsinit_proto = "pTHXo";
if (@_) {
@mods = @$mods if $mods;
@@ -120,8 +120,7 @@ EOF
sub xsi_protos {
my(@exts) = @_;
my(@retval,%seen);
- my $boot_proto = is_perl_object() ?
- "CV* cv _CPERLarg" : "CV* cv";
+ my $boot_proto = "pTHXo_ CV* cv";
foreach $_ (@exts){
my($pname) = canon('/', $_);
my($mname, $cname);
2  lib/ExtUtils/xsubpp
View
@@ -1320,7 +1320,7 @@ EOF
if ($WantCAPI) {
print Q<<"EOF";
##ifdef PERL_CAPI
-##define XSCAPI(name) void name(CV* cv, void* pPerl)
+##define XSCAPI(name) void name(void *pPerl, CV* cv)
#
##ifdef __cplusplus
#extern "C"
10 mg.c
View
@@ -525,15 +525,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
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(aTHX_ sv, dwErr);
-#endif
+ PerlProc_GetOSError(sv, dwErr);
}
else
sv_setpv(sv, "");
4,038 objXSUB.h
View
3,033 additions, 1,005 deletions not shown
13 opcode.h
View
@@ -1072,19 +1072,6 @@ EXT char *PL_op_desc[] = {
END_EXTERN_C
-#ifndef PERL_OBJECT
-START_EXTERN_C
-
-#undef PERL_CKDEF
-#undef PERL_PPDEF
-#define PERL_CKDEF(s) OP *s (pTHX_ OP *o);
-#define PERL_PPDEF(s) OP *s (pTHX);
-
-#include "pp_proto.h"
-
-
-END_EXTERN_C
-#endif /* PERL_OBJECT */
START_EXTERN_C
13 opcode.pl
View
@@ -82,16 +82,6 @@ END
END_EXTERN_C
-#ifndef PERL_OBJECT
-START_EXTERN_C
-
-#undef PERL_CKDEF
-#undef PERL_PPDEF
-#define PERL_CKDEF(s) OP *s (pTHX_ OP *o);
-#define PERL_PPDEF(s) OP *s (pTHX);
-
-#include "pp_proto.h"
-
END
# Emit function declarations.
@@ -110,9 +100,6 @@ END
print <<END;
-END_EXTERN_C
-#endif /* PERL_OBJECT */
-
START_EXTERN_C
#ifndef DOINIT
24 perl.c
View
@@ -24,6 +24,8 @@
char *getenv (char *); /* Usually in <stdlib.h> */
#endif
+static I32 read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen);
+
#ifdef I_FCNTL
#include <fcntl.h>
#endif
@@ -68,7 +70,7 @@ perl_alloc(void)
#endif /* PERL_OBJECT */
void
-perl_construct(register PerlInterpreter *my_perl)
+perl_construct(pTHXx)
{
#ifdef USE_THREADS
int i;
@@ -206,7 +208,7 @@ perl_construct(register PerlInterpreter *my_perl)
}
void
-perl_destruct(register PerlInterpreter *my_perl)
+perl_destruct(pTHXx)
{
dTHR;
int destruct_level; /* 0=none, 1=full, 2=full with checks */
@@ -340,7 +342,7 @@ perl_destruct(register PerlInterpreter *my_perl)
/* call exit list functions */
while (PL_exitlistlen-- > 0)
- PL_exitlist[PL_exitlistlen].fn(aTHX_ PL_exitlist[PL_exitlistlen].ptr);
+ PL_exitlist[PL_exitlistlen].fn(aTHXo_ PL_exitlist[PL_exitlistlen].ptr);
Safefree(PL_exitlist);
@@ -561,7 +563,7 @@ perl_destruct(register PerlInterpreter *my_perl)
}
void
-perl_free(PerlInterpreter *my_perl)
+perl_free(pTHXx)
{
#ifdef PERL_OBJECT
Safefree(this);
@@ -584,7 +586,7 @@ Perl_call_atexit(pTHX_ ATEXIT_t fn, void *ptr)
}
int
-perl_parse(PerlInterpreter *my_perl, XSINIT_t xsinit, int argc, char **argv, char **env)
+perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
{
dTHR;
I32 oldscope;
@@ -737,7 +739,7 @@ S_parse_body(pTHX_ va_list args)
Perl_croak(aTHX_ "No -e allowed in setuid scripts");
if (!PL_e_script) {
PL_e_script = newSVpvn("",0);
- filter_add(S_read_e_script, NULL);
+ filter_add(read_e_script, NULL);
}
if (*++s)
sv_catpv(PL_e_script, s);
@@ -941,7 +943,7 @@ print \" \\@INC:\\n @INC\\n\";");
boot_core_UNIVERSAL();
if (xsinit)
- (*xsinit)(aTHX); /* in case linked C routines want magical variables */
+ (*xsinit)(aTHXo); /* in case linked C routines want magical variables */
#if defined(VMS) || defined(WIN32) || defined(DJGPP)
init_os_extras(aTHX);
#endif
@@ -999,7 +1001,7 @@ print \" \\@INC:\\n @INC\\n\";");
}
int
-perl_run(PerlInterpreter *my_perl)
+perl_run(pTHXx)
{
dTHR;
I32 oldscope;
@@ -3100,15 +3102,15 @@ S_my_exit_jump(pTHX)
#include "XSUB.h"
-STATIC I32
-S_read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
+static I32
+read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen)
{
char *p, *nl;
p = SvPVX(PL_e_script);
nl = strchr(p, '\n');
nl = (nl) ? nl+1 : SvEND(PL_e_script);
if (nl-p == 0) {
- filter_del(S_read_e_script);
+ filter_del(read_e_script);
return 0;
}
sv_catpvn(buf_sv, p, nl-p);
221 perl.h
View
@@ -22,6 +22,14 @@
#define USE_STDIO
#endif /* PERL_FOR_X2P */
+#define VOIDUSED 1
+#include "config.h"
+
+/* XXXXXX testing threads via implicit pointer */
+#ifdef USE_THREADS
+#define PERL_IMPLICIT_CONTEXT
+#endif
+
#ifdef PERL_OBJECT
/* PERL_OBJECT explained - DickH and DougL @ ActiveState.com
@@ -101,22 +109,29 @@ class CPerlObj;
#define STATIC
#define CPERLscope(x) CPerlObj::x
-#define CPERLproto CPerlObj *
-#define _CPERLproto ,CPERLproto
-#define CPERLarg CPerlObj *pPerl
-#define CPERLarg_ CPERLarg,
-#define _CPERLarg ,CPERLarg
-#define PERL_OBJECT_THIS this
-#define _PERL_OBJECT_THIS ,this
-#define PERL_OBJECT_THIS_ this,
#define CALL_FPTR(fptr) (this->*fptr)
+#define pTHXo CPerlObj *pPerl
+#define pTHXo_ pTHXo,
+#define _pTHXo ,pTHXo
+#define aTHXo this
+#define aTHXo_ this,
+#define _aTHXo ,this
+#define PERL_OBJECT_THIS aTHXo
+#define PERL_OBJECT_THIS_ aTHXo_
+#define _PERL_OBJECT_THIS _aTHXo
+
+#define pTHXx void
+#define pTHXx_
+#define _pTHXx
+#define aTHXx
+#define aTHXx_
+#define _aTHXx
+
#else /* !PERL_OBJECT */
#define STATIC static
#define CPERLscope(x) x
-#define CPERLproto
-#define _CPERLproto
#define CPERLarg void
#define CPERLarg_
#define _CPERLarg
@@ -132,12 +147,57 @@ class CPerlObj;
#define CALLREGEXEC CALL_FPTR(PL_regexecp)
#define CALLPROTECT CALL_FPTR(PL_protect)
-#define VOIDUSED 1
-#include "config.h"
+#define NOOP (void)0
+#define dNOOP extern int Perl___notused
-/* XXXXXX testing threads via implicit pointer */
-#ifdef USE_THREADS
-#define PERL_IMPLICIT_CONTEXT
+#ifdef PERL_IMPLICIT_CONTEXT
+# ifdef USE_THREADS
+struct perl_thread;
+# define pTHX register struct perl_thread *thr
+# define aTHX thr
+# define dTHXa(a) pTHX = (struct perl_thread *)a
+# define dTHX dTHXa(SvPVX(PL_thrsv))
+# define dTHR dNOOP
+# else
+# define MULTIPLICITY
+# define pTHX register PerlInterpreter *my_perl
+# define aTHX my_perl
+# define dTHXa(a) pTHX = (PerlInterpreter *)a
+# define dTHX dTHXa(PL_curinterp)
+# endif
+# define pTHX_ pTHX,
+# define _pTHX ,pTHX
+# define aTHX_ aTHX,
+# define _aTHX ,aTHX
+#endif
+
+#ifndef pTHX
+# define pTHX void
+# define pTHX_
+# define _pTHX
+# define aTHX
+#