From: Nick Ing-Simmons Date: Wed, 5 Nov 1997 01:04:10 +0000 (+0000) Subject: Builds C++ Borland, MSVC++ (Win32) and GCC++ (Solaris) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4e35701fd273ba8d0093a29660dee38a92408e9b;p=p5sagit%2Fp5-mst-13.2.git Builds C++ Borland, MSVC++ (Win32) and GCC++ (Solaris) p4raw-id: //depot/ansiperl@203 --- diff --git a/XSUB.h b/XSUB.h index b3ea825..c7c3f6d 100644 --- a/XSUB.h +++ b/XSUB.h @@ -7,7 +7,7 @@ #endif #define dXSARGS \ - dTHR; dSP; dMARK; \ + dSP; dMARK; \ I32 ax = mark - stack_base + 1; \ I32 items = sp - mark diff --git a/doio.c b/doio.c index afb9e75..8413fca 100644 --- a/doio.c +++ b/doio.c @@ -801,7 +801,7 @@ do_print(register SV *sv, FILE *fp) I32 my_stat(ARGSproto) { - dSP; + djSP; IO *io; GV* tmpgv; @@ -852,7 +852,7 @@ my_stat(ARGSproto) I32 my_lstat(ARGSproto) { - dSP; + djSP; SV *sv; if (op->op_flags & OPf_REF) { EXTEND(sp,1); @@ -1551,3 +1551,4 @@ do_shmio(I32 optype, SV **mark, SV **sp) } #endif /* SYSV IPC */ + diff --git a/doop.c b/doop.c index 93b618c..7209e1d 100644 --- a/doop.c +++ b/doop.c @@ -244,7 +244,6 @@ do_chop(register SV *astr, register SV *sv) I32 do_chomp(register SV *sv) { - dTHR; register I32 count; STRLEN len; char *s; @@ -318,7 +317,6 @@ do_chomp(register SV *sv) void do_vop(I32 optype, SV *sv, SV *left, SV *right) { - dTHR; /* just for taint */ #ifdef LIBERAL register long *dl; register long *ll; @@ -432,7 +430,7 @@ do_vop(I32 optype, SV *sv, SV *left, SV *right) OP * do_kv(ARGSproto) { - dSP; + djSP; HV *hv = (HV*)POPs; register HE *entry; SV *tmpstr; @@ -514,3 +512,4 @@ do_kv(ARGSproto) } return NORMAL; } + diff --git a/embed.h b/embed.h index 6deda40..c458b50 100644 --- a/embed.h +++ b/embed.h @@ -289,8 +289,6 @@ #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 @@ -445,6 +443,7 @@ #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 @@ -461,7 +460,6 @@ #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 @@ -516,7 +514,6 @@ #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 @@ -823,7 +820,6 @@ #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 @@ -1058,12 +1054,14 @@ #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 @@ -1086,12 +1084,14 @@ #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 @@ -1181,10 +1181,6 @@ #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 @@ -1268,8 +1264,7 @@ #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) @@ -1283,8 +1278,6 @@ #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) @@ -1297,7 +1290,6 @@ #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) @@ -1424,8 +1416,7 @@ #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 @@ -1439,8 +1430,6 @@ #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 @@ -1453,7 +1442,6 @@ #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 @@ -1589,8 +1577,7 @@ #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 @@ -1604,8 +1591,6 @@ #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 @@ -1618,7 +1603,6 @@ #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 diff --git a/ext/SDBM_File/sdbm/sdbm.h b/ext/SDBM_File/sdbm/sdbm.h index fc0ea87..5bc629f 100644 --- a/ext/SDBM_File/sdbm/sdbm.h +++ b/ext/SDBM_File/sdbm/sdbm.h @@ -49,7 +49,7 @@ typedef struct { extern datum nullitem; -#ifdef __STDC__ +#if defined(__STDC__) || defined(__cplusplus) #define proto(p) p #else #define proto(p) () @@ -268,3 +268,4 @@ extern long sdbm_hash proto((char *, int)); #endif #endif /* Include guard */ + diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index e6714aa..6e7f4b7 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -82,7 +82,7 @@ threadstart(void *arg) #else Thread thr = (Thread) arg; LOGOP myop; - dSP; + djSP; I32 oldmark = TOPMARK; I32 oldscope = scopestack_ix; I32 retval; @@ -208,7 +208,6 @@ static SV * newthread (SV *startsv, AV *initargs, char *Class) { #ifdef USE_THREADS - dTHR; dSP; Thread savethread; int i; @@ -219,9 +218,38 @@ newthread (SV *startsv, AV *initargs, char *Class) #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)); @@ -570,3 +598,4 @@ await_signal() RETVAL = c ? psig_ptr[c] : &sv_no; OUTPUT: RETVAL + diff --git a/global.sym b/global.sym index fc7bc04..5702556 100644 --- a/global.sym +++ b/global.sym @@ -76,8 +76,6 @@ in_my in_my_stash inc_amg io_close -key_create -key_destroy know_next last_lop last_lop_op @@ -122,7 +120,6 @@ na ncmp_amg ne_amg neg_amg -new_struct_thread nexttoke nexttype nextval @@ -165,7 +162,6 @@ pad_reset_pending padix padix_floor patleave -per_thread_magicals pidstatus pow_amg pow_ass_amg @@ -305,10 +301,10 @@ yyval # Functions Gv_AMupdate -SvTRUE -SvIV -SvUV -SvNV +sv_true +sv_iv +sv_uv +sv_nv amagic_call append_elem append_list @@ -622,6 +618,7 @@ newPROG newPVOP newRANGE newRV +newRV_noinc newSLICEOP newSTATEOP newSUB @@ -959,7 +956,6 @@ pp_snetent pp_socket pp_sockpair pp_sort -pp_specific pp_splice pp_split pp_sprintf diff --git a/gv.c b/gv.c index da6dd63..25f8cb1 100644 --- a/gv.c +++ b/gv.c @@ -219,6 +219,7 @@ gv_fetchmeth(HV *stash, char *name, STRLEN len, I32 level) (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)); @@ -1284,7 +1285,6 @@ amagic_call(SV *left, SV *right, int method, int flags) || inc_dec_ass) RvDEEPCP(left); } { - dTHR; dSP; BINOP myop; SV* res; @@ -1362,3 +1362,4 @@ amagic_call(SV *left, SV *right, int method, int flags) } } #endif /* OVERLOAD */ + diff --git a/hv.c b/hv.c index f3ab6cc..2ef9ae3 100644 --- a/hv.c +++ b/hv.c @@ -294,7 +294,6 @@ hv_store_ent(HV *hv, SV *keysv, SV *val, register U32 hash) xhv = (XPVHV*)SvANY(hv); if (SvMAGICAL(hv)) { - dTHR; bool save_taint = tainted; if (tainting) tainted = SvTAINTED(keysv); @@ -878,6 +877,7 @@ hv_iternext(HV *hv) } 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 */ diff --git a/interp.sym b/interp.sym index d64093e..1583ea2 100644 --- a/interp.sym +++ b/interp.sym @@ -47,8 +47,7 @@ e_fp e_tmpname endav envgv -errhv -errsv +errgv eval_root eval_start fdpid @@ -62,8 +61,6 @@ in_eval incgv initav inplace -keys -keys_mutex last_in_gv lastfd lastretstr @@ -76,7 +73,6 @@ leftgv lineary localizing localpatches -magical_keys main_cv main_root main_start diff --git a/mg.c b/mg.c index 0699b47..5d27026 100644 --- a/mg.c +++ b/mg.c @@ -247,7 +247,6 @@ mg_free(SV *sv) U32 magic_len(SV *sv, MAGIC *mg) { - dTHR; register I32 paren; register char *s; register I32 i; @@ -311,7 +310,6 @@ magic_len(SV *sv, MAGIC *mg) int magic_get(SV *sv, MAGIC *mg) { - dTHR; register I32 paren; register char *s; register I32 i; @@ -398,11 +396,7 @@ magic_get(SV *sv, MAGIC *mg) 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]) && @@ -559,11 +553,6 @@ magic_get(SV *sv, MAGIC *mg) break; case '0': break; -#ifdef USE_THREADS - case '@': - sv_setsv(sv, errsv); - break; -#endif /* USE_THREADS */ } return 0; } @@ -729,6 +718,7 @@ magic_getsig(SV *sv, MAGIC *mg) 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 */ @@ -867,7 +857,6 @@ magic_setnkeys(SV *sv, MAGIC *mg) static int magic_methpack(SV *sv, MAGIC *mg, char *meth) { - dTHR; dSP; ENTER; @@ -905,7 +894,6 @@ magic_getpack(SV *sv, MAGIC *mg) int magic_setpack(SV *sv, MAGIC *mg) { - dTHR; dSP; PUSHMARK(sp); @@ -935,7 +923,6 @@ magic_clearpack(SV *sv, MAGIC *mg) int magic_wipepack(SV *sv, MAGIC *mg) { - dTHR; dSP; PUSHMARK(sp); @@ -950,7 +937,6 @@ int magic_wipepack(SV *sv, MAGIC *mg) int magic_nextpack(SV *sv, MAGIC *mg, SV *key) { - dTHR; dSP; char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY"; @@ -1112,7 +1098,6 @@ magic_setsubstr(SV *sv, MAGIC *mg) 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; @@ -1619,11 +1604,6 @@ magic_set(SV *sv, MAGIC *mg) origargv[i] = Nullch; } break; -#ifdef USE_THREADS - case '@': - sv_setsv(errsv, sv); - break; -#endif /* USE_THREADS */ } return 0; } @@ -1681,7 +1661,6 @@ unwind_handler_stack(void *p) Signal_t sighandler(int sig) { - dTHR; dSP; GV *gv; HV *st; @@ -1782,3 +1761,5 @@ sighandler(int sig) Xpv = tXpv; return; } + + diff --git a/miniperlmain.c b/miniperlmain.c index a55a855..7522ae2 100644 --- a/miniperlmain.c +++ b/miniperlmain.c @@ -6,15 +6,12 @@ #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 @@ -58,6 +55,7 @@ char **env; PERL_SYS_TERM(); exit( exitstatus ); + return exitstatus; } /* Register any extra external extensions */ diff --git a/op.c b/op.c index 637537f..a0309de 100644 --- a/op.c +++ b/op.c @@ -235,7 +235,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) 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; } } @@ -495,33 +495,6 @@ pad_reset(void) 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 @@ -1149,7 +1122,6 @@ mod(OP *o, I32 type) goto nomod; /* FALL THROUGH */ case OP_PADSV: - case OP_SPECIFIC: modcount++; if (!type) croak("Can't localize lexical variable %s", @@ -1306,10 +1278,6 @@ ref(OP *o, I32 type) } break; - case OP_SPECIFIC: - o->op_flags |= OPf_MOD; /* XXX ??? */ - break; - case OP_RV2AV: case OP_RV2HV: o->op_flags |= OPf_REF; @@ -2096,8 +2064,7 @@ pmruntime(OP *o, OP *expr, OP *repl) 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 @@ -3295,8 +3262,8 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) 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)); } } } @@ -3678,8 +3645,6 @@ newSVREF(OP *o) o->op_ppaddr = ppaddr[OP_PADSV]; return o; } - else if (o->op_type == OP_SPECIFIC) - return o; return newUNOP(OP_RV2SV, 0, scalar(o)); } diff --git a/op.h b/op.h index ad208cf..c582134 100644 --- a/op.h +++ b/op.h @@ -35,7 +35,7 @@ typedef U32 PADOFFSET; #define BASEOP \ OP* op_next; \ OP* op_sibling; \ - OP* (*op_ppaddr)(); \ + OP* (*op_ppaddr)_((ARGSproto)); \ PADOFFSET op_targ; \ OPCODE op_type; \ U16 op_seq; \ diff --git a/opcode.h b/opcode.h index 936831b..7ac3895 100644 --- a/opcode.h +++ b/opcode.h @@ -349,11 +349,10 @@ typedef enum { 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[]; @@ -704,7 +703,6 @@ EXT char *op_name[] = { "getlogin", "syscall", "lock", - "specific", }; #endif @@ -1057,10 +1055,11 @@ EXT char *op_desc[] = { "getlogin", "syscall", "lock", - "thread-specific", }; #endif +START_EXTERN_C + OP * ck_anoncode _((OP* o)); OP * ck_bitop _((OP* o)); OP * ck_concat _((OP* o)); @@ -1439,12 +1438,14 @@ OP * pp_egrent _((ARGSproto)); 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, @@ -1790,7 +1791,6 @@ EXT OP * (*ppaddr[])() = { pp_getlogin, pp_syscall, pp_lock, - pp_specific, }; #endif @@ -2143,7 +2143,6 @@ EXT OP * (*check[]) _((OP *op)) = { ck_null, /* getlogin */ ck_fun, /* syscall */ ck_rfun, /* lock */ - ck_null, /* specific */ }; #endif @@ -2496,6 +2495,6 @@ EXT U32 opargs[] = { 0x0000000c, /* getlogin */ 0x0002151d, /* syscall */ 0x00001c04, /* lock */ - 0x00000044, /* specific */ }; #endif + diff --git a/opcode.pl b/opcode.pl index a97e987..1ef36f2 100755 --- a/opcode.pl +++ b/opcode.pl @@ -180,6 +180,8 @@ for (@ops) { $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{$_})) { @@ -188,6 +190,7 @@ for (@ops) { $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"; } @@ -677,4 +680,3 @@ syscall syscall ck_fun imst@ S L # For multi-threading lock lock ck_rfun s% S -specific thread-specific ck_null ds0 diff --git a/patchlevel.h b/patchlevel.h index c5dff60..d8da982 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1,5 +1,5 @@ #define PATCHLEVEL 4 -#define SUBVERSION 54 +#define SUBVERSION 52 /* local_patches -- list of locally applied less-than-subversion patches. diff --git a/perl.c b/perl.c index 6606f71..aff14f4 100644 --- a/perl.c +++ b/perl.c @@ -106,12 +106,9 @@ perl_alloc(void) 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; @@ -123,25 +120,45 @@ perl_construct(register PerlInterpreter *sv_interp) /* 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); @@ -211,9 +228,6 @@ perl_construct(register PerlInterpreter *sv_interp) 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); @@ -471,8 +485,7 @@ perl_destruct(register PerlInterpreter *sv_interp) envgv = Nullgv; siggv = Nullgv; incgv = Nullgv; - errhv = Nullhv; - errsv = Nullsv; + errgv = Nullgv; argvgv = Nullgv; argvoutgv = Nullgv; stdingv = Nullgv; @@ -966,11 +979,8 @@ print \" \\@INC:\\n @INC\\n\";"); /* 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(); @@ -1129,7 +1139,6 @@ perl_call_argv(char *subname, I32 flags, register char **argv) /* See G_* flags in cop.h */ /* null terminated arg list */ { - dTHR; dSP; PUSHMARK(sp); @@ -1156,7 +1165,6 @@ perl_call_method(char *methname, I32 flags) /* name of the subroutine */ /* See G_* flags in cop.h */ { - dTHR; dSP; OP myop; if (!op) @@ -1233,7 +1241,7 @@ perl_call_sv(SV *sv, I32 flags) if (flags & G_KEEPERR) in_eval |= 4; else - sv_setpv(errsv,""); + sv_setpv(GvSV(errgv),""); } markstack_ptr++; @@ -1278,7 +1286,7 @@ perl_call_sv(SV *sv, I32 flags) 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) { @@ -1387,7 +1395,7 @@ perl_eval_sv(SV *sv, I32 flags) runops(); retval = stack_sp - (stack_base + oldmark); if (!(flags & G_KEEPERR)) - sv_setpv(errsv,""); + sv_setpv(GvSV(errgv),""); cleanup: JMPENV_POP; @@ -1404,7 +1412,6 @@ perl_eval_sv(SV *sv, I32 flags) SV* perl_eval_pv(char *p, I32 croak_on_error) { - dTHR; dSP; SV* sv = newSVpv(p, 0); @@ -1416,8 +1423,8 @@ perl_eval_pv(char *p, I32 croak_on_error) 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; } @@ -1494,8 +1501,6 @@ moreswitches(char *s) switch (*s) { case '0': - { - dTHR; rschar = scan_oct(s, 4, &numlen); SvREFCNT_dec(nrs); if (rschar & ~((U8)~0)) @@ -1507,7 +1512,6 @@ moreswitches(char *s) nrs = newSVpv(&ch, 1); } return s + numlen; - } case 'F': minus_F = TRUE; splitstr = savepv(s + 1); @@ -1594,7 +1598,6 @@ moreswitches(char *s) s += numlen; } else { - dTHR; if (RsPARA(nrs)) { ors = "\n\n"; orslen = 2; @@ -1783,11 +1786,11 @@ init_main_stash(void) 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)); @@ -2519,11 +2522,7 @@ init_predump_symbols(void) 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); @@ -2556,7 +2555,6 @@ init_predump_symbols(void) static void init_postdump_symbols(register int argc, register char **argv, register char **env) { - dTHR; char *s; SV *sv; GV* tmpgv; @@ -2815,7 +2813,7 @@ call_list(I32 oldscope, AV *list) 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); @@ -2876,8 +2874,8 @@ my_exit(U32 status) 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: @@ -2943,3 +2941,4 @@ my_exit_jump(void) JMPENV_JUMP(2); } + diff --git a/perl.h b/perl.h index 9a8d74e..d039dee 100644 --- a/perl.h +++ b/perl.h @@ -29,6 +29,22 @@ #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 @@ -64,21 +80,6 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); #define WITH_THR(s) do { dTHR; s; } while (0) -#ifdef USE_THREADS -# ifdef FAKE_THREADS -# include "fakethr.h" -# else -# ifdef WIN32 -# include -# else -# include -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. @@ -949,7 +950,31 @@ typedef I32 (*filter_t) _((int, SV *, int)); # include "unixish.h" # endif # endif -#endif +#endif + +/* + * USE_THREADS needs to be after unixish.h as includes + * which defines NSIG - which will stop inclusion of + * 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 +# else +# include +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 @@ -1121,13 +1146,7 @@ EXT char Error[1]; #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))) @@ -1138,15 +1157,11 @@ U32 cast_ulong _((double)); #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))) @@ -1251,9 +1266,7 @@ char *strcpy(), *strcat(); #ifdef I_MATH # include #else -# ifdef __cplusplus - extern "C" { -# endif +START_EXTERN_C double exp _((double)); double log _((double)); double log10 _((double)); @@ -1265,9 +1278,7 @@ char *strcpy(), *strcat(); double cos _((double)); double atan2 _((double,double)); double pow _((double,double)); -# ifdef __cplusplus - }; -# endif +END_EXTERN_C #endif #ifndef __cplusplus @@ -1338,9 +1349,6 @@ int runops_standard _((void)); int runops_debug _((void)); #endif -#define PER_THREAD_MAGICALS "123456789&`'+/.,\\\";^-%=|~:\001\005!@" -#define N_PER_THREAD_MAGICALS 30 - /****************/ /* Truly global */ /****************/ @@ -1357,7 +1365,6 @@ EXT struct thread * eval_owner; /* Owner thread for doeval */ 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 @@ -1860,8 +1867,7 @@ IEXT I32 Imaxscream IINIT(-1); IEXT SV * Ilastscream; /* shortcuts to misc objects */ -IEXT HV * Ierrhv; -IEXT SV * Ierrsv; +IEXT GV * Ierrgv; /* shortcuts to debugging objects */ IEXT GV * IDBgv; @@ -1970,10 +1976,6 @@ IEXT SV * Imess_sv; #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 @@ -1990,10 +1992,7 @@ struct interpreter { #include "thread.h" #include "pp.h" -#ifdef __cplusplus -extern "C" { -#endif - +START_EXTERN_C #include "proto.h" #ifdef EMBED @@ -2004,9 +2003,7 @@ extern "C" { #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 */ diff --git a/pp.c b/pp.c index ac722c4..3234be3 100644 --- a/pp.c +++ b/pp.c @@ -26,16 +26,6 @@ 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. * @@ -125,7 +115,7 @@ extern pid_t getpid (void); PP(pp_stub) { - dSP; + djSP; if (GIMME_V == G_SCALAR) XPUSHs(&sv_undef); RETURN; @@ -140,7 +130,7 @@ PP(pp_scalar) PP(pp_padav) { - dSP; dTARGET; + djSP; dTARGET; if (op->op_private & OPpLVAL_INTRO) SAVECLEARSV(curpad[op->op_targ]); EXTEND(SP, 1); @@ -165,7 +155,7 @@ PP(pp_padav) PP(pp_padhv) { - dSP; dTARGET; + djSP; dTARGET; I32 gimme; XPUSHs(TARG); @@ -198,7 +188,7 @@ PP(pp_padany) PP(pp_rv2gv) { - dSP; dTOPss; + djSP; dTOPss; if (SvROK(sv)) { wasref: @@ -243,7 +233,7 @@ PP(pp_rv2gv) PP(pp_rv2sv) { - dSP; dTOPss; + djSP; dTOPss; if (SvROK(sv)) { wasref: @@ -292,7 +282,7 @@ PP(pp_rv2sv) PP(pp_av2arylen) { - dSP; + djSP; AV *av = (AV*)TOPs; SV *sv = AvARYLEN(av); if (!sv) { @@ -306,7 +296,7 @@ PP(pp_av2arylen) PP(pp_pos) { - dSP; dTARGET; dPOPss; + djSP; dTARGET; dPOPss; if (op->op_flags & OPf_MOD) { if (SvTYPE(TARG) < SVt_PVLV) { @@ -335,7 +325,7 @@ PP(pp_pos) PP(pp_rv2cv) { - dSP; + djSP; GV *gv; HV *stash; @@ -354,7 +344,7 @@ PP(pp_rv2cv) PP(pp_prototype) { - dSP; + djSP; CV *cv; HV *stash; GV *gv; @@ -370,7 +360,7 @@ PP(pp_prototype) PP(pp_anoncode) { - dSP; + djSP; CV* cv = (CV*)curpad[op->op_targ]; if (CvCLONE(cv)) cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); @@ -381,14 +371,14 @@ PP(pp_anoncode) 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; @@ -413,6 +403,7 @@ refto(SV *sv) else if (SvPADTMP(sv)) sv = newSVsv(sv); else { + dTHR; /* just for SvREFCNT_inc */ SvTEMP_off(sv); (void)SvREFCNT_inc(sv); } @@ -425,7 +416,7 @@ refto(SV *sv) PP(pp_ref) { - dSP; dTARGET; + djSP; dTARGET; SV *sv; char *pv; @@ -445,7 +436,7 @@ PP(pp_ref) PP(pp_bless) { - dSP; + djSP; HV *stash; if (MAXARG == 1) @@ -463,7 +454,7 @@ PP(pp_gelem) SV *sv; SV *ref; char *elem; - dSP; + djSP; sv = POPs; elem = SvPV(sv, na); @@ -523,7 +514,7 @@ PP(pp_gelem) PP(pp_study) { - dSP; dPOPss; + djSP; dPOPss; register unsigned char *s; register I32 pos; register I32 ch; @@ -585,7 +576,7 @@ PP(pp_study) PP(pp_trans) { - dSP; dTARG; + djSP; dTARG; SV *sv; if (op->op_flags & OPf_STACKED) @@ -603,7 +594,7 @@ PP(pp_trans) PP(pp_schop) { - dSP; dTARGET; + djSP; dTARGET; do_chop(TARG, TOPs); SETTARG; RETURN; @@ -611,7 +602,7 @@ PP(pp_schop) PP(pp_chop) { - dSP; dMARK; dTARGET; + djSP; dMARK; dTARGET; while (SP > MARK) do_chop(TARG, POPs); PUSHTARG; @@ -620,14 +611,14 @@ PP(pp_chop) 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) @@ -638,7 +629,7 @@ PP(pp_chomp) PP(pp_defined) { - dSP; + djSP; register SV* sv; sv = POPs; @@ -668,7 +659,7 @@ PP(pp_defined) PP(pp_undef) { - dSP; + djSP; SV *sv; if (!op->op_private) { @@ -726,7 +717,7 @@ PP(pp_undef) PP(pp_predec) { - dSP; + djSP; if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) croak(no_modify); if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && @@ -743,7 +734,7 @@ PP(pp_predec) PP(pp_postinc) { - dSP; dTARGET; + djSP; dTARGET; if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) croak(no_modify); sv_setsv(TARG, TOPs); @@ -764,7 +755,7 @@ PP(pp_postinc) PP(pp_postdec) { - dSP; dTARGET; + djSP; dTARGET; if(SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) croak(no_modify); sv_setsv(TARG, TOPs); @@ -785,7 +776,7 @@ PP(pp_postdec) PP(pp_pow) { - dSP; dATARGET; tryAMAGICbin(pow,opASSIGN); + djSP; dATARGET; tryAMAGICbin(pow,opASSIGN); { dPOPTOPnnrl; SETn( pow( left, right) ); @@ -795,7 +786,7 @@ PP(pp_pow) PP(pp_multiply) { - dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); + djSP; dATARGET; tryAMAGICbin(mult,opASSIGN); { dPOPTOPnnrl; SETn( left * right ); @@ -805,7 +796,7 @@ PP(pp_multiply) PP(pp_divide) { - dSP; dATARGET; tryAMAGICbin(div,opASSIGN); + djSP; dATARGET; tryAMAGICbin(div,opASSIGN); { dPOPPOPnnrl; double value; @@ -833,7 +824,7 @@ PP(pp_divide) PP(pp_modulo) { - dSP; dATARGET; tryAMAGICbin(mod,opASSIGN); + djSP; dATARGET; tryAMAGICbin(mod,opASSIGN); { UV left; UV right; @@ -868,8 +859,8 @@ PP(pp_modulo) 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); } @@ -882,7 +873,7 @@ PP(pp_modulo) 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) { @@ -938,7 +929,7 @@ PP(pp_repeat) PP(pp_subtract) { - dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); + djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); { dPOPTOPnnrl_ul; SETn( left - right ); @@ -948,7 +939,7 @@ PP(pp_subtract) PP(pp_left_shift) { - dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); + djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); { IBW shift = POPi; if (op->op_private & HINT_INTEGER) { @@ -967,7 +958,7 @@ PP(pp_left_shift) PP(pp_right_shift) { - dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); + djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); { IBW shift = POPi; if (op->op_private & HINT_INTEGER) { @@ -986,7 +977,7 @@ PP(pp_right_shift) PP(pp_lt) { - dSP; tryAMAGICbinSET(lt,0); + djSP; tryAMAGICbinSET(lt,0); { dPOPnv; SETs(boolSV(TOPn < value)); @@ -996,7 +987,7 @@ PP(pp_lt) PP(pp_gt) { - dSP; tryAMAGICbinSET(gt,0); + djSP; tryAMAGICbinSET(gt,0); { dPOPnv; SETs(boolSV(TOPn > value)); @@ -1006,7 +997,7 @@ PP(pp_gt) PP(pp_le) { - dSP; tryAMAGICbinSET(le,0); + djSP; tryAMAGICbinSET(le,0); { dPOPnv; SETs(boolSV(TOPn <= value)); @@ -1016,7 +1007,7 @@ PP(pp_le) PP(pp_ge) { - dSP; tryAMAGICbinSET(ge,0); + djSP; tryAMAGICbinSET(ge,0); { dPOPnv; SETs(boolSV(TOPn >= value)); @@ -1026,7 +1017,7 @@ PP(pp_ge) PP(pp_ne) { - dSP; tryAMAGICbinSET(ne,0); + djSP; tryAMAGICbinSET(ne,0); { dPOPnv; SETs(boolSV(TOPn != value)); @@ -1036,7 +1027,7 @@ PP(pp_ne) PP(pp_ncmp) { - dSP; dTARGET; tryAMAGICbin(ncmp,0); + djSP; dTARGET; tryAMAGICbin(ncmp,0); { dPOPTOPnnrl; I32 value; @@ -1058,7 +1049,7 @@ PP(pp_ncmp) PP(pp_slt) { - dSP; tryAMAGICbinSET(slt,0); + djSP; tryAMAGICbinSET(slt,0); { dPOPTOPssrl; int cmp = ((op->op_private & OPpLOCALE) @@ -1071,7 +1062,7 @@ PP(pp_slt) PP(pp_sgt) { - dSP; tryAMAGICbinSET(sgt,0); + djSP; tryAMAGICbinSET(sgt,0); { dPOPTOPssrl; int cmp = ((op->op_private & OPpLOCALE) @@ -1084,7 +1075,7 @@ PP(pp_sgt) PP(pp_sle) { - dSP; tryAMAGICbinSET(sle,0); + djSP; tryAMAGICbinSET(sle,0); { dPOPTOPssrl; int cmp = ((op->op_private & OPpLOCALE) @@ -1097,7 +1088,7 @@ PP(pp_sle) PP(pp_sge) { - dSP; tryAMAGICbinSET(sge,0); + djSP; tryAMAGICbinSET(sge,0); { dPOPTOPssrl; int cmp = ((op->op_private & OPpLOCALE) @@ -1110,7 +1101,7 @@ PP(pp_sge) PP(pp_seq) { - dSP; tryAMAGICbinSET(seq,0); + djSP; tryAMAGICbinSET(seq,0); { dPOPTOPssrl; SETs(boolSV(sv_eq(left, right))); @@ -1120,7 +1111,7 @@ PP(pp_seq) PP(pp_sne) { - dSP; tryAMAGICbinSET(sne,0); + djSP; tryAMAGICbinSET(sne,0); { dPOPTOPssrl; SETs(boolSV(!sv_eq(left, right))); @@ -1130,7 +1121,7 @@ PP(pp_sne) PP(pp_scmp) { - dSP; dTARGET; tryAMAGICbin(scmp,0); + djSP; dTARGET; tryAMAGICbin(scmp,0); { dPOPTOPssrl; int cmp = ((op->op_private & OPpLOCALE) @@ -1143,7 +1134,7 @@ PP(pp_scmp) PP(pp_bit_and) { - dSP; dATARGET; tryAMAGICbin(band,opASSIGN); + djSP; dATARGET; tryAMAGICbin(band,opASSIGN); { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { @@ -1166,7 +1157,7 @@ PP(pp_bit_and) PP(pp_bit_xor) { - dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); + djSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { @@ -1189,7 +1180,7 @@ PP(pp_bit_xor) PP(pp_bit_or) { - dSP; dATARGET; tryAMAGICbin(bor,opASSIGN); + djSP; dATARGET; tryAMAGICbin(bor,opASSIGN); { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { @@ -1212,7 +1203,7 @@ PP(pp_bit_or) PP(pp_negate) { - dSP; dTARGET; tryAMAGICun(neg); + djSP; dTARGET; tryAMAGICun(neg); { dTOPss; if (SvGMAGICAL(sv)) @@ -1245,7 +1236,7 @@ PP(pp_negate) PP(pp_not) { #ifdef OVERLOAD - dSP; tryAMAGICunSET(not); + djSP; tryAMAGICunSET(not); #endif /* OVERLOAD */ *stack_sp = boolSV(!SvTRUE(*stack_sp)); return NORMAL; @@ -1253,7 +1244,7 @@ PP(pp_not) PP(pp_complement) { - dSP; dTARGET; tryAMAGICun(compl); + djSP; dTARGET; tryAMAGICun(compl); { dTOPss; if (SvNIOKp(sv)) { @@ -1296,7 +1287,7 @@ PP(pp_complement) PP(pp_i_multiply) { - dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); + djSP; dATARGET; tryAMAGICbin(mult,opASSIGN); { dPOPTOPiirl; SETi( left * right ); @@ -1306,7 +1297,7 @@ PP(pp_i_multiply) PP(pp_i_divide) { - dSP; dATARGET; tryAMAGICbin(div,opASSIGN); + djSP; dATARGET; tryAMAGICbin(div,opASSIGN); { dPOPiv; if (value == 0) @@ -1319,7 +1310,7 @@ PP(pp_i_divide) PP(pp_i_modulo) { - dSP; dATARGET; tryAMAGICbin(mod,opASSIGN); + djSP; dATARGET; tryAMAGICbin(mod,opASSIGN); { dPOPTOPiirl; if (!right) @@ -1331,7 +1322,7 @@ PP(pp_i_modulo) PP(pp_i_add) { - dSP; dATARGET; tryAMAGICbin(add,opASSIGN); + djSP; dATARGET; tryAMAGICbin(add,opASSIGN); { dPOPTOPiirl; SETi( left + right ); @@ -1341,7 +1332,7 @@ PP(pp_i_add) PP(pp_i_subtract) { - dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); + djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); { dPOPTOPiirl; SETi( left - right ); @@ -1351,7 +1342,7 @@ PP(pp_i_subtract) PP(pp_i_lt) { - dSP; tryAMAGICbinSET(lt,0); + djSP; tryAMAGICbinSET(lt,0); { dPOPTOPiirl; SETs(boolSV(left < right)); @@ -1361,7 +1352,7 @@ PP(pp_i_lt) PP(pp_i_gt) { - dSP; tryAMAGICbinSET(gt,0); + djSP; tryAMAGICbinSET(gt,0); { dPOPTOPiirl; SETs(boolSV(left > right)); @@ -1371,7 +1362,7 @@ PP(pp_i_gt) PP(pp_i_le) { - dSP; tryAMAGICbinSET(le,0); + djSP; tryAMAGICbinSET(le,0); { dPOPTOPiirl; SETs(boolSV(left <= right)); @@ -1381,7 +1372,7 @@ PP(pp_i_le) PP(pp_i_ge) { - dSP; tryAMAGICbinSET(ge,0); + djSP; tryAMAGICbinSET(ge,0); { dPOPTOPiirl; SETs(boolSV(left >= right)); @@ -1391,7 +1382,7 @@ PP(pp_i_ge) PP(pp_i_eq) { - dSP; tryAMAGICbinSET(eq,0); + djSP; tryAMAGICbinSET(eq,0); { dPOPTOPiirl; SETs(boolSV(left == right)); @@ -1401,7 +1392,7 @@ PP(pp_i_eq) PP(pp_i_ne) { - dSP; tryAMAGICbinSET(ne,0); + djSP; tryAMAGICbinSET(ne,0); { dPOPTOPiirl; SETs(boolSV(left != right)); @@ -1411,7 +1402,7 @@ PP(pp_i_ne) PP(pp_i_ncmp) { - dSP; dTARGET; tryAMAGICbin(ncmp,0); + djSP; dTARGET; tryAMAGICbin(ncmp,0); { dPOPTOPiirl; I32 value; @@ -1429,7 +1420,7 @@ PP(pp_i_ncmp) PP(pp_i_negate) { - dSP; dTARGET; tryAMAGICun(neg); + djSP; dTARGET; tryAMAGICun(neg); SETi(-TOPi); RETURN; } @@ -1438,7 +1429,7 @@ PP(pp_i_negate) PP(pp_atan2) { - dSP; dTARGET; tryAMAGICbin(atan2,0); + djSP; dTARGET; tryAMAGICbin(atan2,0); { dPOPTOPnnrl; SETn(atan2(left, right)); @@ -1448,7 +1439,7 @@ PP(pp_atan2) PP(pp_sin) { - dSP; dTARGET; tryAMAGICun(sin); + djSP; dTARGET; tryAMAGICun(sin); { double value; value = POPn; @@ -1460,7 +1451,7 @@ PP(pp_sin) PP(pp_cos) { - dSP; dTARGET; tryAMAGICun(cos); + djSP; dTARGET; tryAMAGICun(cos); { double value; value = POPn; @@ -1472,7 +1463,7 @@ PP(pp_cos) PP(pp_rand) { - dSP; dTARGET; + djSP; dTARGET; double value; if (MAXARG < 1) value = 1.0; @@ -1503,7 +1494,7 @@ PP(pp_rand) PP(pp_srand) { - dSP; + djSP; UV anum; if (MAXARG < 1) anum = seed(); @@ -1570,7 +1561,7 @@ seed(void) PP(pp_exp) { - dSP; dTARGET; tryAMAGICun(exp); + djSP; dTARGET; tryAMAGICun(exp); { double value; value = POPn; @@ -1582,7 +1573,7 @@ PP(pp_exp) PP(pp_log) { - dSP; dTARGET; tryAMAGICun(log); + djSP; dTARGET; tryAMAGICun(log); { double value; value = POPn; @@ -1598,7 +1589,7 @@ PP(pp_log) PP(pp_sqrt) { - dSP; dTARGET; tryAMAGICun(sqrt); + djSP; dTARGET; tryAMAGICun(sqrt); { double value; value = POPn; @@ -1614,7 +1605,7 @@ PP(pp_sqrt) PP(pp_int) { - dSP; dTARGET; + djSP; dTARGET; { double value = TOPn; IV iv; @@ -1642,7 +1633,7 @@ PP(pp_int) PP(pp_abs) { - dSP; dTARGET; tryAMAGICun(abs); + djSP; dTARGET; tryAMAGICun(abs); { double value = TOPn; IV iv; @@ -1664,7 +1655,7 @@ PP(pp_abs) PP(pp_hex) { - dSP; dTARGET; + djSP; dTARGET; char *tmps; I32 argtype; @@ -1675,7 +1666,7 @@ PP(pp_hex) PP(pp_oct) { - dSP; dTARGET; + djSP; dTARGET; UV value; I32 argtype; char *tmps; @@ -1697,14 +1688,14 @@ PP(pp_oct) 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; @@ -1791,7 +1782,7 @@ PP(pp_substr) PP(pp_vec) { - dSP; dTARGET; + djSP; dTARGET; register I32 size = POPi; register I32 offset = POPi; register SV *src = POPs; @@ -1865,7 +1856,7 @@ PP(pp_vec) PP(pp_index) { - dSP; dTARGET; + djSP; dTARGET; SV *big; SV *little; I32 offset; @@ -1897,7 +1888,7 @@ PP(pp_index) PP(pp_rindex) { - dSP; dTARGET; + djSP; dTARGET; SV *big; SV *little; STRLEN blen; @@ -1934,7 +1925,7 @@ PP(pp_rindex) PP(pp_sprintf) { - dSP; dMARK; dORIGMARK; dTARGET; + djSP; dMARK; dORIGMARK; dTARGET; #ifdef USE_LOCALE_NUMERIC if (op->op_private & OPpLOCALE) SET_NUMERIC_LOCAL(); @@ -1950,7 +1941,7 @@ PP(pp_sprintf) PP(pp_ord) { - dSP; dTARGET; + djSP; dTARGET; I32 value; char *tmps; @@ -1969,7 +1960,7 @@ PP(pp_ord) PP(pp_chr) { - dSP; dTARGET; + djSP; dTARGET; char *tmps; (void)SvUPGRADE(TARG,SVt_PV); @@ -1985,7 +1976,7 @@ PP(pp_chr) PP(pp_crypt) { - dSP; dTARGET; dPOPTOPssrl; + djSP; dTARGET; dPOPTOPssrl; #ifdef HAS_CRYPT char *tmps = SvPV(left, na); #ifdef FCRYPT @@ -2003,7 +1994,7 @@ PP(pp_crypt) PP(pp_ucfirst) { - dSP; + djSP; SV *sv = TOPs; register char *s; @@ -2029,7 +2020,7 @@ PP(pp_ucfirst) PP(pp_lcfirst) { - dSP; + djSP; SV *sv = TOPs; register char *s; @@ -2056,7 +2047,7 @@ PP(pp_lcfirst) PP(pp_uc) { - dSP; + djSP; SV *sv = TOPs; register char *s; STRLEN len; @@ -2088,7 +2079,7 @@ PP(pp_uc) PP(pp_lc) { - dSP; + djSP; SV *sv = TOPs; register char *s; STRLEN len; @@ -2120,7 +2111,7 @@ PP(pp_lc) PP(pp_quotemeta) { - dSP; dTARGET; + djSP; dTARGET; SV *sv = TOPs; STRLEN len; register char *s = SvPV(sv,len); @@ -2149,7 +2140,7 @@ PP(pp_quotemeta) 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; @@ -2194,7 +2185,7 @@ PP(pp_aslice) PP(pp_each) { - dSP; dTARGET; + djSP; dTARGET; HV *hash = (HV*)POPs; HE *entry; I32 gimme = GIMME_V; @@ -2235,7 +2226,7 @@ PP(pp_keys) PP(pp_delete) { - dSP; + djSP; I32 gimme = GIMME_V; I32 discard = (gimme == G_VOID) ? G_DISCARD : 0; SV *sv; @@ -2282,7 +2273,7 @@ PP(pp_delete) PP(pp_exists) { - dSP; + djSP; SV *tmpsv = POPs; HV *hv = (HV*)POPs; if (SvTYPE(hv) == SVt_PVHV) { @@ -2299,7 +2290,7 @@ PP(pp_exists) 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; @@ -2336,7 +2327,7 @@ PP(pp_hslice) PP(pp_list) { - dSP; dMARK; + djSP; dMARK; if (GIMME != G_ARRAY) { if (++MARK <= SP) *MARK = *SP; /* unwanted list, return last item */ @@ -2349,7 +2340,7 @@ PP(pp_list) PP(pp_lslice) { - dSP; + djSP; SV **lastrelem = stack_sp; SV **lastlelem = stack_base + POPMARK; SV **firstlelem = stack_base + POPMARK + 1; @@ -2407,7 +2398,7 @@ PP(pp_lslice) 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 */ @@ -2417,7 +2408,7 @@ PP(pp_anonlist) PP(pp_anonhash) { - dSP; dMARK; dORIGMARK; + djSP; dMARK; dORIGMARK; HV* hv = (HV*)sv_2mortal((SV*)newHV()); while (MARK < SP) { @@ -2436,7 +2427,7 @@ PP(pp_anonhash) PP(pp_splice) { - dSP; dMARK; dORIGMARK; + djSP; dMARK; dORIGMARK; register AV *ary = (AV*)*++MARK; register SV **src; register SV **dst; @@ -2631,7 +2622,7 @@ PP(pp_splice) PP(pp_push) { - dSP; dMARK; dORIGMARK; dTARGET; + djSP; dMARK; dORIGMARK; dTARGET; register AV *ary = (AV*)*++MARK; register SV *sv = &sv_undef; @@ -2648,7 +2639,7 @@ PP(pp_push) PP(pp_pop) { - dSP; + djSP; AV *av = (AV*)POPs; SV *sv = av_pop(av); if (!SvIMMORTAL(sv) && AvREAL(av)) @@ -2659,7 +2650,7 @@ PP(pp_pop) PP(pp_shift) { - dSP; + djSP; AV *av = (AV*)POPs; SV *sv = av_shift(av); EXTEND(SP, 1); @@ -2673,7 +2664,7 @@ PP(pp_shift) PP(pp_unshift) { - dSP; dMARK; dORIGMARK; dTARGET; + djSP; dMARK; dORIGMARK; dTARGET; register AV *ary = (AV*)*++MARK; register SV *sv; register I32 i = 0; @@ -2692,7 +2683,7 @@ PP(pp_unshift) PP(pp_reverse) { - dSP; dMARK; + djSP; dMARK; register SV *tmp; SV **oldsp = SP; @@ -2763,7 +2754,7 @@ mul128(SV *sv, U8 m) PP(pp_unpack) { - dSP; + djSP; dPOPPOPssrl; SV **oldsp = sp; I32 gimme = GIMME_V; @@ -3401,10 +3392,10 @@ PP(pp_unpack) 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') @@ -3464,8 +3455,8 @@ doencodes(register SV *sv, register char *s, register I32 len) 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; @@ -3557,7 +3548,7 @@ div128(SV *pnum, char *done) PP(pp_pack) { - dSP; dMARK; dORIGMARK; dTARGET; + djSP; dMARK; dORIGMARK; dTARGET; register SV *cat = TARG; register I32 items; STRLEN fromlen; @@ -4023,7 +4014,7 @@ PP(pp_pack) PP(pp_split) { - dSP; dTARG; + djSP; dTARG; AV *ary; register I32 limit = POPi; /* note, negative is forever */ SV *sv = POPs; @@ -4273,7 +4264,7 @@ unlock_condpair(void *svv) PP(pp_lock) { - dSP; + djSP; dTOPss; SV *retsv = sv; #ifdef USE_THREADS @@ -4305,14 +4296,4 @@ PP(pp_lock) 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; -} + diff --git a/pp.h b/pp.h index f15c6e7..bc39f80 100644 --- a/pp.h +++ b/pp.h @@ -10,12 +10,15 @@ #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 @@ -28,7 +31,8 @@ #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 diff --git a/pp_ctl.c b/pp_ctl.c index fbb8ac5..3dfc22e 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -42,7 +42,7 @@ static I32 sortcxix; PP(pp_wantarray) { - dSP; + djSP; I32 cxix; EXTEND(SP, 1); @@ -66,7 +66,7 @@ PP(pp_regcmaybe) } PP(pp_regcomp) { - dSP; + djSP; register PMOP *pm = (PMOP*)cLOGOP->op_other; register char *t; SV *tmpstr; @@ -103,7 +103,7 @@ PP(pp_regcomp) { PP(pp_substcont) { - dSP; + djSP; register PMOP *pm = (PMOP*) cLOGOP->op_other; register CONTEXT *cx = &cxstack[cxstack_ix]; register SV *dstr = cx->sb_dstr; @@ -225,7 +225,7 @@ rxres_free(void **rsp) PP(pp_formline) { - dSP; dMARK; dORIGMARK; + djSP; dMARK; dORIGMARK; register SV *form = *++MARK; register U16 *fpc; register char *t; @@ -518,7 +518,7 @@ PP(pp_formline) PP(pp_grepstart) { - dSP; + djSP; SV *src; if (stack_base + *markstack_ptr == sp) { @@ -555,7 +555,7 @@ PP(pp_mapstart) PP(pp_mapwhile) { - dSP; + djSP; I32 diff = (sp - stack_base) - *markstack_ptr; I32 count; I32 shift; @@ -619,7 +619,7 @@ PP(pp_mapwhile) PP(pp_sort) { - dSP; dMARK; dORIGMARK; + djSP; dMARK; dORIGMARK; register SV **up; SV **myorigmark = ORIGMARK; register I32 max; @@ -753,7 +753,7 @@ PP(pp_range) PP(pp_flip) { - dSP; + djSP; if (GIMME == G_ARRAY) { RETURNOP(((CONDOP*)cUNOP->op_first)->op_false); @@ -785,7 +785,7 @@ PP(pp_flip) PP(pp_flop) { - dSP; + djSP; if (GIMME == G_ARRAY) { dPOPPOPssrl; @@ -899,14 +899,14 @@ block_gimme(void) 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; } } @@ -1029,21 +1029,21 @@ die_where(char *message) 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) { @@ -1066,7 +1066,7 @@ die_where(char *message) 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(); @@ -1081,7 +1081,7 @@ die_where(char *message) PP(pp_xor) { - dSP; dPOPTOPssrl; + djSP; dPOPTOPssrl; if (SvTRUE(left) != SvTRUE(right)) RETSETYES; else @@ -1090,7 +1090,7 @@ PP(pp_xor) PP(pp_andassign) { - dSP; + djSP; if (!SvTRUE(TOPs)) RETURN; else @@ -1099,7 +1099,7 @@ PP(pp_andassign) PP(pp_orassign) { - dSP; + djSP; if (SvTRUE(TOPs)) RETURN; else @@ -1109,7 +1109,7 @@ PP(pp_orassign) #ifdef DEPRECATED PP(pp_entersubr) { - dSP; + djSP; SV** mark = (stack_base + *markstack_ptr + 1); SV* cv = *mark; while (mark < sp) { /* emulate old interface */ @@ -1123,7 +1123,7 @@ PP(pp_entersubr) PP(pp_caller) { - dSP; + djSP; register I32 cxix = dopoptosub(cxstack_ix); register CONTEXT *cx; I32 dbcxix; @@ -1258,7 +1258,7 @@ sortcmp_locale(const void *a, const void *b) PP(pp_reset) { - dSP; + djSP; char *tmps; if (MAXARG < 1) @@ -1328,7 +1328,7 @@ PP(pp_scope) PP(pp_enteriter) { - dSP; dMARK; + djSP; dMARK; register CONTEXT *cx; I32 gimme = GIMME_V; SV **svp; @@ -1360,7 +1360,7 @@ PP(pp_enteriter) PP(pp_enterloop) { - dSP; + djSP; register CONTEXT *cx; I32 gimme = GIMME_V; @@ -1376,7 +1376,7 @@ PP(pp_enterloop) PP(pp_leaveloop) { - dSP; + djSP; register CONTEXT *cx; struct block_loop cxloop; I32 gimme; @@ -1417,7 +1417,7 @@ PP(pp_leaveloop) PP(pp_return) { - dSP; dMARK; + djSP; dMARK; I32 cxix; register CONTEXT *cx; struct block_sub cxsub; @@ -1493,7 +1493,7 @@ PP(pp_return) PP(pp_last) { - dSP; + djSP; I32 cxix; register CONTEXT *cx; struct block_loop cxloop; @@ -1675,7 +1675,7 @@ PP(pp_dump) PP(pp_goto) { - dSP; + djSP; OP *retop = 0; I32 ix; register CONTEXT *cx; @@ -1982,7 +1982,7 @@ PP(pp_goto) PP(pp_exit) { - dSP; + djSP; I32 anum; if (MAXARG < 1) @@ -2002,7 +2002,7 @@ PP(pp_exit) #ifdef NOTYET PP(pp_nswitch) { - dSP; + djSP; double value = SvNVx(GvSV(cCOP->cop_gv)); register I32 match = I_32(value); @@ -2021,7 +2021,7 @@ PP(pp_nswitch) PP(pp_cswitch) { - dSP; + djSP; register I32 match; if (multiline) @@ -2109,7 +2109,6 @@ docatch(OP *o) static OP * doeval(int gimme) { - dTHR; dSP; OP *saveop = op; HV *newstash; @@ -2161,7 +2160,7 @@ doeval(int gimme) 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); @@ -2187,7 +2186,7 @@ doeval(int gimme) 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; @@ -2206,7 +2205,7 @@ doeval(int 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); @@ -2261,7 +2260,7 @@ doeval(int gimme) PP(pp_require) { - dSP; + djSP; register CONTEXT *cx; SV *sv; char *name; @@ -2411,7 +2410,7 @@ PP(pp_dofile) PP(pp_entereval) { - dSP; + djSP; register CONTEXT *cx; dPOPss; I32 gimme = GIMME_V, was = sub_generation; @@ -2471,7 +2470,7 @@ PP(pp_entereval) PP(pp_leaveeval) { - dSP; + djSP; register SV **mark; SV **newsp; PMOP *newpm; @@ -2560,14 +2559,14 @@ PP(pp_leaveeval) 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; @@ -2580,14 +2579,14 @@ PP(pp_entertry) 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; @@ -2628,7 +2627,7 @@ PP(pp_leavetry) curpm = newpm; /* Don't pop $1 et al till now */ LEAVE; - sv_setpv(errsv,""); + sv_setpv(GvSV(errgv),""); RETURN; } @@ -2809,3 +2808,4 @@ doparseform(SV *sv) sv_magic(sv, Nullsv, 'f', Nullch, 0); SvCOMPILED_on(sv); } + diff --git a/pp_hot.c b/pp_hot.c index df9798a..b71299e 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -48,7 +48,7 @@ unset_cvowner(void *cvarg) PP(pp_const) { - dSP; + djSP; XPUSHs(cSVOP->op_sv); RETURN; } @@ -64,7 +64,7 @@ PP(pp_nextstate) PP(pp_gvsv) { - dSP; + djSP; EXTEND(sp,1); if (op->op_private & OPpLVAL_INTRO) PUSHs(save_scalar(cGVOP->op_gv)); @@ -86,7 +86,7 @@ PP(pp_pushmark) PP(pp_stringify) { - dSP; dTARGET; + djSP; dTARGET; STRLEN len; char *s; s = SvPV(TOPs,len); @@ -97,14 +97,14 @@ PP(pp_stringify) PP(pp_gv) { - dSP; + djSP; XPUSHs((SV*)cGVOP->op_gv); RETURN; } PP(pp_and) { - dSP; + djSP; if (!SvTRUE(TOPs)) RETURN; else { @@ -115,7 +115,7 @@ PP(pp_and) PP(pp_sassign) { - dSP; dPOPTOPssrl; + djSP; dPOPTOPssrl; MAGIC *mg; if (op->op_private & OPpASSIGN_BACKWARDS) { @@ -131,7 +131,7 @@ PP(pp_sassign) PP(pp_cond_expr) { - dSP; + djSP; if (SvTRUEx(POPs)) RETURNOP(cCONDOP->op_true); else @@ -151,7 +151,7 @@ PP(pp_unstack) PP(pp_concat) { - dSP; dATARGET; tryAMAGICbin(concat,opASSIGN); + djSP; dATARGET; tryAMAGICbin(concat,opASSIGN); { dPOPTOPssrl; STRLEN len; @@ -178,7 +178,7 @@ PP(pp_concat) PP(pp_padsv) { - dSP; dTARGET; + djSP; dTARGET; XPUSHs(TARG); if (op->op_flags & OPf_MOD) { if (op->op_private & OPpLVAL_INTRO) @@ -197,7 +197,7 @@ PP(pp_readline) PP(pp_eq) { - dSP; tryAMAGICbinSET(eq,0); + djSP; tryAMAGICbinSET(eq,0); { dPOPnv; SETs(boolSV(TOPn == value)); @@ -207,7 +207,7 @@ PP(pp_eq) PP(pp_preinc) { - dSP; + djSP; if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) croak(no_modify); if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && @@ -224,7 +224,7 @@ PP(pp_preinc) PP(pp_or) { - dSP; + djSP; if (SvTRUE(TOPs)) RETURN; else { @@ -235,7 +235,7 @@ PP(pp_or) PP(pp_add) { - dSP; dATARGET; tryAMAGICbin(add,opASSIGN); + djSP; dATARGET; tryAMAGICbin(add,opASSIGN); { dPOPTOPnnrl_ul; SETn( left + right ); @@ -245,7 +245,7 @@ PP(pp_add) 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); @@ -254,7 +254,7 @@ PP(pp_aelemfast) PP(pp_join) { - dSP; dMARK; dTARGET; + djSP; dMARK; dTARGET; MARK++; do_join(TARG, *MARK, MARK, SP); SP = MARK; @@ -264,7 +264,7 @@ PP(pp_join) PP(pp_pushre) { - dSP; + djSP; #ifdef DEBUGGING /* * We ass_u_me that LvTARGOFF() comes first, and that two STRLENs @@ -285,7 +285,7 @@ PP(pp_pushre) PP(pp_print) { - dSP; dMARK; dORIGMARK; + djSP; dMARK; dORIGMARK; GV *gv; IO *io; register PerlIO *fp; @@ -382,7 +382,7 @@ PP(pp_print) PP(pp_rv2av) { - dSP; dPOPss; + djSP; dPOPss; AV *av; if (SvROK(sv)) { @@ -457,7 +457,7 @@ PP(pp_rv2av) PP(pp_rv2hv) { - dSP; dTOPss; + djSP; dTOPss; HV *hv; if (SvROK(sv)) { @@ -538,7 +538,7 @@ PP(pp_rv2hv) PP(pp_aassign) { - dSP; + djSP; SV **lastlelem = stack_sp; SV **lastrelem = stack_base + POPMARK; SV **firstrelem = stack_base + POPMARK + 1; @@ -740,7 +740,7 @@ PP(pp_aassign) PP(pp_match) { - dSP; dTARG; + djSP; dTARG; register PMOP *pm = cPMOP; register char *t; register char *s; @@ -952,7 +952,6 @@ ret_no: OP * do_readline(void) { - dTHR; dSP; dTARGETSTACKED; register SV *sv; STRLEN tmplen = 0; @@ -1211,7 +1210,7 @@ do_readline(void) PP(pp_enter) { - dSP; + djSP; register CONTEXT *cx; I32 gimme = OP_GIMME(op, -1); @@ -1232,7 +1231,7 @@ PP(pp_enter) PP(pp_helem) { - dSP; + djSP; HE* he; SV **svp; SV *keysv = POPs; @@ -1281,7 +1280,7 @@ PP(pp_helem) PP(pp_leave) { - dSP; + djSP; register CONTEXT *cx; register SV **mark; SV **newsp; @@ -1337,7 +1336,7 @@ PP(pp_leave) PP(pp_iter) { - dSP; + djSP; register CONTEXT *cx; SV* sv; AV* av; @@ -1383,7 +1382,7 @@ PP(pp_iter) PP(pp_subst) { - dSP; dTARG; + djSP; dTARG; register PMOP *pm = cPMOP; PMOP *rpm = pm; register SV *dstr; @@ -1635,7 +1634,7 @@ ret_no: PP(pp_grepwhile) { - dSP; + djSP; if (SvTRUEx(POPs)) stack_base[markstack_ptr[-1]++] = stack_base[*markstack_ptr]; @@ -1676,7 +1675,7 @@ PP(pp_grepwhile) PP(pp_leavesub) { - dSP; + djSP; SV **mark; SV **newsp; PMOP *newpm; @@ -1745,7 +1744,7 @@ get_db_sub(SV **svp, CV *cv) PP(pp_entersub) { - dSP; dPOPss; + djSP; dPOPss; GV *gv; HV *stash; register CV *cv; @@ -2158,7 +2157,7 @@ sub_crush_depth(CV *cv) PP(pp_aelem) { - dSP; + djSP; SV** svp; I32 elem = POPi; AV* av = (AV*)POPs; @@ -2227,7 +2226,7 @@ vivify_ref(SV *sv, U32 to_what) PP(pp_method) { - dSP; + djSP; SV* sv; SV* ob; GV* gv; diff --git a/pp_sys.c b/pp_sys.c index caa5e37..9a96f7a 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -175,7 +175,7 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true"; PP(pp_backtick) { - dSP; dTARGET; + djSP; dTARGET; PerlIO *fp; char *tmps = POPp; I32 gimme = GIMME_V; @@ -272,7 +272,7 @@ PP(pp_rcatline) PP(pp_warn) { - dSP; dMARK; + djSP; dMARK; char *tmps; if (SP - MARK != 1) { dTARGET; @@ -284,10 +284,11 @@ PP(pp_warn) 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"; @@ -297,7 +298,7 @@ PP(pp_warn) PP(pp_die) { - dSP; dMARK; + djSP; dMARK; char *tmps; if (SP - MARK != 1) { dTARGET; @@ -309,10 +310,11 @@ PP(pp_die) 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"; @@ -323,7 +325,7 @@ PP(pp_die) PP(pp_open) { - dSP; dTARGET; + djSP; dTARGET; GV *gv; SV *sv; char *tmps; @@ -352,7 +354,7 @@ PP(pp_open) PP(pp_close) { - dSP; + djSP; GV *gv; if (MAXARG == 0) @@ -366,7 +368,7 @@ PP(pp_close) PP(pp_pipe_op) { - dSP; + djSP; #ifdef HAS_PIPE GV *rgv; GV *wgv; @@ -418,7 +420,7 @@ badexit: PP(pp_fileno) { - dSP; dTARGET; + djSP; dTARGET; GV *gv; IO *io; PerlIO *fp; @@ -433,7 +435,7 @@ PP(pp_fileno) PP(pp_umask) { - dSP; dTARGET; + djSP; dTARGET; int anum; #ifdef HAS_UMASK @@ -453,7 +455,7 @@ PP(pp_umask) PP(pp_binmode) { - dSP; + djSP; GV *gv; IO *io; PerlIO *fp; @@ -505,7 +507,7 @@ PP(pp_binmode) PP(pp_tie) { - dSP; + djSP; SV *varsv; HV* stash; GV *gv; @@ -570,7 +572,7 @@ PP(pp_tie) PP(pp_untie) { - dSP; + djSP; SV * sv ; sv = POPs; @@ -598,7 +600,7 @@ PP(pp_untie) PP(pp_tied) { - dSP; + djSP; SV * sv ; MAGIC * mg ; @@ -620,7 +622,7 @@ PP(pp_tied) PP(pp_dbmopen) { - dSP; + djSP; HV *hv; dPOPPOPssrl; HV* stash; @@ -703,7 +705,7 @@ PP(pp_dbmclose) PP(pp_sselect) { - dSP; dTARGET; + djSP; dTARGET; #ifdef HAS_SELECT register I32 i; register I32 j; @@ -848,7 +850,7 @@ setdefout(GV *gv) PP(pp_select) { - dSP; dTARGET; + djSP; dTARGET; GV *newdefout, *egv; HV *hv; @@ -882,7 +884,7 @@ PP(pp_select) PP(pp_getc) { - dSP; dTARGET; + djSP; dTARGET; GV *gv; MAGIC *mg; @@ -944,7 +946,7 @@ doform(CV *cv, GV *gv, OP *retop) PP(pp_enterwrite) { - dSP; + djSP; register GV *gv; register IO *io; GV *fgv; @@ -985,7 +987,7 @@ PP(pp_enterwrite) PP(pp_leavewrite) { - dSP; + djSP; GV *gv = cxstack[cxstack_ix].blk_sub.gv; register IO *io = GvIOp(gv); PerlIO *ofp = IoOFP(io); @@ -1099,7 +1101,7 @@ PP(pp_leavewrite) PP(pp_prtf) { - dSP; dMARK; dORIGMARK; + djSP; dMARK; dORIGMARK; GV *gv; IO *io; PerlIO *fp; @@ -1180,7 +1182,7 @@ PP(pp_prtf) PP(pp_sysopen) { - dSP; + djSP; GV *gv; SV *sv; char *tmps; @@ -1208,7 +1210,7 @@ PP(pp_sysopen) PP(pp_sysread) { - dSP; dMARK; dORIGMARK; dTARGET; + djSP; dMARK; dORIGMARK; dTARGET; int offset; GV *gv; IO *io; @@ -1337,7 +1339,7 @@ PP(pp_syswrite) PP(pp_send) { - dSP; dMARK; dORIGMARK; dTARGET; + djSP; dMARK; dORIGMARK; dTARGET; GV *gv; IO *io; int offset; @@ -1413,7 +1415,7 @@ PP(pp_recv) PP(pp_eof) { - dSP; + djSP; GV *gv; if (MAXARG <= 0) @@ -1426,7 +1428,7 @@ PP(pp_eof) PP(pp_tell) { - dSP; dTARGET; + djSP; dTARGET; GV *gv; if (MAXARG <= 0) @@ -1444,7 +1446,7 @@ PP(pp_seek) PP(pp_sysseek) { - dSP; + djSP; GV *gv; int whence = POPi; long offset = POPl; @@ -1463,7 +1465,7 @@ PP(pp_sysseek) PP(pp_truncate) { - dSP; + djSP; Off_t len = (Off_t)POPn; int result = 1; GV *tmpgv; @@ -1531,7 +1533,7 @@ PP(pp_fcntl) PP(pp_ioctl) { - dSP; dTARGET; + djSP; dTARGET; SV *argsv = POPs; unsigned int func = U_I(POPn); int optype = op->op_type; @@ -1602,7 +1604,7 @@ PP(pp_ioctl) PP(pp_flock) { - dSP; dTARGET; + djSP; dTARGET; I32 value; int argtype; GV *gv; @@ -1635,7 +1637,7 @@ PP(pp_flock) PP(pp_socket) { - dSP; + djSP; #ifdef HAS_SOCKET GV *gv; register IO *io; @@ -1677,7 +1679,7 @@ PP(pp_socket) PP(pp_sockpair) { - dSP; + djSP; #ifdef HAS_SOCKETPAIR GV *gv1; GV *gv2; @@ -1727,7 +1729,7 @@ PP(pp_sockpair) PP(pp_bind) { - dSP; + djSP; #ifdef HAS_SOCKET SV *addrsv = POPs; char *addr; @@ -1757,7 +1759,7 @@ nuts: PP(pp_connect) { - dSP; + djSP; #ifdef HAS_SOCKET SV *addrsv = POPs; char *addr; @@ -1787,7 +1789,7 @@ nuts: PP(pp_listen) { - dSP; + djSP; #ifdef HAS_SOCKET int backlog = POPi; GV *gv = (GV*)POPs; @@ -1813,7 +1815,7 @@ nuts: PP(pp_accept) { - dSP; dTARGET; + djSP; dTARGET; #ifdef HAS_SOCKET GV *ngv; GV *ggv; @@ -1870,7 +1872,7 @@ badexit: PP(pp_shutdown) { - dSP; dTARGET; + djSP; dTARGET; #ifdef HAS_SOCKET int how = POPi; GV *gv = (GV*)POPs; @@ -1903,7 +1905,7 @@ PP(pp_gsockopt) PP(pp_ssockopt) { - dSP; + djSP; #ifdef HAS_SOCKET int optype = op->op_type; SV *sv; @@ -1983,7 +1985,7 @@ PP(pp_getsockname) PP(pp_getpeername) { - dSP; + djSP; #ifdef HAS_SOCKET int optype = op->op_type; SV *sv; @@ -2054,7 +2056,7 @@ PP(pp_lstat) PP(pp_stat) { - dSP; + djSP; GV *tmpgv; I32 gimme; I32 max = 13; @@ -2142,7 +2144,7 @@ PP(pp_stat) PP(pp_ftrread) { I32 result = my_stat(ARGS); - dSP; + djSP; if (result < 0) RETPUSHUNDEF; if (cando(S_IRUSR, 0, &statcache)) @@ -2153,7 +2155,7 @@ PP(pp_ftrread) PP(pp_ftrwrite) { I32 result = my_stat(ARGS); - dSP; + djSP; if (result < 0) RETPUSHUNDEF; if (cando(S_IWUSR, 0, &statcache)) @@ -2164,7 +2166,7 @@ PP(pp_ftrwrite) PP(pp_ftrexec) { I32 result = my_stat(ARGS); - dSP; + djSP; if (result < 0) RETPUSHUNDEF; if (cando(S_IXUSR, 0, &statcache)) @@ -2175,7 +2177,7 @@ PP(pp_ftrexec) PP(pp_fteread) { I32 result = my_stat(ARGS); - dSP; + djSP; if (result < 0) RETPUSHUNDEF; if (cando(S_IRUSR, 1, &statcache)) @@ -2186,7 +2188,7 @@ PP(pp_fteread) PP(pp_ftewrite) { I32 result = my_stat(ARGS); - dSP; + djSP; if (result < 0) RETPUSHUNDEF; if (cando(S_IWUSR, 1, &statcache)) @@ -2197,7 +2199,7 @@ PP(pp_ftewrite) PP(pp_fteexec) { I32 result = my_stat(ARGS); - dSP; + djSP; if (result < 0) RETPUSHUNDEF; if (cando(S_IXUSR, 1, &statcache)) @@ -2208,7 +2210,7 @@ PP(pp_fteexec) PP(pp_ftis) { I32 result = my_stat(ARGS); - dSP; + djSP; if (result < 0) RETPUSHUNDEF; RETPUSHYES; @@ -2222,7 +2224,7 @@ PP(pp_fteowned) 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) ) @@ -2233,7 +2235,7 @@ PP(pp_ftrowned) PP(pp_ftzero) { I32 result = my_stat(ARGS); - dSP; + djSP; if (result < 0) RETPUSHUNDEF; if (!statcache.st_size) @@ -2244,7 +2246,7 @@ PP(pp_ftzero) PP(pp_ftsize) { I32 result = my_stat(ARGS); - dSP; dTARGET; + djSP; dTARGET; if (result < 0) RETPUSHUNDEF; PUSHi(statcache.st_size); @@ -2254,7 +2256,7 @@ PP(pp_ftsize) 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 ); @@ -2264,7 +2266,7 @@ PP(pp_ftmtime) 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 ); @@ -2274,7 +2276,7 @@ PP(pp_ftatime) 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 ); @@ -2284,7 +2286,7 @@ PP(pp_ftctime) PP(pp_ftsock) { I32 result = my_stat(ARGS); - dSP; + djSP; if (result < 0) RETPUSHUNDEF; if (S_ISSOCK(statcache.st_mode)) @@ -2295,7 +2297,7 @@ PP(pp_ftsock) PP(pp_ftchr) { I32 result = my_stat(ARGS); - dSP; + djSP; if (result < 0) RETPUSHUNDEF; if (S_ISCHR(statcache.st_mode)) @@ -2306,7 +2308,7 @@ PP(pp_ftchr) PP(pp_ftblk) { I32 result = my_stat(ARGS); - dSP; + djSP; if (result < 0) RETPUSHUNDEF; if (S_ISBLK(statcache.st_mode)) @@ -2317,7 +2319,7 @@ PP(pp_ftblk) PP(pp_ftfile) { I32 result = my_stat(ARGS); - dSP; + djSP; if (result < 0) RETPUSHUNDEF; if (S_ISREG(statcache.st_mode)) @@ -2328,7 +2330,7 @@ PP(pp_ftfile) PP(pp_ftdir) { I32 result = my_stat(ARGS); - dSP; + djSP; if (result < 0) RETPUSHUNDEF; if (S_ISDIR(statcache.st_mode)) @@ -2339,7 +2341,7 @@ PP(pp_ftdir) PP(pp_ftpipe) { I32 result = my_stat(ARGS); - dSP; + djSP; if (result < 0) RETPUSHUNDEF; if (S_ISFIFO(statcache.st_mode)) @@ -2350,7 +2352,7 @@ PP(pp_ftpipe) PP(pp_ftlink) { I32 result = my_lstat(ARGS); - dSP; + djSP; if (result < 0) RETPUSHUNDEF; if (S_ISLNK(statcache.st_mode)) @@ -2360,7 +2362,7 @@ PP(pp_ftlink) PP(pp_ftsuid) { - dSP; + djSP; #ifdef S_ISUID I32 result = my_stat(ARGS); SPAGAIN; @@ -2374,7 +2376,7 @@ PP(pp_ftsuid) PP(pp_ftsgid) { - dSP; + djSP; #ifdef S_ISGID I32 result = my_stat(ARGS); SPAGAIN; @@ -2388,7 +2390,7 @@ PP(pp_ftsgid) PP(pp_ftsvtx) { - dSP; + djSP; #ifdef S_ISVTX I32 result = my_stat(ARGS); SPAGAIN; @@ -2402,7 +2404,7 @@ PP(pp_ftsvtx) PP(pp_fttty) { - dSP; + djSP; int fd; GV *gv; char *tmps = Nullch; @@ -2437,7 +2439,7 @@ PP(pp_fttty) PP(pp_fttext) { - dSP; + djSP; I32 i; I32 len; I32 odd = 0; @@ -2564,7 +2566,7 @@ PP(pp_ftbinary) PP(pp_chdir) { - dSP; dTARGET; + djSP; dTARGET; char *tmps; SV **svp; @@ -2594,7 +2596,7 @@ PP(pp_chdir) PP(pp_chown) { - dSP; dMARK; dTARGET; + djSP; dMARK; dTARGET; I32 value; #ifdef HAS_CHOWN value = (I32)apply(op->op_type, MARK, SP); @@ -2608,7 +2610,7 @@ PP(pp_chown) PP(pp_chroot) { - dSP; dTARGET; + djSP; dTARGET; char *tmps; #ifdef HAS_CHROOT tmps = POPp; @@ -2622,7 +2624,7 @@ PP(pp_chroot) PP(pp_unlink) { - dSP; dMARK; dTARGET; + djSP; dMARK; dTARGET; I32 value; value = (I32)apply(op->op_type, MARK, SP); SP = MARK; @@ -2632,7 +2634,7 @@ PP(pp_unlink) PP(pp_chmod) { - dSP; dMARK; dTARGET; + djSP; dMARK; dTARGET; I32 value; value = (I32)apply(op->op_type, MARK, SP); SP = MARK; @@ -2642,7 +2644,7 @@ PP(pp_chmod) PP(pp_utime) { - dSP; dMARK; dTARGET; + djSP; dMARK; dTARGET; I32 value; value = (I32)apply(op->op_type, MARK, SP); SP = MARK; @@ -2652,7 +2654,7 @@ PP(pp_utime) PP(pp_rename) { - dSP; dTARGET; + djSP; dTARGET; int anum; char *tmps2 = POPp; @@ -2678,7 +2680,7 @@ PP(pp_rename) PP(pp_link) { - dSP; dTARGET; + djSP; dTARGET; #ifdef HAS_LINK char *tmps2 = POPp; char *tmps = SvPV(TOPs, na); @@ -2692,7 +2694,7 @@ PP(pp_link) PP(pp_symlink) { - dSP; dTARGET; + djSP; dTARGET; #ifdef HAS_SYMLINK char *tmps2 = POPp; char *tmps = SvPV(TOPs, na); @@ -2706,7 +2708,7 @@ PP(pp_symlink) PP(pp_readlink) { - dSP; dTARGET; + djSP; dTARGET; #ifdef HAS_SYMLINK char *tmps; char buf[MAXPATHLEN]; @@ -2819,7 +2821,7 @@ char *filename; PP(pp_mkdir) { - dSP; dTARGET; + djSP; dTARGET; int mode = POPi; #ifndef HAS_MKDIR int oldumask; @@ -2840,7 +2842,7 @@ PP(pp_mkdir) PP(pp_rmdir) { - dSP; dTARGET; + djSP; dTARGET; char *tmps; tmps = POPp; @@ -2857,7 +2859,7 @@ PP(pp_rmdir) PP(pp_open_dir) { - dSP; + djSP; #if defined(Direntry_t) && defined(HAS_READDIR) char *dirname = POPp; GV *gv = (GV*)POPs; @@ -2883,7 +2885,7 @@ nope: PP(pp_readdir) { - dSP; + djSP; #if defined(Direntry_t) && defined(HAS_READDIR) #ifndef I_DIRENT Direntry_t *readdir _((DIR *)); @@ -2939,7 +2941,7 @@ nope: 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 *)); @@ -2963,7 +2965,7 @@ nope: PP(pp_seekdir) { - dSP; + djSP; #if defined(HAS_SEEKDIR) || defined(seekdir) long along = POPl; GV *gv = (GV*)POPs; @@ -2986,7 +2988,7 @@ nope: PP(pp_rewinddir) { - dSP; + djSP; #if defined(HAS_REWINDDIR) || defined(rewinddir) GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); @@ -3007,7 +3009,7 @@ nope: PP(pp_closedir) { - dSP; + djSP; #if defined(Direntry_t) && defined(HAS_READDIR) GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); @@ -3040,7 +3042,7 @@ nope: PP(pp_fork) { #ifdef HAS_FORK - dSP; dTARGET; + djSP; dTARGET; int childpid; GV *tmpgv; @@ -3064,7 +3066,7 @@ PP(pp_fork) PP(pp_wait) { #if !defined(DOSISH) || defined(OS2) - dSP; dTARGET; + djSP; dTARGET; int childpid; int argflags; @@ -3080,7 +3082,7 @@ PP(pp_wait) PP(pp_waitpid) { #if !defined(DOSISH) || defined(OS2) - dSP; dTARGET; + djSP; dTARGET; int childpid; int optype; int argflags; @@ -3098,7 +3100,7 @@ PP(pp_waitpid) PP(pp_system) { - dSP; dMARK; dORIGMARK; dTARGET; + djSP; dMARK; dORIGMARK; dTARGET; I32 value; int childpid; int result; @@ -3149,10 +3151,10 @@ PP(pp_system) #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)); } @@ -3166,7 +3168,7 @@ PP(pp_system) PP(pp_exec) { - dSP; dMARK; dORIGMARK; dTARGET; + djSP; dMARK; dORIGMARK; dTARGET; I32 value; if (op->op_flags & OPf_STACKED) { @@ -3198,7 +3200,7 @@ PP(pp_exec) PP(pp_kill) { - dSP; dMARK; dTARGET; + djSP; dMARK; dTARGET; I32 value; #ifdef HAS_KILL value = (I32)apply(op->op_type, MARK, SP); @@ -3213,7 +3215,7 @@ PP(pp_kill) PP(pp_getppid) { #ifdef HAS_GETPPID - dSP; dTARGET; + djSP; dTARGET; XPUSHi( getppid() ); RETURN; #else @@ -3224,7 +3226,7 @@ PP(pp_getppid) PP(pp_getpgrp) { #ifdef HAS_GETPGRP - dSP; dTARGET; + djSP; dTARGET; int pid; I32 value; @@ -3249,7 +3251,7 @@ PP(pp_getpgrp) PP(pp_setpgrp) { #ifdef HAS_SETPGRP - dSP; dTARGET; + djSP; dTARGET; int pgrp; int pid; if (MAXARG < 2) { @@ -3277,7 +3279,7 @@ PP(pp_setpgrp) PP(pp_getpriority) { - dSP; dTARGET; + djSP; dTARGET; int which; int who; #ifdef HAS_GETPRIORITY @@ -3292,7 +3294,7 @@ PP(pp_getpriority) PP(pp_setpriority) { - dSP; dTARGET; + djSP; dTARGET; int which; int who; int niceval; @@ -3312,7 +3314,7 @@ PP(pp_setpriority) PP(pp_time) { - dSP; dTARGET; + djSP; dTARGET; #ifdef BIG_TIME XPUSHn( time(Null(Time_t*)) ); #else @@ -3339,7 +3341,7 @@ PP(pp_time) PP(pp_tms) { - dSP; + djSP; #ifndef HAS_TIMES DIE("times not implemented"); @@ -3371,7 +3373,7 @@ PP(pp_localtime) PP(pp_gmtime) { - dSP; + djSP; Time_t when; struct tm *tmbuf; static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"}; @@ -3425,7 +3427,7 @@ PP(pp_gmtime) PP(pp_alarm) { - dSP; dTARGET; + djSP; dTARGET; int anum; #ifdef HAS_ALARM anum = POPi; @@ -3442,7 +3444,7 @@ PP(pp_alarm) PP(pp_sleep) { - dSP; dTARGET; + djSP; dTARGET; I32 duration; Time_t lasttime; Time_t when; @@ -3479,7 +3481,7 @@ PP(pp_shmread) 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); @@ -3504,7 +3506,7 @@ PP(pp_msgctl) 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); @@ -3517,7 +3519,7 @@ PP(pp_msgsnd) 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); @@ -3532,7 +3534,7 @@ PP(pp_msgrcv) 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) @@ -3547,7 +3549,7 @@ PP(pp_semget) 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) @@ -3567,7 +3569,7 @@ PP(pp_semctl) 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); @@ -3599,7 +3601,7 @@ PP(pp_ghbyaddr) PP(pp_ghostent) { - dSP; + djSP; #ifdef HAS_SOCKET I32 which = op->op_type; register char **elem; @@ -3700,7 +3702,7 @@ PP(pp_gnbyaddr) PP(pp_gnetent) { - dSP; + djSP; #ifdef HAS_SOCKET I32 which = op->op_type; register char **elem; @@ -3775,7 +3777,7 @@ PP(pp_gpbynumber) PP(pp_gprotoent) { - dSP; + djSP; #ifdef HAS_SOCKET I32 which = op->op_type; register char **elem; @@ -3845,7 +3847,7 @@ PP(pp_gsbyport) PP(pp_gservent) { - dSP; + djSP; #ifdef HAS_SOCKET I32 which = op->op_type; register char **elem; @@ -3922,7 +3924,7 @@ PP(pp_gservent) PP(pp_shostent) { - dSP; + djSP; #ifdef HAS_SOCKET sethostent(TOPi); RETSETYES; @@ -3933,7 +3935,7 @@ PP(pp_shostent) PP(pp_snetent) { - dSP; + djSP; #ifdef HAS_SOCKET setnetent(TOPi); RETSETYES; @@ -3944,7 +3946,7 @@ PP(pp_snetent) PP(pp_sprotoent) { - dSP; + djSP; #ifdef HAS_SOCKET setprotoent(TOPi); RETSETYES; @@ -3955,7 +3957,7 @@ PP(pp_sprotoent) PP(pp_sservent) { - dSP; + djSP; #ifdef HAS_SOCKET setservent(TOPi); RETSETYES; @@ -3966,7 +3968,7 @@ PP(pp_sservent) PP(pp_ehostent) { - dSP; + djSP; #ifdef HAS_SOCKET endhostent(); EXTEND(sp,1); @@ -3978,7 +3980,7 @@ PP(pp_ehostent) PP(pp_enetent) { - dSP; + djSP; #ifdef HAS_SOCKET endnetent(); EXTEND(sp,1); @@ -3990,7 +3992,7 @@ PP(pp_enetent) PP(pp_eprotoent) { - dSP; + djSP; #ifdef HAS_SOCKET endprotoent(); EXTEND(sp,1); @@ -4002,7 +4004,7 @@ PP(pp_eprotoent) PP(pp_eservent) { - dSP; + djSP; #ifdef HAS_SOCKET endservent(); EXTEND(sp,1); @@ -4032,7 +4034,7 @@ PP(pp_gpwuid) PP(pp_gpwent) { - dSP; + djSP; #ifdef HAS_PASSWD I32 which = op->op_type; register SV *sv; @@ -4108,7 +4110,7 @@ PP(pp_gpwent) PP(pp_spwent) { - dSP; + djSP; #if defined(HAS_PASSWD) && !defined(CYGWIN32) setpwent(); RETPUSHYES; @@ -4119,7 +4121,7 @@ PP(pp_spwent) PP(pp_epwent) { - dSP; + djSP; #ifdef HAS_PASSWD endpwent(); RETPUSHYES; @@ -4148,7 +4150,7 @@ PP(pp_ggrgid) PP(pp_ggrent) { - dSP; + djSP; #ifdef HAS_GROUP I32 which = op->op_type; register char **elem; @@ -4197,7 +4199,7 @@ PP(pp_ggrent) PP(pp_sgrent) { - dSP; + djSP; #ifdef HAS_GROUP setgrent(); RETPUSHYES; @@ -4208,7 +4210,7 @@ PP(pp_sgrent) PP(pp_egrent) { - dSP; + djSP; #ifdef HAS_GROUP endgrent(); RETPUSHYES; @@ -4219,7 +4221,7 @@ PP(pp_egrent) PP(pp_getlogin) { - dSP; dTARGET; + djSP; dTARGET; #ifdef HAS_GETLOGIN char *tmps; EXTEND(SP, 1); @@ -4237,7 +4239,7 @@ PP(pp_getlogin) 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; @@ -4450,3 +4452,4 @@ int operation; } #endif /* LOCKF_EMULATE_FLOCK */ + diff --git a/proto.h b/proto.h index 7eddfd9..03c86d4 100644 --- a/proto.h +++ b/proto.h @@ -190,8 +190,6 @@ bool io_close _((IO* io)); 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)); @@ -324,6 +322,7 @@ OP* newLISTOP _((I32 type, I32 flags, OP* first, OP* last)); 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 @@ -340,9 +339,6 @@ SV* newSVsv _((SV* old)); 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)); @@ -470,6 +466,11 @@ SV* sv_2mortal _((SV* sv)); 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)); diff --git a/sv.c b/sv.c index bcb87c2..97cba87 100644 --- a/sv.c +++ b/sv.c @@ -1084,7 +1084,6 @@ sv_grow(SV* sv, unsigned long newlen) void sv_setiv(register SV *sv, IV i) { - dTHR; /* just for taint */ sv_check_thinkfirst(sv); switch (SvTYPE(sv)) { case SVt_NULL: @@ -1132,7 +1131,6 @@ sv_setuv(register SV *sv, UV u) void sv_setnv(register SV *sv, double num) { - dTHR; /* just for taint */ sv_check_thinkfirst(sv); switch (SvTYPE(sv)) { case SVt_NULL: @@ -2148,7 +2146,6 @@ sv_setsv(SV *dstr, register SV *sstr) 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); @@ -2173,7 +2170,6 @@ sv_setpvn(register SV *sv, register const char *ptr, register STRLEN len) void sv_setpv(register SV *sv, register const char *ptr) { - dTHR; /* just for taint */ register STRLEN len; sv_check_thinkfirst(sv); @@ -2198,7 +2194,6 @@ sv_setpv(register SV *sv, register const char *ptr) 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; @@ -2259,7 +2254,6 @@ sv_chop(register SV *sv, register char *ptr) /* like set but assuming ptr is in void sv_catpvn(register SV *sv, register char *ptr, register STRLEN len) { - dTHR; /* just for taint */ STRLEN tlen; char *junk; @@ -2288,7 +2282,6 @@ sv_catsv(SV *dstr, register SV *sstr) void sv_catpv(register SV *sv, register char *ptr) { - dTHR; /* just for taint */ register STRLEN len; STRLEN tlen; char *junk; @@ -2627,8 +2620,7 @@ sv_clear(register SV *sv) if (SvOBJECT(sv)) { dTHR; if (defstash) { /* Still have a symbol table? */ - dTHR; - dSP; + djSP; GV* destructor; ENTER; @@ -2985,7 +2977,6 @@ sv_collxfrm(SV *sv, STRLEN *nxp) char * sv_gets(register SV *sv, register FILE *fp, I32 append) { - dTHR; char *rsptr; STRLEN rslen; register STDCHAR rslast; @@ -3498,7 +3489,7 @@ newRV(SV *ref) return sv; } -#ifdef CRIPPLED_CC + SV * newRV_noinc(SV *ref) { @@ -3508,7 +3499,6 @@ newRV_noinc(SV *ref) SvREFCNT_dec(ref); return sv; } -#endif /* CRIPPLED_CC */ /* make an exact duplicate of old */ @@ -3580,7 +3570,6 @@ sv_reset(register char *s, HV *stash) 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'; @@ -3694,20 +3683,20 @@ sv_2cv(SV *sv, HV **st, GV **gvp, I32 lref) } } -#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; @@ -3723,39 +3712,31 @@ SvTRUE(register SV *sv) } } } -#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) { @@ -3765,7 +3746,6 @@ sv_pvn(SV *sv, STRLEN *lp) } return sv_2pv(sv, lp); } -#endif char * sv_pvn_force(SV *sv, STRLEN *lp) @@ -3808,7 +3788,6 @@ 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", @@ -4863,3 +4842,6 @@ sv_dump(SV *sv) } #endif + + + diff --git a/sv.h b/sv.h index 437f488..7a283a6 100644 --- a/sv.h +++ b/sv.h @@ -70,19 +70,16 @@ struct io { #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) @@ -494,20 +491,19 @@ struct xpvio { #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 */ @@ -547,32 +543,19 @@ I32 SvTRUE _((SV *)); ? 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 */ diff --git a/taint.c b/taint.c index 2dc43a4..c8c6800 100644 --- a/taint.c +++ b/taint.c @@ -10,7 +10,6 @@ void taint_proper(const char *f, char *s) { - dTHR; /* just for taint */ char *ug; DEBUG_u(PerlIO_printf(Perl_debug_log, @@ -69,12 +68,10 @@ taint_env(void) 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}"); } @@ -84,7 +81,6 @@ taint_env(void) /* 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; @@ -103,7 +99,6 @@ taint_env(void) 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); } diff --git a/thread.h b/thread.h index a5dea00..5cb4b28 100644 --- a/thread.h +++ b/thread.h @@ -172,25 +172,10 @@ struct thread { /* 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; @@ -218,7 +203,6 @@ struct thread { 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 */ @@ -294,18 +278,6 @@ typedef struct condpair { #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 @@ -352,19 +324,6 @@ typedef struct condpair { #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) diff --git a/toke.c b/toke.c index 143b3c2..7cb0fc6 100644 --- a/toke.c +++ b/toke.c @@ -1225,37 +1225,27 @@ yylex(void) 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". */ @@ -2611,7 +2601,7 @@ yylex(void) (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 == '('; @@ -5362,7 +5352,7 @@ yyerror(char *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) @@ -5371,3 +5361,4 @@ yyerror(char *s) in_my_stash = Nullhv; return 0; } + diff --git a/util.c b/util.c index 9854487..6eccc55 100644 --- a/util.c +++ b/util.c @@ -56,10 +56,6 @@ static void xstat _((void)); #endif -#ifdef USE_THREADS -static U32 threadnum = 0; -#endif /* USE_THREADS */ - #ifndef MYMALLOC /* paranoid version of malloc */ @@ -97,6 +93,7 @@ safemalloc(MEM_SIZE size) else { PerlIO_puts(PerlIO_stderr(),no_mem) FLUSH; my_exit(1); + return Nullch; } /*NOTREACHED*/ } @@ -145,6 +142,7 @@ saferealloc(Malloc_t where,MEM_SIZE size) else { PerlIO_puts(PerlIO_stderr(),no_mem) FLUSH; my_exit(1); + return Nullch; } /*NOTREACHED*/ } @@ -199,6 +197,7 @@ safecalloc(MEM_SIZE count, MEM_SIZE size) else { PerlIO_puts(PerlIO_stderr(),no_mem) FLUSH; my_exit(1); + return Nullch; } /*NOTREACHED*/ } @@ -1349,8 +1348,7 @@ my_setenv(char *nam, char *val) #else /* if WIN32 */ void -my_setenv(nam,val) -char *nam, *val; +my_setenv(char *nam,char *val) { #ifdef USE_WIN32_RTL_ENV @@ -1448,10 +1446,7 @@ char *f; #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; @@ -1900,9 +1895,7 @@ rsignal_restore(int signo, Sigsave_t *save) #else /* !HAS_SIGACTION */ Sighandler_t -rsignal(signo, handler) -int signo; -Sighandler_t handler; +rsignal(int signo, Sighandler_t handler) { return signal(signo, handler); } @@ -1911,15 +1904,13 @@ static int sig_trapped; 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; @@ -1932,19 +1923,14 @@ int signo; } 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; } @@ -2259,13 +2245,13 @@ scan_hex(char *start, I32 len, I32 *retlen) 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; @@ -2400,138 +2386,6 @@ condpair_magic(SV *sv) } 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 @@ -2546,3 +2400,4 @@ Perl_huge(void) return HUGE_VAL; } #endif + diff --git a/win32/Makefile b/win32/Makefile index a55c299..1bc08ff 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -11,6 +11,7 @@ # 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 @@ -18,7 +19,7 @@ INST_TOP=$(INST_DRV)\perl # # 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 @@ -49,7 +50,8 @@ RUNTIME = -MD !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" @@ -82,7 +84,7 @@ LIBFILES = oldnames.lib kernel32.lib user32.lib gdi32.lib \ 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 @@ -195,11 +197,13 @@ CORE_OBJ= ..\av.obj \ 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 \ @@ -241,7 +245,7 @@ CORE_H = ..\av.h \ .\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 @@ -250,6 +254,7 @@ OPCODE=$(EXTDIR)\Opcode\Opcode 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 @@ -257,6 +262,7 @@ OPCODE_DLL=..\lib\auto\Opcode\Opcode.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= \ @@ -265,7 +271,8 @@ DYNALOADMODULES= \ $(OPCODE_DLL) \ $(SDBM_FILE_DLL)\ $(IO_DLL) \ - $(ATTRS_DLL) + $(ATTRS_DLL) \ + $(THREAD_DLL) POD2HTML=$(PODDIR)\pod2html POD2MAN=$(PODDIR)\pod2man @@ -295,13 +302,14 @@ perlglob.obj : perlglob.c 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 @@ -325,7 +333,7 @@ $(CORE_OBJ) : $(CORE_H) $(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:$@ @<< @@ -392,6 +400,12 @@ $(ATTRS_DLL): $(PERLEXE) $(ATTRS).xs $(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) @@ -449,9 +463,9 @@ distclean: clean $(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 \ diff --git a/win32/config.vc b/win32/config.vc index 7cc91da..a83678b 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -463,7 +463,7 @@ spitshell='' 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)' diff --git a/win32/config_H.vc b/win32/config_H.vc index 76f19f1..4634072 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -1400,7 +1400,7 @@ * 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. diff --git a/win32/makedef.pl b/win32/makedef.pl index 5783ac6..8bc7a8a 100644 --- a/win32/makedef.pl +++ b/win32/makedef.pl @@ -87,6 +87,7 @@ Perl_pp_interp Perl_pp_map Perl_pp_nswitch Perl_q +Perl_rcsid Perl_reall_srchlen Perl_regdump Perl_regfold diff --git a/win32/makefile.mk b/win32/makefile.mk index 560882e..bad3e77 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -10,8 +10,10 @@ # 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 diff --git a/win32/perllib.c b/win32/perllib.c index 391b4d3..317c88a 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -2,16 +2,12 @@ * "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 diff --git a/win32/win32.c b/win32/win32.c index 7cbfae8..e7791d2 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -361,7 +361,7 @@ GetShell(void) } int -do_aspawn(void* really, void** mark, void** arglast) +do_aspawn(void* really, void ** mark, void ** arglast) { char **argv; char *strPtr; @@ -524,7 +524,7 @@ opendir(char *filename) /* 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; } @@ -987,7 +987,7 @@ win32_fopen(const char *filename, const char *mode) DllExport FILE * win32_fdopen( int handle, const char *mode) { - return pIOSubSystem->pfnfdopen(handle, mode); + return pIOSubSystem->pfnfdopen(handle, (char *) mode); } DllExport FILE * @@ -1205,13 +1205,13 @@ win32_chdir(const char *dir) 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 @@ -1637,3 +1637,7 @@ Perl_win32_init(int *argcp, char ***argvp) _control87(MCW_EM, MCW_EM); #endif } + + + + diff --git a/win32/win32.h b/win32/win32.h index dc069ba..525ef0f 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -52,6 +52,10 @@ typedef long gid_t; #endif +#ifdef __cplusplus +extern "C" { +#endif + extern uid_t getuid(void); extern gid_t getgid(void); extern uid_t geteuid(void); @@ -61,6 +65,11 @@ extern int setgid(gid_t gid); 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 @@ -79,10 +88,16 @@ extern char *staticlinkmodules[]; 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 @@ -119,11 +134,15 @@ char *win32PerlLibPath(void); 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). */ /* @@ -144,9 +163,18 @@ 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 diff --git a/win32/win32io.c b/win32/win32io.c index eeb6846..0e2e649 100644 --- a/win32/win32io.c +++ b/win32/win32io.c @@ -1,13 +1,11 @@ -#ifdef __cplusplus -extern "C" { -#endif #define WIN32_LEAN_AND_MEAN +#include +extern int my_fclose(FILE *pf); +#include "EXTERN.h" #define WIN32IO_IS_STDIO -#define EXT #include -#include #include #include #include @@ -17,6 +15,16 @@ extern "C" { #include #include #include + + +#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" /* @@ -238,7 +246,6 @@ my_flock(int fd, int oper) #undef LK_ERR #undef LK_LEN -EXT int my_fclose(FILE *pf); #ifdef PERLDLL __declspec(dllexport) @@ -321,7 +328,6 @@ WIN32_IOSUBSYSTEM win32stdio = { }; -#ifdef __cplusplus -} -#endif + + diff --git a/win32/win32io.h b/win32/win32io.h index ba4080c..0e849cf 100644 --- a/win32/win32io.h +++ b/win32/win32io.h @@ -3,6 +3,9 @@ #ifdef __BORLANDC__ #include +#define MSconst +#else +#define MSconst const #endif typedef struct { @@ -20,7 +23,7 @@ int (*pfnvprintf)(const char *format, va_list arg); 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); @@ -55,12 +58,12 @@ int (*pfnwrite)(int fd, const void *buf, unsigned int cnt); 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); @@ -85,3 +88,4 @@ int signature_end; typedef WIN32_IOSUBSYSTEM *PWIN32_IOSUBSYSTEM; #endif /* WIN32IO_H */ + diff --git a/win32/win32iop.h b/win32/win32iop.h index 4606563..52acce1 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -1,6 +1,15 @@ #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 /* pull in the io sub system structure */ /* * Make this as close to original stdio as possible. @@ -9,6 +18,8 @@ /* * 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); @@ -81,25 +92,20 @@ EXT void* win32_calloc(size_t numitems, size_t size); 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 /* 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 */ diff --git a/win32/win32sck.c b/win32/win32sck.c index 3653fc8..b4ad4f4 100644 --- a/win32/win32sck.c +++ b/win32/win32sck.c @@ -702,7 +702,14 @@ win32_setservent(int stayopen) #define WIN32IO_IS_STDIO #include + +#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) diff --git a/win32/win32thread.h b/win32/win32thread.h index da7c852..697af3f 100644 --- a/win32/win32thread.h +++ b/win32/win32thread.h @@ -95,9 +95,18 @@ typedef HANDLE perl_mutex; } 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 { \ @@ -112,14 +121,6 @@ void init_thread_intern _((struct thread *thr)); 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 */