Split common stuff
gfx [Sat, 28 Aug 2010 09:38:03 +0000 (18:38 +0900)]
mouse.h
perlxs.h [new file with mode: 0644]
xs-src/Mouse.xs

diff --git a/mouse.h b/mouse.h
index 74c46f0..841bb7c 100644 (file)
--- a/mouse.h
+++ b/mouse.h
@@ -1,33 +1,7 @@
 #ifndef MOUSE_H
 #define MOUSE_H
 
-#define PERL_NO_GET_CONTEXT
-#include <EXTERN.h>
-#include <perl.h>
-#include <XSUB.h>
-
-#include "ppport.h"
-
-/* Portability stuff */
-
-#ifndef newSVpvs_share
-#define newSVpvs_share(s) Perl_newSVpvn_share(aTHX_ s, sizeof(s)-1, 0U)
-#endif
-
-#ifndef get_cvs
-#define get_cvs(name, flags) get_cv(name, flags)
-#endif
-
-#ifndef GvNAME_get
-#define GvNAME_get GvNAME
-#endif
-#ifndef GvNAMELEN_get
-#define GvNAMELEN_get GvNAMELEN
-#endif
-
-#ifndef CvGV_set
-#define CvGV_set(cv, gv) (CvGV(cv) = (gv))
-#endif
+#include "perlxs.h"
 
 #ifndef mro_get_linear_isa
 #define no_mro_get_linear_isa
@@ -44,25 +18,6 @@ AV* mouse_mro_get_linear_isa(pTHX_ HV* const stash);
 #endif /* !no_mro_get_linear_isa */
 #endif /* mro_get_package_gen */
 
-#ifndef STATIC_INLINE /* from 5.13.4 */
-#   if defined(__GNUC__) || defined(__cplusplus__) || (defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L))
-#       define STATIC_INLINE static inline
-#   else
-#       define STATIC_INLINE static
-#   endif
-#endif /* STATIC_INLINE */
-
-/* Mouse stuff */
-
-#define newAV_mortal() (AV*)sv_2mortal((SV*)newAV())
-#define newHV_mortal() (HV*)sv_2mortal((SV*)newHV())
-
-#define MOUSE_CALL_BOOT(name) STMT_START {      \
-        EXTERN_C XS(CAT2(boot_, name));         \
-        PUSHMARK(SP);                           \
-        CALL_FPTR(CAT2(boot_, name))(aTHX_ cv); \
-    } STMT_END
-
 extern SV* mouse_package;
 extern SV* mouse_namespace;
 extern SV* mouse_methods;
@@ -71,11 +26,7 @@ extern SV* mouse_coerce;
 
 void
 mouse_throw_error(SV* const metaobject, SV* const data /* not used */, const char* const fmt, ...)
-#ifdef __attribute__format__
     __attribute__format__(__printf__, 3, 4);
-#else
-    ;
-#endif
 
 /* workaround RT #69939 */
 I32
