ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/EV/schmorp.h
Revision: 1.1
Committed: Tue Jul 14 00:09:59 2009 UTC (14 years, 10 months ago) by root
Content type: text/plain
Branch: MAIN
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 #ifndef SCHMORP_PERL_H_
2     #define SCHMORP_PERL_H_
3    
4     /* useful stuff, used by schmorp mostly */
5    
6     #define PERL_VERSION_ATLEAST(a,b,c) \
7     (PERL_REVISION > (a) \
8     || (PERL_REVISION == (a) \
9     && (PERL_VERSION > (b) \
10     || (PERL_VERSION == (b) && PERL_SUBVERSION >= (c)))))
11    
12     #if !PERL_VERSION_ATLEAST (5,6,0)
13     # ifndef PL_ppaddr
14     # define PL_ppaddr ppaddr
15     # endif
16     # ifndef call_sv
17     # define call_sv perl_call_sv
18     # endif
19     # ifndef get_sv
20     # define get_sv perl_get_sv
21     # endif
22     # ifndef get_cv
23     # define get_cv perl_get_cv
24     # endif
25     # ifndef IS_PADGV
26     # define IS_PADGV(v) 0
27     # endif
28     # ifndef IS_PADCONST
29     # define IS_PADCONST(v) 0
30     # endif
31     #endif
32    
33     /* 5.11 */
34     #ifndef CxHASARGS
35     # define CxHASARGS(cx) (cx)->blk_sub.hasargs
36     #endif
37    
38     /* 5.10.0 */
39     #ifndef SvREFCNT_inc_NN
40     # define SvREFCNT_inc_NN(sv) SvREFCNT_inc (sv)
41     #endif
42    
43     /* 5.8.8 */
44     #ifndef GV_NOTQUAL
45     # define GV_NOTQUAL 0
46     #endif
47     #ifndef newSV
48     # define newSV(l) NEWSV(0,l)
49     #endif
50     #ifndef CvISXSUB_on
51     # define CvISXSUB_on(cv) (void)cv
52     #endif
53     #ifndef CvISXSUB
54     # define CvISXSUB(cv) (CvXSUB (cv) ? TRUE : FALSE)
55     #endif
56     #ifndef Newx
57     # define Newx(ptr,nitems,type) New (0,ptr,nitems,type)
58     #endif
59    
60     /* 5.8.7 */
61     #ifndef SvRV_set
62     # define SvRV_set(s,v) SvRV(s) = (v)
63     #endif
64    
65     static int
66     s_signum (SV *sig)
67     {
68     #ifndef SIG_SIZE
69     /* kudos to Slaven Rezic for the idea */
70     static char sig_size [] = { SIG_NUM };
71     # define SIG_SIZE (sizeof (sig_size) + 1)
72     #endif
73     int signum;
74    
75     SvGETMAGIC (sig);
76    
77     for (signum = 1; signum < SIG_SIZE; ++signum)
78     if (strEQ (SvPV_nolen (sig), PL_sig_name [signum]))
79     return signum;
80    
81     signum = SvIV (sig);
82    
83     if (signum > 0 && signum < SIG_SIZE)
84     return signum;
85    
86     return -1;
87     }
88    
89     static int
90     s_signum_croak (SV *sig)
91     {
92     int signum = s_signum (sig);
93    
94     if (signum < 0)
95     croak ("%s: invalid signal name or number", SvPV_nolen (sig));
96    
97     return signum;
98     }
99    
100     static int
101     s_fileno (SV *fh, int wr)
102     {
103     SvGETMAGIC (fh);
104    
105     if (SvROK (fh))
106     {
107     fh = SvRV (fh);
108     SvGETMAGIC (fh);
109     }
110    
111     if (SvTYPE (fh) == SVt_PVGV)
112     return PerlIO_fileno (wr ? IoOFP (sv_2io (fh)) : IoIFP (sv_2io (fh)));
113    
114     if (SvOK (fh) && (SvIV (fh) >= 0) && (SvIV (fh) < 0x7fffffffL))
115     return SvIV (fh);
116    
117     return -1;
118     }
119    
120     static int
121     s_fileno_croak (SV *fh, int wr)
122     {
123     int fd = s_fileno (fh, wr);
124    
125     if (fd < 0)
126     croak ("%s: illegal fh argument, either not an OS file or read/write mode mismatch", SvPV_nolen (fh));
127    
128     return fd;
129     }
130    
131     static SV *
132     s_get_cv (SV *cb_sv)
133     {
134     HV *st;
135     GV *gvp;
136     CV *cv = sv_2cv (cb_sv, &st, &gvp, 0);
137    
138     return (SV *)cv;
139     }
140    
141     static SV *
142     s_get_cv_croak (SV *cb_sv)
143     {
144     cb_sv = s_get_cv (cb_sv);
145    
146     if (!cb_sv)
147     croak ("%s: callback must be a CODE reference or another callable object", SvPV_nolen (cb_sv));
148    
149     return cb_sv;
150     }
151    
152     /*****************************************************************************/
153     /* gensub: simple closure generation utility */
154    
155     #define S_GENSUB_ARG CvXSUBANY (cv).any_ptr
156    
157     /* create a closure from XS, returns a code reference */
158     /* the arg can be accessed via GENSUB_ARG from the callback */
159     /* the callback must use dXSARGS/XSRETURN */
160     static SV *
161     s_gensub (pTHX_ void (*xsub)(pTHX_ CV *), void *arg)
162     {
163     CV *cv = (CV *)newSV (0);
164    
165     sv_upgrade ((SV *)cv, SVt_PVCV);
166    
167     CvANON_on (cv);
168     CvISXSUB_on (cv);
169     CvXSUB (cv) = xsub;
170     S_GENSUB_ARG = arg;
171    
172     return newRV_noinc ((SV *)cv);
173     }
174    
175     #endif
176