Xref: utzoo comp.sources.bugs:2606 comp.lang.perl:2597 Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!usc!elroy.jpl.nasa.gov!jpl-devvax!lwall From: lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) Newsgroups: comp.sources.bugs,comp.lang.perl Subject: perl 3.0 patch #34 Summary: This is an official patch for perl 3.0. Please apply it. Message-ID: <10005@jpl-devvax.JPL.NASA.GOV> Date: 17 Oct 90 16:55:43 GMT Organization: Jet Propulsion Laboratory, Pasadena, CA Lines: 2115 System: perl version 3.0 Patch #: 34 Priority: HIGH Subject: patch #29, continued Description: See patch #29. Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source directory. Outside of rn, say "cd DIR; patch -p -N #define PATCHLEVEL 34 Index: os2/popen.c *** os2/popen.c.old Tue Oct 16 11:56:40 1990 --- os2/popen.c Tue Oct 16 11:56:41 1990 *************** *** 1,210 **** ! /* ! * Pipe support for OS/2. ! * ! * WARNING: I am guilty of chumminess with the runtime library because ! * I had no choice. Details to follow. ! * */ ! #include "EXTERN.h" ! #include "perl.h" ! #define INCL_DOSPROCESS ! #define INCL_DOSQUEUES ! #define INCL_DOSMISC ! #define INCL_DOSMEMMGR ! #include ! extern char **environ; ! /* This mysterious array _osfile is used internally by the runtime ! * library to remember assorted things about open file handles. ! * The problem is that we are creating file handles via DosMakePipe, ! * rather than via the runtime library. This means that we have ! * to fake the runtime library into thinking that the handles we've ! * created are honest file handles. So just before doing the fdopen, ! * we poke in a magic value that fools the library functions into ! * thinking that the handle is already open in text mode. * ! * This might not work for your compiler, so beware. */ - extern char _osfile[]; ! /* The maximum number of simultaneously open pipes. We create an ! * array of this size to record information about each open pipe. */ - #define MAXPIPES 5 ! /* Information to remember about each open pipe. ! * The (FILE *) that popen returns is stored because that's the only ! * way we can keep track of the pipes. */ - typedef struct pipeinfo { - FILE *pfId; /* Which FILE we're talking about */ - HFILE hfMe; /* handle I should close at pclose */ - PID pidChild; /* Child's PID */ - CHAR fReading; /* A read or write pipe? */ - } PIPEINFO, *PPIPEINFO; /* pi and ppi */ ! static PIPEINFO PipeInfo[MAXPIPES]; ! FILE *mypopen(const char *command, const char *t) { ! typedef char *PSZZ; ! PSZZ pszzPipeArgs = 0; ! PSZZ pszzEnviron = 0; ! PSZ *ppsz; ! PSZ psz; ! FILE *f; ! HFILE hfMe, hfYou; ! HFILE hf, hfSave; ! RESULTCODES rc; ! USHORT us; ! PPIPEINFO ppi; ! UINT i; ! /* Validate pipe type */ ! if (*t != 'w' && *t != 'r') fatal("Unknown pipe type"); ! /* Room for another pipe? */ ! for (ppi = &PipeInfo[0]; ppi < &PipeInfo[MAXPIPES]; ppi++) ! if (ppi->pfId == 0) goto foundone; ! return NULL; ! foundone: ! /* Make the pipe */ ! if (DosMakePipe(&hfMe, &hfYou, 0)) return NULL; ! /* Build the environment. First compute its length, then copy ! * the environment strings into it. ! */ ! i = 0; ! for (ppsz = environ; *ppsz; ppsz++) i += 1 + strlen(*ppsz); ! New(1204, pszzEnviron, 1+i, CHAR); ! ! psz = pszzEnviron; ! for (ppsz = environ; *ppsz; ppsz++) { ! strcpy(psz, *ppsz); ! psz += 1 + strlen(*ppsz); } ! *psz = 0; ! /* Build the command string to execute. ! * 6 = length(0 "/c " 0 0) */ - if (DosScanEnv("COMSPEC", &psz)) psz = "C:\\OS2\\cmd.exe"; - #if 0 - New(1203, pszzPipeArgs, strlen(psz) + strlen(command) + 6, CHAR); - #else - #define pszzPipeArgs buf - #endif - sprintf(pszzPipeArgs, "%s%c/c %s%c", psz, 0, command, 0); ! /* Now some stuff that depends on what kind of pipe we're doing. ! * We pull a sneaky trick; namely, that stdin = 0 = false, ! * and stdout = 1 = true. The end result is that if the ! * pipe is a read pipe, then hf = 1; if it's a write pipe, then ! * hf = 0 and Me and You are reversed. ! */ ! if (!(hf = (*t == 'r'))) { ! /* The meaning of Me and You is reversed for write pipes. */ ! hfSave = hfYou; hfYou = hfMe; hfMe = hfSave; ! } ! ppi->fReading = hf; ! /* Trick number 1: Fooling the runtime library into thinking ! * that the file handle is legit. ! * ! * Trick number 2: Don't let my handle go over to the child! ! * Since the child never closes it (why should it?), I'd better ! * make sure he never sees it in the first place. Otherwise, ! * we are in deadlock city. ! */ ! _osfile[hfMe] = 0x81; /* Danger, Will Robinson! */ ! if (!(ppi->pfId = fdopen(hfMe, t))) goto no_fdopen; ! DosSetFHandState(hfMe, OPEN_FLAGS_NOINHERIT); ! /* Save the original handle because we're going to diddle it */ ! hfSave = 0xFFFF; ! if (DosDupHandle(hf, &hfSave)) goto no_dup_init; ! /* Force the child's handle onto the stdio handle */ ! if (DosDupHandle(hfYou, &hf)) goto no_force_dup; ! DosClose(hfYou); ! /* Now run the guy servicing the pipe */ ! us = DosExecPgm(NULL, 0, EXEC_ASYNCRESULT, pszzPipeArgs, pszzEnviron, ! &rc, pszzPipeArgs); ! /* Restore stdio handle, even if exec failed. */ ! DosDupHandle(hfSave, &hf); close(hfSave); ! /* See if the exec succeeded. */ ! if (us) goto no_exec_pgm; ! /* Remember the child's PID */ ! ppi->pidChild = rc.codeTerminate; - Safefree(pszzEnviron); ! /* Phew. */ ! return ppi->pfId; ! /* Here is where we clean up after an error. */ ! no_exec_pgm: ; ! no_force_dup: close(hfSave); ! no_dup_init: fclose(f); ! no_fdopen: ! DosClose(hfMe); DosClose(hfYou); ! ppi->pfId = 0; ! Safefree(pszzEnviron); ! return NULL; } ! /* mypclose: Closes the pipe associated with the file handle. ! * After waiting for the child process to terminate, its return ! * code is returned. If the stream was not associated with a pipe, ! * we return -1. ! */ ! int ! mypclose(FILE *f) { ! PPIPEINFO ppi; ! RESULTCODES rc; ! USHORT us; ! /* Find the pipe this (FILE *) refers to */ ! for (ppi = &PipeInfo[0]; ppi < &PipeInfo[MAXPIPES]; ppi++) ! if (ppi->pfId == f) goto foundit; ! return -1; ! foundit: ! if (ppi->fReading && !DosRead(fileno(f), &rc, 1, &us) && us > 0) { ! DosKillProcess(DKP_PROCESSTREE, ppi->pidChild); ! } ! fclose(f); ! DosCwait(DCWA_PROCESS, DCWW_WAIT, &rc, &ppi->pidChild, ppi->pidChild); ! ppi->pfId = 0; ! return rc.codeResult; } ! /* pipe: The only tricky thing is letting the runtime library know about ! * our two new file descriptors. ! */ ! int pipe(int filedes[2]) { ! HFILE hfRead, hfWrite; ! USHORT usResult; ! usResult = DosMakePipe(&hfRead, &hfWrite, 0); ! if (usResult) { ! /* Error 4 == ERROR_TOO_MANY_OPEN_FILES */ ! errno = (usResult == 4) ? ENFILE : ENOMEM; ! return -1; ! } ! _osfile[hfRead] = _osfile[hfWrite] = 0x81;/* Danger, Will Robinson! */ ! filedes[0] = hfRead; ! filedes[1] = hfWrite; ! return 0; } --- 1,237 ---- ! /* added real/protect mode branch at runtime and real mode version ! * names changed for perl ! * Kai Uwe Rommel */ ! /* ! Several people in the past have asked about having Unix-like pipe ! calls in OS/2. The following source file, adapted from 4.3 BSD Unix, ! uses a #define to give you a pipe(2) call, and contains function ! definitions for popen(3) and pclose(3). Anyone with problems should ! send mail to me; they seem to work fine. ! Mark Towfigh ! Racal Interlan, Inc. ! ----------------------------------cut-here------------------------------------ ! */ ! /* ! * The following code segment is derived from BSD 4.3 Unix. See ! * copyright below. Any bugs, questions, improvements, or problems ! * should be sent to Mark Towfigh (towfiq@interlan.interlan.com). * ! * Racal InterLan Inc. */ ! /* ! * Copyright (c) 1980 Regents of the University of California. ! * All rights reserved. The Berkeley software License Agreement ! * specifies the terms and conditions for redistribution. */ ! #include ! #include ! #include ! #include ! #include ! #include ! ! #define INCL_NOPM ! #define INCL_DOS ! #include ! ! static FILE *dos_popen(const char *cmd, const char *flags); ! static int dos_pclose(FILE *pipe); ! ! /* ! * emulate Unix pipe(2) call */ ! #define tst(a,b) (*mode == 'r'? (b) : (a)) ! #define READH 0 ! #define WRITEH 1 ! static int popen_pid[20]; ! ! FILE *mypopen(char *cmd, char *mode) { ! int p[2]; ! register myside, hisside, save_stream; ! char *shell = getenv("COMPSPEC"); ! if ( shell == NULL ) ! shell = "C:\\OS2\\CMD.EXE"; ! if ( _osmode == DOS_MODE ) ! return dos_popen(cmd, mode); ! if (DosMakePipe((PHFILE) &p[0], (PHFILE) &p[1], 4096) < 0) ! return NULL; ! myside = tst(p[WRITEH], p[READH]); ! hisside = tst(p[READH], p[WRITEH]); ! /* set up file descriptors for remote function */ ! save_stream = dup(tst(0, 1)); /* don't lose stdin/out! */ ! if (dup2(hisside, tst(0, 1)) < 0) ! { ! perror("dup2"); ! return NULL; } ! close(hisside); ! /* ! * make sure that we can close our side of the pipe, by ! * preventing it from being inherited! */ ! /* set no-inheritance flag */ ! DosSetFHandState(myside, OPEN_FLAGS_NOINHERIT); ! /* execute the command: it will inherit our other file descriptors */ ! popen_pid[myside] = spawnlp(P_NOWAIT, shell, shell, "/C", cmd, NULL); ! /* now restore our previous file descriptors */ ! if (dup2(save_stream, tst(0, 1)) < 0) /* retrieve stdin/out */ ! { ! perror("dup2"); ! return NULL; ! } ! close(save_stream); ! return fdopen(myside, mode); /* return a FILE pointer */ ! } ! int mypclose(FILE *ptr) ! { ! register f; ! int status; ! if ( _osmode == DOS_MODE ) ! return dos_pclose(ptr); ! f = fileno(ptr); ! fclose(ptr); ! /* wait for process to terminate */ ! cwait(&status, popen_pid[f], WAIT_GRANDCHILD); ! return status; ! } ! int pipe(int *filedes) ! { ! int res; ! if ( res = DosMakePipe((PHFILE) &filedes[0], (PHFILE) &filedes[1], 4096) ) ! return res; ! ! DosSetFHandState(filedes[0], OPEN_FLAGS_NOINHERIT); ! DosSetFHandState(filedes[1], OPEN_FLAGS_NOINHERIT); ! return 0; } ! /* this is the MS-DOS version */ ! ! typedef enum { unopened = 0, reading, writing } pipemode; ! ! static struct { ! char *name; ! char *command; ! pipemode pmode; ! } ! pipes[_NFILE]; ! static FILE *dos_popen(const char *command, const char *mode) ! { ! FILE *current; ! char name[128]; ! int cur; ! pipemode curmode; ! ! /* ! ** decide on mode. ! */ ! if(strchr(mode, 'r') != NULL) ! curmode = reading; ! else if(strchr(mode, 'w') != NULL) ! curmode = writing; ! else ! return NULL; ! ! /* ! ** get a name to use. ! */ ! strcpy(name, "piXXXXXX"); ! Mktemp(name); ! ! /* ! ** If we're reading, just call system to get a file filled with ! ** output. ! */ ! if(curmode == reading) ! { ! char cmd[256]; ! sprintf(cmd,"%s > %s", command, name); ! system(cmd); ! ! if((current = fopen(name, mode)) == NULL) ! return NULL; ! } ! else ! { ! if((current = fopen(name, mode)) == NULL) ! return NULL; ! } ! ! cur = fileno(current); ! pipes[cur].name = strdup(name); ! pipes[cur].command = strdup(command); ! pipes[cur].pmode = curmode; ! ! return current; } ! static int dos_pclose(FILE * current) { ! int cur = fileno(current), rval; ! char command[256]; ! /* ! ** check for an open file. ! */ ! if(pipes[cur].pmode == unopened) ! return -1; ! ! if(pipes[cur].pmode == reading) ! { ! /* ! ** input pipes are just files we're done with. ! */ ! rval = fclose(current); ! unlink(pipes[cur].name); ! } ! else ! { ! /* ! ** output pipes are temporary files we have ! ** to cram down the throats of programs. ! */ ! fclose(current); ! sprintf(command,"%s < %s", pipes[cur].command, pipes[cur].name); ! rval = system(command); ! unlink(pipes[cur].name); ! } ! ! /* ! ** clean up current pipe. ! */ ! free(pipes[cur].name); ! free(pipes[cur].command); ! pipes[cur].pmode = unopened; ! ! return rval; } Index: regcomp.c Prereq: 3.0.1.5 *** regcomp.c.old Tue Oct 16 12:01:41 1990 --- regcomp.c Tue Oct 16 12:01:55 1990 *************** *** 7,15 **** * blame Henry for some of the lack of readability. */ ! /* $Header: regcomp.c,v 3.0.1.5 90/08/13 22:23:29 lwall Locked $ * * $Log: regcomp.c,v $ * Revision 3.0.1.5 90/08/13 22:23:29 lwall * patch28: /x{m}/ didn't work right * --- 7,18 ---- * blame Henry for some of the lack of readability. */ ! /* $Header: regcomp.c,v 3.0.1.6 90/10/16 10:17:33 lwall Locked $ * * $Log: regcomp.c,v $ + * Revision 3.0.1.6 90/10/16 10:17:33 lwall + * patch29: patterns with multiple short literal strings sometimes failed + * * Revision 3.0.1.5 90/08/13 22:23:29 lwall * patch28: /x{m}/ didn't work right * *************** *** 138,144 **** { register regexp *r; register char *scan; ! register STR *longest; register int len; register char *first; int flags; --- 141,148 ---- { register regexp *r; register char *scan; ! register STR *longish; ! STR *longest; register int len; register char *first; int flags; *************** *** 241,246 **** --- 245,251 ---- * it happens that curback has been invalidated, since the * earlier string may buy us something the later one won't.] */ + longish = str_make("",0); longest = str_make("",0); len = 0; curback = 0; *************** *** 260,266 **** while (OP(regnext(scan)) >= CLOSE) scan = regnext(scan); if (curback - back == len) { ! str_ncat(longest, OPERAND(first)+1, *OPERAND(first)); len += *OPERAND(first); curback += *OPERAND(first); --- 265,271 ---- while (OP(regnext(scan)) >= CLOSE) scan = regnext(scan); if (curback - back == len) { ! str_ncat(longish, OPERAND(first)+1, *OPERAND(first)); len += *OPERAND(first); curback += *OPERAND(first); *************** *** 268,274 **** } else if (*OPERAND(first) >= len + (curback >= 0)) { len = *OPERAND(first); ! str_nset(longest, OPERAND(first)+1,len); back = curback; curback += len; first = regnext(scan); --- 273,279 ---- } else if (*OPERAND(first) >= len + (curback >= 0)) { len = *OPERAND(first); ! str_nset(longish, OPERAND(first)+1,len); back = curback; curback += len; first = regnext(scan); *************** *** 276,293 **** else curback += *OPERAND(first); } ! else if (index(varies,OP(scan))) ! curback = -30000; else if (index(simple,OP(scan))) ! curback++; scan = regnext(scan); } ! if (len) { r->regmust = longest; if (back < 0) back = -1; r->regback = back; ! if (len > !(sawstudy||fold||OP(first)==EOL)) fbmcompile(r->regmust,fold); r->regmust->str_u.str_useful = 100; if (OP(first) == EOL) /* is match anchored to EOL? */ --- 281,307 ---- else curback += *OPERAND(first); } ! else if (index(varies,OP(scan))) { ! curback = -30000; ! len = 0; ! if (longish->str_cur > longest->str_cur) ! str_sset(longest,longish); ! str_nset(longish,"",0); ! } else if (index(simple,OP(scan))) ! curback++; scan = regnext(scan); } ! if (longish->str_cur > longest->str_cur) ! str_sset(longest,longish); ! str_free(longish); ! if (longest->str_cur) { r->regmust = longest; if (back < 0) back = -1; r->regback = back; ! if (longest->str_cur ! > !(sawstudy || fold || OP(first) == EOL) ) fbmcompile(r->regmust,fold); r->regmust->str_u.str_useful = 100; if (OP(first) == EOL) /* is match anchored to EOL? */ *************** *** 1123,1128 **** --- 1137,1144 ---- #endif op = OP(s); fprintf(stderr,"%2d%s", s-r->program, regprop(s)); /* Where, what. */ + if (op == CURLY) + s += 4; next = regnext(s); if (next == NULL) /* Next ptr. */ fprintf(stderr,"(0)"); Index: regexec.c Prereq: 3.0.1.4 *** regexec.c.old Tue Oct 16 12:02:13 1990 --- regexec.c Tue Oct 16 12:02:19 1990 *************** *** 7,15 **** * blame Henry for some of the lack of readability. */ ! /* $Header: regexec.c,v 3.0.1.4 90/08/09 05:12:03 lwall Locked $ * * $Log: regexec.c,v $ * Revision 3.0.1.4 90/08/09 05:12:03 lwall * patch19: sped up /x+y/ patterns greatly by not retrying on every x * patch19: inhibited backoff on patterns anchored to the end like /\s+$/ --- 7,20 ---- * blame Henry for some of the lack of readability. */ ! /* $Header: regexec.c,v 3.0.1.5 90/10/16 10:25:36 lwall Locked $ * * $Log: regexec.c,v $ + * Revision 3.0.1.5 90/10/16 10:25:36 lwall + * patch29: /^pat/ occasionally matched in middle of string when $* = 0 + * patch29: /.{n,m}$/ could match with fewer than n characters remaining + * patch29: /\d{9}/ could match more than 9 characters + * * Revision 3.0.1.4 90/08/09 05:12:03 lwall * patch19: sped up /x+y/ patterns greatly by not retrying on every x * patch19: inhibited backoff on patterns anchored to the end like /\s+$/ *************** *** 139,146 **** if (string == strbeg) /* is ^ valid at stringarg? */ regprev = '\n'; ! else regprev = stringarg[-1]; regprecomp = prog->precomp; /* Check validity of program. */ if (UCHARAT(prog->program) != MAGIC) { --- 144,154 ---- if (string == strbeg) /* is ^ valid at stringarg? */ regprev = '\n'; ! else { regprev = stringarg[-1]; + if (!multiline && regprev == '\n') + regprev = '\0'; /* force ^ to NOT match */ + } regprecomp = prog->precomp; /* Check validity of program. */ if (UCHARAT(prog->program) != MAGIC) { *************** *** 771,777 **** nextchar = -1000; reginput = locinput; n = regrepeat(scan, n); ! if (!multiline && OP(next) == EOL) ln = n; /* why back off? */ while (n >= ln) { /* If it could work, try it. */ --- 779,785 ---- nextchar = -1000; reginput = locinput; n = regrepeat(scan, n); ! if (!multiline && OP(next) == EOL && ln < n) ln = n; /* why back off? */ while (n >= ln) { /* If it could work, try it. */ *************** *** 845,851 **** } break; case ALNUM: ! while (isALNUM(*scan)) scan++; break; case NALNUM: --- 853,859 ---- } break; case ALNUM: ! while (scan < loceol && isALNUM(*scan)) scan++; break; case NALNUM: *************** *** 861,867 **** scan++; break; case DIGIT: ! while (isDIGIT(*scan)) scan++; break; case NDIGIT: --- 869,875 ---- scan++; break; case DIGIT: ! while (scan < loceol && isDIGIT(*scan)) scan++; break; case NDIGIT: Index: x2p/s2p.SH Prereq: 3.0.1.4 *** x2p/s2p.SH.old Tue Oct 16 12:06:38 1990 --- x2p/s2p.SH Tue Oct 16 12:06:41 1990 *************** *** 28,36 **** : In the following dollars and backticks do not need the extra backslash. $spitshell >>s2p <<'!NO!SUBS!' ! # $Header: s2p.SH,v 3.0.1.4 90/08/09 05:50:43 lwall Locked $ # # $Log: s2p.SH,v $ # Revision 3.0.1.4 90/08/09 05:50:43 lwall # patch19: s2p didn't translate \n right # --- 28,39 ---- : In the following dollars and backticks do not need the extra backslash. $spitshell >>s2p <<'!NO!SUBS!' ! # $Header: s2p.SH,v 3.0.1.5 90/10/16 11:32:40 lwall Locked $ # # $Log: s2p.SH,v $ + # Revision 3.0.1.5 90/10/16 11:32:40 lwall + # patch29: s2p modernized + # # Revision 3.0.1.4 90/08/09 05:50:43 lwall # patch19: s2p didn't translate \n right # *************** *** 59,72 **** $indent = 4; $shiftwidth = 4; $l = '{'; $r = '}'; - $tempvar = '1'; ! while ($ARGV[0] =~ '^-') { $_ = shift; last if /^--/; if (/^-D/) { $debug++; ! open(body,'>-'); next; } if (/^-n/) { --- 62,74 ---- $indent = 4; $shiftwidth = 4; $l = '{'; $r = '}'; ! while ($ARGV[0] =~ /^-/) { $_ = shift; last if /^--/; if (/^-D/) { $debug++; ! open(BODY,'>-'); next; } if (/^-n/) { *************** *** 81,92 **** } unless ($debug) { ! open(body,">/tmp/sperl$$") || do Die("Can't open temp file"); } if (!$assumen && !$assumep) { ! print body ! 'while ($ARGV[0] =~ /^-/) { $_ = shift; last if /^--/; if (/^-n/) { --- 83,95 ---- } unless ($debug) { ! open(BODY,">/tmp/sperl$$") || ! &Die("Can't open temp file: $!\n"); } if (!$assumen && !$assumep) { ! print BODY <<'EOT'; ! while ($ARGV[0] =~ /^-/) { $_ = shift; last if /^--/; if (/^-n/) { *************** *** 93,105 **** $nflag++; next; } ! die "I don\'t recognize this switch: $_\\n"; } ! '; } ! print body ' #ifdef PRINTIT #ifdef ASSUMEP $printit++; --- 96,109 ---- $nflag++; next; } ! die "I don't recognize this switch: $_\\n"; } ! EOT } ! print BODY <<'EOT'; ! #ifdef PRINTIT #ifdef ASSUMEP $printit++; *************** *** 107,120 **** $printit++ unless $nflag; #endif #endif ! line: while (<>) { ! '; ! line: while (<>) { s/[ \t]*(.*)\n$/$1/; if (/^:/) { s/^:[ \t]*//; ! $label = do make_label($_); if ($. == 1) { $toplabel = $label; } --- 111,130 ---- $printit++ unless $nflag; #endif #endif ! LINE: while (<>) { ! EOT ! LINE: while (<>) { ! ! # Wipe out surrounding whitespace. ! s/[ \t]*(.*)\n$/$1/; + + # Perhaps it's a label/comment. + if (/^:/) { s/^:[ \t]*//; ! $label = &make_label($_); if ($. == 1) { $toplabel = $label; } *************** *** 121,127 **** $_ = "$label:"; if ($lastlinewaslabel++) { $indent += 4; ! print body "\t" x ($indent / 8), ' ' x ($indent % 8), ";\n"; $indent -= 4; } if ($indent >= 2) { --- 131,137 ---- $_ = "$label:"; if ($lastlinewaslabel++) { $indent += 4; ! print BODY &tab, ";\n"; $indent -= 4; } if ($indent >= 2) { *************** *** 132,137 **** --- 142,150 ---- } else { $lastlinewaslabel = ''; } + + # Look for one or two address clauses + $addr1 = ''; $addr2 = ''; if (s/^([0-9]+)//) { *************** *** 141,147 **** $addr1 = 'eof()'; } elsif (s|^/||) { ! $addr1 = do fetchpat('/'); } if (s/^,//) { if (s/^([0-9]+)//) { --- 154,160 ---- $addr1 = 'eof()'; } elsif (s|^/||) { ! $addr1 = &fetchpat('/'); } if (s/^,//) { if (s/^([0-9]+)//) { *************** *** 149,162 **** } elsif (s/^\$//) { $addr2 = "eof()"; } elsif (s|^/||) { ! $addr2 = do fetchpat('/'); } else { ! do Die("Invalid second address at line $.\n"); } $addr1 .= " .. $addr2"; } ! # a { to keep vi happy s/^[ \t]+//; if ($_ eq '}') { $indent -= 4; next; --- 162,179 ---- } elsif (s/^\$//) { $addr2 = "eof()"; } elsif (s|^/||) { ! $addr2 = &fetchpat('/'); } else { ! &Die("Invalid second address at line $.\n"); } $addr1 .= " .. $addr2"; } ! ! # Now we check for metacommands {, }, and ! and worry ! # about indentation. ! s/^[ \t]+//; + # a { to keep vi happy if ($_ eq '}') { $indent -= 4; next; *************** *** 180,188 **** } else { $space = ''; } ! $_ = do transmogrify(); } if ($addr1) { if ($_ !~ /[\n{}]/ && $rmaybe && !$change && $_ !~ / if / && $_ !~ / unless /) { --- 197,207 ---- } else { $space = ''; } ! $_ = &transmogrify(); } + # See if we can optimize to modifier form. + if ($addr1) { if ($_ !~ /[\n{}]/ && $rmaybe && !$change && $_ !~ / if / && $_ !~ / unless /) { *************** *** 189,208 **** s/;$/ $if $addr1;/; $_ = substr($_,$shiftwidth,1000); } else { ! $command = $_; ! $_ = "$if ($addr1) $l\n$change$command$rmaybe"; } $change = ''; ! next line; } } continue { @lines = split(/\n/,$_); ! while ($#lines >= 0) { ! $_ = shift(lines); unless (s/^ *<<--//) { ! print body "\t" x ($indent / 8), ' ' x ($indent % 8); } ! print body $_, "\n"; } $indent += $indmod; $indmod = 0; --- 208,225 ---- s/;$/ $if $addr1;/; $_ = substr($_,$shiftwidth,1000); } else { ! $_ = "$if ($addr1) $l\n$change$_$rmaybe"; } $change = ''; ! next LINE; } } continue { @lines = split(/\n/,$_); ! for (@lines) { unless (s/^ *<<--//) { ! print BODY &tab; } ! print BODY $_, "\n"; } $indent += $indmod; $indmod = 0; *************** *** 209,227 **** if ($redo) { $_ = $redo; $redo = ''; ! redo line; } } if ($lastlinewaslabel++) { $indent += 4; ! print body "\t" x ($indent / 8), ' ' x ($indent % 8), ";\n"; $indent -= 4; } ! print body "}\n"; if ($appendseen || $tseen || !$assumen) { $printit++ if $dseen || (!$assumen && !$assumep); ! print body ' continue { #ifdef PRINTIT #ifdef DSEEN --- 226,245 ---- if ($redo) { $_ = $redo; $redo = ''; ! redo LINE; } } if ($lastlinewaslabel++) { $indent += 4; ! print BODY &tab, ";\n"; $indent -= 4; } ! print BODY "}\n"; if ($appendseen || $tseen || !$assumen) { $printit++ if $dseen || (!$assumen && !$assumep); ! print BODY <<'EOT'; ! continue { #ifdef PRINTIT #ifdef DSEEN *************** *** 228,234 **** #ifdef ASSUMEP print if $printit++; #else ! if ($printit) { print;} else { $printit++ unless $nflag; } #endif #else print if $printit; --- 246,255 ---- #ifdef ASSUMEP print if $printit++; #else ! if ($printit) ! { print; } ! else ! { $printit++ unless $nflag; } #endif #else print if $printit; *************** *** 237,276 **** print; #endif #ifdef TSEEN ! $tflag = \'\'; #endif #ifdef APPENDSEEN ! if ($atext) { print $atext; $atext = \'\'; } #endif } ! '; } ! close body; unless ($debug) { ! open(head,">/tmp/sperl2$$.c") || do Die("Can't open temp file 2"); ! print head "#define PRINTIT\n" if ($printit); ! print head "#define APPENDSEEN\n" if ($appendseen); ! print head "#define TSEEN\n" if ($tseen); ! print head "#define DSEEN\n" if ($dseen); ! print head "#define ASSUMEN\n" if ($assumen); ! print head "#define ASSUMEP\n" if ($assumep); ! if ($opens) {print head "$opens\n";} ! open(body,"/tmp/sperl$$") || do Die("Can't reopen temp file"); ! while () { ! print head $_; } ! close head; ! print "#!$bin/perl ! eval \"exec $bin/perl -S \$0 \$*\" if \$running_under_some_shell; ! "; ! open(body,"cc -E /tmp/sperl2$$.c |") || ! do Die("Can't reopen temp file"); ! while () { /^# [0-9]/ && next; /^[ \t]*$/ && next; s/^<><>//; --- 258,300 ---- print; #endif #ifdef TSEEN ! $tflag = ''; #endif #ifdef APPENDSEEN ! if ($atext) { print $atext; $atext = ''; } #endif } ! EOT } ! close BODY; unless ($debug) { ! open(HEAD,">/tmp/sperl2$$.c") ! || &Die("Can't open temp file 2: $!\n"); ! print HEAD "#define PRINTIT\n" if ($printit); ! print HEAD "#define APPENDSEEN\n" if ($appendseen); ! print HEAD "#define TSEEN\n" if ($tseen); ! print HEAD "#define DSEEN\n" if ($dseen); ! print HEAD "#define ASSUMEN\n" if ($assumen); ! print HEAD "#define ASSUMEP\n" if ($assumep); ! if ($opens) {print HEAD "$opens\n";} ! open(BODY,"/tmp/sperl$$") ! || &Die("Can't reopen temp file: $!\n"); ! while () { ! print HEAD $_; } ! close HEAD; ! print <<"EOT"; ! #!$bin/perl ! eval 'exec $bin/perl -S \$0 \$*' if \$running_under_some_shell; ! EOT ! open(BODY,"cc -E /tmp/sperl2$$.c |") || ! &Die("Can't reopen temp file: $!\n"); ! while () { /^# [0-9]/ && next; /^[ \t]*$/ && next; s/^<><>//; *************** *** 278,316 **** } } ! unlink "/tmp/sperl$$", "/tmp/sperl2$$", "/tmp/sperl2$$.c"; sub Die { ! unlink "/tmp/sperl$$", "/tmp/sperl2$$", "/tmp/sperl2$$.c"; die $_[0]; } sub make_filehandle { ! $fname = $_ = $_[0]; s/[^a-zA-Z]/_/g; s/^_*//; ! if (/^([a-z])([a-z]*)$/) { ! $first = $1; ! $rest = $2; ! $first =~ y/a-z/A-Z/; ! $_ = $first . $rest; ! } if (!$seen{$_}) { ! $opens .= "open($_,'>$fname') || die \"Can't create $fname\";\n"; } $seen{$_} = $_; } sub make_label { ! $label = $_[0]; $label =~ s/[^a-zA-Z0-9]/_/g; if ($label =~ /^[0-9_]/) { $label = 'L' . $label; } $label = substr($label,0,8); ! if ($label =~ /^([a-z])([a-z]*)$/) { # could be reserved word ! $first = $1; ! $rest = $2; ! $first =~ y/a-z/A-Z/; # so capitalize it ! $label = $first . $rest; ! } $label; } --- 302,345 ---- } } ! &Cleanup; ! exit; + sub Cleanup { + chdir "/tmp"; + unlink "sperl$$", "sperl2$$", "sperl2$$.c"; + } sub Die { ! &Cleanup; die $_[0]; } + sub tab { + "\t" x ($indent / 8) . ' ' x ($indent % 8); + } sub make_filehandle { ! local($_) = $_[0]; ! local($fname) = $_; s/[^a-zA-Z]/_/g; s/^_*//; ! substr($_,0,1) =~ y/a-z/A-Z/ if /^[a-z]/; if (!$seen{$_}) { ! $opens .= <<"EOT"; ! open($_,'>$fname') || die "Can't create $fname"; ! EOT } $seen{$_} = $_; } sub make_label { ! local($label) = @_; $label =~ s/[^a-zA-Z0-9]/_/g; if ($label =~ /^[0-9_]/) { $label = 'L' . $label; } $label = substr($label,0,8); ! ! # Could be a reserved word, so capitalize it. ! substr($label,0,1) =~ y/a-z/A-Z/ ! if $label =~ /^[a-z]/; ! $label; } *************** *** 318,339 **** { # case if (/^d/) { $dseen++; ! $_ = ' <<--#ifdef PRINTIT ! $printit = \'\'; <<--#endif ! next line;'; next; } if (/^n/) { ! $_ = ! '<<--#ifdef PRINTIT <<--#ifdef DSEEN <<--#ifdef ASSUMEP print if $printit++; <<--#else ! if ($printit) { print;} else { $printit++ unless $nflag; } <<--#endif <<--#else print if $printit; --- 347,372 ---- { # case if (/^d/) { $dseen++; ! chop($_ = <<'EOT'); <<--#ifdef PRINTIT ! $printit = ''; <<--#endif ! next LINE; ! EOT next; } if (/^n/) { ! chop($_ = <<'EOT'); ! <<--#ifdef PRINTIT <<--#ifdef DSEEN <<--#ifdef ASSUMEP print if $printit++; <<--#else ! if ($printit) ! { print; } ! else ! { $printit++ unless $nflag; } <<--#endif <<--#else print if $printit; *************** *** 342,359 **** print; <<--#endif <<--#ifdef APPENDSEEN ! if ($atext) {print $atext; $atext = \'\';} <<--#endif $_ = <>; <<--#ifdef TSEEN ! $tflag = \'\'; ! <<--#endif'; next; } if (/^a/) { $appendseen++; ! $command = $space . '$atext .=' . "\n<<--'"; $lastline = 0; while (<>) { s/^[ \t]*//; --- 375,393 ---- print; <<--#endif <<--#ifdef APPENDSEEN ! if ($atext) {print $atext; $atext = '';} <<--#endif $_ = <>; <<--#ifdef TSEEN ! $tflag = ''; ! <<--#endif ! EOT next; } if (/^a/) { $appendseen++; ! $command = $space . '$atext .=' . "\n<<--'"; $lastline = 0; while (<>) { s/^[ \t]*//; *************** *** 372,378 **** if (/^[ic]/) { if (/^c/) { $change = 1; } $addr1 = '$iter = (' . $addr1 . ')'; ! $command = $space . 'if ($iter == 1) { print' . "\n<<--'"; $lastline = 0; while (<>) { s/^[ \t]*//; --- 406,413 ---- if (/^[ic]/) { if (/^c/) { $change = 1; } $addr1 = '$iter = (' . $addr1 . ')'; ! $command = $space . 'if ($iter == 1) { print' ! . "\n<<--'"; $lastline = 0; while (<>) { s/^[ \t]*//; *************** *** 388,398 **** if ($change) { $dseen++; $change = "$_\n"; ! $_ = " <<--#ifdef PRINTIT $space\$printit = ''; <<--#endif ! ${space}next line;"; } last; } --- 423,434 ---- if ($change) { $dseen++; $change = "$_\n"; ! chop($_ = <<"EOT"); <<--#ifdef PRINTIT $space\$printit = ''; <<--#endif ! ${space}next LINE; ! EOT } last; } *************** *** 406,412 **** $c = substr($_,$i,1); if ($c eq $delim) { if ($inbracket) { ! $_ = substr($_,0,$i) . '\\' . substr($_,$i,10000); $i++; $len++; } --- 442,448 ---- $c = substr($_,$i,1); if ($c eq $delim) { if ($inbracket) { ! substr($_, $i, 0) = '\\'; $i++; $len++; } *************** *** 430,441 **** elsif (substr($_,$i,1) =~ /^[n]$/) { ; } ! elsif (!$repl && substr($_,$i,1) =~ /^[(){}\w]$/) { $i--; $len--; ! $_ = substr($_,0,$i) . substr($_,$i+1,10000); } ! elsif (!$repl && substr($_,$i,1) =~ /^[<>]$/) { substr($_,$i,1) = 'b'; } } --- 466,479 ---- elsif (substr($_,$i,1) =~ /^[n]$/) { ; } ! elsif (!$repl && ! substr($_,$i,1) =~ /^[(){}\w]$/) { $i--; $len--; ! substr($_, $i, 1) = ''; } ! elsif (!$repl && ! substr($_,$i,1) =~ /^[<>]$/) { substr($_,$i,1) = 'b'; } } *************** *** 448,461 **** $inbracket = 0; } elsif (!$repl && index("()+",$c) >= 0) { ! $_ = substr($_,0,$i) . '\\' . substr($_,$i,10000); $i++; $len++; } } ! do Die("Malformed substitution at line $.\n") unless $end; $pat = substr($_, 0, $repl + 1); ! $repl = substr($_, $repl + 1, $end - $repl - 1); $end = substr($_, $end + 1, 1000); $dol = '$'; $repl =~ s/\$/\\$/; --- 486,500 ---- $inbracket = 0; } elsif (!$repl && index("()+",$c) >= 0) { ! substr($_, $i, 0) = '\\'; $i++; $len++; } } ! &Die("Malformed substitution at line $.\n") ! unless $end; $pat = substr($_, 0, $repl + 1); ! $repl = substr($_, $repl+1, $end-$repl-1); $end = substr($_, $end + 1, 1000); $dol = '$'; $repl =~ s/\$/\\$/; *************** *** 464,485 **** $subst = "$pat$repl$delim"; $cmd = ''; while ($end) { ! if ($end =~ s/^g//) { $subst .= 'g'; next; } ! if ($end =~ s/^p//) { $cmd .= ' && (print)'; next; } if ($end =~ s/^w[ \t]*//) { ! $fh = do make_filehandle($end); $cmd .= " && (print $fh \$_)"; $end = ''; next; } ! do Die("Unrecognized substitution command ($end) at line $.\n"); } ! $_ = ! "<<--#ifdef TSEEN $subst && \$tflag++$cmd; <<--#else $subst$cmd; ! <<--#endif"; next; } --- 503,532 ---- $subst = "$pat$repl$delim"; $cmd = ''; while ($end) { ! if ($end =~ s/^g//) { ! $subst .= 'g'; ! next; ! } ! if ($end =~ s/^p//) { ! $cmd .= ' && (print)'; ! next; ! } if ($end =~ s/^w[ \t]*//) { ! $fh = &make_filehandle($end); $cmd .= " && (print $fh \$_)"; $end = ''; next; } ! &Die("Unrecognized substitution command". ! "($end) at line $.\n"); } ! chop ($_ = <<"EOT"); ! <<--#ifdef TSEEN $subst && \$tflag++$cmd; <<--#else $subst$cmd; ! <<--#endif ! EOT next; } *************** *** 490,496 **** if (/^w/) { s/^w[ \t]*//; ! $fh = do make_filehandle($_); $_ = "print $fh \$_;"; next; } --- 537,543 ---- if (/^w/) { s/^w[ \t]*//; ! $fh = &make_filehandle($_); $_ = "print $fh \$_;"; next; } *************** *** 509,527 **** } if (/^D/) { ! $_ = ! 's/^.*\n//; ! redo line if $_; ! next line;'; next; } if (/^N/) { ! $_ = ' $_ .= <>; <<--#ifdef TSEEN ! $tflag = \'\'; ! <<--#endif'; next; } --- 556,576 ---- } if (/^D/) { ! chop($_ = <<'EOT'); ! s/^.*\n//; ! redo LINE if $_; ! next LINE; ! EOT next; } if (/^N/) { ! chop($_ = <<'EOT'); $_ .= <>; <<--#ifdef TSEEN ! $tflag = ''; ! <<--#endif ! EOT next; } *************** *** 551,565 **** } if (/^b$/) { ! $_ = 'next line;'; next; } if (/^b/) { s/^b[ \t]*//; ! $lab = do make_label($_); if ($lab eq $toplabel) { ! $_ = 'redo line;'; } else { $_ = "goto $lab;"; } --- 600,614 ---- } if (/^b$/) { ! $_ = 'next LINE;'; next; } if (/^b/) { s/^b[ \t]*//; ! $lab = &make_label($_); if ($lab eq $toplabel) { ! $_ = 'redo LINE;'; } else { $_ = "goto $lab;"; } *************** *** 567,573 **** } if (/^t$/) { ! $_ = 'next line if $tflag;'; $tseen++; next; } --- 616,622 ---- } if (/^t$/) { ! $_ = 'next LINE if $tflag;'; $tseen++; next; } *************** *** 574,584 **** if (/^t/) { s/^t[ \t]*//; ! $lab = do make_label($_); if ($lab eq $toplabel) { ! $_ = 'if ($tflag) {$tflag = \'\'; redo line;}'; } else { ! $_ = "if (\$tflag) {\$tflag = ''; goto $lab;}"; } $tseen++; next; --- 623,634 ---- if (/^t/) { s/^t[ \t]*//; ! $lab = &make_label($_); ! $_ = q/if ($tflag) {$tflag = ''; /; if ($lab eq $toplabel) { ! $_ .= 'redo LINE;}'; } else { ! $_ .= "goto $lab;}"; } $tseen++; next; *************** *** 590,599 **** } if (/^q/) { ! $_ = ! 'close(ARGV); @ARGV = (); ! next line;'; next; } } continue { --- 640,650 ---- } if (/^q/) { ! chop($_ = <<'EOT'); ! close(ARGV); @ARGV = (); ! next LINE; ! EOT next; } } continue { *************** *** 612,618 **** local($inbracket); local($prefix,$delim,$ch); ! delim: while (s:^([^\]+(|)[\\/]*)([]+(|)[\\/])::) { $prefix = $1; $delim = $2; if ($delim eq '\\') { --- 663,671 ---- local($inbracket); local($prefix,$delim,$ch); ! # Process pattern one potential delimiter at a time. ! ! DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) { $prefix = $1; $delim = $2; if ($delim eq '\\') { *************** *** 636,642 **** $addr .= $prefix; $addr .= $delim; if ($delim eq $outer && !$inbracket) { ! last delim; } } $addr; --- 689,695 ---- $addr .= $prefix; $addr .= $delim; if ($delim eq $outer && !$inbracket) { ! last DELIM; } } $addr; Index: os2/selfrun.cmd *** os2/selfrun.cmd.old Tue Oct 16 11:56:46 1990 --- os2/selfrun.cmd Tue Oct 16 11:56:48 1990 *************** *** 0 **** --- 1,7 ---- + extproc perl -x + #!perl + + printf " + This is a self-running perl script using the + extproc feature of the OS/2 command processor. + " Index: stab.c Prereq: 3.0.1.8 *** stab.c.old Tue Oct 16 12:02:43 1990 --- stab.c Tue Oct 16 12:02:52 1990 *************** *** 1,4 **** ! /* $Header: stab.c,v 3.0.1.8 90/08/13 22:30:17 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: stab.c,v 3.0.1.9 90/10/16 10:32:05 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,18 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: stab.c,v $ + * Revision 3.0.1.9 90/10/16 10:32:05 lwall + * patch29: added -M, -A and -C + * patch29: taintperl now checks for world writable PATH components + * patch29: *foo now prints as *package'foo + * patch29: scripts now run at almost full speed under the debugger + * patch29: package behavior is now more consistent + * * Revision 3.0.1.8 90/08/13 22:30:17 lwall * patch28: the NSIG hack didn't work right on Xenix * *************** *** 77,82 **** --- 84,92 ---- return stab_val(stab); switch (*stab->str_magic->str_ptr) { + case '\024': /* ^T */ + str_numset(stab_val(stab),(double)basetime); + break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case '&': if (curspat) { *************** *** 220,226 **** struct ufuncs *uf = (struct ufuncs *)str->str_ptr; if (uf && uf->uf_val) ! uf->uf_val(uf->uf_index, stab_val(stab)); } break; } --- 230,236 ---- struct ufuncs *uf = (struct ufuncs *)str->str_ptr; if (uf && uf->uf_val) ! (*uf->uf_val)(uf->uf_index, stab_val(stab)); } break; } *************** *** 240,246 **** case 'E': setenv(mstr->str_ptr,str_get(str)); /* And you'll never guess what the dog had */ ! break; /* in its mouth... */ case 'S': s = str_get(str); i = whichsig(mstr->str_ptr); /* ...no, a brick */ --- 250,271 ---- case 'E': setenv(mstr->str_ptr,str_get(str)); /* And you'll never guess what the dog had */ ! /* in its mouth... */ ! #ifdef TAINT ! if (strEQ(mstr->str_ptr,"PATH")) { ! char *strend = str->str_ptr + str->str_cur; ! ! s = str->str_ptr; ! while (s < strend) { ! s = cpytill(tokenbuf,s,strend,':',&i); ! s++; ! if (*tokenbuf != '/' ! || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) ) ! str->str_tainted = 2; ! } ! } ! #endif ! break; case 'S': s = str_get(str); i = whichsig(mstr->str_ptr); /* ...no, a brick */ *************** *** 252,259 **** #endif else if (strEQ(s,"DEFAULT") || !*s) (void)signal(i,SIG_DFL); ! else (void)signal(i,sighandler); break; #ifdef SOME_DBM case 'D': --- 277,289 ---- #endif else if (strEQ(s,"DEFAULT") || !*s) (void)signal(i,SIG_DFL); ! else { (void)signal(i,sighandler); + if (!index(s,'\'')) { + sprintf(tokenbuf, "main'%s",s); + str_set(str,tokenbuf); + } + } break; #ifdef SOME_DBM case 'D': *************** *** 260,265 **** --- 290,306 ---- hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str); break; #endif + case 'L': + { + CMD *cmd; + + i = str_true(str); + str = afetch(stab_xarray(stab),atoi(mstr->str_ptr)); + cmd = str->str_magic->str_u.str_cmd; + cmd->c_flags &= ~CF_OPTIMIZE; + cmd->c_flags |= i? CFT_D1 : CFT_D0; + } + break; case '#': afill(stab_array(stab), (int)str_gnum(str) - arybase); break; *************** *** 310,315 **** --- 351,359 ---- case 0: switch (*stab->str_magic->str_ptr) { + case '\024': /* ^T */ + basetime = (long)str_gnum(str); + break; case '.': if (localizing) savesptr((STR**)&last_in_stab); *************** *** 473,479 **** struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr; if (uf && uf->uf_set) ! uf->uf_set(uf->uf_index, str); } break; } --- 517,523 ---- struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr; if (uf && uf->uf_set) ! (*uf->uf_set)(uf->uf_index, str); } break; } *************** *** 507,520 **** STAB *stab; ARRAY *savearray; STR *str; ! char *oldfile = filename; int oldsave = savestack->ary_fill; ARRAY *oldstack = stack; SUBR *sub; #ifdef OS2 /* or anybody else who requires SIG_ACK */ signal(sig, SIG_ACK); #endif stab = stabent( str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]), TRUE)), TRUE); --- 551,566 ---- STAB *stab; ARRAY *savearray; STR *str; ! CMD *oldcurcmd = curcmd; int oldsave = savestack->ary_fill; ARRAY *oldstack = stack; + CSV *oldcurcsv = curcsv; SUBR *sub; #ifdef OS2 /* or anybody else who requires SIG_ACK */ signal(sig, SIG_ACK); #endif + curcsv = Nullcsv; stab = stabent( str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]), TRUE)), TRUE); *************** *** 546,552 **** warn("Deep recursion on subroutine \"%s\"",stab_name(stab)); savelist(sub->tosave->ary_array,sub->tosave->ary_fill); } - filename = sub->filename; (void)cmd_exec(sub->cmd,G_SCALAR,1); /* so do it already */ --- 592,597 ---- *************** *** 555,563 **** afree(stab_xarray(defstab)); /* put back old $_[] */ stab_xarray(defstab) = savearray; stack = oldstack; - filename = oldfile; if (savestack->ary_fill > oldsave) restorelist(oldsave); } STAB * --- 600,609 ---- afree(stab_xarray(defstab)); /* put back old $_[] */ stab_xarray(defstab) = savearray; stack = oldstack; if (savestack->ary_fill > oldsave) restorelist(oldsave); + curcmd = oldcurcmd; + curcsv = oldcurcsv; } STAB * *************** *** 579,584 **** --- 625,645 ---- } STAB * + fstab(name) + char *name; + { + char tmpbuf[1200]; + STAB *stab; + + sprintf(tmpbuf,"'_<%s", name); + stab = stabent(tmpbuf, TRUE); + str_set(stab_val(stab), name); + if (perldb) + (void)hadd(aadd(stab)); + return stab; + } + + STAB * stabent(name,add) register char *name; int add; *************** *** 625,632 **** } else if (!isalpha(*name) || global) stash = defstash; ! else stash = curstash; if (sawquote) { char tmpbuf[256]; char *s, *d; --- 686,695 ---- } else if (!isalpha(*name) || global) stash = defstash; ! else if (curcmd == &compiling) stash = curstash; + else + stash = curcmd->c_stash; if (sawquote) { char tmpbuf[256]; char *s, *d; *************** *** 645,656 **** stab = stabent(tmpbuf,TRUE); if (!(stash = stab_xhash(stab))) stash = stab_xhash(stab) = hnew(0); name = sawquote+1; *sawquote = '\''; } len = namend - name; stab = (STAB*)hfetch(stash,name,len,add); ! if (!stab) return Nullstab; if (stab->str_pok) { stab->str_pok |= SP_MULTI; --- 708,721 ---- stab = stabent(tmpbuf,TRUE); if (!(stash = stab_xhash(stab))) stash = stab_xhash(stab) = hnew(0); + if (!stash->tbl_name) + stash->tbl_name = savestr(name); name = sawquote+1; *sawquote = '\''; } len = namend - name; stab = (STAB*)hfetch(stash,name,len,add); ! if (stab == (STAB*)&str_undef) return Nullstab; if (stab->str_pok) { stab->str_pok |= SP_MULTI; *************** *** 667,676 **** --- 732,751 ---- stab_val(stab) = Str_new(72,0); stab_line(stab) = curcmd->c_line; str_magic(stab,stab,'*',name,len); + stab_stash(stab) = stash; return stab; } } + stab_fullname(str,stab) + STR *str; + STAB *stab; + { + str_set(str,stab_stash(stab)->tbl_name); + str_ncat(str,"'", 1); + str_scat(str,stab->str_magic); + } + STIO * stio_new() { *************** *** 719,725 **** SUBR *sub; afree(stab_xarray(stab)); ! (void)hfree(stab_xhash(stab)); str_free(stab_val(stab)); if (stio = stab_io(stab)) { do_close(stab,FALSE); --- 794,800 ---- SUBR *sub; afree(stab_xarray(stab)); ! (void)hfree(stab_xhash(stab), FALSE); str_free(stab_val(stab)); if (stio = stab_io(stab)) { do_close(stab,FALSE); *** End of Patch 34 ***