diff --git a/perlxs.h b/perlxs.h
new file mode 100644 (file)
index 0000000..4168cd3
--- /dev/null
+++ b/perlxs.h
@@ -0,0 +1,77 @@
+/*
+    perlxs.h - Standard XS header file
+    Copyright (c) Fuji, Goro (gfx)
+*/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define PERL_NO_GET_CONTEXT /* we want efficiency */
+#include <EXTERN.h>
+
+#include <perl.h>
+#define NO_XSLOCKS /* for exceptions */
+#include <XSUB.h>
+
+#ifdef __cplusplus
+} /* extern "C" */
+#endif
+
+#include "ppport.h"
+
+/* portability stuff not supported by ppport.h yet */
+
+#ifndef STATIC_INLINE /* from 5.13.4 */
+#   if defined(__GNUC__) || defined(__cplusplus__) || (defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L))
+#       define STATIC_INLINE static inline
+#   else
+#       define STATIC_INLINE static
+#   endif
+#endif /* STATIC_INLINE */
+
+#ifndef __attribute__format__
+#define __attribute__format__(a,b,c) /* nothing */
+#endif
+
+#ifndef LIKELY /* they are just a compiler's hint */
+#define LIKELY(x)   (x)
+#define UNLIKELY(x) (x)
+#endif
+
+#ifndef newSVpvs_share
+#define newSVpvs_share(s) Perl_newSVpvn_share(aTHX_ STR_WITH_LEN(s), 0U)
+#endif
+
+#ifndef get_cvs
+#define get_cvs(name, flags) get_cv(name, flags)
+#endif
+
+#ifndef GvNAME_get
+#define GvNAME_get GvNAME
+#endif
+#ifndef GvNAMELEN_get
+#define GvNAMELEN_get GvNAMELEN
+#endif
+
+#ifndef CvGV_set
+#define CvGV_set(cv, gv) (CvGV(cv) = (gv))
+#endif
+
+/* general utility */
+
+#if PERL_BCDVERSION < 0x5008005
+#define LooksLikeNumber(x) (SvOK(x) && looks_like_number(x))
+#else
+#define LooksLikeNumber(x) looks_like_number(x)
+#endif
+
+#define newAV_mortal() (AV*)sv_2mortal((SV*)newAV())
+#define newHV_mortal() (HV*)sv_2mortal((SV*)newHV())
+
+#define DECL_BOOT(name) EXTERN_C XS(CAT2(boot_, name))
+#define CALL_BOOT(name) STMT_START {            \
+        PUSHMARK(SP);                           \
+        CALL_FPTR(CAT2(boot_, name))(aTHX_ cv); \
+    } STMT_END
+
index ecc6e8c..efd1e94 100644 (file)
@@ -76,10 +76,10 @@ mouse_class_push_attribute_list(pTHX_ SV* const metaclass, AV* const attrall, HV
     }
 }
 
+XS(XS_Mouse__Object_BUILDARGS); /* prototype */
+
 static int
 mouse_class_has_custom_buildargs(pTHX_ HV* const stash) {
-    XS(XS_Mouse__Object_BUILDARGS); /* prototype */
-
     GV* const buildargs = gv_fetchmeth_autoload(stash, "BUILDARGS", sizeof("BUILDARGS")-1, 0);
 
     return buildargs && CvXSUB(GvCV(buildargs)) != XS_Mouse__Object_BUILDARGS;
@@ -445,6 +445,11 @@ mouse_get_modifier_storage(pTHX_
     return (AV*)SvRV(storage_ref);
 }
 
+DECL_BOOT(Mouse__Util);
+DECL_BOOT(Mouse__Util__TypeConstraints);
+DECL_BOOT(Mouse__Meta__Method__Accessor__XS);
+DECL_BOOT(Mouse__Meta__Attribute);
+
 MODULE = Mouse  PACKAGE = Mouse
 
 PROTOTYPES: DISABLE
@@ -459,10 +464,10 @@ BOOT:
     mouse_get_attribute      = newSVpvs_share("get_attribute");
     mouse_get_attribute_list = newSVpvs_share("get_attribute_list");
 
-    MOUSE_CALL_BOOT(Mouse__Util);
-    MOUSE_CALL_BOOT(Mouse__Util__TypeConstraints);
-    MOUSE_CALL_BOOT(Mouse__Meta__Method__Accessor__XS);
-    MOUSE_CALL_BOOT(Mouse__Meta__Attribute);
+    CALL_BOOT(Mouse__Util);
+    CALL_BOOT(Mouse__Util__TypeConstraints);
+    CALL_BOOT(Mouse__Meta__Method__Accessor__XS);
+    CALL_BOOT(Mouse__Meta__Attribute);
 
 
 MODULE = Mouse  PACKAGE = Mouse::Meta::Module
@@ -662,7 +667,7 @@ void
 add_before_modifier(SV* self, SV* name, SV* modifier)
 CODE:
 {
-    av_push(mouse_get_modifier_storage(aTHX_ self, ix, name), newSVsv(modifier));
+    av_push(mouse_get_modifier_storage(aTHX_ self, (enum mouse_modifier_t)ix, name), newSVsv(modifier));
 }
 ALIAS:
     add_before_method_modifier = MOUSE_M_BEFORE
@@ -677,7 +682,7 @@ ALIAS:
     get_after_method_modifiers  = MOUSE_M_AFTER
 PPCODE:
 {
-    AV* const storage = mouse_get_modifier_storage(aTHX_ self, ix, name);
+    AV* const storage = mouse_get_modifier_storage(aTHX_ self, (enum mouse_modifier_t)ix, name);
     I32 const len     = av_len(storage) + 1;
     if(GIMME_V == G_ARRAY) {
         I32 i;