#endif
#define dXSARGS \
- dTHR; dSP; dMARK; \
+ dSP; dMARK; \
I32 ax = mark - stack_base + 1; \
I32 items = sp - mark
I32
my_stat(ARGSproto)
{
- dSP;
+ djSP;
IO *io;
GV* tmpgv;
I32
my_lstat(ARGSproto)
{
- dSP;
+ djSP;
SV *sv;
if (op->op_flags & OPf_REF) {
EXTEND(sp,1);
}
#endif /* SYSV IPC */
+
I32
do_chomp(register SV *sv)
{
- dTHR;
register I32 count;
STRLEN len;
char *s;
void
do_vop(I32 optype, SV *sv, SV *left, SV *right)
{
- dTHR; /* just for taint */
#ifdef LIBERAL
register long *dl;
register long *ll;
OP *
do_kv(ARGSproto)
{
- dSP;
+ djSP;
HV *hv = (HV*)POPs;
register HE *entry;
SV *tmpstr;
}
return NORMAL;
}
+
#define invert Perl_invert
#define io_close Perl_io_close
#define jmaybe Perl_jmaybe
-#define key_create Perl_key_create
-#define key_destroy Perl_key_destroy
#define keyword Perl_keyword
#define know_next Perl_know_next
#define last_lop Perl_last_lop
#define newPVOP Perl_newPVOP
#define newRANGE Perl_newRANGE
#define newRV Perl_newRV
+#define newRV_noinc Perl_newRV_noinc
#define newSLICEOP Perl_newSLICEOP
#define newSTATEOP Perl_newSTATEOP
#define newSUB Perl_newSUB
#define newWHILEOP Perl_newWHILEOP
#define newXS Perl_newXS
#define newXSUB Perl_newXSUB
-#define new_struct_thread Perl_new_struct_thread
#define nextargv Perl_nextargv
#define nexttoke Perl_nexttoke
#define nexttype Perl_nexttype
#define padix Perl_padix
#define patleave Perl_patleave
#define peep Perl_peep
-#define per_thread_magicals Perl_per_thread_magicals
#define pidgone Perl_pidgone
#define pidstatus Perl_pidstatus
#define pmflag Perl_pmflag
#define pp_socket Perl_pp_socket
#define pp_sockpair Perl_pp_sockpair
#define pp_sort Perl_pp_sort
-#define pp_specific Perl_pp_specific
#define pp_splice Perl_pp_splice
#define pp_split Perl_pp_split
#define pp_sprintf Perl_pp_sprintf
#define sv_insert Perl_sv_insert
#define sv_isa Perl_sv_isa
#define sv_isobject Perl_sv_isobject
+#define sv_iv Perl_sv_iv
#define sv_len Perl_sv_len
#define sv_magic Perl_sv_magic
#define sv_mortalcopy Perl_sv_mortalcopy
#define sv_newmortal Perl_sv_newmortal
#define sv_newref Perl_sv_newref
#define sv_no Perl_sv_no
+#define sv_nv Perl_sv_nv
#define sv_peek Perl_sv_peek
#define sv_pvn_force Perl_sv_pvn_force
#define sv_ref Perl_sv_ref
#define sv_setuv Perl_sv_setuv
#define sv_taint Perl_sv_taint
#define sv_tainted Perl_sv_tainted
+#define sv_true Perl_sv_true
#define sv_undef Perl_sv_undef
#define sv_unmagic Perl_sv_unmagic
#define sv_unref Perl_sv_unref
#define sv_untaint Perl_sv_untaint
#define sv_upgrade Perl_sv_upgrade
#define sv_usepvn Perl_sv_usepvn
+#define sv_uv Perl_sv_uv
#define sv_vcatpvfn Perl_sv_vcatpvfn
#define sv_vsetpvfn Perl_sv_vsetpvfn
#define sv_yes Perl_sv_yes
#ifndef BINCOMPAT3
#define Error Perl_Error
-#define SvIV Perl_SvIV
-#define SvNV Perl_SvNV
-#define SvTRUE Perl_SvTRUE
-#define SvUV Perl_SvUV
#define block_type Perl_block_type
#define boot_core_UNIVERSAL Perl_boot_core_UNIVERSAL
#define comppad_name_floor Perl_comppad_name_floor
#define e_tmpname (curinterp->Ie_tmpname)
#define endav (curinterp->Iendav)
#define envgv (curinterp->Ienvgv)
-#define errhv (curinterp->Ierrhv)
-#define errsv (curinterp->Ierrsv)
+#define errgv (curinterp->Ierrgv)
#define eval_root (curinterp->Ieval_root)
#define eval_start (curinterp->Ieval_start)
#define fdpid (curinterp->Ifdpid)
#define incgv (curinterp->Iincgv)
#define initav (curinterp->Iinitav)
#define inplace (curinterp->Iinplace)
-#define keys (curinterp->Ikeys)
-#define keys_mutex (curinterp->Ikeys_mutex)
#define last_in_gv (curinterp->Ilast_in_gv)
#define lastfd (curinterp->Ilastfd)
#define lastretstr (curinterp->Ilastretstr)
#define lineary (curinterp->Ilineary)
#define localizing (curinterp->Ilocalizing)
#define localpatches (curinterp->Ilocalpatches)
-#define magical_keys (curinterp->Imagical_keys)
#define main_cv (curinterp->Imain_cv)
#define main_root (curinterp->Imain_root)
#define main_start (curinterp->Imain_start)
#define Ie_tmpname e_tmpname
#define Iendav endav
#define Ienvgv envgv
-#define Ierrhv errhv
-#define Ierrsv errsv
+#define Ierrgv errgv
#define Ieval_root eval_root
#define Ieval_start eval_start
#define Ifdpid fdpid
#define Iincgv incgv
#define Iinitav initav
#define Iinplace inplace
-#define Ikeys keys
-#define Ikeys_mutex keys_mutex
#define Ilast_in_gv last_in_gv
#define Ilastfd lastfd
#define Ilastretstr lastretstr
#define Ilineary lineary
#define Ilocalizing localizing
#define Ilocalpatches localpatches
-#define Imagical_keys magical_keys
#define Imain_cv main_cv
#define Imain_root main_root
#define Imain_start main_start
#define e_fp Perl_e_fp
#define e_tmpname Perl_e_tmpname
#define endav Perl_endav
-#define errhv Perl_errhv
-#define errsv Perl_errsv
+#define errgv Perl_errgv
#define eval_root Perl_eval_root
#define eval_start Perl_eval_start
#define fdpid Perl_fdpid
#define incgv Perl_incgv
#define initav Perl_initav
#define inplace Perl_inplace
-#define keys Perl_keys
-#define keys_mutex Perl_keys_mutex
#define last_in_gv Perl_last_in_gv
#define lastfd Perl_lastfd
#define lastretstr Perl_lastretstr
#define lineary Perl_lineary
#define localizing Perl_localizing
#define localpatches Perl_localpatches
-#define magical_keys Perl_magical_keys
#define main_cv Perl_main_cv
#define main_root Perl_main_root
#define main_start Perl_main_start
extern datum nullitem;
-#ifdef __STDC__
+#if defined(__STDC__) || defined(__cplusplus)
#define proto(p) p
#else
#define proto(p) ()
#endif
#endif /* Include guard */
+
#else
Thread thr = (Thread) arg;
LOGOP myop;
- dSP;
+ djSP;
I32 oldmark = TOPMARK;
I32 oldscope = scopestack_ix;
I32 retval;
newthread (SV *startsv, AV *initargs, char *Class)
{
#ifdef USE_THREADS
- dTHR;
dSP;
Thread savethread;
int i;
#endif
savethread = thr;
- thr = new_struct_thread(thr);
+ sv = newSVpv("", 0);
+ SvGROW(sv, sizeof(struct thread) + 1);
+ SvCUR_set(sv, sizeof(struct thread));
+ thr = (Thread) SvPVX(sv);
+ DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: newthread(%s) = %p)\n",
+ savethread, SvPEEK(startsv), thr));
+ oursv = sv;
+ /* If we don't zero these foostack pointers, init_stacks won't init them */
+ markstack = 0;
+ scopestack = 0;
+ savestack = 0;
+ retstack = 0;
init_stacks(ARGS);
+ curcop = savethread->Tcurcop; /* XXX As good a guess as any? */
SPAGAIN;
+ defstash = savethread->Tdefstash; /* XXX maybe these should */
+ curstash = savethread->Tcurstash; /* always be set to main? */
+ /* top_env? */
+ /* runlevel */
+ cvcache = newHV();
+ thr->flags = THRf_R_JOINABLE;
+ MUTEX_INIT(&thr->mutex);
+ thr->tid = ++threadnum;
+ /* Insert new thread into the circular linked list and bump nthreads */
+ MUTEX_LOCK(&threads_mutex);
+ thr->next = savethread->next;
+ thr->prev = savethread;
+ savethread->next = thr;
+ thr->next->prev = thr;
+ nthreads++;
+ MUTEX_UNLOCK(&threads_mutex);
+
DEBUG_L(PerlIO_printf(PerlIO_stderr(),
"%p: newthread, tid is %u, preparing stack\n",
savethread, thr->tid));
RETVAL = c ? psig_ptr[c] : &sv_no;
OUTPUT:
RETVAL
+
in_my_stash
inc_amg
io_close
-key_create
-key_destroy
know_next
last_lop
last_lop_op
ncmp_amg
ne_amg
neg_amg
-new_struct_thread
nexttoke
nexttype
nextval
padix
padix_floor
patleave
-per_thread_magicals
pidstatus
pow_amg
pow_ass_amg
# Functions
Gv_AMupdate
-SvTRUE
-SvIV
-SvUV
-SvNV
+sv_true
+sv_iv
+sv_uv
+sv_nv
amagic_call
append_elem
append_list
newPVOP
newRANGE
newRV
+newRV_noinc
newSLICEOP
newSTATEOP
newSUB
pp_socket
pp_sockpair
pp_sort
-pp_specific
pp_splice
pp_split
pp_sprintf
(cv = GvCV(gv)) &&
(CvROOT(cv) || CvXSUB(cv)))
{
+ dTHR; /* just for SvREFCNT_inc */
if (cv = GvCV(topgv))
SvREFCNT_dec(cv);
GvCV(topgv) = (CV*)SvREFCNT_inc(GvCV(gv));
|| inc_dec_ass) RvDEEPCP(left);
}
{
- dTHR;
dSP;
BINOP myop;
SV* res;
}
}
#endif /* OVERLOAD */
+
xhv = (XPVHV*)SvANY(hv);
if (SvMAGICAL(hv)) {
- dTHR;
bool save_taint = tainted;
if (tainting)
tainted = SvTAINTED(keysv);
}
magic_nextpack((SV*) hv,mg,key);
if (SvOK(key)) {
+ dTHR; /* just for SvREFCNT_inc */
/* force key to stay around until next time */
HeSVKEY_set(entry, SvREFCNT_inc(key));
return entry; /* beware, hent_val is not set */
e_tmpname
endav
envgv
-errhv
-errsv
+errgv
eval_root
eval_start
fdpid
incgv
initav
inplace
-keys
-keys_mutex
last_in_gv
lastfd
lastretstr
lineary
localizing
localpatches
-magical_keys
main_cv
main_root
main_start
U32
magic_len(SV *sv, MAGIC *mg)
{
- dTHR;
register I32 paren;
register char *s;
register I32 i;
int
magic_get(SV *sv, MAGIC *mg)
{
- dTHR;
register I32 paren;
register char *s;
register I32 i;
case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9': case '&':
if (curpm && (rx = curpm->op_pmregexp)) {
- /*
- * Pre-threads, this was paren = atoi(GvENAME((GV*)mg->mg_obj));
- * XXX Does the new way break anything?
- */
- paren = atoi(mg->mg_ptr);
+ paren = atoi(GvENAME((GV*)mg->mg_obj));
getparen:
if (paren <= rx->nparens &&
(s = rx->startp[paren]) &&
break;
case '0':
break;
-#ifdef USE_THREADS
- case '@':
- sv_setsv(sv, errsv);
- break;
-#endif /* USE_THREADS */
}
return 0;
}
if(psig_ptr[i])
sv_setsv(sv,psig_ptr[i]);
else {
+ dTHR; /* just for SvREFCNT_inc */
Sighandler_t sigstate = rsignal_state(i);
/* cache state so we don't fetch it again */
static int
magic_methpack(SV *sv, MAGIC *mg, char *meth)
{
- dTHR;
dSP;
ENTER;
int
magic_setpack(SV *sv, MAGIC *mg)
{
- dTHR;
dSP;
PUSHMARK(sp);
int magic_wipepack(SV *sv, MAGIC *mg)
{
- dTHR;
dSP;
PUSHMARK(sp);
int
magic_nextpack(SV *sv, MAGIC *mg, SV *key)
{
- dTHR;
dSP;
char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
int
magic_gettaint(SV *sv, MAGIC *mg)
{
- dTHR;
TAINT_IF((mg->mg_len & 1) ||
(mg->mg_len & 2) && mg->mg_obj == sv); /* kludge */
return 0;
origargv[i] = Nullch;
}
break;
-#ifdef USE_THREADS
- case '@':
- sv_setsv(errsv, sv);
- break;
-#endif /* USE_THREADS */
}
return 0;
}
Signal_t
sighandler(int sig)
{
- dTHR;
dSP;
GV *gv;
HV *st;
Xpv = tXpv;
return;
}
+
+
#pragma runopts(HEAP(1M,32K,ANYWHERE,KEEP,8K,4K))
#endif
-#ifdef __cplusplus
-extern "C" {
-#endif
#include "EXTERN.h"
#include "perl.h"
+#undef EXTERN_C
#ifdef __cplusplus
-}
# define EXTERN_C extern "C"
#else
# define EXTERN_C extern
PERL_SYS_TERM();
exit( exitstatus );
+ return exitstatus;
}
/* Register any extra external extensions */
warn("Variable \"%s\" will not stay shared", name);
}
}
- av_store(comppad, newoff, oldsv ? SvREFCNT_inc(oldsv) : 0);
+ av_store(comppad, newoff, SvREFCNT_inc(oldsv));
return newoff;
}
}
pad_reset_pending = FALSE;
}
-#ifdef USE_THREADS
-PADOFFSET
-find_thread_magical(name)
-char *name;
-{
- dTHR;
- char *p;
- PADOFFSET key;
- /* We currently only handle single character magicals */
- p = strchr(per_thread_magicals, *name);
- if (!p)
- return NOT_IN_PAD;
- key = magical_keys[p - per_thread_magicals];
- if (key == NOT_IN_PAD) {
- SV *sv;
- key = magical_keys[p - per_thread_magicals] = key_create();
- sv = NEWSV(0, 0);
- av_store(thr->specific, key, sv);
- sv_magic(sv, 0, 0, name, 1);
- DEBUG_L(PerlIO_printf(PerlIO_stderr(),
- "find_thread_magical: key %d new SV %p for %d\n",
- (int)key, sv, (int)*name));
- }
- return key;
-}
-#endif /* USE_THREADS */
-
/* Destructor */
void
goto nomod;
/* FALL THROUGH */
case OP_PADSV:
- case OP_SPECIFIC:
modcount++;
if (!type)
croak("Can't localize lexical variable %s",
}
break;
- case OP_SPECIFIC:
- o->op_flags |= OPf_MOD; /* XXX ??? */
- break;
-
case OP_RV2AV:
case OP_RV2HV:
o->op_flags |= OPf_REF;
else if (curop->op_type == OP_PADSV ||
curop->op_type == OP_PADAV ||
curop->op_type == OP_PADHV ||
- curop->op_type == OP_PADANY ||
- curop->op_type == OP_SPECIFIC) {
+ curop->op_type == OP_PADANY) {
/* is okay */
}
else
croak(not_safe);
else {
/* force display of errors found but not reported */
- sv_catpv(errsv, not_safe);
- croak("%s", SvPV(errsv, na));
+ sv_catpv(GvSV(errgv), not_safe);
+ croak("%s", SvPVx(GvSV(errgv), na));
}
}
}
o->op_ppaddr = ppaddr[OP_PADSV];
return o;
}
- else if (o->op_type == OP_SPECIFIC)
- return o;
return newUNOP(OP_RV2SV, 0, scalar(o));
}
#define BASEOP \
OP* op_next; \
OP* op_sibling; \
- OP* (*op_ppaddr)(); \
+ OP* (*op_ppaddr)_((ARGSproto)); \
PADOFFSET op_targ; \
OPCODE op_type; \
U16 op_seq; \
OP_GETLOGIN, /* 342 */
OP_SYSCALL, /* 343 */
OP_LOCK, /* 344 */
- OP_SPECIFIC, /* 345 */
OP_max
} opcode;
-#define MAXO 346
+#define MAXO 345
#ifndef DOINIT
EXT char *op_name[];
"getlogin",
"syscall",
"lock",
- "specific",
};
#endif
"getlogin",
"syscall",
"lock",
- "thread-specific",
};
#endif
+START_EXTERN_C
+
OP * ck_anoncode _((OP* o));
OP * ck_bitop _((OP* o));
OP * ck_concat _((OP* o));
OP * pp_getlogin _((ARGSproto));
OP * pp_syscall _((ARGSproto));
OP * pp_lock _((ARGSproto));
-OP * pp_specific _((ARGSproto));
+
+
+END_EXTERN_C
#ifndef DOINIT
-EXT OP * (*ppaddr[])();
+EXT OP * (*ppaddr[])_((ARGSproto));
#else
-EXT OP * (*ppaddr[])() = {
+EXT OP * (*ppaddr[])_((ARGSproto)) = {
pp_null,
pp_stub,
pp_scalar,
pp_getlogin,
pp_syscall,
pp_lock,
- pp_specific,
};
#endif
ck_null, /* getlogin */
ck_fun, /* syscall */
ck_rfun, /* lock */
- ck_null, /* specific */
};
#endif
0x0000000c, /* getlogin */
0x0002151d, /* syscall */
0x00001c04, /* lock */
- 0x00000044, /* specific */
};
#endif
+
$argsum |= 128 if $flags =~ /u/; # defaults to $_
$flags =~ /([^a-zA-Z])/ or die qq[Opcode "$_" has no class indicator];
+ printf STDERR "op $_, class $1 => 0x%x, argsum 0x%x",
+ $opclass{$1}, $argsum; # debug
$argsum |= $opclass{$1} << 8;
$mul = 4096; # 2 ^ OASHIFT
for $arg (split(' ',$args{$_})) {
$argsum += $argnum * $mul;
$mul <<= 4;
}
+ printf STDERR ", argsum now 0x%x\n", $argsum; # debug
$argsum = sprintf("0x%08x", $argsum);
print "\t", &tab(3, "$argsum,"), "/* $_ */\n";
}
# For multi-threading
lock lock ck_rfun s% S
-specific thread-specific ck_null ds0
#define PATCHLEVEL 4
-#define SUBVERSION 54
+#define SUBVERSION 52
/*
local_patches -- list of locally applied less-than-subversion patches.
void
perl_construct(register PerlInterpreter *sv_interp)
{
-#ifdef USE_THREADS
- int i;
-#ifndef FAKE_THREADS
+#if defined(USE_THREADS) && !defined(FAKE_THREADS)
struct thread *thr;
-#endif /* FAKE_THREADS */
-#endif /* USE_THREADS */
+#endif
if (!(curinterp = sv_interp))
return;
/* Init the real globals (and main thread)? */
if (!linestr) {
#ifdef USE_THREADS
+ XPV *xpv;
INIT_THREADS;
-#ifndef WIN32
- if (pthread_key_create(&thr_key, 0))
- croak("panic: pthread_key_create");
-#endif
+ Newz(53, thr, 1, struct thread);
MUTEX_INIT(&malloc_mutex);
MUTEX_INIT(&sv_mutex);
- /*
- * Safe to use basic SV functions from now on (though
- * not things like mortals or tainting yet).
- */
+ /* Safe to use SVs from now on */
MUTEX_INIT(&eval_mutex);
COND_INIT(&eval_cond);
MUTEX_INIT(&threads_mutex);
COND_INIT(&nthreads_cond);
- MUTEX_INIT(&keys_mutex);
-
- thr = new_struct_thread(0);
+ nthreads = 1;
+ cvcache = newHV();
+ curcop = &compiling;
+ thr->flags = THRf_R_JOINABLE;
+ MUTEX_INIT(&thr->mutex);
+ thr->next = thr;
+ thr->prev = thr;
+ thr->tid = 0;
+
+ /* Handcraft thrsv similarly to mess_sv */
+ New(53, thrsv, 1, SV);
+ Newz(53, xpv, 1, XPV);
+ SvFLAGS(thrsv) = SVt_PV;
+ SvANY(thrsv) = (void*)xpv;
+ SvREFCNT(thrsv) = 1 << 30; /* practically infinite */
+ SvPVX(thrsv) = (char*)thr;
+ SvCUR_set(thrsv, sizeof(thr));
+ SvLEN_set(thrsv, sizeof(thr));
+ *SvEND(thrsv) = '\0'; /* in the trailing_nul field */
+ oursv = thrsv;
+#ifdef HAVE_THREAD_INTERN
+ init_thread_intern(thr);
+#else
+ thr->self = pthread_self();
+ if (pthread_key_create(&thr_key, 0))
+ croak("panic: pthread_key_create");
+#endif /* HAVE_THREAD_INTERN */
+ SET_THR(thr);
#endif /* USE_THREADS */
linestr = NEWSV(65,80);
fdpid = newAV(); /* for remembering popen pids by fd */
- for (i = 0; i < N_PER_THREAD_MAGICALS; i++)
- magical_keys[i] = NOT_IN_PAD;
- keys = newSVpv("", 0);
init_stacks(ARGS);
DEBUG( {
New(51,debname,128,char);
envgv = Nullgv;
siggv = Nullgv;
incgv = Nullgv;
- errhv = Nullhv;
- errsv = Nullsv;
+ errgv = Nullgv;
argvgv = Nullgv;
argvoutgv = Nullgv;
stdingv = Nullgv;
/* now that script is parsed, we can modify record separator */
SvREFCNT_dec(rs);
rs = SvREFCNT_inc(nrs);
-#ifdef USE_THREADS
- sv_setsv(*av_fetch(thr->specific, find_thread_magical("/"), TRUE), rs);
-#else
sv_setsv(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), rs);
-#endif /* USE_THREADS */
+
if (do_undump)
my_unexec();
/* See G_* flags in cop.h */
/* null terminated arg list */
{
- dTHR;
dSP;
PUSHMARK(sp);
/* name of the subroutine */
/* See G_* flags in cop.h */
{
- dTHR;
dSP;
OP myop;
if (!op)
if (flags & G_KEEPERR)
in_eval |= 4;
else
- sv_setpv(errsv,"");
+ sv_setpv(GvSV(errgv),"");
}
markstack_ptr++;
runops();
retval = stack_sp - (stack_base + oldmark);
if ((flags & G_EVAL) && !(flags & G_KEEPERR))
- sv_setpv(errsv,"");
+ sv_setpv(GvSV(errgv),"");
cleanup:
if (flags & G_EVAL) {
runops();
retval = stack_sp - (stack_base + oldmark);
if (!(flags & G_KEEPERR))
- sv_setpv(errsv,"");
+ sv_setpv(GvSV(errgv),"");
cleanup:
JMPENV_POP;
SV*
perl_eval_pv(char *p, I32 croak_on_error)
{
- dTHR;
dSP;
SV* sv = newSVpv(p, 0);
sv = POPs;
PUTBACK;
- if (croak_on_error && SvTRUE(errsv))
- croak(SvPV(errsv, na));
+ if (croak_on_error && SvTRUE(GvSV(errgv)))
+ croak(SvPVx(GvSV(errgv), na));
return sv;
}
switch (*s) {
case '0':
- {
- dTHR;
rschar = scan_oct(s, 4, &numlen);
SvREFCNT_dec(nrs);
if (rschar & ~((U8)~0))
nrs = newSVpv(&ch, 1);
}
return s + numlen;
- }
case 'F':
minus_F = TRUE;
splitstr = savepv(s + 1);
s += numlen;
}
else {
- dTHR;
if (RsPARA(nrs)) {
ors = "\n\n";
orslen = 2;
incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
GvMULTI_on(incgv);
defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
- errsv = newSVpv("", 0);
- errhv = newHV();
+ errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
+ GvMULTI_on(errgv);
(void)form("%240s",""); /* Preallocate temp - for immediate signals. */
- sv_grow(errsv, 240); /* Preallocate - for immediate signals. */
- sv_setpvn(errsv, "", 0);
+ sv_grow(GvSV(errgv), 240); /* Preallocate - for immediate signals. */
+ sv_setpvn(GvSV(errgv), "", 0);
curstash = defstash;
compiling.cop_stash = defstash;
debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
GV *tmpgv;
GV *othergv;
-#ifdef USE_THREADS
- sv_setpvn(*av_fetch(thr->specific,find_thread_magical("\""),TRUE), " ", 1);
-#else
sv_setpvn(GvSV(gv_fetchpv("\"", TRUE, SVt_PV)), " ", 1);
-#endif /* USE_THREADS */
stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
GvMULTI_on(stdingv);
static void
init_postdump_symbols(register int argc, register char **argv, register char **env)
{
- dTHR;
char *s;
SV *sv;
GV* tmpgv;
JMPENV_PUSH(ret);
switch (ret) {
case 0: {
- SV* atsv = sv_mortalcopy(errsv);
+ SV* atsv = GvSV(errgv);
PUSHMARK(stack_sp);
perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
(void)SvPV(atsv, len);
dTHR;
#ifdef USE_THREADS
- DEBUG_L(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n",
- thr, (unsigned long) status));
+ DEBUG_L(PerlIO_printf(Perl_debug_log, "my_exit: thread 0x%lx, status %lu\n",
+ (unsigned long) thr, (unsigned long) status));
#endif /* USE_THREADS */
switch (status) {
case 0:
JMPENV_JUMP(2);
}
+
#include "embed.h"
+#ifdef __cplusplus
+# define START_EXTERN_C extern "C" {
+# define END_EXTERN_C }
+# define EXTERN_C extern "C"
+#else
+# define START_EXTERN_C
+# define END_EXTERN_C
+# define EXTERN_C
+#endif
+
+#if defined(USE_THREADS) /* && !defined(PERL_CORE) && !defined(PERLDLL) */
+#ifndef CRIPPLED_CC
+#define CRIPPLED_CC
+#endif
+#endif
+
#ifdef OP_IN_REGISTER
# ifdef __GNUC__
# define stringify_immed(s) #s
#define WITH_THR(s) do { dTHR; s; } while (0)
-#ifdef USE_THREADS
-# ifdef FAKE_THREADS
-# include "fakethr.h"
-# else
-# ifdef WIN32
-# include <win32thread.h>
-# else
-# include <pthread.h>
-typedef pthread_mutex_t perl_mutex;
-typedef pthread_cond_t perl_cond;
-typedef pthread_key_t perl_key;
-# endif /* WIN32 */
-# endif /* FAKE_THREADS */
-#endif /* USE_THREADS */
-
/*
* SOFT_CAST can be used for args to prototyped functions to retain some
* type checking; it only casts if the compiler does not know prototypes.
# include "unixish.h"
# endif
# endif
-#endif
+#endif
+
+/*
+ * USE_THREADS needs to be after unixish.h as <pthread.h> includes <sys/signal.h>
+ * which defines NSIG - which will stop inclusion of <signal.h>
+ * this results in many functions being undeclared which bothers C++
+ * May make sense to have threads after "*ish.h" anyway
+ */
+
+#ifdef USE_THREADS
+# ifdef FAKE_THREADS
+# include "fakethr.h"
+# else
+# ifdef WIN32
+# include <win32thread.h>
+# else
+# include <pthread.h>
+typedef pthread_mutex_t perl_mutex;
+typedef pthread_cond_t perl_cond;
+typedef pthread_key_t perl_key;
+# endif /* WIN32 */
+# endif /* FAKE_THREADS */
+#endif /* USE_THREADS */
+
+
#ifdef VMS
# define STATUS_NATIVE statusvalue_vms
#define U_I(what) ((unsigned int)(what))
#define U_L(what) ((U32)(what))
#else
-# ifdef __cplusplus
- extern "C" {
-# endif
-U32 cast_ulong _((double));
-# ifdef __cplusplus
- }
-# endif
+EXTERN_C U32 cast_ulong _((double));
#define U_S(what) ((U16)cast_ulong((double)(what)))
#define U_I(what) ((unsigned int)cast_ulong((double)(what)))
#define U_L(what) (cast_ulong((double)(what)))
#define I_V(what) ((IV)(what))
#define U_V(what) ((UV)(what))
#else
-# ifdef __cplusplus
- extern "C" {
-# endif
+START_EXTERN_C
I32 cast_i32 _((double));
IV cast_iv _((double));
UV cast_uv _((double));
-# ifdef __cplusplus
- }
-# endif
+END_EXTERN_C
#define I_32(what) (cast_i32((double)(what)))
#define I_V(what) (cast_iv((double)(what)))
#define U_V(what) (cast_uv((double)(what)))
#ifdef I_MATH
# include <math.h>
#else
-# ifdef __cplusplus
- extern "C" {
-# endif
+START_EXTERN_C
double exp _((double));
double log _((double));
double log10 _((double));
double cos _((double));
double atan2 _((double,double));
double pow _((double,double));
-# ifdef __cplusplus
- };
-# endif
+END_EXTERN_C
#endif
#ifndef __cplusplus
int runops_debug _((void));
#endif
-#define PER_THREAD_MAGICALS "123456789&`'+/.,\\\";^-%=|~:\001\005!@"
-#define N_PER_THREAD_MAGICALS 30
-
/****************/
/* Truly global */
/****************/
EXT int nthreads; /* Number of threads currently */
EXT perl_mutex threads_mutex; /* Mutex for nthreads and thread list */
EXT perl_cond nthreads_cond; /* Condition variable for nthreads */
-EXT char * per_thread_magicals INIT(PER_THREAD_MAGICALS);
#ifdef FAKE_THREADS
EXT struct thread * thr; /* Currently executing (fake) thread */
#endif
IEXT SV * Ilastscream;
/* shortcuts to misc objects */
-IEXT HV * Ierrhv;
-IEXT SV * Ierrsv;
+IEXT GV * Ierrgv;
/* shortcuts to debugging objects */
IEXT GV * IDBgv;
#ifdef USE_THREADS
/* threads stuff */
IEXT SV * Ithrsv; /* holds struct thread for main thread */
-IEXT perl_mutex Ikeys_mutex; /* protects keys and magical_keys */
-IEXT SV * Ikeys; /* each char marks a per-thread key in-use */
-IEXT PADOFFSET Imagical_keys[N_PER_THREAD_MAGICALS];
- /* index is position in per_thread_magicals */
#endif /* USE_THREADS */
#undef IEXT
#include "thread.h"
#include "pp.h"
-#ifdef __cplusplus
-extern "C" {
-#endif
-
+START_EXTERN_C
#include "proto.h"
#ifdef EMBED
#define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,(IV)ptr)
#endif
-#ifdef __cplusplus
-};
-#endif
+END_EXTERN_C
/* The following must follow proto.h */
static double UV_MAX_cxux = ((double)UV_MAX);
#endif
-#ifdef HAS_CRYPT
-#ifdef __cplusplus
-#ifdef FCRYPT
-extern "C" char *fcrypt(char *,char *);
-#else
-extern "C" char *crypt(char *,char *);
-#endif
-#endif
-#endif
-
/*
* Types used in bitwise operations.
*
PP(pp_stub)
{
- dSP;
+ djSP;
if (GIMME_V == G_SCALAR)
XPUSHs(&sv_undef);
RETURN;
PP(pp_padav)
{
- dSP; dTARGET;
+ djSP; dTARGET;
if (op->op_private & OPpLVAL_INTRO)
SAVECLEARSV(curpad[op->op_targ]);
EXTEND(SP, 1);
PP(pp_padhv)
{
- dSP; dTARGET;
+ djSP; dTARGET;
I32 gimme;
XPUSHs(TARG);
PP(pp_rv2gv)
{
- dSP; dTOPss;
+ djSP; dTOPss;
if (SvROK(sv)) {
wasref:
PP(pp_rv2sv)
{
- dSP; dTOPss;
+ djSP; dTOPss;
if (SvROK(sv)) {
wasref:
PP(pp_av2arylen)
{
- dSP;
+ djSP;
AV *av = (AV*)TOPs;
SV *sv = AvARYLEN(av);
if (!sv) {
PP(pp_pos)
{
- dSP; dTARGET; dPOPss;
+ djSP; dTARGET; dPOPss;
if (op->op_flags & OPf_MOD) {
if (SvTYPE(TARG) < SVt_PVLV) {
PP(pp_rv2cv)
{
- dSP;
+ djSP;
GV *gv;
HV *stash;
PP(pp_prototype)
{
- dSP;
+ djSP;
CV *cv;
HV *stash;
GV *gv;
PP(pp_anoncode)
{
- dSP;
+ djSP;
CV* cv = (CV*)curpad[op->op_targ];
if (CvCLONE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
PP(pp_srefgen)
{
- dSP;
+ djSP;
*SP = refto(*SP);
RETURN;
}
PP(pp_refgen)
{
- dSP; dMARK;
+ djSP; dMARK;
if (GIMME != G_ARRAY) {
MARK[1] = *SP;
SP = MARK + 1;
else if (SvPADTMP(sv))
sv = newSVsv(sv);
else {
+ dTHR; /* just for SvREFCNT_inc */
SvTEMP_off(sv);
(void)SvREFCNT_inc(sv);
}
PP(pp_ref)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SV *sv;
char *pv;
PP(pp_bless)
{
- dSP;
+ djSP;
HV *stash;
if (MAXARG == 1)
SV *sv;
SV *ref;
char *elem;
- dSP;
+ djSP;
sv = POPs;
elem = SvPV(sv, na);
PP(pp_study)
{
- dSP; dPOPss;
+ djSP; dPOPss;
register unsigned char *s;
register I32 pos;
register I32 ch;
PP(pp_trans)
{
- dSP; dTARG;
+ djSP; dTARG;
SV *sv;
if (op->op_flags & OPf_STACKED)
PP(pp_schop)
{
- dSP; dTARGET;
+ djSP; dTARGET;
do_chop(TARG, TOPs);
SETTARG;
RETURN;
PP(pp_chop)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
while (SP > MARK)
do_chop(TARG, POPs);
PUSHTARG;
PP(pp_schomp)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SETi(do_chomp(TOPs));
RETURN;
}
PP(pp_chomp)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
register I32 count = 0;
while (SP > MARK)
PP(pp_defined)
{
- dSP;
+ djSP;
register SV* sv;
sv = POPs;
PP(pp_undef)
{
- dSP;
+ djSP;
SV *sv;
if (!op->op_private) {
PP(pp_predec)
{
- dSP;
+ djSP;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
croak(no_modify);
if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
PP(pp_postinc)
{
- dSP; dTARGET;
+ djSP; dTARGET;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
croak(no_modify);
sv_setsv(TARG, TOPs);
PP(pp_postdec)
{
- dSP; dTARGET;
+ djSP; dTARGET;
if(SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
croak(no_modify);
sv_setsv(TARG, TOPs);
PP(pp_pow)
{
- dSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
{
dPOPTOPnnrl;
SETn( pow( left, right) );
PP(pp_multiply)
{
- dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
{
dPOPTOPnnrl;
SETn( left * right );
PP(pp_divide)
{
- dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
{
dPOPPOPnnrl;
double value;
PP(pp_modulo)
{
- dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
{
UV left;
UV right;
if (right_neg) {
/* XXX may warn: unary minus operator applied to unsigned type */
/* could change -foo to be (~foo)+1 instead */
- if (ans <= -(UV)IV_MAX)
- sv_setiv(TARG, (IV) -ans);
+ if (ans <= ~((UV)IV_MAX)+1)
+ sv_setiv(TARG, ~ans+1);
else
sv_setnv(TARG, -(double)ans);
}
PP(pp_repeat)
{
- dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
{
register I32 count = POPi;
if (GIMME == G_ARRAY && op->op_private & OPpREPEAT_DOLIST) {
PP(pp_subtract)
{
- dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
{
dPOPTOPnnrl_ul;
SETn( left - right );
PP(pp_left_shift)
{
- dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
{
IBW shift = POPi;
if (op->op_private & HINT_INTEGER) {
PP(pp_right_shift)
{
- dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
{
IBW shift = POPi;
if (op->op_private & HINT_INTEGER) {
PP(pp_lt)
{
- dSP; tryAMAGICbinSET(lt,0);
+ djSP; tryAMAGICbinSET(lt,0);
{
dPOPnv;
SETs(boolSV(TOPn < value));
PP(pp_gt)
{
- dSP; tryAMAGICbinSET(gt,0);
+ djSP; tryAMAGICbinSET(gt,0);
{
dPOPnv;
SETs(boolSV(TOPn > value));
PP(pp_le)
{
- dSP; tryAMAGICbinSET(le,0);
+ djSP; tryAMAGICbinSET(le,0);
{
dPOPnv;
SETs(boolSV(TOPn <= value));
PP(pp_ge)
{
- dSP; tryAMAGICbinSET(ge,0);
+ djSP; tryAMAGICbinSET(ge,0);
{
dPOPnv;
SETs(boolSV(TOPn >= value));
PP(pp_ne)
{
- dSP; tryAMAGICbinSET(ne,0);
+ djSP; tryAMAGICbinSET(ne,0);
{
dPOPnv;
SETs(boolSV(TOPn != value));
PP(pp_ncmp)
{
- dSP; dTARGET; tryAMAGICbin(ncmp,0);
+ djSP; dTARGET; tryAMAGICbin(ncmp,0);
{
dPOPTOPnnrl;
I32 value;
PP(pp_slt)
{
- dSP; tryAMAGICbinSET(slt,0);
+ djSP; tryAMAGICbinSET(slt,0);
{
dPOPTOPssrl;
int cmp = ((op->op_private & OPpLOCALE)
PP(pp_sgt)
{
- dSP; tryAMAGICbinSET(sgt,0);
+ djSP; tryAMAGICbinSET(sgt,0);
{
dPOPTOPssrl;
int cmp = ((op->op_private & OPpLOCALE)
PP(pp_sle)
{
- dSP; tryAMAGICbinSET(sle,0);
+ djSP; tryAMAGICbinSET(sle,0);
{
dPOPTOPssrl;
int cmp = ((op->op_private & OPpLOCALE)
PP(pp_sge)
{
- dSP; tryAMAGICbinSET(sge,0);
+ djSP; tryAMAGICbinSET(sge,0);
{
dPOPTOPssrl;
int cmp = ((op->op_private & OPpLOCALE)
PP(pp_seq)
{
- dSP; tryAMAGICbinSET(seq,0);
+ djSP; tryAMAGICbinSET(seq,0);
{
dPOPTOPssrl;
SETs(boolSV(sv_eq(left, right)));
PP(pp_sne)
{
- dSP; tryAMAGICbinSET(sne,0);
+ djSP; tryAMAGICbinSET(sne,0);
{
dPOPTOPssrl;
SETs(boolSV(!sv_eq(left, right)));
PP(pp_scmp)
{
- dSP; dTARGET; tryAMAGICbin(scmp,0);
+ djSP; dTARGET; tryAMAGICbin(scmp,0);
{
dPOPTOPssrl;
int cmp = ((op->op_private & OPpLOCALE)
PP(pp_bit_and)
{
- dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(band,opASSIGN);
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
PP(pp_bit_xor)
{
- dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
PP(pp_bit_or)
{
- dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
PP(pp_negate)
{
- dSP; dTARGET; tryAMAGICun(neg);
+ djSP; dTARGET; tryAMAGICun(neg);
{
dTOPss;
if (SvGMAGICAL(sv))
PP(pp_not)
{
#ifdef OVERLOAD
- dSP; tryAMAGICunSET(not);
+ djSP; tryAMAGICunSET(not);
#endif /* OVERLOAD */
*stack_sp = boolSV(!SvTRUE(*stack_sp));
return NORMAL;
PP(pp_complement)
{
- dSP; dTARGET; tryAMAGICun(compl);
+ djSP; dTARGET; tryAMAGICun(compl);
{
dTOPss;
if (SvNIOKp(sv)) {
PP(pp_i_multiply)
{
- dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
{
dPOPTOPiirl;
SETi( left * right );
PP(pp_i_divide)
{
- dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
{
dPOPiv;
if (value == 0)
PP(pp_i_modulo)
{
- dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
{
dPOPTOPiirl;
if (!right)
PP(pp_i_add)
{
- dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(add,opASSIGN);
{
dPOPTOPiirl;
SETi( left + right );
PP(pp_i_subtract)
{
- dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
{
dPOPTOPiirl;
SETi( left - right );
PP(pp_i_lt)
{
- dSP; tryAMAGICbinSET(lt,0);
+ djSP; tryAMAGICbinSET(lt,0);
{
dPOPTOPiirl;
SETs(boolSV(left < right));
PP(pp_i_gt)
{
- dSP; tryAMAGICbinSET(gt,0);
+ djSP; tryAMAGICbinSET(gt,0);
{
dPOPTOPiirl;
SETs(boolSV(left > right));
PP(pp_i_le)
{
- dSP; tryAMAGICbinSET(le,0);
+ djSP; tryAMAGICbinSET(le,0);
{
dPOPTOPiirl;
SETs(boolSV(left <= right));
PP(pp_i_ge)
{
- dSP; tryAMAGICbinSET(ge,0);
+ djSP; tryAMAGICbinSET(ge,0);
{
dPOPTOPiirl;
SETs(boolSV(left >= right));
PP(pp_i_eq)
{
- dSP; tryAMAGICbinSET(eq,0);
+ djSP; tryAMAGICbinSET(eq,0);
{
dPOPTOPiirl;
SETs(boolSV(left == right));
PP(pp_i_ne)
{
- dSP; tryAMAGICbinSET(ne,0);
+ djSP; tryAMAGICbinSET(ne,0);
{
dPOPTOPiirl;
SETs(boolSV(left != right));
PP(pp_i_ncmp)
{
- dSP; dTARGET; tryAMAGICbin(ncmp,0);
+ djSP; dTARGET; tryAMAGICbin(ncmp,0);
{
dPOPTOPiirl;
I32 value;
PP(pp_i_negate)
{
- dSP; dTARGET; tryAMAGICun(neg);
+ djSP; dTARGET; tryAMAGICun(neg);
SETi(-TOPi);
RETURN;
}
PP(pp_atan2)
{
- dSP; dTARGET; tryAMAGICbin(atan2,0);
+ djSP; dTARGET; tryAMAGICbin(atan2,0);
{
dPOPTOPnnrl;
SETn(atan2(left, right));
PP(pp_sin)
{
- dSP; dTARGET; tryAMAGICun(sin);
+ djSP; dTARGET; tryAMAGICun(sin);
{
double value;
value = POPn;
PP(pp_cos)
{
- dSP; dTARGET; tryAMAGICun(cos);
+ djSP; dTARGET; tryAMAGICun(cos);
{
double value;
value = POPn;
PP(pp_rand)
{
- dSP; dTARGET;
+ djSP; dTARGET;
double value;
if (MAXARG < 1)
value = 1.0;
PP(pp_srand)
{
- dSP;
+ djSP;
UV anum;
if (MAXARG < 1)
anum = seed();
PP(pp_exp)
{
- dSP; dTARGET; tryAMAGICun(exp);
+ djSP; dTARGET; tryAMAGICun(exp);
{
double value;
value = POPn;
PP(pp_log)
{
- dSP; dTARGET; tryAMAGICun(log);
+ djSP; dTARGET; tryAMAGICun(log);
{
double value;
value = POPn;
PP(pp_sqrt)
{
- dSP; dTARGET; tryAMAGICun(sqrt);
+ djSP; dTARGET; tryAMAGICun(sqrt);
{
double value;
value = POPn;
PP(pp_int)
{
- dSP; dTARGET;
+ djSP; dTARGET;
{
double value = TOPn;
IV iv;
PP(pp_abs)
{
- dSP; dTARGET; tryAMAGICun(abs);
+ djSP; dTARGET; tryAMAGICun(abs);
{
double value = TOPn;
IV iv;
PP(pp_hex)
{
- dSP; dTARGET;
+ djSP; dTARGET;
char *tmps;
I32 argtype;
PP(pp_oct)
{
- dSP; dTARGET;
+ djSP; dTARGET;
UV value;
I32 argtype;
char *tmps;
PP(pp_length)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SETi( sv_len(TOPs) );
RETURN;
}
PP(pp_substr)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SV *sv;
I32 len;
STRLEN curlen;
PP(pp_vec)
{
- dSP; dTARGET;
+ djSP; dTARGET;
register I32 size = POPi;
register I32 offset = POPi;
register SV *src = POPs;
PP(pp_index)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SV *big;
SV *little;
I32 offset;
PP(pp_rindex)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SV *big;
SV *little;
STRLEN blen;
PP(pp_sprintf)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
#ifdef USE_LOCALE_NUMERIC
if (op->op_private & OPpLOCALE)
SET_NUMERIC_LOCAL();
PP(pp_ord)
{
- dSP; dTARGET;
+ djSP; dTARGET;
I32 value;
char *tmps;
PP(pp_chr)
{
- dSP; dTARGET;
+ djSP; dTARGET;
char *tmps;
(void)SvUPGRADE(TARG,SVt_PV);
PP(pp_crypt)
{
- dSP; dTARGET; dPOPTOPssrl;
+ djSP; dTARGET; dPOPTOPssrl;
#ifdef HAS_CRYPT
char *tmps = SvPV(left, na);
#ifdef FCRYPT
PP(pp_ucfirst)
{
- dSP;
+ djSP;
SV *sv = TOPs;
register char *s;
PP(pp_lcfirst)
{
- dSP;
+ djSP;
SV *sv = TOPs;
register char *s;
PP(pp_uc)
{
- dSP;
+ djSP;
SV *sv = TOPs;
register char *s;
STRLEN len;
PP(pp_lc)
{
- dSP;
+ djSP;
SV *sv = TOPs;
register char *s;
STRLEN len;
PP(pp_quotemeta)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SV *sv = TOPs;
STRLEN len;
register char *s = SvPV(sv,len);
PP(pp_aslice)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
register SV** svp;
register AV* av = (AV*)POPs;
register I32 lval = op->op_flags & OPf_MOD;
PP(pp_each)
{
- dSP; dTARGET;
+ djSP; dTARGET;
HV *hash = (HV*)POPs;
HE *entry;
I32 gimme = GIMME_V;
PP(pp_delete)
{
- dSP;
+ djSP;
I32 gimme = GIMME_V;
I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
SV *sv;
PP(pp_exists)
{
- dSP;
+ djSP;
SV *tmpsv = POPs;
HV *hv = (HV*)POPs;
if (SvTYPE(hv) == SVt_PVHV) {
PP(pp_hslice)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
register HE *he;
register HV *hv = (HV*)POPs;
register I32 lval = op->op_flags & OPf_MOD;
PP(pp_list)
{
- dSP; dMARK;
+ djSP; dMARK;
if (GIMME != G_ARRAY) {
if (++MARK <= SP)
*MARK = *SP; /* unwanted list, return last item */
PP(pp_lslice)
{
- dSP;
+ djSP;
SV **lastrelem = stack_sp;
SV **lastlelem = stack_base + POPMARK;
SV **firstlelem = stack_base + POPMARK + 1;
PP(pp_anonlist)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
I32 items = SP - MARK;
SV *av = sv_2mortal((SV*)av_make(items, MARK+1));
SP = ORIGMARK; /* av_make() might realloc stack_sp */
PP(pp_anonhash)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
HV* hv = (HV*)sv_2mortal((SV*)newHV());
while (MARK < SP) {
PP(pp_splice)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
register AV *ary = (AV*)*++MARK;
register SV **src;
register SV **dst;
PP(pp_push)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
register AV *ary = (AV*)*++MARK;
register SV *sv = &sv_undef;
PP(pp_pop)
{
- dSP;
+ djSP;
AV *av = (AV*)POPs;
SV *sv = av_pop(av);
if (!SvIMMORTAL(sv) && AvREAL(av))
PP(pp_shift)
{
- dSP;
+ djSP;
AV *av = (AV*)POPs;
SV *sv = av_shift(av);
EXTEND(SP, 1);
PP(pp_unshift)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
register AV *ary = (AV*)*++MARK;
register SV *sv;
register I32 i = 0;
PP(pp_reverse)
{
- dSP; dMARK;
+ djSP; dMARK;
register SV *tmp;
SV **oldsp = SP;
PP(pp_unpack)
{
- dSP;
+ djSP;
dPOPPOPssrl;
SV **oldsp = sp;
I32 gimme = GIMME_V;
d = (*s++ - ' ') & 077;
else
d = 0;
- hunk[0] = a << 2 | b >> 4;
- hunk[1] = b << 4 | c >> 2;
- hunk[2] = c << 6 | d;
- sv_catpvn(sv, hunk, len > 3 ? 3 : len);
+ hunk[0] = (a << 2) | (b >> 4);
+ hunk[1] = (b << 4) | (c >> 2);
+ hunk[2] = (c << 6) | d;
+ sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
len -= 3;
}
if (*s == '\n')
hunk[4] = '\0';
while (len > 0) {
hunk[0] = ' ' + (077 & (*s >> 2));
- hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
- hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
+ hunk[1] = ' ' + (077 & (((*s << 4) & 060) | ((s[1] >> 4) & 017)));
+ hunk[2] = ' ' + (077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)));
hunk[3] = ' ' + (077 & (s[2] & 077));
sv_catpvn(sv, hunk, 4);
s += 3;
PP(pp_pack)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
register SV *cat = TARG;
register I32 items;
STRLEN fromlen;
PP(pp_split)
{
- dSP; dTARG;
+ djSP; dTARG;
AV *ary;
register I32 limit = POPi; /* note, negative is forever */
SV *sv = POPs;
PP(pp_lock)
{
- dSP;
+ djSP;
dTOPss;
SV *retsv = sv;
#ifdef USE_THREADS
RETURN;
}
-PP(pp_specific)
-{
-#ifdef USE_THREADS
- dSP;
- SV **svp = av_fetch(thr->specific, op->op_targ, TRUE);
- XPUSHs(svp ? *svp : &sv_undef);
-#else
- DIE("tried to access thread-specific data in non-threaded perl");
-#endif /* USE_THREADS */
- RETURN;
-}
+
#ifdef USE_THREADS
#define ARGS thr
#define dARGS struct thread *thr;
-#define PP(s) OP* s(ARGS) dARGS
#else
#define ARGS
#define dARGS
-#define PP(s) OP* s(ARGS) dARGS
#endif /* USE_THREADS */
+#ifdef CAN_PROTOTYPE
+#define PP(s) OP * s(ARGSproto)
+#else /* CAN_PROTOTYPE */
+#define PP(s) OP* s(ARGS) dARGS
+#endif /* CAN_PROTOTYPE */
#define SP sp
#define MARK mark
#define TOPMARK (*markstack_ptr)
#define POPMARK (*markstack_ptr--)
-#define dSP register SV **sp = stack_sp
+#define djSP register SV **sp = stack_sp
+#define dSP dTHR; djSP
#define dMARK register SV **mark = stack_base + POPMARK
#define dORIGMARK I32 origmark = mark - stack_base
#define SETORIGMARK origmark = mark - stack_base
PP(pp_wantarray)
{
- dSP;
+ djSP;
I32 cxix;
EXTEND(SP, 1);
}
PP(pp_regcomp) {
- dSP;
+ djSP;
register PMOP *pm = (PMOP*)cLOGOP->op_other;
register char *t;
SV *tmpstr;
PP(pp_substcont)
{
- dSP;
+ djSP;
register PMOP *pm = (PMOP*) cLOGOP->op_other;
register CONTEXT *cx = &cxstack[cxstack_ix];
register SV *dstr = cx->sb_dstr;
PP(pp_formline)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
register SV *form = *++MARK;
register U16 *fpc;
register char *t;
PP(pp_grepstart)
{
- dSP;
+ djSP;
SV *src;
if (stack_base + *markstack_ptr == sp) {
PP(pp_mapwhile)
{
- dSP;
+ djSP;
I32 diff = (sp - stack_base) - *markstack_ptr;
I32 count;
I32 shift;
PP(pp_sort)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
register SV **up;
SV **myorigmark = ORIGMARK;
register I32 max;
PP(pp_flip)
{
- dSP;
+ djSP;
if (GIMME == G_ARRAY) {
RETURNOP(((CONDOP*)cUNOP->op_first)->op_false);
PP(pp_flop)
{
- dSP;
+ djSP;
if (GIMME == G_ARRAY) {
dPOPPOPssrl;
return G_VOID;
switch (cxstack[cxix].blk_gimme) {
- case G_VOID:
- return G_VOID;
case G_SCALAR:
return G_SCALAR;
case G_ARRAY:
return G_ARRAY;
default:
croak("panic: bad gimme: %d\n", cxstack[cxix].blk_gimme);
+ case G_VOID:
+ return G_VOID;
}
}
SV **svp;
STRLEN klen = strlen(message);
- svp = hv_fetch(errhv, message, klen, TRUE);
+ svp = hv_fetch(GvHV(errgv), message, klen, TRUE);
if (svp) {
if (!SvIOK(*svp)) {
static char prefix[] = "\t(in cleanup) ";
sv_upgrade(*svp, SVt_IV);
(void)SvIOK_only(*svp);
- SvGROW(errsv, SvCUR(errsv)+sizeof(prefix)+klen);
- sv_catpvn(errsv, prefix, sizeof(prefix)-1);
- sv_catpvn(errsv, message, klen);
+ SvGROW(GvSV(errgv), SvCUR(GvSV(errgv))+sizeof(prefix)+klen);
+ sv_catpvn(GvSV(errgv), prefix, sizeof(prefix)-1);
+ sv_catpvn(GvSV(errgv), message, klen);
}
sv_inc(*svp);
}
}
else
- sv_setpv(errsv, message);
+ sv_setpv(GvSV(errgv), message);
cxix = dopoptoeval(cxstack_ix);
if (cxix >= 0) {
LEAVE;
if (optype == OP_REQUIRE) {
- char* msg = SvPV(errsv, na);
+ char* msg = SvPVx(GvSV(errgv), na);
DIE("%s", *msg ? msg : "Compilation failed in require");
}
return pop_return();
PP(pp_xor)
{
- dSP; dPOPTOPssrl;
+ djSP; dPOPTOPssrl;
if (SvTRUE(left) != SvTRUE(right))
RETSETYES;
else
PP(pp_andassign)
{
- dSP;
+ djSP;
if (!SvTRUE(TOPs))
RETURN;
else
PP(pp_orassign)
{
- dSP;
+ djSP;
if (SvTRUE(TOPs))
RETURN;
else
#ifdef DEPRECATED
PP(pp_entersubr)
{
- dSP;
+ djSP;
SV** mark = (stack_base + *markstack_ptr + 1);
SV* cv = *mark;
while (mark < sp) { /* emulate old interface */
PP(pp_caller)
{
- dSP;
+ djSP;
register I32 cxix = dopoptosub(cxstack_ix);
register CONTEXT *cx;
I32 dbcxix;
PP(pp_reset)
{
- dSP;
+ djSP;
char *tmps;
if (MAXARG < 1)
PP(pp_enteriter)
{
- dSP; dMARK;
+ djSP; dMARK;
register CONTEXT *cx;
I32 gimme = GIMME_V;
SV **svp;
PP(pp_enterloop)
{
- dSP;
+ djSP;
register CONTEXT *cx;
I32 gimme = GIMME_V;
PP(pp_leaveloop)
{
- dSP;
+ djSP;
register CONTEXT *cx;
struct block_loop cxloop;
I32 gimme;
PP(pp_return)
{
- dSP; dMARK;
+ djSP; dMARK;
I32 cxix;
register CONTEXT *cx;
struct block_sub cxsub;
PP(pp_last)
{
- dSP;
+ djSP;
I32 cxix;
register CONTEXT *cx;
struct block_loop cxloop;
PP(pp_goto)
{
- dSP;
+ djSP;
OP *retop = 0;
I32 ix;
register CONTEXT *cx;
PP(pp_exit)
{
- dSP;
+ djSP;
I32 anum;
if (MAXARG < 1)
#ifdef NOTYET
PP(pp_nswitch)
{
- dSP;
+ djSP;
double value = SvNVx(GvSV(cCOP->cop_gv));
register I32 match = I_32(value);
PP(pp_cswitch)
{
- dSP;
+ djSP;
register I32 match;
if (multiline)
static OP *
doeval(int gimme)
{
- dTHR;
dSP;
OP *saveop = op;
HV *newstash;
CvPADLIST(compcv) = comppadlist;
if (saveop->op_type != OP_REQUIRE)
- CvOUTSIDE(compcv) = caller ? (CV*)SvREFCNT_inc(caller) : 0;
+ CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc(caller);
SAVEFREESV(compcv);
if (saveop->op_flags & OPf_SPECIAL)
in_eval |= 4;
else
- sv_setpv(errsv,"");
+ sv_setpv(GvSV(errgv),"");
if (yyparse() || error_count || !eval_root) {
SV **newsp;
I32 gimme;
lex_end();
LEAVE;
if (optype == OP_REQUIRE) {
- char* msg = SvPV(errsv, na);
+ char* msg = SvPVx(GvSV(errgv), na);
DIE("%s", *msg ? msg : "Compilation failed in require");
}
SvREFCNT_dec(rs);
PP(pp_require)
{
- dSP;
+ djSP;
register CONTEXT *cx;
SV *sv;
char *name;
PP(pp_entereval)
{
- dSP;
+ djSP;
register CONTEXT *cx;
dPOPss;
I32 gimme = GIMME_V, was = sub_generation;
PP(pp_leaveeval)
{
- dSP;
+ djSP;
register SV **mark;
SV **newsp;
PMOP *newpm;
LEAVE;
if (!(save_flags & OPf_SPECIAL))
- sv_setpv(errsv,"");
+ sv_setpv(GvSV(errgv),"");
RETURNOP(retop);
}
PP(pp_entertry)
{
- dSP;
+ djSP;
register CONTEXT *cx;
I32 gimme = GIMME_V;
eval_root = op; /* Only needed so that goto works right. */
in_eval = 1;
- sv_setpv(errsv,"");
+ sv_setpv(GvSV(errgv),"");
PUTBACK;
return DOCATCH(op->op_next);
}
PP(pp_leavetry)
{
- dSP;
+ djSP;
register SV **mark;
SV **newsp;
PMOP *newpm;
curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
- sv_setpv(errsv,"");
+ sv_setpv(GvSV(errgv),"");
RETURN;
}
sv_magic(sv, Nullsv, 'f', Nullch, 0);
SvCOMPILED_on(sv);
}
+
PP(pp_const)
{
- dSP;
+ djSP;
XPUSHs(cSVOP->op_sv);
RETURN;
}
PP(pp_gvsv)
{
- dSP;
+ djSP;
EXTEND(sp,1);
if (op->op_private & OPpLVAL_INTRO)
PUSHs(save_scalar(cGVOP->op_gv));
PP(pp_stringify)
{
- dSP; dTARGET;
+ djSP; dTARGET;
STRLEN len;
char *s;
s = SvPV(TOPs,len);
PP(pp_gv)
{
- dSP;
+ djSP;
XPUSHs((SV*)cGVOP->op_gv);
RETURN;
}
PP(pp_and)
{
- dSP;
+ djSP;
if (!SvTRUE(TOPs))
RETURN;
else {
PP(pp_sassign)
{
- dSP; dPOPTOPssrl;
+ djSP; dPOPTOPssrl;
MAGIC *mg;
if (op->op_private & OPpASSIGN_BACKWARDS) {
PP(pp_cond_expr)
{
- dSP;
+ djSP;
if (SvTRUEx(POPs))
RETURNOP(cCONDOP->op_true);
else
PP(pp_concat)
{
- dSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
{
dPOPTOPssrl;
STRLEN len;
PP(pp_padsv)
{
- dSP; dTARGET;
+ djSP; dTARGET;
XPUSHs(TARG);
if (op->op_flags & OPf_MOD) {
if (op->op_private & OPpLVAL_INTRO)
PP(pp_eq)
{
- dSP; tryAMAGICbinSET(eq,0);
+ djSP; tryAMAGICbinSET(eq,0);
{
dPOPnv;
SETs(boolSV(TOPn == value));
PP(pp_preinc)
{
- dSP;
+ djSP;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
croak(no_modify);
if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
PP(pp_or)
{
- dSP;
+ djSP;
if (SvTRUE(TOPs))
RETURN;
else {
PP(pp_add)
{
- dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(add,opASSIGN);
{
dPOPTOPnnrl_ul;
SETn( left + right );
PP(pp_aelemfast)
{
- dSP;
+ djSP;
AV *av = GvAV((GV*)cSVOP->op_sv);
SV** svp = av_fetch(av, op->op_private, op->op_flags & OPf_MOD);
PUSHs(svp ? *svp : &sv_undef);
PP(pp_join)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
MARK++;
do_join(TARG, *MARK, MARK, SP);
SP = MARK;
PP(pp_pushre)
{
- dSP;
+ djSP;
#ifdef DEBUGGING
/*
* We ass_u_me that LvTARGOFF() comes first, and that two STRLENs
PP(pp_print)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
GV *gv;
IO *io;
register PerlIO *fp;
PP(pp_rv2av)
{
- dSP; dPOPss;
+ djSP; dPOPss;
AV *av;
if (SvROK(sv)) {
PP(pp_rv2hv)
{
- dSP; dTOPss;
+ djSP; dTOPss;
HV *hv;
if (SvROK(sv)) {
PP(pp_aassign)
{
- dSP;
+ djSP;
SV **lastlelem = stack_sp;
SV **lastrelem = stack_base + POPMARK;
SV **firstrelem = stack_base + POPMARK + 1;
PP(pp_match)
{
- dSP; dTARG;
+ djSP; dTARG;
register PMOP *pm = cPMOP;
register char *t;
register char *s;
OP *
do_readline(void)
{
- dTHR;
dSP; dTARGETSTACKED;
register SV *sv;
STRLEN tmplen = 0;
PP(pp_enter)
{
- dSP;
+ djSP;
register CONTEXT *cx;
I32 gimme = OP_GIMME(op, -1);
PP(pp_helem)
{
- dSP;
+ djSP;
HE* he;
SV **svp;
SV *keysv = POPs;
PP(pp_leave)
{
- dSP;
+ djSP;
register CONTEXT *cx;
register SV **mark;
SV **newsp;
PP(pp_iter)
{
- dSP;
+ djSP;
register CONTEXT *cx;
SV* sv;
AV* av;
PP(pp_subst)
{
- dSP; dTARG;
+ djSP; dTARG;
register PMOP *pm = cPMOP;
PMOP *rpm = pm;
register SV *dstr;
PP(pp_grepwhile)
{
- dSP;
+ djSP;
if (SvTRUEx(POPs))
stack_base[markstack_ptr[-1]++] = stack_base[*markstack_ptr];
PP(pp_leavesub)
{
- dSP;
+ djSP;
SV **mark;
SV **newsp;
PMOP *newpm;
PP(pp_entersub)
{
- dSP; dPOPss;
+ djSP; dPOPss;
GV *gv;
HV *stash;
register CV *cv;
PP(pp_aelem)
{
- dSP;
+ djSP;
SV** svp;
I32 elem = POPi;
AV* av = (AV*)POPs;
PP(pp_method)
{
- dSP;
+ djSP;
SV* sv;
SV* ob;
GV* gv;
PP(pp_backtick)
{
- dSP; dTARGET;
+ djSP; dTARGET;
PerlIO *fp;
char *tmps = POPp;
I32 gimme = GIMME_V;
PP(pp_warn)
{
- dSP; dMARK;
+ djSP; dMARK;
char *tmps;
if (SP - MARK != 1) {
dTARGET;
tmps = SvPV(TOPs, na);
}
if (!tmps || !*tmps) {
- (void)SvUPGRADE(errsv, SVt_PV);
- if (SvPOK(errsv) && SvCUR(errsv))
- sv_catpv(errsv, "\t...caught");
- tmps = SvPV(errsv, na);
+ SV *error = GvSV(errgv);
+ (void)SvUPGRADE(error, SVt_PV);
+ if (SvPOK(error) && SvCUR(error))
+ sv_catpv(error, "\t...caught");
+ tmps = SvPV(error, na);
}
if (!tmps || !*tmps)
tmps = "Warning: something's wrong";
PP(pp_die)
{
- dSP; dMARK;
+ djSP; dMARK;
char *tmps;
if (SP - MARK != 1) {
dTARGET;
tmps = SvPV(TOPs, na);
}
if (!tmps || !*tmps) {
- (void)SvUPGRADE(errsv, SVt_PV);
- if (SvPOK(errsv) && SvCUR(errsv))
- sv_catpv(errsv, "\t...propagated");
- tmps = SvPV(errsv, na);
+ SV *error = GvSV(errgv);
+ (void)SvUPGRADE(error, SVt_PV);
+ if (SvPOK(error) && SvCUR(error))
+ sv_catpv(error, "\t...propagated");
+ tmps = SvPV(error, na);
}
if (!tmps || !*tmps)
tmps = "Died";
PP(pp_open)
{
- dSP; dTARGET;
+ djSP; dTARGET;
GV *gv;
SV *sv;
char *tmps;
PP(pp_close)
{
- dSP;
+ djSP;
GV *gv;
if (MAXARG == 0)
PP(pp_pipe_op)
{
- dSP;
+ djSP;
#ifdef HAS_PIPE
GV *rgv;
GV *wgv;
PP(pp_fileno)
{
- dSP; dTARGET;
+ djSP; dTARGET;
GV *gv;
IO *io;
PerlIO *fp;
PP(pp_umask)
{
- dSP; dTARGET;
+ djSP; dTARGET;
int anum;
#ifdef HAS_UMASK
PP(pp_binmode)
{
- dSP;
+ djSP;
GV *gv;
IO *io;
PerlIO *fp;
PP(pp_tie)
{
- dSP;
+ djSP;
SV *varsv;
HV* stash;
GV *gv;
PP(pp_untie)
{
- dSP;
+ djSP;
SV * sv ;
sv = POPs;
PP(pp_tied)
{
- dSP;
+ djSP;
SV * sv ;
MAGIC * mg ;
PP(pp_dbmopen)
{
- dSP;
+ djSP;
HV *hv;
dPOPPOPssrl;
HV* stash;
PP(pp_sselect)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#ifdef HAS_SELECT
register I32 i;
register I32 j;
PP(pp_select)
{
- dSP; dTARGET;
+ djSP; dTARGET;
GV *newdefout, *egv;
HV *hv;
PP(pp_getc)
{
- dSP; dTARGET;
+ djSP; dTARGET;
GV *gv;
MAGIC *mg;
PP(pp_enterwrite)
{
- dSP;
+ djSP;
register GV *gv;
register IO *io;
GV *fgv;
PP(pp_leavewrite)
{
- dSP;
+ djSP;
GV *gv = cxstack[cxstack_ix].blk_sub.gv;
register IO *io = GvIOp(gv);
PerlIO *ofp = IoOFP(io);
PP(pp_prtf)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
GV *gv;
IO *io;
PerlIO *fp;
PP(pp_sysopen)
{
- dSP;
+ djSP;
GV *gv;
SV *sv;
char *tmps;
PP(pp_sysread)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
int offset;
GV *gv;
IO *io;
PP(pp_send)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
GV *gv;
IO *io;
int offset;
PP(pp_eof)
{
- dSP;
+ djSP;
GV *gv;
if (MAXARG <= 0)
PP(pp_tell)
{
- dSP; dTARGET;
+ djSP; dTARGET;
GV *gv;
if (MAXARG <= 0)
PP(pp_sysseek)
{
- dSP;
+ djSP;
GV *gv;
int whence = POPi;
long offset = POPl;
PP(pp_truncate)
{
- dSP;
+ djSP;
Off_t len = (Off_t)POPn;
int result = 1;
GV *tmpgv;
PP(pp_ioctl)
{
- dSP; dTARGET;
+ djSP; dTARGET;
SV *argsv = POPs;
unsigned int func = U_I(POPn);
int optype = op->op_type;
PP(pp_flock)
{
- dSP; dTARGET;
+ djSP; dTARGET;
I32 value;
int argtype;
GV *gv;
PP(pp_socket)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
GV *gv;
register IO *io;
PP(pp_sockpair)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKETPAIR
GV *gv1;
GV *gv2;
PP(pp_bind)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
SV *addrsv = POPs;
char *addr;
PP(pp_connect)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
SV *addrsv = POPs;
char *addr;
PP(pp_listen)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
int backlog = POPi;
GV *gv = (GV*)POPs;
PP(pp_accept)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#ifdef HAS_SOCKET
GV *ngv;
GV *ggv;
PP(pp_shutdown)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#ifdef HAS_SOCKET
int how = POPi;
GV *gv = (GV*)POPs;
PP(pp_ssockopt)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
int optype = op->op_type;
SV *sv;
PP(pp_getpeername)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
int optype = op->op_type;
SV *sv;
PP(pp_stat)
{
- dSP;
+ djSP;
GV *tmpgv;
I32 gimme;
I32 max = 13;
PP(pp_ftrread)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
if (cando(S_IRUSR, 0, &statcache))
PP(pp_ftrwrite)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
if (cando(S_IWUSR, 0, &statcache))
PP(pp_ftrexec)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
if (cando(S_IXUSR, 0, &statcache))
PP(pp_fteread)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
if (cando(S_IRUSR, 1, &statcache))
PP(pp_ftewrite)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
if (cando(S_IWUSR, 1, &statcache))
PP(pp_fteexec)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
if (cando(S_IXUSR, 1, &statcache))
PP(pp_ftis)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
RETPUSHYES;
PP(pp_ftrowned)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
if (statcache.st_uid == (op->op_type == OP_FTEOWNED ? euid : uid) )
PP(pp_ftzero)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
if (!statcache.st_size)
PP(pp_ftsize)
{
I32 result = my_stat(ARGS);
- dSP; dTARGET;
+ djSP; dTARGET;
if (result < 0)
RETPUSHUNDEF;
PUSHi(statcache.st_size);
PP(pp_ftmtime)
{
I32 result = my_stat(ARGS);
- dSP; dTARGET;
+ djSP; dTARGET;
if (result < 0)
RETPUSHUNDEF;
PUSHn( ((I32)basetime - (I32)statcache.st_mtime) / 86400.0 );
PP(pp_ftatime)
{
I32 result = my_stat(ARGS);
- dSP; dTARGET;
+ djSP; dTARGET;
if (result < 0)
RETPUSHUNDEF;
PUSHn( ((I32)basetime - (I32)statcache.st_atime) / 86400.0 );
PP(pp_ftctime)
{
I32 result = my_stat(ARGS);
- dSP; dTARGET;
+ djSP; dTARGET;
if (result < 0)
RETPUSHUNDEF;
PUSHn( ((I32)basetime - (I32)statcache.st_ctime) / 86400.0 );
PP(pp_ftsock)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
if (S_ISSOCK(statcache.st_mode))
PP(pp_ftchr)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
if (S_ISCHR(statcache.st_mode))
PP(pp_ftblk)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
if (S_ISBLK(statcache.st_mode))
PP(pp_ftfile)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
if (S_ISREG(statcache.st_mode))
PP(pp_ftdir)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
if (S_ISDIR(statcache.st_mode))
PP(pp_ftpipe)
{
I32 result = my_stat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
if (S_ISFIFO(statcache.st_mode))
PP(pp_ftlink)
{
I32 result = my_lstat(ARGS);
- dSP;
+ djSP;
if (result < 0)
RETPUSHUNDEF;
if (S_ISLNK(statcache.st_mode))
PP(pp_ftsuid)
{
- dSP;
+ djSP;
#ifdef S_ISUID
I32 result = my_stat(ARGS);
SPAGAIN;
PP(pp_ftsgid)
{
- dSP;
+ djSP;
#ifdef S_ISGID
I32 result = my_stat(ARGS);
SPAGAIN;
PP(pp_ftsvtx)
{
- dSP;
+ djSP;
#ifdef S_ISVTX
I32 result = my_stat(ARGS);
SPAGAIN;
PP(pp_fttty)
{
- dSP;
+ djSP;
int fd;
GV *gv;
char *tmps = Nullch;
PP(pp_fttext)
{
- dSP;
+ djSP;
I32 i;
I32 len;
I32 odd = 0;
PP(pp_chdir)
{
- dSP; dTARGET;
+ djSP; dTARGET;
char *tmps;
SV **svp;
PP(pp_chown)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
I32 value;
#ifdef HAS_CHOWN
value = (I32)apply(op->op_type, MARK, SP);
PP(pp_chroot)
{
- dSP; dTARGET;
+ djSP; dTARGET;
char *tmps;
#ifdef HAS_CHROOT
tmps = POPp;
PP(pp_unlink)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
I32 value;
value = (I32)apply(op->op_type, MARK, SP);
SP = MARK;
PP(pp_chmod)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
I32 value;
value = (I32)apply(op->op_type, MARK, SP);
SP = MARK;
PP(pp_utime)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
I32 value;
value = (I32)apply(op->op_type, MARK, SP);
SP = MARK;
PP(pp_rename)
{
- dSP; dTARGET;
+ djSP; dTARGET;
int anum;
char *tmps2 = POPp;
PP(pp_link)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#ifdef HAS_LINK
char *tmps2 = POPp;
char *tmps = SvPV(TOPs, na);
PP(pp_symlink)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#ifdef HAS_SYMLINK
char *tmps2 = POPp;
char *tmps = SvPV(TOPs, na);
PP(pp_readlink)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#ifdef HAS_SYMLINK
char *tmps;
char buf[MAXPATHLEN];
PP(pp_mkdir)
{
- dSP; dTARGET;
+ djSP; dTARGET;
int mode = POPi;
#ifndef HAS_MKDIR
int oldumask;
PP(pp_rmdir)
{
- dSP; dTARGET;
+ djSP; dTARGET;
char *tmps;
tmps = POPp;
PP(pp_open_dir)
{
- dSP;
+ djSP;
#if defined(Direntry_t) && defined(HAS_READDIR)
char *dirname = POPp;
GV *gv = (GV*)POPs;
PP(pp_readdir)
{
- dSP;
+ djSP;
#if defined(Direntry_t) && defined(HAS_READDIR)
#ifndef I_DIRENT
Direntry_t *readdir _((DIR *));
PP(pp_telldir)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#if defined(HAS_TELLDIR) || defined(telldir)
#if !defined(telldir) && !defined(HAS_TELLDIR_PROTOTYPE) && !defined(DONT_DECLARE_STD)
long telldir _((DIR *));
PP(pp_seekdir)
{
- dSP;
+ djSP;
#if defined(HAS_SEEKDIR) || defined(seekdir)
long along = POPl;
GV *gv = (GV*)POPs;
PP(pp_rewinddir)
{
- dSP;
+ djSP;
#if defined(HAS_REWINDDIR) || defined(rewinddir)
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
PP(pp_closedir)
{
- dSP;
+ djSP;
#if defined(Direntry_t) && defined(HAS_READDIR)
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
PP(pp_fork)
{
#ifdef HAS_FORK
- dSP; dTARGET;
+ djSP; dTARGET;
int childpid;
GV *tmpgv;
PP(pp_wait)
{
#if !defined(DOSISH) || defined(OS2)
- dSP; dTARGET;
+ djSP; dTARGET;
int childpid;
int argflags;
PP(pp_waitpid)
{
#if !defined(DOSISH) || defined(OS2)
- dSP; dTARGET;
+ djSP; dTARGET;
int childpid;
int optype;
int argflags;
PP(pp_system)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
I32 value;
int childpid;
int result;
#else /* ! FORK or VMS or OS/2 */
if (op->op_flags & OPf_STACKED) {
SV *really = *++MARK;
- value = (I32)do_aspawn(really, MARK, SP);
+ value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
}
else if (SP - MARK != 1)
- value = (I32)do_aspawn(Nullsv, MARK, SP);
+ value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
else {
value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
}
PP(pp_exec)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
I32 value;
if (op->op_flags & OPf_STACKED) {
PP(pp_kill)
{
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
I32 value;
#ifdef HAS_KILL
value = (I32)apply(op->op_type, MARK, SP);
PP(pp_getppid)
{
#ifdef HAS_GETPPID
- dSP; dTARGET;
+ djSP; dTARGET;
XPUSHi( getppid() );
RETURN;
#else
PP(pp_getpgrp)
{
#ifdef HAS_GETPGRP
- dSP; dTARGET;
+ djSP; dTARGET;
int pid;
I32 value;
PP(pp_setpgrp)
{
#ifdef HAS_SETPGRP
- dSP; dTARGET;
+ djSP; dTARGET;
int pgrp;
int pid;
if (MAXARG < 2) {
PP(pp_getpriority)
{
- dSP; dTARGET;
+ djSP; dTARGET;
int which;
int who;
#ifdef HAS_GETPRIORITY
PP(pp_setpriority)
{
- dSP; dTARGET;
+ djSP; dTARGET;
int which;
int who;
int niceval;
PP(pp_time)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#ifdef BIG_TIME
XPUSHn( time(Null(Time_t*)) );
#else
PP(pp_tms)
{
- dSP;
+ djSP;
#ifndef HAS_TIMES
DIE("times not implemented");
PP(pp_gmtime)
{
- dSP;
+ djSP;
Time_t when;
struct tm *tmbuf;
static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
PP(pp_alarm)
{
- dSP; dTARGET;
+ djSP; dTARGET;
int anum;
#ifdef HAS_ALARM
anum = POPi;
PP(pp_sleep)
{
- dSP; dTARGET;
+ djSP; dTARGET;
I32 duration;
Time_t lasttime;
Time_t when;
PP(pp_shmwrite)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
I32 value = (I32)(do_shmio(op->op_type, MARK, SP) >= 0);
SP = MARK;
PUSHi(value);
PP(pp_msgsnd)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
I32 value = (I32)(do_msgsnd(MARK, SP) >= 0);
SP = MARK;
PUSHi(value);
PP(pp_msgrcv)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
I32 value = (I32)(do_msgrcv(MARK, SP) >= 0);
SP = MARK;
PUSHi(value);
PP(pp_semget)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
int anum = do_ipcget(op->op_type, MARK, SP);
SP = MARK;
if (anum == -1)
PP(pp_semctl)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
int anum = do_ipcctl(op->op_type, MARK, SP);
SP = MARK;
if (anum == -1)
PP(pp_semop)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dSP; dMARK; dTARGET;
+ djSP; dMARK; dTARGET;
I32 value = (I32)(do_semop(MARK, SP) >= 0);
SP = MARK;
PUSHi(value);
PP(pp_ghostent)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
I32 which = op->op_type;
register char **elem;
PP(pp_gnetent)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
I32 which = op->op_type;
register char **elem;
PP(pp_gprotoent)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
I32 which = op->op_type;
register char **elem;
PP(pp_gservent)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
I32 which = op->op_type;
register char **elem;
PP(pp_shostent)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
sethostent(TOPi);
RETSETYES;
PP(pp_snetent)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
setnetent(TOPi);
RETSETYES;
PP(pp_sprotoent)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
setprotoent(TOPi);
RETSETYES;
PP(pp_sservent)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
setservent(TOPi);
RETSETYES;
PP(pp_ehostent)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
endhostent();
EXTEND(sp,1);
PP(pp_enetent)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
endnetent();
EXTEND(sp,1);
PP(pp_eprotoent)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
endprotoent();
EXTEND(sp,1);
PP(pp_eservent)
{
- dSP;
+ djSP;
#ifdef HAS_SOCKET
endservent();
EXTEND(sp,1);
PP(pp_gpwent)
{
- dSP;
+ djSP;
#ifdef HAS_PASSWD
I32 which = op->op_type;
register SV *sv;
PP(pp_spwent)
{
- dSP;
+ djSP;
#if defined(HAS_PASSWD) && !defined(CYGWIN32)
setpwent();
RETPUSHYES;
PP(pp_epwent)
{
- dSP;
+ djSP;
#ifdef HAS_PASSWD
endpwent();
RETPUSHYES;
PP(pp_ggrent)
{
- dSP;
+ djSP;
#ifdef HAS_GROUP
I32 which = op->op_type;
register char **elem;
PP(pp_sgrent)
{
- dSP;
+ djSP;
#ifdef HAS_GROUP
setgrent();
RETPUSHYES;
PP(pp_egrent)
{
- dSP;
+ djSP;
#ifdef HAS_GROUP
endgrent();
RETPUSHYES;
PP(pp_getlogin)
{
- dSP; dTARGET;
+ djSP; dTARGET;
#ifdef HAS_GETLOGIN
char *tmps;
EXTEND(SP, 1);
PP(pp_syscall)
{
#ifdef HAS_SYSCALL
- dSP; dMARK; dORIGMARK; dTARGET;
+ djSP; dMARK; dORIGMARK; dTARGET;
register I32 items = SP - MARK;
unsigned long a[20];
register I32 i = 0;
}
#endif /* LOCKF_EMULATE_FLOCK */
+
OP* invert _((OP* cmd));
OP* jmaybe _((OP* arg));
I32 keyword _((char* d, I32 len));
-PADOFFSET key_create _((void));
-void key_destroy _((PADOFFSET key));
void leave_scope _((I32 base));
void lex_end _((void));
void lex_start _((SV* line));
OP* newPMOP _((I32 type, I32 flags));
OP* newPVOP _((I32 type, I32 flags, char* pv));
SV* newRV _((SV* ref));
+SV* newRV_noinc _((SV *));
#ifdef LEAKTEST
SV* newSV _((I32 x, STRLEN len));
#else
OP* newUNOP _((I32 type, I32 flags, OP* first));
OP* newWHILEOP _((I32 flags, I32 debuggable, LOOP* loop,
I32 whileline, OP* expr, OP* block, OP* cont));
-#ifdef USE_THREADS
-struct thread * new_struct_thread _((struct thread *t));
-#endif
PerlIO* nextargv _((GV* gv));
char* ninstr _((char* big, char* bigend, char* little, char* lend));
OP* oopsCV _((OP* o));
double sv_2nv _((SV* sv));
char* sv_2pv _((SV* sv, STRLEN* lp));
UV sv_2uv _((SV* sv));
+IV sv_iv _((SV* sv));
+UV sv_uv _((SV* sv));
+double sv_nv _((SV* sv));
+char * sv_pvn _((SV *, STRLEN *));
+I32 sv_true _((SV *));
void sv_add_arena _((char* ptr, U32 size, U32 flags));
int sv_backoff _((SV* sv));
SV* sv_bless _((SV* sv, HV* stash));
void
sv_setiv(register SV *sv, IV i)
{
- dTHR; /* just for taint */
sv_check_thinkfirst(sv);
switch (SvTYPE(sv)) {
case SVt_NULL:
void
sv_setnv(register SV *sv, double num)
{
- dTHR; /* just for taint */
sv_check_thinkfirst(sv);
switch (SvTYPE(sv)) {
case SVt_NULL:
void
sv_setpvn(register SV *sv, register const char *ptr, register STRLEN len)
{
- dTHR; /* just for taint */
assert(len >= 0); /* STRLEN is probably unsigned, so this may
elicit a warning, but it won't hurt. */
sv_check_thinkfirst(sv);
void
sv_setpv(register SV *sv, register const char *ptr)
{
- dTHR; /* just for taint */
register STRLEN len;
sv_check_thinkfirst(sv);
void
sv_usepvn(register SV *sv, register char *ptr, register STRLEN len)
{
- dTHR; /* just for taint */
sv_check_thinkfirst(sv);
if (!SvUPGRADE(sv, SVt_PV))
return;
void
sv_catpvn(register SV *sv, register char *ptr, register STRLEN len)
{
- dTHR; /* just for taint */
STRLEN tlen;
char *junk;
void
sv_catpv(register SV *sv, register char *ptr)
{
- dTHR; /* just for taint */
register STRLEN len;
STRLEN tlen;
char *junk;
if (SvOBJECT(sv)) {
dTHR;
if (defstash) { /* Still have a symbol table? */
- dTHR;
- dSP;
+ djSP;
GV* destructor;
ENTER;
char *
sv_gets(register SV *sv, register FILE *fp, I32 append)
{
- dTHR;
char *rsptr;
STRLEN rslen;
register STDCHAR rslast;
return sv;
}
-#ifdef CRIPPLED_CC
+
SV *
newRV_noinc(SV *ref)
{
SvREFCNT_dec(ref);
return sv;
}
-#endif /* CRIPPLED_CC */
/* make an exact duplicate of old */
sv = GvSV(gv);
(void)SvOK_off(sv);
if (SvTYPE(sv) >= SVt_PV) {
- dTHR; /* just for taint */
SvCUR_set(sv, 0);
if (SvPVX(sv) != Nullch)
*SvPVX(sv) = '\0';
}
}
-#ifndef SvTRUE
I32
-SvTRUE(register SV *sv)
+sv_true(register SV *sv)
{
+ dTHR;
if (!sv)
return 0;
if (SvGMAGICAL(sv))
mg_get(sv);
if (SvPOK(sv)) {
- register XPV* Xpv;
- if ((Xpv = (XPV*)SvANY(sv)) &&
- (*Xpv->xpv_pv > '0' ||
- Xpv->xpv_cur > 1 ||
- (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
+ register XPV* tXpv;
+ if ((tXpv = (XPV*)SvANY(sv)) &&
+ (*tXpv->xpv_pv > '0' ||
+ tXpv->xpv_cur > 1 ||
+ (tXpv->xpv_cur && *tXpv->xpv_pv != '0')))
return 1;
else
return 0;
}
}
}
-#endif /* !SvTRUE */
-#ifndef SvIV
IV
-SvIV(register SV *sv)
+sv_iv(register SV *sv)
{
if (SvIOK(sv))
return SvIVX(sv);
return sv_2iv(sv);
}
-#endif /* !SvIV */
-#ifndef SvUV
UV
-SvUV(register SV *sv)
+sv_uv(register SV *sv)
{
if (SvIOK(sv))
return SvUVX(sv);
return sv_2uv(sv);
}
-#endif /* !SvUV */
-#ifndef SvNV
double
-SvNV(register SV *sv)
+sv_nv(register SV *sv)
{
if (SvNOK(sv))
return SvNVX(sv);
return sv_2nv(sv);
}
-#endif /* !SvNV */
-#ifdef CRIPPLED_CC
char *
sv_pvn(SV *sv, STRLEN *lp)
{
}
return sv_2pv(sv, lp);
}
-#endif
char *
sv_pvn_force(SV *sv, STRLEN *lp)
*SvEND(sv) = '\0';
}
if (!SvPOK(sv)) {
- dTHR; /* just for taint */
SvPOK_on(sv); /* validate pointer */
SvTAINT(sv);
DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n",
}
#endif
+
+
+
#define SvANY(sv) (sv)->sv_any
#define SvFLAGS(sv) (sv)->sv_flags
-#define SvREFCNT(sv) (sv)->sv_refcnt
-#ifdef __GNUC__
-# define SvREFCNT_inc(sv) ({SV *nsv = (SV*)(sv); ++SvREFCNT(nsv); nsv;})
+#define SvREFCNT(sv) (sv)->sv_refcnt
+#ifdef CRIPPLED_CC
+#define SvREFCNT_inc(sv) sv_newref((SV*)sv)
+#define SvREFCNT_dec(sv) sv_free((SV*)sv)
#else
-# if defined(CRIPPLED_CC) || defined(USE_THREADS)
-# define SvREFCNT_inc(sv) sv_newref((SV*)sv)
-# else
-# define SvREFCNT_inc(sv) ((Sv = (SV*)(sv)), ++SvREFCNT(Sv), (SV*)Sv)
-# endif
-#endif
-
+#define SvREFCNT_inc(sv) ((Sv = (SV*)(sv)), \
+ (Sv && ++SvREFCNT(Sv)), (SV*)Sv)
#define SvREFCNT_dec(sv) sv_free((SV*)sv)
+#endif
#define SVTYPEMASK 0xff
#define SvTYPE(sv) ((sv)->sv_flags & SVTYPEMASK)
#ifdef CRIPPLED_CC
-IV SvIV _((SV* sv));
-UV SvUV _((SV* sv));
-double SvNV _((SV* sv));
#define SvPV_force(sv, lp) sv_pvn_force(sv, &lp)
#define SvPV(sv, lp) sv_pvn(sv, &lp)
-char *sv_pvn _((SV *, STRLEN *));
-I32 SvTRUE _((SV *));
-
-#define SvIVx(sv) SvIV(sv)
-#define SvUVx(sv) SvUV(sv)
-#define SvNVx(sv) SvNV(sv)
+#define SvIVx(sv) sv_iv(sv)
+#define SvUVx(sv) sv_uv(sv)
+#define SvNVx(sv) sv_nv(sv)
#define SvPVx(sv, lp) sv_pvn(sv, &lp)
#define SvPVx_force(sv, lp) sv_pvn_force(sv, &lp)
-#define SvTRUEx(sv) SvTRUE(sv)
+#define SvTRUEx(sv) sv_true(sv)
+
+#define SvIV(sv) SvIVx(sv)
+#define SvNV(sv) SvNVx(sv)
+#define SvUV(sv) SvIVx(sv)
+#define SvTRUE(sv) SvTRUEx(sv)
#else /* !CRIPPLED_CC */
? SvNVX(sv) != 0.0 \
: sv_2bool(sv) )
-#ifdef __GNUC__
-# define SvIVx(sv) ({SV *nsv = (SV*)(sv); SvIV(nsv); })
-# define SvUVx(sv) ({SV *nsv = (SV*)(sv); SvUV(nsv); })
-# define SvNVx(sv) ({SV *nsv = (SV*)(sv); SvNV(nsv); })
-# define SvPVx(sv, lp) ({SV *nsv = (sv); SvPV(nsv, lp); })
-#else
-# define SvIVx(sv) ((Sv = (sv)), SvIV(Sv))
-# define SvUVx(sv) ((Sv = (sv)), SvUV(Sv))
-# define SvNVx(sv) ((Sv = (sv)), SvNV(Sv))
-# define SvPVx(sv, lp) ((Sv = (sv)), SvPV(Sv, lp))
-#endif /* __GNUC__ */
-
+#define SvIVx(sv) ((Sv = (sv)), SvIV(Sv))
+#define SvUVx(sv) ((Sv = (sv)), SvUV(Sv))
+#define SvNVx(sv) ((Sv = (sv)), SvNV(Sv))
+#define SvPVx(sv, lp) ((Sv = (sv)), SvPV(Sv, lp))
#define SvTRUEx(sv) ((Sv = (sv)), SvTRUE(Sv))
#endif /* CRIPPLED_CC */
#define newRV_inc(sv) newRV(sv)
-#ifdef __GNUC__
-# define newRV_noinc(sv) ({SV *nsv=newRV((sv)); --SvREFCNT(SvRV(nsv)); nsv;})
-#else
-# if defined(CRIPPLED_CC) || defined(USE_THREADS)
-SV *newRV_noinc _((SV *));
-# else
-# define newRV_noinc(sv) ((Sv = newRV(sv)), --SvREFCNT(SvRV(Sv)), Sv)
-# endif
-#endif /* __GNUC__ */
+#ifndef CRIPPLED_CC
+#undef newRV_noinc
+#define newRV_noinc(sv) ((Sv = newRV(sv)), --SvREFCNT(SvRV(Sv)), Sv)
+#endif
/* the following macro updates any magic values this sv is associated with */
void
taint_proper(const char *f, char *s)
{
- dTHR; /* just for taint */
char *ug;
DEBUG_u(PerlIO_printf(Perl_debug_log,
svp = hv_fetch(GvHVn(envgv),"PATH",4,FALSE);
if (svp && *svp) {
if (SvTAINTED(*svp)) {
- dTHR;
TAINT;
taint_proper("Insecure %s%s", "$ENV{PATH}");
}
if ((mg = mg_find(*svp, 'e')) && MgTAINTEDDIR(mg)) {
- dTHR;
TAINT;
taint_proper("Insecure directory in %s%s", "$ENV{PATH}");
}
/* tainted $TERM is okay if it contains no metachars */
svp = hv_fetch(GvHVn(envgv),"TERM",4,FALSE);
if (svp && *svp && SvTAINTED(*svp)) {
- dTHR; /* just for taint */
bool was_tainted = tainted;
char *t = SvPV(*svp, na);
char *e = t + na;
for (e = misc_env; *e; e++) {
svp = hv_fetch(GvHVn(envgv), *e, strlen(*e), FALSE);
if (svp && *svp != &sv_undef && SvTAINTED(*svp)) {
- dTHR; /* just for taint */
TAINT;
taint_proper("Insecure $ENV{%s}%s", *e);
}
/* Now the fields that used to be "per interpreter" (even when global) */
- /* Fields used by magic variables such as $@, $/ and so on */
- bool Ttainted;
- PMOP * Tcurpm;
- SV * Tnrs;
- SV * Trs;
- GV * Tlast_in_gv;
- char * Tofs;
- STRLEN Tofslen;
- GV * Tdefoutgv;
- char * Tchopset;
- SV * Tformtarget;
- SV * Tbodytarget;
- SV * Ttoptarget;
-
- /* Stashes */
+ /* XXX What about magic variables such as $/, $? and so on? */
HV * Tdefstash;
HV * Tcurstash;
- /* Stacks */
SV ** Ttmps_stack;
I32 Ttmps_ix;
I32 Ttmps_floor;
HV * Tcvcache;
perl_thread self; /* Underlying thread object */
U32 flags;
- AV * specific; /* Thread specific data (& magicals) */
perl_mutex mutex; /* For the fields others can change */
U32 tid;
struct thread *next, *prev; /* Circular linked list of threads */
#undef Xpv
#undef statbuf
#undef timesbuf
-#undef tainted
-#undef curpm
-#undef nrs
-#undef rs
-#undef last_in_gv
-#undef ofs
-#undef ofslen
-#undef defoutgv
-#undef chopset
-#undef formtarget
-#undef bodytarget
-#undef toptarget
#undef top_env
#undef runlevel
#undef in_eval
#define Xpv (thr->TXpv)
#define statbuf (thr->Tstatbuf)
#define timesbuf (thr->Ttimesbuf)
-#define tainted (thr->Ttainted)
-#define tainted (thr->Ttainted)
-#define curpm (thr->Tcurpm)
-#define nrs (thr->Tnrs)
-#define rs (thr->Trs)
-#define last_in_gv (thr->Tlast_in_gv)
-#define ofs (thr->Tofs)
-#define ofslen (thr->Tofslen)
-#define defoutgv (thr->Tdefoutgv)
-#define chopset (thr->Tchopset)
-#define formtarget (thr->Tformtarget)
-#define bodytarget (thr->Tbodytarget)
-#define toptarget (thr->Ttoptarget)
#define defstash (thr->Tdefstash)
#define curstash (thr->Tcurstash)
return PRIVATEREF;
}
- if (!strchr(tokenbuf,':')) {
-#ifdef USE_THREADS
- /* Check for single character per-thread magicals */
- if (tokenbuf[0] == '$' && tokenbuf[2] == '\0'
- && (tmp = find_thread_magical(&tokenbuf[1])) != NOT_IN_PAD) {
- yylval.opval = newOP(OP_SPECIFIC, 0);
- yylval.opval->op_targ = tmp;
- return PRIVATEREF;
- }
-#endif /* USE_THREADS */
- if ((tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) {
- if (last_lop_op == OP_SORT &&
- tokenbuf[0] == '$' &&
- (tokenbuf[1] == 'a' || tokenbuf[1] == 'b')
- && !tokenbuf[2])
+ if (!strchr(tokenbuf,':')
+ && (tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) {
+ if (last_lop_op == OP_SORT &&
+ tokenbuf[0] == '$' &&
+ (tokenbuf[1] == 'a' || tokenbuf[1] == 'b')
+ && !tokenbuf[2])
+ {
+ for (d = in_eval ? oldoldbufptr : linestart;
+ d < bufend && *d != '\n';
+ d++)
{
- for (d = in_eval ? oldoldbufptr : linestart;
- d < bufend && *d != '\n';
- d++)
- {
- if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) {
- croak("Can't use \"my %s\" in sort comparison",
- tokenbuf);
- }
+ if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) {
+ croak("Can't use \"my %s\" in sort comparison",
+ tokenbuf);
}
}
-
- yylval.opval = newOP(OP_PADANY, 0);
- yylval.opval->op_targ = tmp;
- return PRIVATEREF;
}
+
+ yylval.opval = newOP(OP_PADANY, 0);
+ yylval.opval->op_targ = tmp;
+ return PRIVATEREF;
}
/* Force them to make up their mind on "@foo". */
(oldoldbufptr == last_lop || oldoldbufptr == last_uni) &&
/* NO SKIPSPACE BEFORE HERE! */
(expect == XREF ||
- (opargs[last_lop_op] >> OASHIFT & 7) == OA_FILEREF) )
+ ((opargs[last_lop_op] >> OASHIFT)& 7) == OA_FILEREF) )
{
bool immediate_paren = *s == '(';
if (in_eval & 2)
warn("%_", msg);
else if (in_eval)
- sv_catsv(errsv, msg);
+ sv_catsv(GvSV(errgv), msg);
else
PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
if (++error_count >= 10)
in_my_stash = Nullhv;
return 0;
}
+
static void xstat _((void));
#endif
-#ifdef USE_THREADS
-static U32 threadnum = 0;
-#endif /* USE_THREADS */
-
#ifndef MYMALLOC
/* paranoid version of malloc */
else {
PerlIO_puts(PerlIO_stderr(),no_mem) FLUSH;
my_exit(1);
+ return Nullch;
}
/*NOTREACHED*/
}
else {
PerlIO_puts(PerlIO_stderr(),no_mem) FLUSH;
my_exit(1);
+ return Nullch;
}
/*NOTREACHED*/
}
else {
PerlIO_puts(PerlIO_stderr(),no_mem) FLUSH;
my_exit(1);
+ return Nullch;
}
/*NOTREACHED*/
}
#else /* if WIN32 */
void
-my_setenv(nam,val)
-char *nam, *val;
+my_setenv(char *nam,char *val)
{
#ifdef USE_WIN32_RTL_ENV
#if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
char *
-my_bcopy(from,to,len)
-register char *from;
-register char *to;
-register I32 len;
+my_bcopy(register char *from,register char *to,register I32 len)
{
char *retval = to;
#else /* !HAS_SIGACTION */
Sighandler_t
-rsignal(signo, handler)
-int signo;
-Sighandler_t handler;
+rsignal(int signo, Sighandler_t handler)
{
return signal(signo, handler);
}
static
Signal_t
-sig_trap(signo)
-int signo;
+sig_trap(int signo)
{
sig_trapped++;
}
Sighandler_t
-rsignal_state(signo)
-int signo;
+rsignal_state(int signo)
{
Sighandler_t oldsig;
}
int
-rsignal_save(signo, handler, save)
-int signo;
-Sighandler_t handler;
-Sigsave_t *save;
+rsignal_save(int signo, Sighandler_t handler, Sigsave_t *save)
{
*save = signal(signo, handler);
return (*save == SIG_ERR) ? -1 : 0;
}
int
-rsignal_restore(signo, save)
-int signo;
-Sigsave_t *save;
+rsignal_restore(int signo, Sigsave_t *save)
{
return (signal(signo, *save) == SIG_ERR) ? -1 : 0;
}
bool overflowed = FALSE;
char *tmp;
- while (len-- && *s && (tmp = strchr(hexdigit, *s))) {
+ while (len-- && *s && (tmp = strchr((char *) hexdigit, *s))) {
register UV n = retval << 4;
if (!overflowed && (n >> 4) != retval) {
warn("Integer overflow in hex number");
overflowed = TRUE;
}
- retval = n | (tmp - hexdigit) & 15;
+ retval = n | ((tmp - hexdigit) & 15);
s++;
}
*retlen = s - start;
}
return mg;
}
-
-/*
- * Make a new perl thread structure using t as a prototype. If t is NULL
- * then this is the initial main thread and we have to bootstrap carefully.
- * Some of the fields for the new thread are copied from the prototype
- * thread, t, so t should not be running in perl at the time this function
- * is called. The usual case, where t is the thread calling new_struct_thread,
- * clearly satisfies this constraint.
- */
-struct thread *
-new_struct_thread(t)
-struct thread *t;
-{
- struct thread *thr;
- XPV *xpv;
- SV *sv;
-
- Newz(53, thr, 1, struct thread);
- cvcache = newHV();
- curcop = &compiling;
- thr->specific = newAV();
- thr->flags = THRf_R_JOINABLE;
- MUTEX_INIT(&thr->mutex);
- if (t) {
- oursv = newSVpv("", 0);
- SvGROW(oursv, sizeof(struct thread) + 1);
- SvCUR_set(oursv, sizeof(struct thread));
- thr = (struct thread *) SvPVX(sv);
- } else {
- /* Handcraft thrsv similarly to mess_sv */
- New(53, thrsv, 1, SV);
- Newz(53, xpv, 1, XPV);
- SvFLAGS(thrsv) = SVt_PV;
- SvANY(thrsv) = (void*)xpv;
- SvREFCNT(thrsv) = 1 << 30; /* practically infinite */
- SvPVX(thrsv) = (char*)thr;
- SvCUR_set(thrsv, sizeof(thr));
- SvLEN_set(thrsv, sizeof(thr));
- *SvEND(thrsv) = '\0'; /* in the trailing_nul field */
- oursv = thrsv;
- }
- if (t) {
- curcop = t->Tcurcop; /* XXX As good a guess as any? */
- defstash = t->Tdefstash; /* XXX maybe these should */
- curstash = t->Tcurstash; /* always be set to main? */
- /* top_env? */
- /* runlevel */
- tainted = t->Ttainted;
- curpm = t->Tcurpm; /* XXX No PMOP ref count */
- nrs = newSVsv(t->Tnrs);
- rs = newSVsv(t->Trs);
- last_in_gv = (GV*)SvREFCNT_inc(t->Tlast_in_gv);
- ofslen = t->Tofslen;
- ofs = savepvn(t->Tofs, ofslen);
- defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv);
- chopset = t->Tchopset;
- formtarget = newSVsv(t->Tformtarget);
- bodytarget = newSVsv(t->Tbodytarget);
- toptarget = newSVsv(t->Ttoptarget);
- keys = newSVpv("", 0);
- } else {
- curcop = &compiling;
- chopset = " \n-";
- }
- MUTEX_LOCK(&threads_mutex);
- nthreads++;
- thr->tid = threadnum++;
- if (t) {
- thr->next = t->next;
- thr->prev = t;
- t->next = thr;
- thr->next->prev = thr;
- } else {
- thr->next = thr;
- thr->prev = thr;
- }
- MUTEX_UNLOCK(&threads_mutex);
-
-#ifdef HAVE_THREAD_INTERN
- init_thread_intern(thr);
-#else
- thr->self = pthread_self();
-#endif /* HAVE_THREAD_INTERN */
- SET_THR(thr);
- if (!t) {
- /*
- * These must come after the SET_THR because sv_setpvn does
- * SvTAINT and the taint fields require dTHR.
- */
- toptarget = NEWSV(0,0);
- sv_upgrade(toptarget, SVt_PVFM);
- sv_setpvn(toptarget, "", 0);
- bodytarget = NEWSV(0,0);
- sv_upgrade(bodytarget, SVt_PVFM);
- sv_setpvn(bodytarget, "", 0);
- formtarget = bodytarget;
- }
- return thr;
-}
-
-PADOFFSET
-key_create()
-{
- char *s;
- STRLEN len;
- PADOFFSET i;
- MUTEX_LOCK(&keys_mutex);
- s = SvPV(keys, len);
- for (i = 0; i < len; i++) {
- if (!s[i]) {
- s[i] = 1;
- break;
- }
- }
- if (i == len)
- sv_catpvn(keys, "\1", 1);
- MUTEX_UNLOCK(&keys_mutex);
- DEBUG_L(PerlIO_printf(PerlIO_stderr(), "key_create: %d\n", (int)i));
- return i;
-}
-
-void
-key_destroy(key)
-PADOFFSET key;
-{
- char *s;
- MUTEX_LOCK(&keys_mutex);
- s = SvPVX(keys);
- s[key] = 0;
- MUTEX_UNLOCK(&keys_mutex);
- DEBUG_L(PerlIO_printf(PerlIO_stderr(), "key_destroy: %d\n", (int)key));
-}
#endif /* USE_THREADS */
#ifdef HUGE_VAL
return HUGE_VAL;
}
#endif
+
# newly built perl.
INST_DRV=c:
INST_TOP=$(INST_DRV)\perl
+BUILDOPT=-DUSE_THREADS -TP
#
# uncomment next line if you are using Visual C++ 2.x
#
# uncomment next line if you want debug version of perl (big,slow)
-#CFG=Debug
+CFG=Debug
#
# set the install locations of the compiler include/libraries
!ENDIF
INCLUDES = -I.\include -I. -I..
#PCHFLAGS = -Fp"$(INTDIR)/modules.pch" -YX
-DEFINES = -DWIN32 -D_CONSOLE -DPERLDLL -TP
+DEFINES = -DWIN32 -D_CONSOLE $(BUILDOPT)
+LOCDEFS = -DPERLDLL
SUBSYS = console
!IF "$(RUNTIME)" == "-MD"
oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \
version.lib odbc32.lib odbccp32.lib
-CFLAGS = -nologo -W3 $(INCLUDES) $(DEFINES) $(PCHFLAGS) $(OPTIMIZE)
+CFLAGS = -nologo -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) $(PCHFLAGS) $(OPTIMIZE)
LINK_FLAGS = -nologo $(LIBFILES) $(LINK_DBG) -machine:I386
OBJOUT_FLAG = -Fo
WIN32_C = perllib.c \
win32.c \
win32io.c \
- win32sck.c
+ win32sck.c \
+ win32thread.c
WIN32_OBJ = win32.obj \
win32io.obj \
- win32sck.obj
+ win32sck.obj \
+ win32thread.obj
PERL95_OBJ = perl95.obj \
win32mt.obj \
.\include\sys\socket.h \
.\win32.h
-EXTENSIONS=DynaLoader Socket IO Fcntl Opcode SDBM_File attrs
+EXTENSIONS=DynaLoader Socket IO Fcntl Opcode SDBM_File attrs Thread
DYNALOADER=$(EXTDIR)\DynaLoader\DynaLoader
SOCKET=$(EXTDIR)\Socket\Socket
SDBM_FILE=$(EXTDIR)\SDBM_File\SDBM_File
IO=$(EXTDIR)\IO\IO
ATTRS=$(EXTDIR)\attrs\attrs
+THREAD=$(EXTDIR)\Thread\Thread
SOCKET_DLL=..\lib\auto\Socket\Socket.dll
FCNTL_DLL=..\lib\auto\Fcntl\Fcntl.dll
SDBM_FILE_DLL=..\lib\auto\SDBM_File\SDBM_File.dll
IO_DLL=..\lib\auto\IO\IO.dll
ATTRS_DLL=..\lib\auto\attrs\attrs.dll
+THREAD_DLL=..\lib\auto\Thread\Thread.dll
STATICLINKMODULES=DynaLoader
DYNALOADMODULES= \
$(OPCODE_DLL) \
$(SDBM_FILE_DLL)\
$(IO_DLL) \
- $(ATTRS_DLL)
+ $(ATTRS_DLL) \
+ $(THREAD_DLL)
POD2HTML=$(PODDIR)\pod2html
POD2MAN=$(PODDIR)\pod2man
config.w32 : $(CFGSH_TMPL)
copy $(CFGSH_TMPL) config.w32
-.\config.h : $(CFGSH_TMPL)
+.\config.h : $(CFGH_TMPL)
-del /f config.h
copy $(CFGH_TMPL) config.h
+
..\config.sh : config.w32 $(MINIPERL) config_sh.PL
$(MINIPERL) -I..\lib config_sh.PL "INST_DRV=$(INST_DRV)" \
- "INST_TOP=$(INST_TOP)" "cc=$(CC)" "ccflags=$(RUNTIME) -DWIN32" \
+ "INST_TOP=$(INST_TOP)" "cc=$(CC)" "ccflags=$(OPTIMIZE) $(DEFINES)" \
"cf_email=$(EMAIL)" "libs=$(LIBFILES)" "incpath=$(CCINCDIR)" \
"libpth=$(CCLIBDIR)" "libc=$(LIBC)" \
config.w32 > ..\config.sh
$(DLL_OBJ) : $(CORE_H)
perldll.def : $(MINIPERL) $(CONFIGPM)
- $(MINIPERL) -w makedef.pl $(CCTYPE) > perldll.def
+ $(MINIPERL) -w makedef.pl $(DEFINES) $(CCTYPE) > perldll.def
$(PERLDLL): perldll.def $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ)
$(LINK32) -dll -def:perldll.def -out:$@ @<<
$(MAKE)
cd ..\..\win32
+$(THREAD_DLL): $(PERLEXE) $(THREAD).xs
+ cd $(EXTDIR)\$(*B)
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ $(MAKE)
+ cd ..\..\win32
+
$(IO_DLL): $(PERLEXE) $(CONFIGPM) $(IO).xs
cd $(EXTDIR)\$(*B)
$(PERLIMPLIB) ..\miniperl.lib $(MINIMOD)
-del /f *.def *.map
-del /f $(SOCKET_DLL) $(IO_DLL) $(SDBM_FILE_DLL) $(FCNTL_DLL) \
- $(OPCODE_DLL) $(ATTRS_DLL)
+ $(OPCODE_DLL) $(ATTRS_DLL) $(THREAD_DLL)
-del /f $(SOCKET).c $(IO).c $(SDBM_FILE).c $(FCNTL).c $(OPCODE).c \
- $(DYNALOADER).c $(ATTRS).c
+ $(DYNALOADER).c $(ATTRS).c $(THREAD).c
-del /f $(PODDIR)\*.html
-del /f $(PODDIR)\*.bat
-del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c \
split=''
ssizetype='int'
startperl='#perl'
-stdchar='unsigned char'
+stdchar='char'
stdio_base='((fp)->_base)'
stdio_bufsiz='((fp)->_cnt + (fp)->_ptr - (fp)->_base)'
stdio_cnt='((fp)->_cnt)'
* This symbol is defined to be the type of char used in stdio.h.
* It has the values "unsigned char" or "char".
*/
-#define STDCHAR unsigned char /**/
+#define STDCHAR char /**/
/* Uid_t:
* This symbol holds the type used to declare user ids in the kernel.
Perl_pp_map
Perl_pp_nswitch
Perl_q
+Perl_rcsid
Perl_reall_srchlen
Perl_regdump
Perl_regfold
# Set these to wherever you want "nmake install" to put your
# newly built perl.
INST_DRV=c:
-INST_TOP=$(INST_DRV)\perl
-BUILDOPT=-DUSE_THREADS
+INST_TOP=$(INST_DRV)\perl\perl5004.5X
+BUILDOPT=-DUSE_THREADS
+
+# -DUSE_PERLIO -D__STDC__=1 -DUSE_SFIO -DI_SFIO -I\sfio97\include
#
# uncomment one if you are using Visual C++ 2.x or Borland
* "The Road goes ever on and on, down from the door where it began."
*/
-#ifdef __cplusplus
-extern "C" {
-#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef __cplusplus
-}
# define EXTERN_C extern "C"
#else
# define EXTERN_C extern
}
int
-do_aspawn(void* really, void** mark, void** arglast)
+do_aspawn(void* really, void ** mark, void ** arglast)
{
char **argv;
char *strPtr;
/* char *dummy;*/
/* check to see if filename is a directory */
- if (win32_stat(filename, &sbuf) < 0 || sbuf.st_mode & S_IFDIR == 0) {
+ if (win32_stat(filename, &sbuf) < 0 || (sbuf.st_mode & S_IFDIR) == 0) {
return NULL;
}
DllExport FILE *
win32_fdopen( int handle, const char *mode)
{
- return pIOSubSystem->pfnfdopen(handle, mode);
+ return pIOSubSystem->pfnfdopen(handle, (char *) mode);
}
DllExport FILE *
DllExport int
win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
{
- return pIOSubSystem->pfnspawnvp(mode, cmdname, argv);
+ return pIOSubSystem->pfnspawnvp(mode, cmdname, (char * const *) argv);
}
DllExport int
win32_execvp(const char *cmdname, const char *const *argv)
{
- return pIOSubSystem->pfnexecvp(cmdname, argv);
+ return pIOSubSystem->pfnexecvp(cmdname, (char *const *)argv);
}
DllExport void
_control87(MCW_EM, MCW_EM);
#endif
}
+
+
+
+
#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+
extern uid_t getuid(void);
extern gid_t getgid(void);
extern uid_t geteuid(void);
extern int kill(int pid, int sig);
+#ifdef __cplusplus
+}
+#endif
+
+
extern char *staticlinkmodules[];
/* if USE_WIN32_RTL_ENV is not defined, Perl uses direct Win32 calls
EXT char *win32_getenv(const char *name);
#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
EXT void Perl_win32_init(int *argcp, char ***argvp);
#define USE_SOCKETS_AS_HANDLES
#ifndef USE_SOCKETS_AS_HANDLES
+
extern FILE *myfdopen(int, char *);
#undef fdopen
char *win32SiteLibPath(void);
int mytimes(struct tms *timebuf);
unsigned int myalarm(unsigned int sec);
-int do_aspawn(void* really, void** mark, void** arglast);
+int do_aspawn(void* really, void ** mark, void ** arglast);
int do_spawn(char *cmd);
char do_exec(char *cmd);
void init_os_extras(void);
+#ifdef __cplusplus
+}
+#endif
+
typedef char * caddr_t; /* In malloc.c (core address). */
/*
#pragma warning(disable: 4018 4035 4101 4102 4244 4245 4761)
#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+
int IsWin95(void);
int IsWinNT(void);
+#ifdef __cplusplus
+}
+#endif
+
+
#ifndef VER_PLATFORM_WIN32_WINDOWS /* VC-2.0 headers dont have this */
#define VER_PLATFORM_WIN32_WINDOWS 1
#endif
-#ifdef __cplusplus
-extern "C" {
-#endif
#define WIN32_LEAN_AND_MEAN
+#include <stdio.h>
+extern int my_fclose(FILE *pf);
+#include "EXTERN.h"
#define WIN32IO_IS_STDIO
-#define EXT
#include <windows.h>
-#include <stdio.h>
#include <stdlib.h>
#include <io.h>
#include <sys/stat.h>
#include <errno.h>
#include <process.h>
#include <direct.h>
+
+
+#ifdef __cplusplus
+#define START_EXTERN_C extern "C" {
+#define END_EXTERN_C }
+#else
+#define START_EXTERN_C
+#define END_EXTERN_C
+#endif
+
#include "win32iop.h"
/*
#undef LK_ERR
#undef LK_LEN
-EXT int my_fclose(FILE *pf);
#ifdef PERLDLL
__declspec(dllexport)
};
-#ifdef __cplusplus
-}
-#endif
+
+
#ifdef __BORLANDC__
#include <stdarg.h>
+#define MSconst
+#else
+#define MSconst const
#endif
typedef struct {
size_t (*pfnfread)(void *buf, size_t size, size_t count, FILE *pf);
size_t (*pfnfwrite)(const void *buf, size_t size, size_t count, FILE *pf);
FILE* (*pfnfopen)(const char *path, const char *mode);
-FILE* (*pfnfdopen)(int fh, const char *mode);
+FILE* (*pfnfdopen)(int fh, MSconst char *mode);
FILE* (*pfnfreopen)(const char *path, const char *mode, FILE *pf);
int (*pfnfclose)(FILE *pf);
int (*pfnfputs)(const char *s,FILE *pf);
int (*pfnopenmode)(int mode);
int (*pfn_open_osfhandle)(long handle, int flags);
long (*pfn_get_osfhandle)(int fd);
-int (*pfnspawnvp)(int mode, const char *cmdname, const char *const *argv);
+int (*pfnspawnvp)(int mode, const char *cmdname, MSconst char * const *argv);
int (*pfnmkdir)(const char *path);
int (*pfnrmdir)(const char *path);
int (*pfnchdir)(const char *path);
int (*pfnflock)(int fd, int oper);
-int (*pfnexecvp)(const char *cmdname, const char *const *argv);
+int (*pfnexecvp)(const char *cmdname, MSconst char *const *argv);
void (*pfnperror)(const char *str);
void (*pfnsetbuf)(FILE *pf, char *buf);
int (*pfnsetvbuf)(FILE *pf, char *buf, int type, size_t size);
typedef WIN32_IOSUBSYSTEM *PWIN32_IOSUBSYSTEM;
#endif /* WIN32IO_H */
+
#ifndef WIN32IOP_H
#define WIN32IOP_H
+/*
+ * defines for flock emulation
+ */
+#define LOCK_SH 1
+#define LOCK_EX 2
+#define LOCK_NB 4
+#define LOCK_UN 8
+
+#include <win32io.h> /* pull in the io sub system structure */
/*
* Make this as close to original stdio as possible.
/*
* function prototypes for our own win32io layer
*/
+START_EXTERN_C
+
EXT int * win32_errno(void);
EXT char *** win32_environ(void);
EXT FILE* win32_stdin(void);
EXT void* win32_realloc(void *block, size_t size);
EXT void win32_free(void *block);
+
+
/*
* these two are win32 specific but still io related
*/
int stolen_open_osfhandle(long handle, int flags);
long stolen_get_osfhandle(int fd);
-/*
- * defines for flock emulation
- */
-#define LOCK_SH 1
-#define LOCK_EX 2
-#define LOCK_NB 4
-#define LOCK_UN 8
-
-#include <win32io.h> /* pull in the io sub system structure */
EXT PWIN32_IOSUBSYSTEM SetIOSubSystem(void *piosubsystem);
EXT PWIN32_IOSUBSYSTEM GetIOSubSystem(void);
+END_EXTERN_C
+
/*
* the following six(6) is #define in stdio.h
*/
#define WIN32IO_IS_STDIO
#include <io.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
#include "win32iop.h"
+#ifdef __cplusplus
+}
+#endif
static struct servent*
win32_savecopyservent(struct servent*d, struct servent*s, const char *proto)
} STMT_END
#define THR ((struct thread *) TlsGetValue(thr_key))
+#define THREAD_CREATE(t, f) Perl_thread_create(t, f)
+#define THREAD_POST_CREATE(t) NOOP
+#define THREAD_RET_TYPE DWORD WINAPI
+#define THREAD_RET_CAST(p) ((DWORD)(p))
+
+typedef THREAD_RET_TYPE thread_func_t(void *);
#define HAVE_THREAD_INTERN
-void init_thread_intern _((struct thread *thr));
+START_EXTERN_C
+void Perl_init_thread_intern _((struct thread *thr));
+int Perl_thread_create _((struct thread *thr, thread_func_t *fn));
+END_EXTERN_C
#define JOIN(t, avp) \
STMT_START { \
croak("panic: TlsSetValue"); \
} STMT_END
-#define THREAD_CREATE(t, f) Perl_thread_create(t, f)
-#define THREAD_POST_CREATE(t) NOOP
-#define THREAD_RET_TYPE DWORD WINAPI
-#define THREAD_RET_CAST(p) ((DWORD)(p))
#define YIELD Sleep(0)
-typedef THREAD_RET_TYPE thread_func_t(void *);
-
-int Perl_thread_create _((struct thread *thr, thread_func_t *fn));
-
-#endif /* _WIN32THREAD_H */
\ No newline at end of file
+#endif /* _WIN32THREAD_H */
projects / p5sagit/p5-mst-13.2.git / commitdiff