From 55497cffdd24c959994f9a8ddd56db8ce85e1c5b Mon Sep 17 00:00:00 2001 From: Perl 5 Porters Date: Tue, 19 Nov 1996 14:16:00 +1200 Subject: [inseparable changes from patch from perl5.003_07 to perl5.003_08] CORE LANGUAGE CHANGES Subject: Bitwise op sign rationalization From: Chip Salzenberg Files: op.c opcode.pl pod/perlop.pod pod/perltoc.pod pp.c pp.h pp_hot.c proto.h sv.c t/op/bop.t Make bitwise ops result in unsigned values, unless C is in effect. Includes initial support for UVs. Subject: Defined scoping for C in control structures From: Chip Salzenberg Files: op.c perly.c perly.c.diff perly.h perly.y proto.h toke.c Finally defines semantics of "my" in control expressions, like the condition of "if" and "while". In all cases, scope of a "my" var extends to the end of the entire control structure. Also adds new construct "for my", which automatically declares the control variable "my" and limits its scope to the loop. Subject: Fix ++/-- after int conversion (e.g. 'printf "%d"') From: Chip Salzenberg Files: pp.c pp_hot.c sv.c This patch makes Perl correctly ignore SvIVX() if either NOK or POK is true, since SvIVX() may be a truncated or overflowed version of the real value. Subject: Make code match Camel II re: functions that use $_ From: Paul Marquess Files: opcode.pl Subject: Provide scalar context on left side of "->" From: Chip Salzenberg Files: perly.c perly.y Subject: Quote bearword package/handle FOO in "funcname FOO => 'bar'" From: Chip Salzenberg Files: toke.c OTHER CORE CHANGES Subject: Warn on overflow of octal and hex integers From: Chip Salzenberg Files: proto.h toke.c util.c Subject: If -w active, warn for commas and hashes ('#') in qw() From: Chip Salzenberg Files: toke.c Subject: Fixes for pack('w') From: Ulrich Pfeifer Files: pp.c t/op/pack.t Subject: More complete output from sv_dump() From: Gurusamy Sarathy Files: sv.c Subject: Major '..' and debugger patches From: Ilya Zakharevich Files: lib/perl5db.pl op.c pp_ctl.c scope.c scope.h Subject: Fix for formline() From: Gurusamy Sarathy Files: global.sym mg.c perl.h pod/perldiag.pod pp_ctl.c proto.h sv.c t/op/write.t Subject: Fix stack botch in untie and binmode From: Gurusamy Sarathy Files: pp_sys.c Subject: Complete EMBED, including symbols from interp.sym From: Chip Salzenberg Files: MANIFEST embed.pl ext/DynaLoader/dlutils.c ext/SDBM_File/sdbm/sdbm.h global.sym handy.h malloc.c perl.h pp_sys.c proto.h regexec.c toke.c util.c x2p/Makefile.SH x2p/a2p.h x2p/handy.h x2p/util.h New define EMBEDMYMALLOC makes embedding total by avoiding "Mymalloc" etc. Subject: Support old embedding for people who want it From: Chip Salzenberg Files: MANIFEST Makefile.SH old_embed.pl old_global.sym PORTABILITY Subject: Miscellaneous VMS fixes From: Charles Bailey Files: lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_VMS.pm lib/Math/Complex.pm lib/Time/Local.pm lib/timelocal.pl perl.h perl_exp.SH proto.h t/TEST t/io/read.t t/lib/findbin.t t/lib/getopt.t util.c utils/h2xs.PL vms/Makefile vms/config.vms vms/descrip.mms vms/ext/Stdio/Stdio.pm vms/ext/Stdio/Stdio.xs vms/perlvms.pod vms/test.com vms/vms.c Subject: DJGPP patches (MS-DOS) From: "Douglas E. Wegscheid" Files: doio.c dosish.h ext/SDBM_File/sdbm/sdbm.c handy.h lib/AutoSplit.pm lib/Cwd.pm lib/File/Find.pm malloc.c perl.c perl.h pp_sys.c proto.h sv.c util.c Subject: Patch to make Perl work under AmigaOS From: "Norbert Pueschel" Files: MANIFEST hints/amigaos.sh installman lib/File/Basename.pm lib/File/Find.pm pod/pod2man.PL pp_sys.c util.c --- pp_ctl.c | 57 +++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 45 insertions(+), 12 deletions(-) (limited to 'pp_ctl.c') diff --git a/pp_ctl.c b/pp_ctl.c index 0c7e3d4f03..6d6b469556 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -174,7 +174,7 @@ PP(pp_formline) bool gotsome; STRLEN len; - if (!SvCOMPILED(form)) { + if (!SvMAGICAL(form) || !SvCOMPILED(form)) { SvREADONLY_off(form); doparseform(form); } @@ -708,12 +708,16 @@ PP(pp_flop) if (SvNIOKp(left) || !SvPOKp(left) || (looks_like_number(left) && *SvPVX(left) != '0') ) { + SV *sv_iv; + i = SvIV(left); max = SvIV(right); if (max > i) EXTEND(SP, max - i + 1); + sv_iv = sv_2mortal(newSViv(i)); + if (i++ <= max) PUSHs(sv_iv); while (i <= max) { - sv = sv_mortalcopy(&sv_no); + sv = sv_mortalcopy(sv_iv); sv_setiv(sv,i++); PUSHs(sv); } @@ -1295,7 +1299,7 @@ PP(pp_dbstate) SAVETMPS; SAVEI32(debug); - SAVESPTR(stack_sp); + SAVESTACK_POS(); debug = 0; hasargs = 0; sp = stack_sp; @@ -1996,13 +2000,13 @@ int gimme; /* set up a scratch pad */ - SAVEINT(padix); + SAVEI32(padix); SAVESPTR(curpad); SAVESPTR(comppad); SAVESPTR(comppad_name); - SAVEINT(comppad_name_fill); - SAVEINT(min_intro_pending); - SAVEINT(max_intro_pending); + SAVEI32(comppad_name_fill); + SAVEI32(min_intro_pending); + SAVEI32(max_intro_pending); SAVESPTR(compcv); compcv = (CV*)NEWSV(1104,0); @@ -2080,6 +2084,20 @@ int gimme; DEBUG_x(dump_eval()); + /* Register with debugger: */ + + if (perldb && saveop->op_type == OP_REQUIRE) { + CV *cv = perl_get_cv("DB::postponed", FALSE); + + if (cv) { + dSP; + PUSHMARK(sp); + XPUSHs((SV*)compiling.cop_filegv); + PUTBACK; + perl_call_sv((SV*)cv, G_DISCARD); + } + } + /* compiled okay, so do it */ SP = stack_base + POPMARK; /* pop original mark */ @@ -2213,9 +2231,10 @@ PP(pp_entereval) dSP; register CONTEXT *cx; dPOPss; - I32 gimme = GIMME; - char tmpbuf[32]; + I32 gimme = GIMME, was = sub_generation; + char tmpbuf[32], *safestr; STRLEN len; + OP *ret; if (!SvPV(sv,len) || !len) RETPUSHUNDEF; @@ -2231,7 +2250,13 @@ PP(pp_entereval) sprintf(tmpbuf, "_<(eval %d)", ++evalseq); compiling.cop_filegv = gv_fetchfile(tmpbuf+2); compiling.cop_line = 1; - SAVEDELETE(defstash, savepv(tmpbuf), strlen(tmpbuf)); + /* XXX For Cs within BEGIN {} blocks, this ends up + deleting the eval's FILEGV from the stash before gv_check() runs + (i.e. before run-time proper). To work around the coredump that + ensues, we always turn GvMULTI_on for any globals that were + introduced within evals. See force_ident(). GSAR 96-10-12 */ + safestr = savepv(tmpbuf); + SAVEDELETE(defstash, safestr, strlen(safestr)); SAVEI32(hints); hints = op->op_targ; @@ -2244,7 +2269,11 @@ PP(pp_entereval) if (perldb && curstash != debstash) save_lines(GvAV(compiling.cop_filegv), linestr); PUTBACK; - return doeval(gimme); + ret = doeval(gimme); + if (perldb && was != sub_generation) { /* Some subs defined here. */ + strcpy(safestr, "_<(eval )"); /* Anything fake and short. */ + } + return ret; } PP(pp_leaveeval) @@ -2388,7 +2417,10 @@ SV *sv; register I32 arg; bool ischop; - New(804, fops, (send - s)*3+2, U16); /* Almost certainly too long... */ + if (len == 0) + die("Null picture in formline"); + + New(804, fops, (send - s)*3+10, U16); /* Almost certainly too long... */ fpc = fops; if (s < send) { @@ -2543,5 +2575,6 @@ SV *sv; } Copy(fops, s, arg, U16); Safefree(fops); + sv_magic(sv, Nullsv, 'f', Nullch, 0); SvCOMPILED_on(sv); } -- cgit v1.2.1