GV*
Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
{
char autoload[] = "AUTOLOAD";
STRLEN autolen = sizeof(autoload)-1;
GV* gv;
CV* cv;
HV* varstash;
GV* vargv;
SV* varsv;
if (len == autolen && strnEQ(name, autoload, autolen))
return Nullgv;
if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE)))
return Nullgv;
cv = GvCV(gv);
if (!CvROOT(cv))
return Nullgv;
/*
* Inheriting AUTOLOAD for non-methods works ... for now.
*/
if (ckWARN(WARN_DEPRECATED) && !method &&
(GvCVGEN(gv) || GvSTASH(gv) != stash))
Perl_warner(aTHX_ WARN_DEPRECATED,
"Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
HvNAME(stash), (int)len, name);
/*
* Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
* The subroutine's original name may not be "AUTOLOAD", so we don't
* use that, but for lack of anything better we will use the sub's
* original package to look up $AUTOLOAD.
*/
varstash = GvSTASH(CvGV(cv));
vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE);
ENTER;
#ifdef USE_THREADS
sv_lock((SV *)varstash);
#endif
if (!isGV(vargv))
gv_init(vargv, varstash, autoload, autolen, FALSE);
LEAVE;
varsv = GvSV(vargv);
#ifdef USE_THREADS
sv_lock(varsv);
#endif
sv_setpv(varsv, HvNAME(stash));
sv_catpvn(varsv, "::", 2);
sv_catpvn(varsv, name, len);
SvTAINTED_off(varsv);
return gv;
}
void sv_broadcast(sv_t *sv)
{
#ifdef SV_DEBUG_INTERRUPT_STATE
if(sv->sv_flags & SV_INTS) {
unsigned long flags;
__save_flags(flags);
if(SV_TEST_INTERRUPTS_ENABLED(flags))
printk(KERN_ERR "sv_broadcast: SV_INTS and "
"interrupts enabled! (flags: 0x%lx)\n", flags);
}
#endif /* SV_DEBUG_INTERRUPT_STATE */
sv_lock(sv);
wake_up_all(&sv->sv_waiters);
sv_unlock(sv);
}
void sv_signal(sv_t *sv)
{
/* If interrupts can acquire this lock, they can also acquire the
sv_mon_lock, which we must already have to have called this, so
interrupts must be disabled already. If interrupts cannot
contend for this lock, we don't have to worry about it. */
#ifdef SV_DEBUG_INTERRUPT_STATE
if(sv->sv_flags & SV_INTS) {
unsigned long flags;
__save_flags(flags);
if(SV_TEST_INTERRUPTS_ENABLED(flags))
printk(KERN_ERR "sv_signal: SV_INTS and "
"interrupts enabled! (flags: 0x%lx)\n", flags);
}
#endif /* SV_DEBUG_INTERRUPT_STATE */
sv_lock(sv);
wake_up(&sv->sv_waiters);
sv_unlock(sv);
}
GV*
Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
{
char autoload[] = "AUTOLOAD";
STRLEN autolen = sizeof(autoload)-1;
GV* gv;
CV* cv;
HV* varstash;
GV* vargv;
SV* varsv;
char *packname = "";
if (len == autolen && strnEQ(name, autoload, autolen))
return Nullgv;
if (stash) {
if (SvTYPE(stash) < SVt_PVHV) {
packname = SvPV_nolen((SV*)stash);
stash = Nullhv;
}
else {
packname = HvNAME(stash);
}
}
if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE)))
return Nullgv;
cv = GvCV(gv);
if (!(CvROOT(cv) || CvXSUB(cv)))
return Nullgv;
/*
* Inheriting AUTOLOAD for non-methods works ... for now.
*/
if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX) && !method &&
(GvCVGEN(gv) || GvSTASH(gv) != stash))
Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
"Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
packname, (int)len, name);
#ifndef USE_5005THREADS
if (CvXSUB(cv)) {
/* rather than lookup/init $AUTOLOAD here
* only to have the XSUB do another lookup for $AUTOLOAD
* and split that value on the last '::',
* pass along the same data via some unused fields in the CV
*/
CvSTASH(cv) = stash;
SvPVX(cv) = (char *)name; /* cast to lose constness warning */
SvCUR(cv) = len;
return gv;
}
#endif
/*
* Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
* The subroutine's original name may not be "AUTOLOAD", so we don't
* use that, but for lack of anything better we will use the sub's
* original package to look up $AUTOLOAD.
*/
varstash = GvSTASH(CvGV(cv));
vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE);
ENTER;
#ifdef USE_5005THREADS
sv_lock((SV *)varstash);
#endif
if (!isGV(vargv))
gv_init(vargv, varstash, autoload, autolen, FALSE);
LEAVE;
varsv = GvSV(vargv);
#ifdef USE_5005THREADS
sv_lock(varsv);
#endif
sv_setpv(varsv, packname);
sv_catpvn(varsv, "::", 2);
sv_catpvn(varsv, name, len);
SvTAINTED_off(varsv);
return gv;
}
/*
* The associated lock must be locked on entry. It is unlocked on return.
*
* Return values:
*
* n < 0 : interrupted, -n jiffies remaining on timeout, or -1 if timeout == 0
* n = 0 : timeout expired
* n > 0 : sv_signal()'d, n jiffies remaining on timeout, or 1 if timeout == 0
*/
signed long sv_wait(sv_t *sv, int sv_wait_flags, unsigned long timeout)
{
DECLARE_WAITQUEUE( wait, current );
unsigned long flags;
signed long ret = 0;
#ifdef SV_DEBUG_INTERRUPT_STATE
{
unsigned long flags;
__save_flags(flags);
if(sv->sv_flags & SV_INTS) {
if(SV_TEST_INTERRUPTS_ENABLED(flags)) {
printk(KERN_ERR "sv_wait: SV_INTS and interrupts "
"enabled (flags: 0x%lx)\n", flags);
BUG();
}
} else {
if (SV_TEST_INTERRUPTS_DISABLED(flags)) {
printk(KERN_WARNING "sv_wait: !SV_INTS and interrupts "
"disabled! (flags: 0x%lx)\n", flags);
}
}
}
#endif /* SV_DEBUG_INTERRUPT_STATE */
sv_lock(sv);
sv->sv_mon_unlock_func(sv->sv_mon_lock);
/* Add ourselves to the wait queue and set the state before
* releasing the sv_lock so as to avoid racing with the
* wake_up() in sv_signal() and sv_broadcast().
*/
/* don't need the _irqsave part, but there is no wq_write_lock() */
wq_write_lock_irqsave(&sv->sv_waiters.lock, flags);
#ifdef EXCLUSIVE_IN_QUEUE
wait.flags |= WQ_FLAG_EXCLUSIVE;
#endif
switch(sv->sv_flags & SV_ORDER_MASK) {
case SV_ORDER_FIFO:
__add_wait_queue_tail(&sv->sv_waiters, &wait);
break;
case SV_ORDER_FILO:
__add_wait_queue(&sv->sv_waiters, &wait);
break;
default:
printk(KERN_ERR "sv_wait: unknown order! (sv: 0x%p, flags: 0x%x)\n",
(void *)sv, sv->sv_flags);
BUG();
}
wq_write_unlock_irqrestore(&sv->sv_waiters.lock, flags);
if(sv_wait_flags & SV_WAIT_SIG)
set_current_state(TASK_EXCLUSIVE | TASK_INTERRUPTIBLE );
else
set_current_state(TASK_EXCLUSIVE | TASK_UNINTERRUPTIBLE);
spin_unlock(&sv->sv_lock);
if(sv->sv_flags & SV_INTS)
local_irq_enable();
else if(sv->sv_flags & SV_BHS)
local_bh_enable();
if (timeout)
ret = schedule_timeout(timeout);
else
schedule();
if(current->state != TASK_RUNNING) /* XXX Is this possible? */ {
printk(KERN_ERR "sv_wait: state not TASK_RUNNING after "
"schedule().\n");
set_current_state(TASK_RUNNING);
}
remove_wait_queue(&sv->sv_waiters, &wait);
/* Return cases:
- woken by a sv_signal/sv_broadcast
- woken by a signal
- woken by timeout expiring
*/
/* XXX This isn't really accurate; we may have been woken
before the signal anyway.... */
if(signal_pending(current))
return timeout ? -ret : -1;
return timeout ? ret : 1;
}
