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;
21 if (vtbl && vtbl->svt_get)
22 (*vtbl->svt_get)(sv, mg);
32 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
33 MGVTBL* vtbl = mg->mg_virtual;
34 if (vtbl && vtbl->svt_set)
35 (*vtbl->svt_set)(sv, mg);
45 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
46 MGVTBL* vtbl = mg->mg_virtual;
47 if (vtbl && vtbl->svt_len)
48 return (*vtbl->svt_len)(sv, mg);
51 if (!SvPOK(sv) && SvNIOK(sv))
63 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
64 MGVTBL* vtbl = mg->mg_virtual;
65 if (vtbl && vtbl->svt_clear)
66 (*vtbl->svt_clear)(sv, mg);
77 MAGIC** mgp = &SvMAGIC(sv);
78 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
79 if (mg->mg_type == type)
91 MAGIC** mgp = &SvMAGIC(sv);
92 for (mg = *mgp; mg; mg = *mgp) {
93 if (mg->mg_type == type) {
94 MGVTBL* vtbl = mg->mg_virtual;
95 *mgp = mg->mg_moremagic;
96 if (vtbl && vtbl->svt_free)
97 (*vtbl->svt_free)(sv, mg);
98 if (mg->mg_ptr && mg->mg_type != 'g')
103 mgp = &mg->mg_moremagic;
114 for (mg = SvMAGIC(sv); mg; mg = moremagic) {
115 MGVTBL* vtbl = mg->mg_virtual;
116 moremagic = mg->mg_moremagic;
117 if (vtbl && vtbl->svt_free)
118 (*vtbl->svt_free)(sv, mg);
119 if (mg->mg_ptr && mg->mg_type != 'g')
120 Safefree(mg->mg_ptr);
127 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
132 #define handlertype void
134 #define handlertype int
137 static handlertype sighandler();
148 switch (*mg->mg_ptr) {
149 case '1': case '2': case '3': case '4':
150 case '5': case '6': case '7': case '8': case '9': case '&':
152 paren = atoi(mg->mg_ptr);
154 if (curpm->op_pmregexp &&
155 paren <= curpm->op_pmregexp->nparens &&
156 (s = curpm->op_pmregexp->startp[paren]) ) {
157 i = curpm->op_pmregexp->endp[paren] - s;
169 paren = curpm->op_pmregexp->lastparen;
175 if (curpm->op_pmregexp &&
176 (s = curpm->op_pmregexp->subbeg) ) {
177 i = curpm->op_pmregexp->startp[0] - s;
189 if (curpm->op_pmregexp &&
190 (s = curpm->op_pmregexp->endp[0]) ) {
191 return (STRLEN) (curpm->op_pmregexp->subend - s);
198 return (STRLEN)ofslen;
200 return (STRLEN)orslen;
203 if (!SvPOK(sv) && SvNIOK(sv))
219 switch (*mg->mg_ptr) {
220 case '\004': /* ^D */
221 sv_setiv(sv,(I32)(debug & 32767));
223 case '\006': /* ^F */
224 sv_setiv(sv,(I32)maxsysfd);
228 sv_setpv(sv, inplace);
230 sv_setsv(sv,&sv_undef);
232 case '\020': /* ^P */
233 sv_setiv(sv,(I32)perldb);
235 case '\024': /* ^T */
236 sv_setiv(sv,(I32)basetime);
238 case '\027': /* ^W */
239 sv_setiv(sv,(I32)dowarn);
241 case '1': case '2': case '3': case '4':
242 case '5': case '6': case '7': case '8': case '9': case '&':
244 paren = atoi(GvENAME(mg->mg_obj));
246 if (curpm->op_pmregexp &&
247 paren <= curpm->op_pmregexp->nparens &&
248 (s = curpm->op_pmregexp->startp[paren]) ) {
249 i = curpm->op_pmregexp->endp[paren] - s;
253 sv_setsv(sv,&sv_undef);
256 sv_setsv(sv,&sv_undef);
261 paren = curpm->op_pmregexp->lastparen;
267 if (curpm->op_pmregexp &&
268 (s = curpm->op_pmregexp->subbeg) ) {
269 i = curpm->op_pmregexp->startp[0] - s;
281 if (curpm->op_pmregexp &&
282 (s = curpm->op_pmregexp->endp[0]) ) {
283 sv_setpvn(sv,s, curpm->op_pmregexp->subend - s);
291 if (last_in_gv && GvIO(last_in_gv)) {
292 sv_setiv(sv,(I32)GvIO(last_in_gv)->lines);
297 sv_setiv(sv,(I32)statusvalue);
300 s = GvIO(defoutgv)->top_name;
304 sv_setpv(sv,GvENAME(defoutgv));
309 s = GvIO(defoutgv)->fmt_name;
311 s = GvENAME(defoutgv);
316 sv_setiv(sv,(I32)GvIO(defoutgv)->page_len);
319 sv_setiv(sv,(I32)GvIO(defoutgv)->lines_left);
322 sv_setiv(sv,(I32)GvIO(defoutgv)->page);
330 sv_setiv(sv,(I32)arybase);
334 GvIO(defoutgv) = newIO();
335 sv_setiv(sv, (GvIO(defoutgv)->flags & IOf_FLUSH) != 0 );
338 sv_setpvn(sv,ofs,ofslen);
341 sv_setpvn(sv,ors,orslen);
347 sv_setnv(sv,(double)errno);
348 sv_setpv(sv, errno ? strerror(errno) : "");
349 SvNOK_on(sv); /* what a wonderful hack! */
352 sv_setiv(sv,(I32)uid);
355 sv_setiv(sv,(I32)euid);
359 (void)sprintf(s,"%d",(int)gid);
363 (void)sprintf(s,"%d",(int)egid);
371 GROUPSTYPE gary[NGROUPS];
373 i = getgroups(NGROUPS,gary);
375 (void)sprintf(s," %ld", (long)gary[i]);
390 magic_getuvar(sv, mg)
394 struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
396 if (uf && uf->uf_val)
397 (*uf->uf_val)(uf->uf_index, sv);
409 my_setenv(mg->mg_ptr,s);
410 /* And you'll never guess what the dog had */
411 /* in its mouth... */
413 if (s && strEQ(mg->mg_ptr,"PATH")) {
414 char *strend = SvEND(sv);
417 s = cpytill(tokenbuf,s,strend,':',&i);
420 || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
436 i = whichsig(mg->mg_ptr); /* ...no, a brick */
437 if (!i && (dowarn || strEQ(mg->mg_ptr,"ALARM")))
438 warn("No such signal: SIG%s", mg->mg_ptr);
439 if (strEQ(s,"IGNORE"))
441 (void)signal(i,SIG_IGN);
445 else if (strEQ(s,"DEFAULT") || !*s)
446 (void)signal(i,SIG_DFL);
448 (void)signal(i,sighandler);
449 if (!strchr(s,'\'')) {
450 sprintf(tokenbuf, "main'%s",s);
451 sv_setpv(sv,tokenbuf);
462 HV* hv = (HV*)mg->mg_obj;
463 hv_dbmstore(hv,mg->mg_ptr,mg->mg_len,sv); /* XXX slurp? */
468 magic_setdbline(sv,mg)
479 svp = av_fetch(GvAV(gv),atoi(mg->mg_ptr), FALSE);
480 if (svp && SvIOK(*svp) && (o = (OP*)SvSTASH(*svp)))
483 warn("Can't break at that line\n");
488 magic_getarylen(sv,mg)
492 sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + arybase);
497 magic_setarylen(sv,mg)
501 av_fill((AV*)mg->mg_obj, (SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)) - arybase);
510 gv_efullname(sv,((GV*)sv));/* a gv value, be nice */
524 s = SvPOK(sv) ? SvPV(sv) : sv_2pv(sv);
525 if (*s == '*' && s[1])
527 gv = gv_fetchpv(s,TRUE);
532 GvGP(sv) = gp_ref(GvGP(gv));
543 magic_setsubstr(sv,mg)
547 char *tmps = SvPV(sv);
550 sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps,SvCUR(sv));
559 do_vecset(sv); /* XXX slurp this routine */
564 magic_setmglob(sv,mg)
588 struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
590 if (uf && uf->uf_set)
591 (*uf->uf_set)(uf->uf_index, sv);
602 switch (*mg->mg_ptr) {
603 case '\004': /* ^D */
604 debug = (SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)) | 32768;
607 case '\006': /* ^F */
608 maxsysfd = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
614 inplace = savestr(SvPV(sv));
618 case '\020': /* ^P */
619 i = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
628 case '\024': /* ^T */
629 basetime = (time_t)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv));
631 case '\027': /* ^W */
632 dowarn = (bool)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv));
636 save_sptr((SV**)&last_in_gv);
639 Safefree(GvIO(defoutgv)->top_name);
640 GvIO(defoutgv)->top_name = s = savestr(SvPV(sv));
641 GvIO(defoutgv)->top_gv = gv_fetchpv(s,TRUE);
644 Safefree(GvIO(defoutgv)->fmt_name);
645 GvIO(defoutgv)->fmt_name = s = savestr(SvPV(sv));
646 GvIO(defoutgv)->fmt_gv = gv_fetchpv(s,TRUE);
649 GvIO(defoutgv)->page_len = (long)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv));
652 GvIO(defoutgv)->lines_left = (long)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv));
653 if (GvIO(defoutgv)->lines_left < 0L)
654 GvIO(defoutgv)->lines_left = 0L;
657 GvIO(defoutgv)->page = (long)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv));
661 GvIO(defoutgv) = newIO();
662 GvIO(defoutgv)->flags &= ~IOf_FLUSH;
663 if ((SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)) != 0) {
664 GvIO(defoutgv)->flags |= IOf_FLUSH;
668 i = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
669 multiline = (i != 0);
674 nrslen = rslen = SvCUR(sv);
675 if (rspara = !rslen) {
679 nrschar = rschar = rs[rslen - 1];
682 nrschar = rschar = 0777; /* fake a non-existent char */
689 ors = savestr(SvPV(sv));
695 ofs = savestr(SvPV(sv));
701 ofmt = savestr(SvPV(sv));
704 arybase = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
707 statusvalue = U_S(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv));
710 errno = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); /* will anyone ever use this? */
713 uid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
715 delaymagic |= DM_RUID;
716 break; /* don't do magic till later */
719 (void)setruid((UIDTYPE)uid);
722 (void)setreuid((UIDTYPE)uid, (UIDTYPE)-1);
724 if (uid == euid) /* special case $< = $> */
727 fatal("setruid() not implemented");
730 uid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
733 euid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
735 delaymagic |= DM_EUID;
736 break; /* don't do magic till later */
739 (void)seteuid((UIDTYPE)euid);
742 (void)setreuid((UIDTYPE)-1, (UIDTYPE)euid);
744 if (euid == uid) /* special case $> = $< */
747 fatal("seteuid() not implemented");
750 euid = (I32)geteuid();
753 gid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
755 delaymagic |= DM_RGID;
756 break; /* don't do magic till later */
759 (void)setrgid((GIDTYPE)gid);
762 (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
764 if (gid == egid) /* special case $( = $) */
767 fatal("setrgid() not implemented");
773 egid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
775 delaymagic |= DM_EGID;
776 break; /* don't do magic till later */
779 (void)setegid((GIDTYPE)egid);
782 (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
784 if (egid == gid) /* special case $) = $( */
787 fatal("setegid() not implemented");
790 egid = (I32)getegid();
799 /* See if all the arguments are contiguous in memory */
800 for (i = 1; i < origargc; i++) {
801 if (origargv[i] == s + 1)
802 s += strlen(++s); /* this one is ok too */
804 if (origenviron[0] == s + 1) { /* can grab env area too? */
805 my_setenv("NoNeSuCh", Nullch);
806 /* force copy of environment */
807 for (i = 0; origenviron[i]; i++)
808 if (origenviron[i] == s + 1)
811 origalen = s - origargv[0];
819 Copy(s, origargv[0], i, char);
822 Copy(s, origargv[0], i, char);
825 while (++i < origalen)
837 register char **sigv;
839 for (sigv = sig_name+1; *sigv; sigv++)
840 if (strEQ(sig,*sigv))
841 return sigv - sig_name;
843 if (strEQ(sig,"CHLD"))
847 if (strEQ(sig,"CLD"))
865 I32 gimme = G_SCALAR;
867 #ifdef OS2 /* or anybody else who requires SIG_ACK */
868 signal(sig, SIG_ACK);
872 SvPVnx(*hv_fetch(GvHVn(siggv),sig_name[sig],strlen(sig_name[sig]),
875 if (!cv && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
876 if (sig_name[sig][1] == 'H')
877 gv = gv_fetchpv(SvPVnx(*hv_fetch(GvHVn(siggv),"CLD",3,TRUE)),
880 gv = gv_fetchpv(SvPVnx(*hv_fetch(GvHVn(siggv),"CHLD",4,TRUE)),
882 cv = GvCV(gv); /* gag */
886 warn("SIG%s handler \"%s\" not defined.\n",
887 sig_name[sig], GvENAME(gv) );
892 SWITCHSTACK(stack, signalstack);
894 sv = sv_mortalcopy(&sv_undef);
895 sv_setpv(sv,sig_name[sig]);
903 PUSHBLOCK(cx, CXt_SUB, sp);
905 cx->blk_sub.savearray = GvAV(defgv);
906 cx->blk_sub.argarray = av_fake(items, sp);
907 GvAV(defgv) = cx->blk_sub.argarray;
909 if (CvDEPTH(cv) >= 2) {
910 if (CvDEPTH(cv) == 100 && dowarn)
911 warn("Deep recursion on subroutine \"%s\"",GvENAME(gv));
915 run(); /* Does the LEAVE for us. */
917 SWITCHSTACK(signalstack, oldstack);