diff options
| -rw-r--r-- | embed.h | 42 | ||||
| -rw-r--r-- | embedvar.h | 8 | ||||
| -rw-r--r-- | objXSUB.h | 30 | ||||
| -rw-r--r-- | opcode.h | 14 | ||||
| -rw-r--r-- | opnames.h | 3 | ||||
| -rw-r--r-- | perlapi.c | 48 | ||||
| -rw-r--r-- | perlapi.h | 4 | ||||
| -rw-r--r-- | proto.h | 12 |
8 files changed, 160 insertions, 1 deletions
@@ -873,6 +873,18 @@ #define sys_intern_clear Perl_sys_intern_clear #define sys_intern_init Perl_sys_intern_init #endif +#if defined(PERL_CUSTOM_OPS) +#define custom_op_name Perl_custom_op_name +#define custom_op_desc Perl_custom_op_desc +#endif +#if defined(PERL_CUSTOM_OPS) +#define custom_op_name Perl_custom_op_name +#define custom_op_desc Perl_custom_op_desc +#endif +#if defined(PERL_CUSTOM_OPS) +#define custom_op_name Perl_custom_op_name +#define custom_op_desc Perl_custom_op_desc +#endif #if defined(PERL_OBJECT) #else #endif @@ -2388,6 +2400,18 @@ #define sys_intern_clear() Perl_sys_intern_clear(aTHX) #define sys_intern_init() Perl_sys_intern_init(aTHX) #endif +#if defined(PERL_CUSTOM_OPS) +#define custom_op_name(a) Perl_custom_op_name(aTHX_ a) +#define custom_op_desc(a) Perl_custom_op_desc(aTHX_ a) +#endif +#if defined(PERL_CUSTOM_OPS) +#define custom_op_name(a) Perl_custom_op_name(aTHX_ a) +#define custom_op_desc(a) Perl_custom_op_desc(aTHX_ a) +#endif +#if defined(PERL_CUSTOM_OPS) +#define custom_op_name(a) Perl_custom_op_name(aTHX_ a) +#define custom_op_desc(a) Perl_custom_op_desc(aTHX_ a) +#endif #if defined(PERL_OBJECT) #else #endif @@ -4697,6 +4721,24 @@ #define Perl_sys_intern_init CPerlObj::Perl_sys_intern_init #define sys_intern_init Perl_sys_intern_init #endif +#if defined(PERL_CUSTOM_OPS) +#define Perl_custom_op_name CPerlObj::Perl_custom_op_name +#define custom_op_name Perl_custom_op_name +#define Perl_custom_op_desc CPerlObj::Perl_custom_op_desc +#define custom_op_desc Perl_custom_op_desc +#endif +#if defined(PERL_CUSTOM_OPS) +#define Perl_custom_op_name CPerlObj::Perl_custom_op_name +#define custom_op_name Perl_custom_op_name +#define Perl_custom_op_desc CPerlObj::Perl_custom_op_desc +#define custom_op_desc Perl_custom_op_desc +#endif +#if defined(PERL_CUSTOM_OPS) +#define Perl_custom_op_name CPerlObj::Perl_custom_op_name +#define custom_op_name Perl_custom_op_name +#define Perl_custom_op_desc CPerlObj::Perl_custom_op_desc +#define custom_op_desc Perl_custom_op_desc +#endif #if defined(PERL_OBJECT) #else #endif diff --git a/embedvar.h b/embedvar.h index 3af647c4b2..9198d2e670 100644 --- a/embedvar.h +++ b/embedvar.h @@ -223,6 +223,8 @@ #define PL_curcopdb (PERL_GET_INTERP->Icurcopdb) #define PL_curstname (PERL_GET_INTERP->Icurstname) #define PL_curthr (PERL_GET_INTERP->Icurthr) +#define PL_custom_op_descs (PERL_GET_INTERP->Icustom_op_descs) +#define PL_custom_op_names (PERL_GET_INTERP->Icustom_op_names) #define PL_dbargs (PERL_GET_INTERP->Idbargs) #define PL_debstash (PERL_GET_INTERP->Idebstash) #define PL_debug (PERL_GET_INTERP->Idebug) @@ -509,6 +511,8 @@ #define PL_curcopdb (vTHX->Icurcopdb) #define PL_curstname (vTHX->Icurstname) #define PL_curthr (vTHX->Icurthr) +#define PL_custom_op_descs (vTHX->Icustom_op_descs) +#define PL_custom_op_names (vTHX->Icustom_op_names) #define PL_dbargs (vTHX->Idbargs) #define PL_debstash (vTHX->Idebstash) #define PL_debug (vTHX->Idebug) @@ -934,6 +938,8 @@ #define PL_curcopdb (aTHXo->interp.Icurcopdb) #define PL_curstname (aTHXo->interp.Icurstname) #define PL_curthr (aTHXo->interp.Icurthr) +#define PL_custom_op_descs (aTHXo->interp.Icustom_op_descs) +#define PL_custom_op_names (aTHXo->interp.Icustom_op_names) #define PL_dbargs (aTHXo->interp.Idbargs) #define PL_debstash (aTHXo->interp.Idebstash) #define PL_debug (aTHXo->interp.Idebug) @@ -1221,6 +1227,8 @@ #define PL_Icurcopdb PL_curcopdb #define PL_Icurstname PL_curstname #define PL_Icurthr PL_curthr +#define PL_Icustom_op_descs PL_custom_op_descs +#define PL_Icustom_op_names PL_custom_op_names #define PL_Idbargs PL_dbargs #define PL_Idebstash PL_debstash #define PL_Idebug PL_debug @@ -2339,6 +2339,36 @@ #undef sys_intern_init #define sys_intern_init Perl_sys_intern_init #endif +#if defined(PERL_CUSTOM_OPS) +#undef Perl_custom_op_name +#define Perl_custom_op_name pPerl->Perl_custom_op_name +#undef custom_op_name +#define custom_op_name Perl_custom_op_name +#undef Perl_custom_op_desc +#define Perl_custom_op_desc pPerl->Perl_custom_op_desc +#undef custom_op_desc +#define custom_op_desc Perl_custom_op_desc +#endif +#if defined(PERL_CUSTOM_OPS) +#undef Perl_custom_op_name +#define Perl_custom_op_name pPerl->Perl_custom_op_name +#undef custom_op_name +#define custom_op_name Perl_custom_op_name +#undef Perl_custom_op_desc +#define Perl_custom_op_desc pPerl->Perl_custom_op_desc +#undef custom_op_desc +#define custom_op_desc Perl_custom_op_desc +#endif +#if defined(PERL_CUSTOM_OPS) +#undef Perl_custom_op_name +#define Perl_custom_op_name pPerl->Perl_custom_op_name +#undef custom_op_name +#define custom_op_name Perl_custom_op_name +#undef Perl_custom_op_desc +#define Perl_custom_op_desc pPerl->Perl_custom_op_desc +#undef custom_op_desc +#define custom_op_desc Perl_custom_op_desc +#endif #if defined(PERL_OBJECT) #else #endif @@ -11,6 +11,16 @@ START_EXTERN_C +#ifdef PERL_CUSTOM_OPS +#define OP_NAME(o) (o->op_type == OP_CUSTOM ? custom_op_name(o) : \ + PL_op_name[o->op_type]) +#define OP_DESC(o) (o->op_type == OP_CUSTOM ? custom_op_desc(o) : \ + PL_op_desc[o->op_type]) +#else +#define OP_NAME(o) PL_op_name[o->op_type] +#define OP_DESC(o) PL_op_desc[o->op_type] +#endif + #ifndef DOINIT EXT char *PL_op_name[]; #else @@ -366,6 +376,7 @@ EXT char *PL_op_name[] = { "threadsv", "setstate", "method_named", + "custom", }; #endif @@ -724,6 +735,7 @@ EXT char *PL_op_desc[] = { "per-thread value", "set statement info", "method with known name", + "unknown custom operator", }; #endif @@ -1445,6 +1457,7 @@ EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = { MEMBER_TO_FPTR(Perl_ck_null), /* threadsv */ MEMBER_TO_FPTR(Perl_ck_null), /* setstate */ MEMBER_TO_FPTR(Perl_ck_null), /* method_named */ + MEMBER_TO_FPTR(Perl_ck_null), /* custom */ }; #endif @@ -1803,6 +1816,7 @@ EXT U32 PL_opargs[] = { 0x00000044, /* threadsv */ 0x00001404, /* setstate */ 0x00000c40, /* method_named */ + 0x00000000, /* custom */ }; #endif @@ -355,10 +355,11 @@ typedef enum opcode { OP_THREADSV, /* 348 */ OP_SETSTATE, /* 349 */ OP_METHOD_NAMED,/* 350 */ + OP_CUSTOM, /* 351 */ OP_max } opcode; -#define MAXO 351 +#define MAXO 352 #define OP_phoney_INPUT_ONLY -1 #define OP_phoney_OUTPUT_ONLY -2 @@ -4213,6 +4213,54 @@ Perl_sys_intern_init(pTHXo) ((CPerlObj*)pPerl)->Perl_sys_intern_init(); } #endif +#if defined(PERL_CUSTOM_OPS) + +#undef Perl_custom_op_name +char * +Perl_custom_op_name(pTHXo_ OP* op) +{ + return ((CPerlObj*)pPerl)->Perl_custom_op_name(op); +} + +#undef Perl_custom_op_desc +char * +Perl_custom_op_desc(pTHXo_ OP* op) +{ + return ((CPerlObj*)pPerl)->Perl_custom_op_desc(op); +} +#endif +#if defined(PERL_CUSTOM_OPS) + +#undef Perl_custom_op_name +char * +Perl_custom_op_name(pTHXo_ OP* op) +{ + return ((CPerlObj*)pPerl)->Perl_custom_op_name(op); +} + +#undef Perl_custom_op_desc +char * +Perl_custom_op_desc(pTHXo_ OP* op) +{ + return ((CPerlObj*)pPerl)->Perl_custom_op_desc(op); +} +#endif +#if defined(PERL_CUSTOM_OPS) + +#undef Perl_custom_op_name +char * +Perl_custom_op_name(pTHXo_ OP* op) +{ + return ((CPerlObj*)pPerl)->Perl_custom_op_name(op); +} + +#undef Perl_custom_op_desc +char * +Perl_custom_op_desc(pTHXo_ OP* op) +{ + return ((CPerlObj*)pPerl)->Perl_custom_op_desc(op); +} +#endif #if defined(PERL_OBJECT) #else #endif @@ -180,6 +180,10 @@ START_EXTERN_C #define PL_curstname (*Perl_Icurstname_ptr(aTHXo)) #undef PL_curthr #define PL_curthr (*Perl_Icurthr_ptr(aTHXo)) +#undef PL_custom_op_descs +#define PL_custom_op_descs (*Perl_Icustom_op_descs_ptr(aTHXo)) +#undef PL_custom_op_names +#define PL_custom_op_names (*Perl_Icustom_op_names_ptr(aTHXo)) #undef PL_dbargs #define PL_dbargs (*Perl_Idbargs_ptr(aTHXo)) #undef PL_debstash @@ -984,6 +984,18 @@ PERL_CALLCONV void Perl_ptr_table_free(pTHX_ PTR_TBL_t *tbl); PERL_CALLCONV void Perl_sys_intern_clear(pTHX); PERL_CALLCONV void Perl_sys_intern_init(pTHX); #endif +#if defined(PERL_CUSTOM_OPS) +PERL_CALLCONV char * Perl_custom_op_name(pTHX_ OP* op); +PERL_CALLCONV char * Perl_custom_op_desc(pTHX_ OP* op); +#endif +#if defined(PERL_CUSTOM_OPS) +PERL_CALLCONV char * Perl_custom_op_name(pTHX_ OP* op); +PERL_CALLCONV char * Perl_custom_op_desc(pTHX_ OP* op); +#endif +#if defined(PERL_CUSTOM_OPS) +PERL_CALLCONV char * Perl_custom_op_name(pTHX_ OP* op); +PERL_CALLCONV char * Perl_custom_op_desc(pTHX_ OP* op); +#endif #if defined(PERL_OBJECT) protected: |