lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (10/17/90)
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 <thisarticle". If you don't have the patch program, apply the following by hand, or get patch (version 2.0, latest patchlevel). After patching: *** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #36 FIRST *** If patch indicates that patchlevel is the wrong version, you may need to apply one or more previous patches, or the patch may already have been applied. See the patchlevel.h file to find out what has or has not been applied. In any event, don't continue with the patch. If you are missing previous patches they can be obtained from me: Larry Wall lwall@jpl-devvax.jpl.nasa.gov If you send a mail message of the following form it will greatly speed processing: Subject: Command @SH mailpatch PATH perl 3.0 LIST ^ note the c where PATH is a return path FROM ME TO YOU either in Internet notation, or in bang notation from some well-known host, and LIST is the number of one or more patches you need, separated by spaces, commas, and/or hyphens. Saying 35- says everything from 35 to the end. You can also get the patches via anonymous FTP from jpl-devvax.jpl.nasa.gov (128.149.1.143). Index: patchlevel.h Prereq: 33 1c1 < #define PATCHLEVEL 33 --- > #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 <os2.h> ! 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 <stdio.h> ! #include <stdlib.h> ! #include <io.h> ! #include <string.h> ! #include <process.h> ! #include <errno.h> ! ! #define INCL_NOPM ! #define INCL_DOS ! #include <os2.h> ! ! 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 (<body>) { ! 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 (<body>) { /^# [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 (<BODY>) { ! 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 (<BODY>) { /^# [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 ***