#define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o))
+#ifdef PERL_OBJECT
+#define CALLOP this->*op
+#else
+#define CALLOP *op
static OP *docatch _((OP *o));
static OP *dofindlabel _((OP *o, char *label, OP **opstack, OP **oplimit));
static void doparseform _((SV *sv));
static I32 sortcv _((SV *a, SV *b));
static void qsortsv _((SV **array, size_t num_elts, I32 (*fun)(SV *a, SV *b)));
static OP *doeval _((int gimme, OP** startop));
-
-static I32 sortcxix;
+#endif
PP(pp_wantarray)
{
PP(pp_formline)
{
djSP; dMARK; dORIGMARK;
- register SV *form = *++MARK;
+ register SV *tmpForm = *++MARK;
register U16 *fpc;
register char *t;
register char *f;
bool gotsome;
STRLEN len;
- if (!SvMAGICAL(form) || !SvCOMPILED(form)) {
- SvREADONLY_off(form);
- doparseform(form);
+ if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) {
+ SvREADONLY_off(tmpForm);
+ doparseform(tmpForm);
}
SvPV_force(formtarget, len);
- t = SvGROW(formtarget, len + SvCUR(form) + 1); /* XXX SvCUR bad */
+ t = SvGROW(formtarget, len + SvCUR(tmpForm) + 1); /* XXX SvCUR bad */
t += len;
- f = SvPV(form, len);
+ f = SvPV(tmpForm, len);
/* need to jump to the next word */
- s = f + len + WORD_ALIGN - SvCUR(form) % WORD_ALIGN;
+ s = f + len + WORD_ALIGN - SvCUR(tmpForm) % WORD_ALIGN;
fpc = (U16*)s;
}
SvCUR_set(formtarget, t - SvPVX(formtarget));
sv_catpvn(formtarget, item, itemsize);
- SvGROW(formtarget, SvCUR(formtarget) + SvCUR(form) + 1);
+ SvGROW(formtarget, SvCUR(formtarget) + SvCUR(tmpForm) + 1);
t = SvPVX(formtarget) + SvCUR(formtarget);
}
break;
}
}
-
PP(pp_sort)
{
djSP; dMARK; dORIGMARK;
(void)SvREFCNT_inc(cv); /* in preparation for POPSUB */
}
sortcxix = cxstack_ix;
-
- qsortsv(myorigmark+1, max, sortcv);
+ qsortsv((myorigmark+1), max, FUNC_NAME_TO_PTR(sortcv));
POPBLOCK(cx,curpm);
POPSTACK();
if (max > 1) {
MEXTEND(SP, 20); /* Can't afford stack realloc on signal. */
qsortsv(ORIGMARK+1, max,
- (op->op_private & OPpLOCALE) ? sv_cmp_locale : sv_cmp);
+ (op->op_private & OPpLOCALE)
+ ? FUNC_NAME_TO_PTR(sv_cmp_locale)
+ : FUNC_NAME_TO_PTR(sv_cmp));
}
}
LEAVE;
/* Control. */
-static I32
+STATIC I32
dopoptolabel(char *label)
{
dTHR;
}
}
-static I32
+STATIC I32
dopoptosub(I32 startingblock)
{
dTHR;
return i;
}
-static I32
+STATIC I32
dopoptoeval(I32 startingblock)
{
dTHR;
return i;
}
-static I32
+STATIC I32
dopoptoloop(I32 startingblock)
{
dTHR;
RETURN;
}
-static I32
+STATIC I32
sortcv(SV *a, SV *b)
{
dTHR;
GvSV(secondgv) = b;
stack_sp = stack_base;
op = sortcop;
- runops();
+ CALLRUNOPS();
if (stack_sp != stack_base + 1)
croak("Sort subroutine didn't return single value");
if (!SvNIOKp(*stack_sp))
TAINT_NOT;
if (gimme == G_SCALAR) {
- if (MARK < SP)
- *++newsp = (popsub2 && SvTEMP(*SP))
- ? *SP : sv_mortalcopy(*SP);
- else
+ if (MARK < SP) {
+ if (popsub2) {
+ if (cxsub.cv && CvDEPTH(cxsub.cv) > 1) {
+ if (SvTEMP(TOPs)) {
+ *++newsp = SvREFCNT_inc(*SP);
+ FREETMPS;
+ sv_2mortal(*newsp);
+ } else {
+ FREETMPS;
+ *++newsp = sv_mortalcopy(*SP);
+ }
+ } else
+ *++newsp = (SvTEMP(*SP)) ? *SP : sv_mortalcopy(*SP);
+ } else
+ *++newsp = sv_mortalcopy(*SP);
+ } else
*++newsp = &sv_undef;
}
else if (gimme == G_ARRAY) {
return cx->blk_loop.redo_op;
}
-static OP* lastgotoprobe;
-
-static OP *
+STATIC OP *
dofindlabel(OP *o, char *label, OP **opstack, OP **oplimit)
{
OP *kid;
}
else {
stack_sp--; /* There is no cv arg. */
- (void)(*CvXSUB(cv))(cv);
+ (void)(*CvXSUB(cv))(cv _PERL_OBJECT_THIS);
}
LEAVE;
return pop_return();
if (op->op_type == OP_ENTERITER)
DIE("Can't \"goto\" into the middle of a foreach loop",
label);
- (*op->op_ppaddr)(ARGS);
+ (CALLOP->op_ppaddr)(ARGS);
}
op = oldop;
}
/* Eval. */
-static void
+STATIC void
save_lines(AV *array, SV *sv)
{
register char *s = SvPVX(sv);
}
}
-static OP *
+STATIC OP *
docatch(OP *o)
{
dTHR;
restartop = 0;
/* FALL THROUGH */
case 0:
- runops();
+ CALLRUNOPS();
break;
}
JMPENV_POP;
}
/* With USE_THREADS, eval_owner must be held on entry to doeval */
-static OP *
+STATIC OP *
doeval(int gimme, OP** startop)
{
dSP;
RETURN;
}
-static void
+STATIC void
doparseform(SV *sv)
{
STRLEN len;
/* Return < 0 == 0 or > 0 as the value of elt1 is < elt2, == elt2, > elt2
*/
+#ifdef PERL_OBJECT
+#define qsort_cmp(elt1, elt2) \
+ ((this->*compare)(array[elt1], array[elt2]))
+#else
#define qsort_cmp(elt1, elt2) \
((*compare)(array[elt1], array[elt2]))
+#endif
#ifdef QSORT_ORDER_GUESS
#define QSORT_NOTICE_SWAP swapped++;
/* ****************************************************************** qsort */
void
+#ifdef PERL_OBJECT
+qsortsv(SV ** array, size_t num_elts, SVCOMPARE compare)
+#else
qsortsv(
SV ** array,
size_t num_elts,
I32 (*compare)(SV *a, SV *b))
+#endif
{
register SV * temp;