1 /* $RCSfile: hash.c,v $$Revision: 4.1 $$Date: 92/08/07 18:21:48 $
3 * Copyright (c) 1993, Larry Wall
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
19 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
20 MGVTBL* vtbl = mg->mg_virtual;
26 if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
37 U32 savemagic = SvMAGICAL(sv);
40 SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
42 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
43 MGVTBL* vtbl = mg->mg_virtual;
44 if (vtbl && vtbl->svt_get)
45 (*vtbl->svt_get)(sv, mg);
48 SvFLAGS(sv) |= savemagic;
49 assert(SvGMAGICAL(sv));
50 SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
61 U32 savemagic = SvMAGICAL(sv);
65 for (mg = SvMAGIC(sv); mg; mg = nextmg) {
66 MGVTBL* vtbl = mg->mg_virtual;
67 nextmg = mg->mg_moremagic; /* it may delete itself */
68 if (vtbl && vtbl->svt_set)
69 (*vtbl->svt_set)(sv, mg);
73 SvFLAGS(sv) |= savemagic;
75 SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
88 U32 savemagic = SvMAGICAL(sv);
91 SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
93 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
94 MGVTBL* vtbl = mg->mg_virtual;
95 if (vtbl && vtbl->svt_len)
96 return (*vtbl->svt_len)(sv, mg);
101 SvFLAGS(sv) |= savemagic;
103 SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
113 U32 savemagic = SvMAGICAL(sv);
116 SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
118 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
119 MGVTBL* vtbl = mg->mg_virtual;
120 if (vtbl && vtbl->svt_clear)
121 (*vtbl->svt_clear)(sv, mg);
124 SvFLAGS(sv) |= savemagic;
126 SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
137 mg_find(SV *sv, char type)
138 #endif /* STANDARD_C */
141 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
142 if (mg->mg_type == type)
149 mg_copy(sv, nsv, key, klen)
157 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
158 if (isUPPER(mg->mg_type)) {
159 sv_magic(nsv, mg->mg_obj, tolower(mg->mg_type), key, klen);
172 for (mg = SvMAGIC(sv); mg; mg = moremagic) {
173 MGVTBL* vtbl = mg->mg_virtual;
174 moremagic = mg->mg_moremagic;
175 if (vtbl && vtbl->svt_free)
176 (*vtbl->svt_free)(sv, mg);
177 if (mg->mg_ptr && mg->mg_type != 'g')
178 Safefree(mg->mg_ptr);
179 if (mg->mg_obj != sv)
180 SvREFCNT_dec(mg->mg_obj);
187 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
192 #define handlertype void
194 #define handlertype int
197 static handlertype sighandler();
208 switch (*mg->mg_ptr) {
209 case '1': case '2': case '3': case '4':
210 case '5': case '6': case '7': case '8': case '9': case '&':
212 paren = atoi(mg->mg_ptr);
214 if (curpm->op_pmregexp &&
215 paren <= curpm->op_pmregexp->nparens &&
216 (s = curpm->op_pmregexp->startp[paren]) ) {
217 i = curpm->op_pmregexp->endp[paren] - s;
229 paren = curpm->op_pmregexp->lastparen;
235 if (curpm->op_pmregexp &&
236 (s = curpm->op_pmregexp->subbeg) ) {
237 i = curpm->op_pmregexp->startp[0] - s;
249 if (curpm->op_pmregexp &&
250 (s = curpm->op_pmregexp->endp[0]) ) {
251 return (STRLEN) (curpm->op_pmregexp->subend - s);
258 return (STRLEN)ofslen;
260 return (STRLEN)orslen;
263 if (!SvPOK(sv) && SvNIOK(sv))
279 switch (*mg->mg_ptr) {
280 case '\004': /* ^D */
281 sv_setiv(sv,(I32)(debug & 32767));
283 case '\006': /* ^F */
284 sv_setiv(sv,(I32)maxsysfd);
288 sv_setpv(sv, inplace);
290 sv_setsv(sv,&sv_undef);
292 case '\020': /* ^P */
293 sv_setiv(sv,(I32)perldb);
295 case '\024': /* ^T */
296 sv_setiv(sv,(I32)basetime);
298 case '\027': /* ^W */
299 sv_setiv(sv,(I32)dowarn);
301 case '1': case '2': case '3': case '4':
302 case '5': case '6': case '7': case '8': case '9': case '&':
304 paren = atoi(GvENAME(mg->mg_obj));
306 if (curpm->op_pmregexp &&
307 paren <= curpm->op_pmregexp->nparens &&
308 (s = curpm->op_pmregexp->startp[paren]) ) {
309 i = curpm->op_pmregexp->endp[paren] - s;
313 sv_setsv(sv,&sv_undef);
316 sv_setsv(sv,&sv_undef);
321 paren = curpm->op_pmregexp->lastparen;
327 if (curpm->op_pmregexp &&
328 (s = curpm->op_pmregexp->subbeg) ) {
329 i = curpm->op_pmregexp->startp[0] - s;
341 if (curpm->op_pmregexp &&
342 (s = curpm->op_pmregexp->endp[0]) ) {
343 sv_setpvn(sv,s, curpm->op_pmregexp->subend - s);
351 if (last_in_gv && GvIO(last_in_gv)) {
352 sv_setiv(sv,(I32)IoLINES(GvIO(last_in_gv)));
357 sv_setiv(sv,(I32)statusvalue);
360 s = IoTOP_NAME(GvIO(defoutgv));
364 sv_setpv(sv,GvENAME(defoutgv));
369 s = IoFMT_NAME(GvIO(defoutgv));
371 s = GvENAME(defoutgv);
376 sv_setiv(sv,(I32)IoPAGE_LEN(GvIO(defoutgv)));
379 sv_setiv(sv,(I32)IoLINES_LEFT(GvIO(defoutgv)));
382 sv_setiv(sv,(I32)IoPAGE(GvIO(defoutgv)));
390 sv_setiv(sv,(I32)arybase);
394 GvIO(defoutgv) = newIO();
395 sv_setiv(sv, (IoFLAGS(GvIO(defoutgv)) & IOf_FLUSH) != 0 );
398 sv_setpvn(sv,ofs,ofslen);
401 sv_setpvn(sv,ors,orslen);
407 sv_setnv(sv,(double)errno);
408 sv_setpv(sv, errno ? strerror(errno) : "");
409 SvNOK_on(sv); /* what a wonderful hack! */
412 sv_setiv(sv,(I32)uid);
415 sv_setiv(sv,(I32)euid);
419 (void)sprintf(s,"%d",(int)gid);
423 (void)sprintf(s,"%d",(int)egid);
431 GROUPSTYPE gary[NGROUPS];
433 i = getgroups(NGROUPS,gary);
435 (void)sprintf(s," %ld", (long)gary[i]);
450 magic_getuvar(sv, mg)
454 struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
456 if (uf && uf->uf_val)
457 (*uf->uf_val)(uf->uf_index, sv);
469 my_setenv(mg->mg_ptr,s);
470 /* And you'll never guess what the dog had */
471 /* in its mouth... */
473 if (s && strEQ(mg->mg_ptr,"PATH")) {
474 char *strend = SvEND(sv);
477 s = cpytill(tokenbuf,s,strend,':',&i);
480 || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
496 i = whichsig(mg->mg_ptr); /* ...no, a brick */
497 if (!i && (dowarn || strEQ(mg->mg_ptr,"ALARM")))
498 warn("No such signal: SIG%s", mg->mg_ptr);
499 if (strEQ(s,"IGNORE"))
501 (void)signal(i,SIG_IGN);
505 else if (strEQ(s,"DEFAULT") || !*s)
506 (void)signal(i,SIG_DFL);
508 (void)signal(i,sighandler);
509 if (!strchr(s,'\'')) {
510 sprintf(tokenbuf, "main'%s",s);
511 sv_setpv(sv,tokenbuf);
532 HV* stash = SvSTASH(SvRV(rv));
533 GV* gv = gv_fetchmethod(stash, "fetch");
537 if (!gv || !GvCV(gv)) {
538 croak("No fetch method for magical variable in package \"%s\"",
541 Zero(&myop, 1, BINOP);
542 myop.op_last = (OP *) &myop;
543 myop.op_next = Nullop;
544 myop.op_flags = OPf_STACKED;
556 PUSHs(sv_mortalcopy(newSVpv(mg->mg_ptr, mg->mg_len)));
557 else if (mg->mg_len >= 0)
558 PUSHs(sv_mortalcopy(newSViv(mg->mg_len)));
561 if (op = pp_entersubr())
578 HV* stash = SvSTASH(SvRV(rv));
579 GV* gv = gv_fetchmethod(stash, "store");
583 if (!gv || !GvCV(gv)) {
584 croak("No store method for magical variable in package \"%s\"",
587 Zero(&myop, 1, BINOP);
588 myop.op_last = (OP *) &myop;
589 myop.op_next = Nullop;
590 myop.op_flags = OPf_STACKED;
602 PUSHs(sv_mortalcopy(newSVpv(mg->mg_ptr, mg->mg_len)));
603 else if (mg->mg_len >= 0)
604 PUSHs(sv_mortalcopy(newSViv(mg->mg_len)));
608 if (op = pp_entersubr())
620 magic_clearpack(sv,mg)
625 HV* stash = SvSTASH(SvRV(rv));
626 GV* gv = gv_fetchmethod(stash, "delete");
630 if (!gv || !GvCV(gv)) {
631 croak("No delete method for magical variable in package \"%s\"",
634 Zero(&myop, 1, BINOP);
635 myop.op_last = (OP *) &myop;
636 myop.op_next = Nullop;
637 myop.op_flags = OPf_STACKED;
649 PUSHs(sv_mortalcopy(newSVpv(mg->mg_ptr, mg->mg_len)));
651 PUSHs(sv_mortalcopy(newSViv(mg->mg_len)));
654 if (op = pp_entersubr())
666 magic_nextpack(sv,mg,key)
672 HV* stash = SvSTASH(SvRV(rv));
673 GV* gv = gv_fetchmethod(stash, SvOK(key) ? "nextkey" : "firstkey");
677 if (!gv || !GvCV(gv)) {
678 croak("No fetch method for magical variable in package \"%s\"",
681 Zero(&myop, 1, BINOP);
682 myop.op_last = (OP *) &myop;
683 myop.op_next = Nullop;
684 myop.op_flags = OPf_STACKED;
699 if (op = pp_entersubr())
711 magic_setdbline(sv,mg)
722 svp = av_fetch(GvAV(gv),atoi(mg->mg_ptr), FALSE);
723 if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
726 warn("Can't break at that line\n");
731 magic_getarylen(sv,mg)
735 sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + arybase);
740 magic_setarylen(sv,mg)
744 av_fill((AV*)mg->mg_obj, (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) - arybase);
753 gv_efullname(sv,((GV*)sv));/* a gv value, be nice */
768 if (*s == '*' && s[1])
770 gv = gv_fetchpv(s,TRUE);
775 GvGP(sv) = gp_ref(GvGP(gv));
786 magic_setsubstr(sv,mg)
791 char *tmps = SvPV(sv,len);
792 sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps, len);
797 magic_gettaint(sv,mg)
806 magic_settaint(sv,mg)
820 do_vecset(sv); /* XXX slurp this routine */
825 magic_setmglob(sv,mg)
849 struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
851 if (uf && uf->uf_set)
852 (*uf->uf_set)(uf->uf_index, sv);
864 switch (*mg->mg_ptr) {
865 case '\004': /* ^D */
866 debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
869 case '\006': /* ^F */
870 maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
876 inplace = savestr(SvPV(sv,na));
880 case '\020': /* ^P */
881 i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
890 case '\024': /* ^T */
891 basetime = (time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
893 case '\027': /* ^W */
894 dowarn = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
898 save_sptr((SV**)&last_in_gv);
901 Safefree(IoTOP_NAME(GvIO(defoutgv)));
902 IoTOP_NAME(GvIO(defoutgv)) = s = savestr(SvPV(sv,na));
903 IoTOP_GV(GvIO(defoutgv)) = gv_fetchpv(s,TRUE);
906 Safefree(IoFMT_NAME(GvIO(defoutgv)));
907 IoFMT_NAME(GvIO(defoutgv)) = s = savestr(SvPV(sv,na));
908 IoFMT_GV(GvIO(defoutgv)) = gv_fetchpv(s,TRUE);
911 IoPAGE_LEN(GvIO(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
914 IoLINES_LEFT(GvIO(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
915 if (IoLINES_LEFT(GvIO(defoutgv)) < 0L)
916 IoLINES_LEFT(GvIO(defoutgv)) = 0L;
919 IoPAGE(GvIO(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
923 GvIO(defoutgv) = newIO();
924 IoFLAGS(GvIO(defoutgv)) &= ~IOf_FLUSH;
925 if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) {
926 IoFLAGS(GvIO(defoutgv)) |= IOf_FLUSH;
930 i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
931 multiline = (i != 0);
935 nrs = rs = SvPV(sv,rslen);
937 if (rspara = !rslen) {
941 nrschar = rschar = rs[rslen - 1];
944 nrschar = rschar = 0777; /* fake a non-existent char */
951 ors = savestr(SvPV(sv,orslen));
956 ofs = savestr(SvPV(sv, ofslen));
961 ofmt = savestr(SvPV(sv,na));
964 arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
967 statusvalue = U_S(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
970 errno = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); /* will anyone ever use this? */
973 uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
975 delaymagic |= DM_RUID;
976 break; /* don't do magic till later */
979 (void)setruid((UIDTYPE)uid);
982 (void)setreuid((UIDTYPE)uid, (UIDTYPE)-1);
984 if (uid == euid) /* special case $< = $> */
987 croak("setruid() not implemented");
990 uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
991 tainting |= (euid != uid || egid != gid);
994 euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
996 delaymagic |= DM_EUID;
997 break; /* don't do magic till later */
1000 (void)seteuid((UIDTYPE)euid);
1003 (void)setreuid((UIDTYPE)-1, (UIDTYPE)euid);
1005 if (euid == uid) /* special case $> = $< */
1008 croak("seteuid() not implemented");
1011 euid = (I32)geteuid();
1012 tainting |= (euid != uid || egid != gid);
1015 gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
1017 delaymagic |= DM_RGID;
1018 break; /* don't do magic till later */
1021 (void)setrgid((GIDTYPE)gid);
1024 (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
1026 if (gid == egid) /* special case $( = $) */
1029 croak("setrgid() not implemented");
1032 gid = (I32)getgid();
1033 tainting |= (euid != uid || egid != gid);
1036 egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
1038 delaymagic |= DM_EGID;
1039 break; /* don't do magic till later */
1042 (void)setegid((GIDTYPE)egid);
1045 (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
1047 if (egid == gid) /* special case $) = $( */
1050 croak("setegid() not implemented");
1053 egid = (I32)getegid();
1054 tainting |= (euid != uid || egid != gid);
1057 chopset = SvPV(sv,na);
1063 /* See if all the arguments are contiguous in memory */
1064 for (i = 1; i < origargc; i++) {
1065 if (origargv[i] == s + 1)
1066 s += strlen(++s); /* this one is ok too */
1068 if (origenviron[0] == s + 1) { /* can grab env area too? */
1069 my_setenv("NoNeSuCh", Nullch);
1070 /* force copy of environment */
1071 for (i = 0; origenviron[i]; i++)
1072 if (origenviron[i] == s + 1)
1075 origalen = s - origargv[0];
1079 if (i >= origalen) {
1083 Copy(s, origargv[0], i, char);
1086 Copy(s, origargv[0], i, char);
1089 while (++i < origalen)
1092 for (i = 1; i < origargc; i++)
1093 origargv[i] = Nullch;
1104 register char **sigv;
1106 for (sigv = sig_name+1; *sigv; sigv++)
1107 if (strEQ(sig,*sigv))
1108 return sigv - sig_name;
1110 if (strEQ(sig,"CHLD"))
1114 if (strEQ(sig,"CLD"))
1132 I32 gimme = G_SCALAR;
1134 #ifdef OS2 /* or anybody else who requires SIG_ACK */
1135 signal(sig, SIG_ACK);
1139 SvPVx(*hv_fetch(GvHVn(siggv),sig_name[sig],strlen(sig_name[sig]),
1142 if (!cv && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
1143 if (sig_name[sig][1] == 'H')
1144 gv = gv_fetchpv(SvPVx(*hv_fetch(GvHVn(siggv),"CLD",3,TRUE), na),
1147 gv = gv_fetchpv(SvPVx(*hv_fetch(GvHVn(siggv),"CHLD",4,TRUE), na),
1149 cv = GvCV(gv); /* gag */
1153 warn("SIG%s handler \"%s\" not defined.\n",
1154 sig_name[sig], GvENAME(gv) );
1159 SWITCHSTACK(stack, signalstack);
1161 sv = sv_newmortal();
1162 sv_setpv(sv,sig_name[sig]);
1170 PUSHBLOCK(cx, CXt_SUB, sp);
1172 cx->blk_sub.savearray = GvAV(defgv);
1173 cx->blk_sub.argarray = av_fake(items, sp);
1174 SAVEFREESV(cx->blk_sub.argarray);
1175 GvAV(defgv) = cx->blk_sub.argarray;
1177 if (CvDEPTH(cv) >= 2) {
1178 if (CvDEPTH(cv) == 100 && dowarn)
1179 warn("Deep recursion on subroutine \"%s\"",GvENAME(gv));
1183 run(); /* Does the LEAVE for us. */
1185 SWITCHSTACK(signalstack, oldstack);