home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2006 December / PCpro_2006_12.ISO / ossdvd / server / Perl2 / lib / core / pp.h < prev    next >
Encoding:
C/C++ Source or Header  |  2002-06-19  |  13.0 KB  |  405 lines
  1. /*    pp.h
  2.  *
  3.  *    Copyright (c) 1991-2002, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. #ifdef USE_5005THREADS
  11. #define ARGS thr
  12. #define dARGS struct perl_thread *thr;
  13. #else
  14. #define ARGS
  15. #define dARGS
  16. #endif /* USE_5005THREADS */
  17.  
  18. #define PP(s) OP * Perl_##s(pTHX)
  19.  
  20. /*
  21. =head1 Stack Manipulation Macros
  22.  
  23. =for apidoc AmU||SP
  24. Stack pointer.  This is usually handled by C<xsubpp>.  See C<dSP> and
  25. C<SPAGAIN>.
  26.  
  27. =for apidoc AmU||MARK
  28. Stack marker variable for the XSUB.  See C<dMARK>.
  29.  
  30. =for apidoc Ams||PUSHMARK
  31. Opening bracket for arguments on a callback.  See C<PUTBACK> and
  32. L<perlcall>.
  33.  
  34. =for apidoc Ams||dSP
  35. Declares a local copy of perl's stack pointer for the XSUB, available via
  36. the C<SP> macro.  See C<SP>.
  37.  
  38. =for apidoc ms||djSP
  39.  
  40. Declare Just C<SP>. This is actually identical to C<dSP>, and declares
  41. a local copy of perl's stack pointer, available via the C<SP> macro.
  42. See C<SP>.  (Available for backward source code compatibility with the
  43. old (Perl 5.005) thread model.)
  44.  
  45. =for apidoc Ams||dMARK
  46. Declare a stack marker variable, C<mark>, for the XSUB.  See C<MARK> and
  47. C<dORIGMARK>.
  48.  
  49. =for apidoc Ams||dORIGMARK
  50. Saves the original stack mark for the XSUB.  See C<ORIGMARK>.
  51.  
  52. =for apidoc AmU||ORIGMARK
  53. The original stack mark for the XSUB.  See C<dORIGMARK>.
  54.  
  55. =for apidoc Ams||SPAGAIN
  56. Refetch the stack pointer.  Used after a callback.  See L<perlcall>.
  57.  
  58. =cut */
  59.  
  60. #undef SP /* Solaris 2.7 i386 has this in /usr/include/sys/reg.h */
  61. #define SP sp
  62. #define MARK mark
  63. #define TARG targ
  64.  
  65. #define PUSHMARK(p) if (++PL_markstack_ptr == PL_markstack_max)    \
  66.             markstack_grow();            \
  67.             *PL_markstack_ptr = (p) - PL_stack_base
  68.  
  69. #define TOPMARK        (*PL_markstack_ptr)
  70. #define POPMARK        (*PL_markstack_ptr--)
  71.  
  72. #define dSP        register SV **sp = PL_stack_sp
  73. #define djSP        dSP
  74. #define dMARK        register SV **mark = PL_stack_base + POPMARK
  75. #define dORIGMARK    I32 origmark = mark - PL_stack_base
  76. #define SETORIGMARK    origmark = mark - PL_stack_base
  77. #define ORIGMARK    (PL_stack_base + origmark)
  78.  
  79. #define SPAGAIN        sp = PL_stack_sp
  80. #define MSPAGAIN    sp = PL_stack_sp; mark = ORIGMARK
  81.  
  82. #define GETTARGETSTACKED targ = (PL_op->op_flags & OPf_STACKED ? POPs : PAD_SV(PL_op->op_targ))
  83. #define dTARGETSTACKED SV * GETTARGETSTACKED
  84.  
  85. #define GETTARGET targ = PAD_SV(PL_op->op_targ)
  86. #define dTARGET SV * GETTARGET
  87.  
  88. #define GETATARGET targ = (PL_op->op_flags & OPf_STACKED ? sp[-1] : PAD_SV(PL_op->op_targ))
  89. #define dATARGET SV * GETATARGET
  90.  
  91. #define dTARG SV *targ
  92.  
  93. #define NORMAL PL_op->op_next
  94. #define DIE return Perl_die
  95.  
  96. /*
  97. =for apidoc Ams||PUTBACK
  98. Closing bracket for XSUB arguments.  This is usually handled by C<xsubpp>.
  99. See C<PUSHMARK> and L<perlcall> for other uses.
  100.  
  101. =for apidoc Amn|SV*|POPs
  102. Pops an SV off the stack.
  103.  
  104. =for apidoc Amn|char*|POPp
  105. Pops a string off the stack. Deprecated. New code should provide
  106. a STRLEN n_a and use POPpx.
  107.  
  108. =for apidoc Amn|char*|POPpx
  109. Pops a string off the stack.
  110. Requires a variable STRLEN n_a in scope.
  111.  
  112. =for apidoc Amn|char*|POPpbytex
  113. Pops a string off the stack which must consist of bytes i.e. characters < 256.
  114. Requires a variable STRLEN n_a in scope.
  115.  
  116. =for apidoc Amn|NV|POPn
  117. Pops a double off the stack.
  118.  
  119. =for apidoc Amn|IV|POPi
  120. Pops an integer off the stack.
  121.  
  122. =for apidoc Amn|long|POPl
  123. Pops a long off the stack.
  124.  
  125. =cut
  126. */
  127.  
  128. #define PUTBACK        PL_stack_sp = sp
  129. #define RETURN        return PUTBACK, NORMAL
  130. #define RETURNOP(o)    return PUTBACK, o
  131. #define RETURNX(x)    return x, PUTBACK, NORMAL
  132.  
  133. #define POPs        (*sp--)
  134. #define POPp        (SvPVx(POPs, PL_na))        /* deprecated */
  135. #define POPpx        (SvPVx(POPs, n_a))
  136. #define POPpbytex    (SvPVbytex(POPs, n_a))
  137. #define POPn        (SvNVx(POPs))
  138. #define POPi        ((IV)SvIVx(POPs))
  139. #define POPu        ((UV)SvUVx(POPs))
  140. #define POPl        ((long)SvIVx(POPs))
  141. #define POPul        ((unsigned long)SvIVx(POPs))
  142. #ifdef HAS_QUAD
  143. #define POPq        ((Quad_t)SvIVx(POPs))
  144. #define POPuq        ((Uquad_t)SvUVx(POPs))
  145. #endif
  146.  
  147. #define TOPs        (*sp)
  148. #define TOPm1s        (*(sp-1))
  149. #define TOPp1s        (*(sp+1))
  150. #define TOPp        (SvPV(TOPs, PL_na))        /* deprecated */
  151. #define TOPpx        (SvPV(TOPs, n_a))
  152. #define TOPn        (SvNV(TOPs))
  153. #define TOPi        ((IV)SvIV(TOPs))
  154. #define TOPu        ((UV)SvUV(TOPs))
  155. #define TOPl        ((long)SvIV(TOPs))
  156. #define TOPul        ((unsigned long)SvUV(TOPs))
  157. #ifdef HAS_QUAD
  158. #define TOPq        ((Quad_t)SvIV(TOPs))
  159. #define TOPuq        ((Uquad_t)SvUV(TOPs))
  160. #endif
  161.  
  162. /* Go to some pains in the rare event that we must extend the stack. */
  163.  
  164. /*
  165. =for apidoc Am|void|EXTEND|SP|int nitems
  166. Used to extend the argument stack for an XSUB's return values. Once
  167. used, guarantees that there is room for at least C<nitems> to be pushed
  168. onto the stack.
  169.  
  170. =for apidoc Am|void|PUSHs|SV* sv
  171. Push an SV onto the stack.  The stack must have room for this element.
  172. Does not handle 'set' magic.  See C<XPUSHs>.
  173.  
  174. =for apidoc Am|void|PUSHp|char* str|STRLEN len
  175. Push a string onto the stack.  The stack must have room for this element.
  176. The C<len> indicates the length of the string.  Handles 'set' magic.  See
  177. C<XPUSHp>.
  178.  
  179. =for apidoc Am|void|PUSHn|NV nv
  180. Push a double onto the stack.  The stack must have room for this element.
  181. Handles 'set' magic.  See C<XPUSHn>.
  182.  
  183. =for apidoc Am|void|PUSHi|IV iv
  184. Push an integer onto the stack.  The stack must have room for this element.
  185. Handles 'set' magic.  See C<XPUSHi>.
  186.  
  187. =for apidoc Am|void|PUSHu|UV uv
  188. Push an unsigned integer onto the stack.  The stack must have room for this
  189. element.  See C<XPUSHu>.
  190.  
  191. =for apidoc Am|void|XPUSHs|SV* sv
  192. Push an SV onto the stack, extending the stack if necessary.  Does not
  193. handle 'set' magic.  See C<PUSHs>.
  194.  
  195. =for apidoc Am|void|XPUSHp|char* str|STRLEN len
  196. Push a string onto the stack, extending the stack if necessary.  The C<len>
  197. indicates the length of the string.  Handles 'set' magic.  See
  198. C<PUSHp>.
  199.  
  200. =for apidoc Am|void|XPUSHn|NV nv
  201. Push a double onto the stack, extending the stack if necessary.  Handles
  202. 'set' magic.  See C<PUSHn>.
  203.  
  204. =for apidoc Am|void|XPUSHi|IV iv
  205. Push an integer onto the stack, extending the stack if necessary.  Handles
  206. 'set' magic. See C<PUSHi>.
  207.  
  208. =for apidoc Am|void|XPUSHu|UV uv
  209. Push an unsigned integer onto the stack, extending the stack if necessary.
  210. See C<PUSHu>.
  211.  
  212. =cut
  213. */
  214.  
  215. #define EXTEND(p,n)    STMT_START { if (PL_stack_max - p < (n)) {        \
  216.                 sp = stack_grow(sp,p, (int) (n));        \
  217.             } } STMT_END
  218.  
  219. /* Same thing, but update mark register too. */
  220. #define MEXTEND(p,n)    STMT_START {if (PL_stack_max - p < (n)) {        \
  221.                 int markoff = mark - PL_stack_base;        \
  222.                 sp = stack_grow(sp,p,(int) (n));        \
  223.                 mark = PL_stack_base + markoff;        \
  224.             } } STMT_END
  225.  
  226. #define PUSHs(s)    (*++sp = (s))
  227. #define PUSHTARG    STMT_START { SvSETMAGIC(TARG); PUSHs(TARG); } STMT_END
  228. #define PUSHp(p,l)    STMT_START { sv_setpvn(TARG, (p), (l)); PUSHTARG; } STMT_END
  229. #define PUSHn(n)    STMT_START { sv_setnv(TARG, (NV)(n)); PUSHTARG; } STMT_END
  230. #define PUSHi(i)    STMT_START { sv_setiv(TARG, (IV)(i)); PUSHTARG; } STMT_END
  231. #define PUSHu(u)    STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
  232.  
  233. #define XPUSHs(s)    STMT_START { EXTEND(sp,1); (*++sp = (s)); } STMT_END
  234. #define XPUSHTARG    STMT_START { SvSETMAGIC(TARG); XPUSHs(TARG); } STMT_END
  235. #define XPUSHp(p,l)    STMT_START { sv_setpvn(TARG, (p), (l)); XPUSHTARG; } STMT_END
  236. #define XPUSHn(n)    STMT_START { sv_setnv(TARG, (NV)(n)); XPUSHTARG; } STMT_END
  237. #define XPUSHi(i)    STMT_START { sv_setiv(TARG, (IV)(i)); XPUSHTARG; } STMT_END
  238. #define XPUSHu(u)    STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
  239. #define XPUSHundef    STMT_START { SvOK_off(TARG); XPUSHs(TARG); } STMT_END
  240.  
  241. #define SETs(s)        (*sp = s)
  242. #define SETTARG        STMT_START { SvSETMAGIC(TARG); SETs(TARG); } STMT_END
  243. #define SETp(p,l)    STMT_START { sv_setpvn(TARG, (p), (l)); SETTARG; } STMT_END
  244. #define SETn(n)        STMT_START { sv_setnv(TARG, (NV)(n)); SETTARG; } STMT_END
  245. #define SETi(i)        STMT_START { sv_setiv(TARG, (IV)(i)); SETTARG; } STMT_END
  246. #define SETu(u)        STMT_START { sv_setuv(TARG, (UV)(u)); SETTARG; } STMT_END
  247.  
  248. #define dTOPss        SV *sv = TOPs
  249. #define dPOPss        SV *sv = POPs
  250. #define dTOPnv        NV value = TOPn
  251. #define dPOPnv        NV value = POPn
  252. #define dTOPiv        IV value = TOPi
  253. #define dPOPiv        IV value = POPi
  254. #define dTOPuv        UV value = TOPu
  255. #define dPOPuv        UV value = POPu
  256. #ifdef HAS_QUAD
  257. #define dTOPqv        Quad_t value = TOPu
  258. #define dPOPqv        Quad_t value = POPu
  259. #define dTOPuqv        Uquad_t value = TOPuq
  260. #define dPOPuqv        Uquad_t value = POPuq
  261. #endif
  262.  
  263. #define dPOPXssrl(X)    SV *right = POPs; SV *left = CAT2(X,s)
  264. #define dPOPXnnrl(X)    NV right = POPn; NV left = CAT2(X,n)
  265. #define dPOPXiirl(X)    IV right = POPi; IV left = CAT2(X,i)
  266.  
  267. #define USE_LEFT(sv) \
  268.     (SvOK(sv) || SvGMAGICAL(sv) || !(PL_op->op_flags & OPf_STACKED))
  269. #define dPOPXnnrl_ul(X)    \
  270.     NV right = POPn;                \
  271.     SV *leftsv = CAT2(X,s);                \
  272.     NV left = USE_LEFT(leftsv) ? SvNV(leftsv) : 0.0
  273. #define dPOPXiirl_ul(X) \
  274.     IV right = POPi;                    \
  275.     SV *leftsv = CAT2(X,s);                \
  276.     IV left = USE_LEFT(leftsv) ? SvIV(leftsv) : 0
  277.  
  278. #define dPOPPOPssrl    dPOPXssrl(POP)
  279. #define dPOPPOPnnrl    dPOPXnnrl(POP)
  280. #define dPOPPOPnnrl_ul    dPOPXnnrl_ul(POP)
  281. #define dPOPPOPiirl    dPOPXiirl(POP)
  282. #define dPOPPOPiirl_ul    dPOPXiirl_ul(POP)
  283.  
  284. #define dPOPTOPssrl    dPOPXssrl(TOP)
  285. #define dPOPTOPnnrl    dPOPXnnrl(TOP)
  286. #define dPOPTOPnnrl_ul    dPOPXnnrl_ul(TOP)
  287. #define dPOPTOPiirl    dPOPXiirl(TOP)
  288. #define dPOPTOPiirl_ul    dPOPXiirl_ul(TOP)
  289.  
  290. #define RETPUSHYES    RETURNX(PUSHs(&PL_sv_yes))
  291. #define RETPUSHNO    RETURNX(PUSHs(&PL_sv_no))
  292. #define RETPUSHUNDEF    RETURNX(PUSHs(&PL_sv_undef))
  293.  
  294. #define RETSETYES    RETURNX(SETs(&PL_sv_yes))
  295. #define RETSETNO    RETURNX(SETs(&PL_sv_no))
  296. #define RETSETUNDEF    RETURNX(SETs(&PL_sv_undef))
  297.  
  298. #define ARGTARG        PL_op->op_targ
  299.  
  300.     /* See OPpTARGET_MY: */
  301. #define MAXARG        (PL_op->op_private & 15)
  302.  
  303. #define SWITCHSTACK(f,t) \
  304.     STMT_START {                            \
  305.     AvFILLp(f) = sp - PL_stack_base;                \
  306.     PL_stack_base = AvARRAY(t);                    \
  307.     PL_stack_max = PL_stack_base + AvMAX(t);            \
  308.     sp = PL_stack_sp = PL_stack_base + AvFILLp(t);            \
  309.     PL_curstack = t;                        \
  310.     } STMT_END
  311.  
  312. #define EXTEND_MORTAL(n) \
  313.     STMT_START {                            \
  314.     if (PL_tmps_ix + (n) >= PL_tmps_max)                \
  315.         tmps_grow(n);                        \
  316.     } STMT_END
  317.  
  318. #define AMGf_noright    1
  319. #define AMGf_noleft    2
  320. #define AMGf_assign    4
  321. #define AMGf_unary    8
  322.  
  323. #define tryAMAGICbinW(meth,assign,set) STMT_START { \
  324.           if (PL_amagic_generation) { \
  325.         SV* tmpsv; \
  326.         SV* right= *(sp); SV* left= *(sp-1);\
  327.         if ((SvAMAGIC(left)||SvAMAGIC(right))&&\
  328.         (tmpsv=amagic_call(left, \
  329.                    right, \
  330.                    CAT2(meth,_amg), \
  331.                    (assign)? AMGf_assign: 0))) {\
  332.            SPAGAIN;    \
  333.            (void)POPs; set(tmpsv); RETURN; } \
  334.       } \
  335.     } STMT_END
  336.  
  337. #define tryAMAGICbin(meth,assign) tryAMAGICbinW(meth,assign,SETsv)
  338. #define tryAMAGICbinSET(meth,assign) tryAMAGICbinW(meth,assign,SETs)
  339.  
  340. #define AMG_CALLun(sv,meth) amagic_call(sv,&PL_sv_undef,  \
  341.                     CAT2(meth,_amg),AMGf_noright | AMGf_unary)
  342. #define AMG_CALLbinL(left,right,meth) \
  343.             amagic_call(left,right,CAT2(meth,_amg),AMGf_noright)
  344.  
  345. #define tryAMAGICunW(meth,set,shift,ret) STMT_START { \
  346.           if (PL_amagic_generation) { \
  347.         SV* tmpsv; \
  348.         SV* arg= sp[shift]; \
  349.           if(0) goto am_again;  /* shut up unused warning */ \
  350.       am_again: \
  351.         if ((SvAMAGIC(arg))&&\
  352.         (tmpsv=AMG_CALLun(arg,meth))) {\
  353.            SPAGAIN; if (shift) sp += shift; \
  354.            set(tmpsv); ret; } \
  355.       } \
  356.     } STMT_END
  357.  
  358. #define FORCE_SETs(sv) STMT_START { sv_setsv(TARG, (sv)); SETTARG; } STMT_END
  359.  
  360. #define tryAMAGICun(meth)    tryAMAGICunW(meth,SETsvUN,0,RETURN)
  361. #define tryAMAGICunSET(meth)    tryAMAGICunW(meth,SETs,0,RETURN)
  362. #define tryAMAGICunTARGET(meth, shift)                    \
  363.     { dSP; sp--;     /* get TARGET from below PL_stack_sp */        \
  364.         { dTARGETSTACKED;                         \
  365.         { dSP; tryAMAGICunW(meth,FORCE_SETs,shift,RETURN);}}}
  366.  
  367. #define setAGAIN(ref) sv = ref;                            \
  368.   if (!SvROK(ref))                                \
  369.       Perl_croak(aTHX_ "Overloaded dereference did not return a reference");    \
  370.   if (ref != arg && SvRV(ref) != SvRV(arg)) {                    \
  371.       arg = ref;                                \
  372.       goto am_again;                                \
  373.   }
  374.  
  375. #define tryAMAGICunDEREF(meth) tryAMAGICunW(meth,setAGAIN,0,(void)0)
  376.  
  377. #define opASSIGN (PL_op->op_flags & OPf_STACKED)
  378. #define SETsv(sv)    STMT_START {                    \
  379.         if (opASSIGN || (SvFLAGS(TARG) & SVs_PADMY))        \
  380.            { sv_setsv(TARG, (sv)); SETTARG; }            \
  381.         else SETs(sv); } STMT_END
  382.  
  383. #define SETsvUN(sv)    STMT_START {                    \
  384.         if (SvFLAGS(TARG) & SVs_PADMY)        \
  385.            { sv_setsv(TARG, (sv)); SETTARG; }            \
  386.         else SETs(sv); } STMT_END
  387.  
  388. /* newSVsv does not behave as advertised, so we copy missing
  389.  * information by hand */
  390.  
  391. /* SV* ref causes confusion with the member variable
  392.    changed SV* ref to SV* tmpRef */
  393. #define RvDEEPCP(rv) STMT_START { SV* tmpRef=SvRV(rv);      \
  394.   if (SvREFCNT(tmpRef)>1) {                 \
  395.     SvREFCNT_dec(tmpRef);                   \
  396.     SvRV(rv)=AMG_CALLun(rv,copy);        \
  397.   } } STMT_END
  398.  
  399. /*
  400. =for apidoc mU||LVRET
  401. True if this op will be the return value of an lvalue subroutine
  402.  
  403. =cut */
  404. #define LVRET ((PL_op->op_private & OPpMAYBE_LVSUB) && is_lvalue_sub())
  405.