Xref: utzoo comp.sources.bugs:2477 comp.lang.perl:2034 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 #26 Summary: This is an official patch for perl 3.0. Please apply it. Message-ID: <9104@jpl-devvax.JPL.NASA.GOV> Date: 10 Aug 90 21:30:42 GMT Organization: Jet Propulsion Laboratory, Pasadena, CA Lines: 1945 System: perl version 3.0 Patch #: 26 Priority: Subject: patch #19, continued Description: See patch #19. 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 26 Index: stab.h Prereq: 3.0.1.2 *** stab.h.old Thu Aug 9 06:05:26 1990 --- stab.h Thu Aug 9 06:05:27 1990 *************** *** 1,4 **** ! /* $Header: stab.h,v 3.0.1.2 90/03/12 17:00:43 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: stab.h,v 3.0.1.3 90/08/09 05:18:42 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: stab.h,v $ + * Revision 3.0.1.3 90/08/09 05:18:42 lwall + * patch19: Added support for linked-in C subroutines + * * Revision 3.0.1.2 90/03/12 17:00:43 lwall * patch13: did some ndir straightening up for Xenix * *************** *** 88,93 **** --- 91,98 ---- struct sub { CMD *cmd; + int (*usersub)(); + int userindex; char *filename; long depth; /* >= 2 indicates recursive call */ ARRAY *tosave; Index: lib/stat.pl Prereq: 3.0 *** lib/stat.pl.old Thu Aug 9 06:01:06 1990 --- lib/stat.pl Thu Aug 9 06:01:07 1990 *************** *** 1,6 **** ! ;# $Header: stat.pl,v 3.0 89/10/18 15:19:53 lwall Locked $ ;# Usage: ;# @ary = stat(foo); ;# $st_dev = @ary[$ST_DEV]; ;# --- 1,7 ---- ! ;# $Header: stat.pl,v 3.0.1.1 90/08/09 04:01:34 lwall Locked $ ;# Usage: + ;# require 'stat.pl'; ;# @ary = stat(foo); ;# $st_dev = @ary[$ST_DEV]; ;# *************** *** 19,24 **** --- 20,26 ---- $ST_BLOCKS = 12 + $[; ;# Usage: + ;# require 'stat.pl'; ;# do Stat('foo'); # sets st_* as a side effect ;# sub Stat { Index: str.c Prereq: 3.0.1.7 *** str.c.old Thu Aug 9 06:05:38 1990 --- str.c Thu Aug 9 06:05:43 1990 *************** *** 1,4 **** ! /* $Header: str.c,v 3.0.1.7 90/03/27 16:24:11 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: str.c,v 3.0.1.8 90/08/09 05:22:18 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,15 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: str.c,v $ + * Revision 3.0.1.8 90/08/09 05:22:18 lwall + * patch19: the number to string converter wasn't allocating enough space + * patch19: tainting didn't work on setgid scripts + * * Revision 3.0.1.7 90/03/27 16:24:11 lwall * patch16: strings with prefix chopped off sometimes freed wrong * patch16: taint check blows up on undefined array element *************** *** 97,106 **** --- 101,120 ---- char * str_grow(str,newlen) register STR *str; + #ifndef MSDOS register int newlen; + #else + unsigned long newlen; + #endif { register char *s = str->str_ptr; + #ifdef MSDOS + if (newlen >= 0x10000) { + fprintf(stderr, "Allocation too large: %lx\n", newlen); + exit(1); + } + #endif /* MSDOS */ if (str->str_state == SS_INCR) { /* data before str_ptr? */ str->str_len += str->str_u.str_useful; str->str_ptr -= str->str_u.str_useful; *************** *** 129,135 **** if (str->str_pok) { str->str_pok = 0; /* invalidate pointer */ if (str->str_state == SS_INCR) ! str_grow(str,0); } str->str_u.str_nval = num; str->str_state = SS_NORM; --- 143,149 ---- if (str->str_pok) { str->str_pok = 0; /* invalidate pointer */ if (str->str_state == SS_INCR) ! Str_Grow(str,0); } str->str_u.str_nval = num; str->str_state = SS_NORM; *************** *** 149,163 **** if (!str) return ""; if (str->str_nok) { - /* this is a problem on the sun 4... 24 bytes is not always enough and the - exponent blows away the malloc stack - PEJ Wed Jan 31 18:41:34 CST 1990 - */ - #ifdef sun4 STR_GROW(str, 30); - #else - STR_GROW(str, 24); - #endif /* sun 4 */ s = str->str_ptr; olderrno = errno; /* some Xenix systems wipe out errno here */ #if defined(scs) && defined(ns32000) --- 163,169 ---- *************** *** 182,192 **** return No; if (dowarn) warn("Use of uninitialized variable"); - #ifdef sun4 STR_GROW(str, 30); - #else - STR_GROW(str, 24); - #endif s = str->str_ptr; } *s = '\0'; --- 188,194 ---- *************** *** 206,212 **** if (!str) return 0.0; if (str->str_state == SS_INCR) ! str_grow(str,0); /* just force copy down */ str->str_state = SS_NORM; if (str->str_len && str->str_pok) str->str_u.str_nval = atof(str->str_ptr); --- 208,214 ---- if (!str) return 0.0; if (str->str_state == SS_INCR) ! Str_Grow(str,0); /* just force copy down */ str->str_state = SS_NORM; if (str->str_len && str->str_pok) str->str_u.str_nval = atof(str->str_ptr); *************** *** 257,263 **** str_numset(dstr,sstr->str_u.str_nval); else { if (dstr->str_state == SS_INCR) ! str_grow(dstr,0); /* just force copy down */ #ifdef STRUCTCOPY dstr->str_u = sstr->str_u; --- 259,265 ---- str_numset(dstr,sstr->str_u.str_nval); else { if (dstr->str_state == SS_INCR) ! Str_Grow(dstr,0); /* just force copy down */ #ifdef STRUCTCOPY dstr->str_u = sstr->str_u; *************** *** 271,277 **** str_nset(str,ptr,len) register STR *str; register char *ptr; ! register int len; { STR_GROW(str, len + 1); if (ptr) --- 273,279 ---- str_nset(str,ptr,len) register STR *str; register char *ptr; ! register STRLEN len; { STR_GROW(str, len + 1); if (ptr) *************** *** 289,295 **** register STR *str; register char *ptr; { ! register int len; if (!ptr) ptr = ""; --- 291,297 ---- register STR *str; register char *ptr; { ! register STRLEN len; if (!ptr) ptr = ""; *************** *** 308,314 **** register STR *str; register char *ptr; { ! register int delta; if (!(str->str_pok)) fatal("str_chop: internal inconsistency"); --- 310,316 ---- register STR *str; register char *ptr; { ! register STRLEN delta; if (!(str->str_pok)) fatal("str_chop: internal inconsistency"); *************** *** 329,335 **** str_ncat(str,ptr,len) register STR *str; register char *ptr; ! register int len; { if (!(str->str_pok)) (void)str_2ptr(str); --- 331,337 ---- str_ncat(str,ptr,len) register STR *str; register char *ptr; ! register STRLEN len; { if (!(str->str_pok)) (void)str_2ptr(str); *************** *** 363,369 **** register STR *str; register char *ptr; { ! register int len; if (!ptr) return; --- 365,371 ---- register STR *str; register char *ptr; { ! register STRLEN len; if (!ptr) return; *************** *** 389,395 **** char *keeplist; { register char *to; ! register int len; if (!from) return Nullch; --- 391,397 ---- char *keeplist; { register char *to; ! register STRLEN len; if (!from) return Nullch; *************** *** 427,433 **** #else str_new(len) #endif ! int len; { register STR *str; --- 429,435 ---- #else str_new(len) #endif ! STRLEN len; { register STR *str; *************** *** 451,457 **** STAB *stab; int how; char *name; ! int namlen; { if (str->str_magic) return; --- 453,459 ---- STAB *stab; int how; char *name; ! STRLEN namlen; { if (str->str_magic) return; *************** *** 466,475 **** void str_insert(bigstr,offset,len,little,littlelen) STR *bigstr; ! int offset; ! int len; char *little; ! int littlelen; { register char *big; register char *mid; --- 468,477 ---- void str_insert(bigstr,offset,len,little,littlelen) STR *bigstr; ! STRLEN offset; ! STRLEN len; char *little; ! STRLEN littlelen; { register char *big; register char *mid; *************** *** 549,557 **** register STR *nstr; { if (str->str_state == SS_INCR) ! str_grow(str,0); /* just force copy down */ if (nstr->str_state == SS_INCR) ! str_grow(nstr,0); if (str->str_ptr) Safefree(str->str_ptr); str->str_ptr = nstr->str_ptr; --- 551,559 ---- register STR *nstr; { if (str->str_state == SS_INCR) ! Str_Grow(str,0); /* just force copy down */ if (nstr->str_state == SS_INCR) ! Str_Grow(nstr,0); if (str->str_ptr) Safefree(str->str_ptr); str->str_ptr = nstr->str_ptr; *************** *** 616,621 **** --- 618,624 ---- #endif /* LEAKTEST */ } + STRLEN str_len(str) register STR *str; { *************** *** 690,697 **** register STDCHAR *ptr; /* in the innermost loop into registers */ register int newline = record_separator;/* (assuming >= 6 registers) */ int i; ! int bpx; ! int obpx; register int get_paragraph; register char *oldbp; --- 693,700 ---- register STDCHAR *ptr; /* in the innermost loop into registers */ register int newline = record_separator;/* (assuming >= 6 registers) */ int i; ! STRLEN bpx; ! STRLEN obpx; register int get_paragraph; register char *oldbp; *************** *** 786,794 **** { register CMD *cmd; register ARG *arg; ! line_t oldline = line; int retval; - char *tmps; str_sset(linestr,str); in_eval++; --- 789,796 ---- { register CMD *cmd; register ARG *arg; ! CMD *oldcurcmd = curcmd; int retval; str_sset(linestr,str); in_eval++; *************** *** 812,818 **** } #ifdef DEBUGGING if (debug & 4) { ! tmps = loop_stack[loop_ptr].loop_label; deb("(Popping label #%d %s)\n",loop_ptr, tmps ? tmps : "" ); } --- 814,820 ---- } #ifdef DEBUGGING if (debug & 4) { ! char *tmps = loop_stack[loop_ptr].loop_label; deb("(Popping label #%d %s)\n",loop_ptr, tmps ? tmps : "" ); } *************** *** 819,825 **** --- 821,830 ---- #endif loop_ptr--; error_count = 0; + curcmd = &compiling; + curcmd->c_line = oldcurcmd->c_line; retval = yyparse(); + curcmd = oldcurcmd; in_eval--; if (retval || error_count) fatal("Invalid component in string or format"); *************** *** 828,834 **** if (cmd->c_type != C_EXPR || cmd->c_next || arg->arg_type != O_LIST) fatal("panic: error in parselist %d %x %d", cmd->c_type, cmd->c_next, arg ? arg->arg_type : -1); - line = oldline; Safefree(cmd); return arg; } --- 833,838 ---- *************** *** 842,848 **** register STR *str; register char *t; STR *toparse; ! int len; register int brackets; register char *d; STAB *stab; --- 846,852 ---- register STR *str; register char *t; STR *toparse; ! STRLEN len; register int brackets; register char *d; STAB *stab; *************** *** 1222,1228 **** STR * str_make(s,len) char *s; ! int len; { register STR *str = Str_new(79,0); --- 1226,1232 ---- STR * str_make(s,len) char *s; ! STRLEN len; { register STR *str = Str_new(79,0); *************** *** 1257,1263 **** return Nullstr; } if (old->str_state == SS_INCR && !(old->str_pok & 2)) ! str_grow(old,0); if (new->str_ptr) Safefree(new->str_ptr); Copy(old,new,1,STR); --- 1261,1267 ---- return Nullstr; } if (old->str_state == SS_INCR && !(old->str_pok & 2)) ! Str_Grow(old,0); if (new->str_ptr) Safefree(new->str_ptr); Copy(old,new,1,STR); *************** *** 1328,1334 **** if (debug & 2048) fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid); #endif ! if (tainted && (!euid || euid != uid)) { if (!unsafe) fatal("%s", s); else if (dowarn) --- 1332,1338 ---- if (debug & 2048) fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid); #endif ! if (tainted && (!euid || euid != uid || egid != gid)) { if (!unsafe) fatal("%s", s); else if (dowarn) Index: str.h Prereq: 3.0.1.1 *** str.h.old Thu Aug 9 06:05:50 1990 --- str.h Thu Aug 9 06:05:51 1990 *************** *** 1,4 **** ! /* $Header: str.h,v 3.0.1.1 89/10/26 23:24:42 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: str.h,v 3.0.1.2 90/08/09 05:23:24 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: str.h,v $ + * Revision 3.0.1.2 90/08/09 05:23:24 lwall + * patch19: various MSDOS and OS/2 patches folded in + * * Revision 3.0.1.1 89/10/26 23:24:42 lwall * patch1: rearranged some structures to align doubles better on Gould * *************** *** 16,22 **** struct string { char * str_ptr; /* pointer to malloced string */ ! int str_len; /* allocated size */ union { double str_nval; /* numeric value, if any */ STAB *str_stab; /* magic stab for magic "key" string */ --- 19,25 ---- struct string { char * str_ptr; /* pointer to malloced string */ ! STRLEN str_len; /* allocated size */ union { double str_nval; /* numeric value, if any */ STAB *str_stab; /* magic stab for magic "key" string */ *************** *** 25,32 **** HASH *str_hash; /* string represents an assoc array (stab?) */ ARRAY *str_array; /* string represents an array */ } str_u; ! int str_cur; /* length of str_ptr as a C string */ ! STR *str_magic; /* while free, link to next free str */ /* while in use, ptr to "key" for magic items */ char str_pok; /* state of str_ptr */ char str_nok; /* state of str_nval */ --- 28,35 ---- HASH *str_hash; /* string represents an assoc array (stab?) */ ARRAY *str_array; /* string represents an array */ } str_u; ! STRLEN str_cur; /* length of str_ptr as a C string */ ! STR *str_magic; /* while free, link to next free str */ /* while in use, ptr to "key" for magic items */ char str_pok; /* state of str_ptr */ char str_nok; /* state of str_nval */ *************** *** 40,46 **** struct stab { /* should be identical, except for str_ptr */ STBP * str_ptr; /* pointer to malloced string */ ! int str_len; /* allocated size */ union { double str_nval; /* numeric value, if any */ STAB *str_stab; /* magic stab for magic "key" string */ --- 43,49 ---- struct stab { /* should be identical, except for str_ptr */ STBP * str_ptr; /* pointer to malloced string */ ! STRLEN str_len; /* allocated size */ union { double str_nval; /* numeric value, if any */ STAB *str_stab; /* magic stab for magic "key" string */ *************** *** 49,56 **** HASH *str_hash; /* string represents an assoc array (stab?) */ ARRAY *str_array; /* string represents an array */ } str_u; ! int str_cur; /* length of str_ptr as a C string */ ! STR *str_magic; /* while free, link to next free str */ /* while in use, ptr to "key" for magic items */ char str_pok; /* state of str_ptr */ char str_nok; /* state of str_nval */ --- 52,59 ---- HASH *str_hash; /* string represents an assoc array (stab?) */ ARRAY *str_array; /* string represents an array */ } str_u; ! STRLEN str_cur; /* length of str_ptr as a C string */ ! STR *str_magic; /* while free, link to next free str */ /* while in use, ptr to "key" for magic items */ char str_pok; /* state of str_ptr */ char str_nok; /* state of str_nval */ *************** *** 66,73 **** struct lstring { struct string lstr; ! int lstr_offset; ! int lstr_len; }; /* These are the values of str_pok: */ --- 69,76 ---- struct lstring { struct string lstr; ! STRLEN lstr_offset; ! STRLEN lstr_len; }; /* These are the values of str_pok: */ *************** *** 127,129 **** --- 130,133 ---- int str_eq(); void str_magic(); void str_insert(); + STRLEN str_len(); Index: os2/suffix.c *** os2/suffix.c.old Thu Aug 9 06:02:43 1990 --- os2/suffix.c Thu Aug 9 06:02:44 1990 *************** *** 0 **** --- 1,146 ---- + /* + * Suffix appending for in-place editing under MS-DOS and OS/2. + * + * Here are the rules: + * + * Style 0: Append the suffix exactly as standard perl would do it. + * If the filesystem groks it, use it. (HPFS will always + * grok it. FAT will rarely accept it.) + * + * Style 1: The suffix begins with a '.'. The extension is replaced. + * If the name matches the original name, use the fallback method. + * + * Style 2: The suffix is a single character, not a '.'. Try to add the + * suffix to the following places, using the first one that works. + * [1] Append to extension. + * [2] Append to filename, + * [3] Replace end of extension, + * [4] Replace end of filename. + * If the name matches the original name, use the fallback method. + * + * Style 3: Any other case: Ignore the suffix completely and use the + * fallback method. + * + * Fallback method: Change the extension to ".$$$". If that matches the + * original name, then change the extension to ".~~~". + * + * If filename is more than 1000 characters long, we die a horrible + * death. Sorry. + * + * The filename restriction is a cheat so that we can use buf[] to store + * assorted temporary goo. + * + * Examples, assuming style 0 failed. + * + * suffix = ".bak" (style 1) + * foo.bar => foo.bak + * foo.bak => foo.$$$ (fallback) + * foo.$$$ => foo.~~~ (fallback) + * makefile => makefile.bak + * + * suffix = "~" (style 2) + * foo.c => foo.c~ + * foo.c~ => foo.c~~ + * foo.c~~ => foo~.c~~ + * foo~.c~~ => foo~~.c~~ + * foo~~~~~.c~~ => foo~~~~~.$$$ (fallback) + * + * foo.pas => foo~.pas + * makefile => makefile.~ + * longname.fil => longname.fi~ + * longname.fi~ => longnam~.fi~ + * longnam~.fi~ => longnam~.$$$ + * + */ + + #include "EXTERN.h" + #include "perl.h" + #ifdef OS2 + #define INCL_DOSFILEMGR + #define INCL_DOSERRORS + #include + #endif /* OS2 */ + + static char suffix1[] = ".$$$"; + static char suffix2[] = ".~~~"; + + #define ext (&buf[1000]) + + add_suffix(str,suffix) + register STR *str; + register char *suffix; + { + int baselen; + int extlen; + char *s, *t, *p; + STRLEN slen; + + if (!(str->str_pok)) (void)str_2ptr(str); + if (str->str_cur > 1000) + fatal("Cannot do inplace edit on long filename (%d characters)", str->str_cur); + + #ifdef OS2 + /* Style 0 */ + slen = str->str_cur; + str_cat(str, suffix); + if (valid_filename(str->str_ptr)) return; + + /* Fooey, style 0 failed. Fix str before continuing. */ + str->str_ptr[str->str_cur = slen] = '\0'; + #endif /* OS2 */ + + slen = strlen(suffix); + t = buf; baselen = 0; s = str->str_ptr; + while ( (*t = *s) && *s != '.') { + baselen++; + if (*s == '\\' || *s == '/') baselen = 0; + s++; t++; + } + p = t; + + t = ext; extlen = 0; + while (*t++ = *s++) extlen++; + if (extlen == 0) { ext[0] = '.'; ext[1] = 0; extlen++; } + + if (*suffix == '.') { /* Style 1 */ + if (strEQ(ext, suffix)) goto fallback; + strcpy(p, suffix); + } else if (suffix[1] == '\0') { /* Style 2 */ + if (extlen < 4) { + ext[extlen] = *suffix; + ext[++extlen] = '\0'; + } else if (baselen < 8) { + *p++ = *suffix; + } else if (ext[3] != *suffix) { + ext[3] = *suffix; + } else if (buf[7] != *suffix) { + buf[7] = *suffix; + } else goto fallback; + strcpy(p, ext); + } else { /* Style 3: Panic */ + fallback: + (void)bcopy(strEQ(ext, suffix1) ? suffix2 : suffix1, p, 4+1); + } + str_set(str, buf); + } + + #ifdef OS2 + int + valid_filename(s) + char *s; + { + HFILE hf; + USHORT usAction; + + switch(DosOpen(s, &hf, &usAction, 0L, 0, FILE_OPEN, + OPEN_ACCESS_READONLY | OPEN_SHARE_DENYNONE, 0L)) { + case NO_ERROR: + DosClose(hf); + /*FALLTHROUGH*/ + default: + return 1; + case ERROR_FILENAME_EXCED_RANGE: + return 0; + } + } + #endif /* OS2 */ Index: os2/eg/syscalls.pl *** os2/eg/syscalls.pl.old Thu Aug 9 06:02:32 1990 --- os2/eg/syscalls.pl Thu Aug 9 06:02:34 1990 *************** *** 0 **** --- 1,16 ---- + # OS/2 syscall values + + $OS2_GetVersion = 0; + $OS2_Shutdown = 1; + $OS2_Beep = 2; + $OS2_PhysicalDisk = 3; + $OS2_Config = 4; + $OS2_IOCtl = 5; + $OS2_QCurDisk = 6; + $OS2_SelectDisk = 7; + $OS2_SetMaxFH = 8; + $OS2_Sleep = 9; + $OS2_StartSession = 10; + $OS2_StopSession = 11; + $OS2_SelectSession = 12; + 1; Index: h2pl/eg/sysexits.pl *** h2pl/eg/sysexits.pl.old Thu Aug 9 05:59:40 1990 --- h2pl/eg/sysexits.pl Thu Aug 9 05:59:41 1990 *************** *** 0 **** --- 1,16 ---- + $EX_OK = 0x0; + $EX__BASE = 0x40; + $EX_USAGE = 0x40; + $EX_DATAERR = 0x41; + $EX_NOINPUT = 0x42; + $EX_NOUSER = 0x43; + $EX_NOHOST = 0x44; + $EX_UNAVAILABLE = 0x45; + $EX_SOFTWARE = 0x46; + $EX_OSERR = 0x47; + $EX_OSFILE = 0x48; + $EX_CANTCREAT = 0x49; + $EX_IOERR = 0x4A; + $EX_TEMPFAIL = 0x4B; + $EX_PROTOCOL = 0x4C; + $EX_NOPERM = 0x4D; Index: lib/syslog.pl *** lib/syslog.pl.old Thu Aug 9 06:01:10 1990 --- lib/syslog.pl Thu Aug 9 06:01:11 1990 *************** *** 8,14 **** # call syslog() with a string priority and a list of printf() args # like syslog(3) # ! # usage: do 'syslog.pl' || die "syslog.pl: $@"; # # then (put these all in a script to test function) # --- 8,14 ---- # call syslog() with a string priority and a list of printf() args # like syslog(3) # ! # usage: require 'syslog.pl'; # # then (put these all in a script to test function) # *************** *** 29,36 **** $host = 'localhost' unless $host; # set $syslog'host to change ! do '/usr/local/lib/perl/syslog.h' ! || die "syslog: Can't do syslog.h: ",($@||$!),"\n"; sub main'openlog { ($ident, $logopt, $facility) = @_; # package vars --- 29,35 ---- $host = 'localhost' unless $host; # set $syslog'host to change ! require 'syslog.ph'; sub main'openlog { ($ident, $logopt, $facility) = @_; # package vars Index: h2pl/tcbreak *** h2pl/tcbreak.old Thu Aug 9 05:59:56 1990 --- h2pl/tcbreak Thu Aug 9 05:59:57 1990 *************** *** 0 **** --- 1,17 ---- + #!/usr/bin/perl + + require 'cbreak.pl'; + + &cbreak; + + $| = 1; + + print "gimme a char: "; + + $c = getc; + + print "$c\n"; + + printf "you gave me `%s', which is 0x%02x\n", $c, ord($c); + + &cooked; Index: h2pl/tcbreak2 *** h2pl/tcbreak2.old Thu Aug 9 05:59:59 1990 --- h2pl/tcbreak2 Thu Aug 9 06:00:01 1990 *************** *** 0 **** --- 1,17 ---- + #!/usr/bin/perl + + require 'cbreak2.pl'; + + &cbreak; + + $| = 1; + + print "gimme a char: "; + + $c = getc; + + print "$c\n"; + + printf "you gave me `%s', which is 0x%02x\n", $c, ord($c); + + &cooked; Index: lib/termcap.pl Prereq: 3.0.1.2 *** lib/termcap.pl.old Thu Aug 9 06:01:15 1990 --- lib/termcap.pl Thu Aug 9 06:01:18 1990 *************** *** 1,10 **** ! ;# $Header: termcap.pl,v 3.0.1.2 90/03/14 12:28:28 lwall Locked $ ;# ;# Usage: ! ;# do 'ioctl.pl'; ;# ioctl(TTY,$TIOCGETP,$foo); ;# ($ispeed,$ospeed) = unpack('cc',$foo); ! ;# do 'termcap.pl' || die "Can't get termcap.pl"; ;# &Tgetent('vt100'); # sets $TC{'cm'}, etc. ;# &Tputs(&Tgoto($TC{'cm'},$col,$row), 0, 'FILEHANDLE'); ;# &Tputs($TC{'dl'},$affcnt,'FILEHANDLE'); --- 1,10 ---- ! ;# $Header: termcap.pl,v 3.0.1.3 90/08/09 04:02:53 lwall Locked $ ;# ;# Usage: ! ;# require 'ioctl.pl'; ;# ioctl(TTY,$TIOCGETP,$foo); ;# ($ispeed,$ospeed) = unpack('cc',$foo); ! ;# require 'termcap.pl'; ;# &Tgetent('vt100'); # sets $TC{'cm'}, etc. ;# &Tputs(&Tgoto($TC{'cm'},$col,$row), 0, 'FILEHANDLE'); ;# &Tputs($TC{'dl'},$affcnt,'FILEHANDLE'); Index: toke.c Prereq: 3.0.1.7 *** toke.c.old Thu Aug 9 06:06:17 1990 --- toke.c Thu Aug 9 06:06:25 1990 *************** *** 1,4 **** ! /* $Header: toke.c,v 3.0.1.7 90/03/27 16:32:37 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: toke.c,v 3.0.1.8 90/08/09 05:39:58 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,23 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: toke.c,v $ + * Revision 3.0.1.8 90/08/09 05:39:58 lwall + * patch19: added require operator + * patch19: added -x switch to extract script from input trash + * patch19: bare @name didn't add array to symbol table + * patch19: Added __LINE__ and __FILE__ tokens + * patch19: Added __END__ token + * patch19: Numeric literals are now stored only in floating point + * patch19: some support for FPS compiler misfunction + * patch19: "\\$foo" not handled right + * patch19: program and data can now both come from STDIN + * patch19: "here" strings caused warnings about uninitialized variables + * * Revision 3.0.1.7 90/03/27 16:32:37 lwall * patch16: MSDOS support * patch16: formats didn't work inside eval *************** *** 52,58 **** #ifdef CLINE #undef CLINE #endif ! #define CLINE (cmdline = (line < cmdline ? line : cmdline)) #define META(c) ((c) | 128) --- 64,70 ---- #ifdef CLINE #undef CLINE #endif ! #define CLINE (cmdline = (curcmd->c_line < cmdline ? curcmd->c_line : cmdline)) #define META(c) ((c) | 128) *************** *** 172,177 **** --- 184,198 ---- else fprintf(stderr,"Tokener at %s\n",s); #endif + #ifdef BADSWITCH + if (*s & 128) { + if ((*s & 127) == '(') + *s++ = '('; + else + warn("Unrecognized character \\%03o ignored", *s++); + goto retry; + } + #endif switch (*s) { default: if ((*s & 127) == '(') *************** *** 179,184 **** --- 200,208 ---- else warn("Unrecognized character \\%03o ignored", *s++); goto retry; + case 4: + case 26: + goto fake_eof; /* emulate EOF on ^D or ^Z */ case 0: if (!rsfp) RETURN(0); *************** *** 189,196 **** if (minus_n || minus_p || perldb) { str_set(linestr,""); if (perldb) ! str_cat(linestr, ! "do 'perldb.pl' || die \"Can't find perldb.pl in @INC\"; print $@;"); if (minus_n || minus_p) { str_cat(linestr,"line: while (<>) {"); if (minus_a) --- 213,219 ---- if (minus_n || minus_p || perldb) { str_set(linestr,""); if (perldb) ! str_cat(linestr, "require 'perldb.pl';"); if (minus_n || minus_p) { str_cat(linestr,"line: while (<>) {"); if (minus_a) *************** *** 207,239 **** in_format = FALSE; oldoldbufptr = oldbufptr = s = str_get(linestr) + 1; bufend = linestr->str_ptr + linestr->str_cur; ! TERM(FORMLIST); } ! line++; ! if ((s = str_gets(linestr, rsfp, 0)) == Nullch) { ! if (preprocess) ! (void)mypclose(rsfp); ! else if (rsfp != stdin) ! (void)fclose(rsfp); ! rsfp = Nullfp; ! if (minus_n || minus_p) { ! str_set(linestr,minus_p ? ";}continue{print" : ""); ! str_cat(linestr,";}"); oldoldbufptr = oldbufptr = s = str_get(linestr); ! bufend = linestr->str_ptr + linestr->str_cur; ! minus_n = minus_p = 0; ! goto retry; } ! oldoldbufptr = oldbufptr = s = str_get(linestr); ! str_set(linestr,""); ! RETURN(';'); /* not infinite loop because rsfp is NULL now */ ! } oldoldbufptr = oldbufptr = bufptr = s; if (perldb) { STR *str = Str_new(85,0); str_sset(str,linestr); ! astore(lineary,(int)line,str); } #ifdef DEBUG if (firstline) { --- 230,272 ---- in_format = FALSE; oldoldbufptr = oldbufptr = s = str_get(linestr) + 1; bufend = linestr->str_ptr + linestr->str_cur; ! OPERATOR(FORMLIST); } ! curcmd->c_line++; ! #ifdef CRYPTSCRIPT ! cryptswitch(); ! #endif /* CRYPTSCRIPT */ ! do { ! if ((s = str_gets(linestr, rsfp, 0)) == Nullch) { ! fake_eof: ! if (preprocess) ! (void)mypclose(rsfp); ! else if (rsfp == stdin) ! clearerr(stdin); ! else ! (void)fclose(rsfp); ! rsfp = Nullfp; ! if (minus_n || minus_p) { ! str_set(linestr,minus_p ? ";}continue{print" : ""); ! str_cat(linestr,";}"); ! oldoldbufptr = oldbufptr = s = str_get(linestr); ! bufend = linestr->str_ptr + linestr->str_cur; ! minus_n = minus_p = 0; ! goto retry; ! } oldoldbufptr = oldbufptr = s = str_get(linestr); ! str_set(linestr,""); ! RETURN(';'); /* not infinite loop because rsfp is NULL now */ } ! if (doextract && *linestr->str_ptr == '#') ! doextract = FALSE; ! } while (doextract); oldoldbufptr = oldbufptr = bufptr = s; if (perldb) { STR *str = Str_new(85,0); str_sset(str,linestr); ! astore(lineary,(int)curcmd->c_line,str); } #ifdef DEBUG if (firstline) { *************** *** 242,248 **** } #endif bufend = linestr->str_ptr + linestr->str_cur; ! if (line == 1) { if (*s == '#' && s[1] == '!') { if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) { char **newargv; --- 275,281 ---- } #endif bufend = linestr->str_ptr + linestr->str_cur; ! if (curcmd->c_line == 1) { if (*s == '#' && s[1] == '!') { if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) { char **newargv; *************** *** 283,298 **** case ' ': case '\t': case '\f': s++; goto retry; - case '\n': case '#': if (preprocess && s == str_get(linestr) && s[1] == ' ' && isdigit(s[2])) { ! line = atoi(s+2)-1; for (s += 2; isdigit(*s); s++) ; d = bufend; while (s < d && isspace(*s)) s++; - if (filename) - Safefree(filename); s[strlen(s)-1] = '\0'; /* wipe out newline */ if (*s == '"') { s++; --- 316,328 ---- case ' ': case '\t': case '\f': s++; goto retry; case '#': if (preprocess && s == str_get(linestr) && s[1] == ' ' && isdigit(s[2])) { ! curcmd->c_line = atoi(s+2)-1; for (s += 2; isdigit(*s); s++) ; d = bufend; while (s < d && isspace(*s)) s++; s[strlen(s)-1] = '\0'; /* wipe out newline */ if (*s == '"') { s++; *************** *** 301,309 **** if (*s) filename = savestr(s); else ! filename = savestr(origfilename); oldoldbufptr = oldbufptr = s = str_get(linestr); } if (in_eval && !rsfp) { d = bufend; while (s < d && *s != '\n') --- 331,341 ---- if (*s) filename = savestr(s); else ! filename = origfilename; oldoldbufptr = oldbufptr = s = str_get(linestr); } + /* FALL THROUGH */ + case '\n': if (in_eval && !rsfp) { d = bufend; while (s < d && *s != '\n') *************** *** 317,323 **** oldoldbufptr = oldbufptr = s = bufptr + 1; TERM(FORMLIST); } ! line++; } else { *s = '\0'; --- 349,355 ---- oldoldbufptr = oldbufptr = s = bufptr + 1; TERM(FORMLIST); } ! curcmd->c_line++; } else { *s = '\0'; *************** *** 412,419 **** cmdline = NOLINE; /* invalidate current command line number */ OPERATOR(tmp); case ';': ! if (line < cmdline) ! cmdline = line; tmp = *s++; OPERATOR(tmp); case ')': --- 444,451 ---- cmdline = NOLINE; /* invalidate current command line number */ OPERATOR(tmp); case ';': ! if (curcmd->c_line < cmdline) ! cmdline = curcmd->c_line; tmp = *s++; OPERATOR(tmp); case ')': *************** *** 521,527 **** s = scanreg(s,bufend,tokenbuf); if (reparse) goto do_reparse; ! yylval.stabval = stabent(tokenbuf,TRUE); TERM(ARY); case '/': /* may either be division or pattern */ --- 553,559 ---- s = scanreg(s,bufend,tokenbuf); if (reparse) goto do_reparse; ! yylval.stabval = aadd(stabent(tokenbuf,TRUE)); TERM(ARY); case '/': /* may either be division or pattern */ *************** *** 556,561 **** --- 588,610 ---- /* FALL THROUGH */ case '_': SNARFWORD; + if (d[1] == '_') { + if (strEQ(d,"__LINE__") || strEQ(d,"__FILE__")) { + ARG *arg = op_new(1); + + yylval.arg = arg; + arg->arg_type = O_ITEM; + if (d[2] == 'L') + (void)sprintf(tokenbuf,"%ld",(long)curcmd->c_line); + else + strcpy(tokenbuf, filename); + arg[1].arg_type = A_SINGLE; + arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf)); + TERM(RSTRING); + } + else if (strEQ(d,"__END__")) + goto fake_eof; + } break; case 'a': case 'A': SNARFWORD; *************** *** 630,636 **** if (strEQ(d,"else")) OPERATOR(ELSE); if (strEQ(d,"elsif")) { ! yylval.ival = line; OPERATOR(ELSIF); } if (strEQ(d,"eq") || strEQ(d,"EQ")) --- 679,685 ---- if (strEQ(d,"else")) OPERATOR(ELSE); if (strEQ(d,"elsif")) { ! yylval.ival = curcmd->c_line; OPERATOR(ELSIF); } if (strEQ(d,"eq") || strEQ(d,"EQ")) *************** *** 667,673 **** case 'f': case 'F': SNARFWORD; if (strEQ(d,"for") || strEQ(d,"foreach")) { ! yylval.ival = line; OPERATOR(FOR); } if (strEQ(d,"format")) { --- 716,722 ---- case 'f': case 'F': SNARFWORD; if (strEQ(d,"for") || strEQ(d,"foreach")) { ! yylval.ival = curcmd->c_line; OPERATOR(FOR); } if (strEQ(d,"format")) { *************** *** 778,784 **** case 'i': case 'I': SNARFWORD; if (strEQ(d,"if")) { ! yylval.ival = line; OPERATOR(IF); } if (strEQ(d,"index")) --- 827,833 ---- case 'i': case 'I': SNARFWORD; if (strEQ(d,"if")) { ! yylval.ival = curcmd->c_line; OPERATOR(IF); } if (strEQ(d,"index")) *************** *** 897,902 **** --- 946,955 ---- SNARFWORD; if (strEQ(d,"return")) OLDLOP(O_RETURN); + if (strEQ(d,"require")) { + allstabs = TRUE; /* must initialize everything since */ + UNI(O_REQUIRE); /* we don't know what will be used */ + } if (strEQ(d,"reset")) UNI(O_RESET); if (strEQ(d,"redo")) *************** *** 945,951 **** break; case 'e': if (strEQ(d,"select")) ! OPERATOR(SELECT); if (strEQ(d,"seek")) FOP3(O_SEEK); if (strEQ(d,"send")) --- 998,1004 ---- break; case 'e': if (strEQ(d,"select")) ! OPERATOR(SSELECT); if (strEQ(d,"seek")) FOP3(O_SEEK); if (strEQ(d,"send")) *************** *** 998,1004 **** if (strEQ(d,"socket")) FOP4(O_SOCKET); if (strEQ(d,"socketpair")) ! FOP25(O_SOCKETPAIR); if (strEQ(d,"sort")) { checkcomma(s,"subroutine name"); d = bufend; --- 1051,1057 ---- if (strEQ(d,"socket")) FOP4(O_SOCKET); if (strEQ(d,"socketpair")) ! FOP25(O_SOCKPAIR); if (strEQ(d,"sort")) { checkcomma(s,"subroutine name"); d = bufend; *************** *** 1053,1059 **** if (strEQ(d,"substr")) FUN3(O_SUBSTR); if (strEQ(d,"sub")) { ! subline = line; d = bufend; while (s < d && isspace(*s)) s++; --- 1106,1112 ---- if (strEQ(d,"substr")) FUN3(O_SUBSTR); if (strEQ(d,"sub")) { ! subline = curcmd->c_line; d = bufend; while (s < d && isspace(*s)) s++; *************** *** 1110,1115 **** --- 1163,1170 ---- FUN0(O_TIME); if (strEQ(d,"times")) FUN0(O_TMS); + if (strEQ(d,"truncate")) + FOP2(O_TRUNCATE); break; case 'u': case 'U': SNARFWORD; *************** *** 1116,1126 **** if (strEQ(d,"using")) OPERATOR(USING); if (strEQ(d,"until")) { ! yylval.ival = line; OPERATOR(UNTIL); } if (strEQ(d,"unless")) { ! yylval.ival = line; OPERATOR(UNLESS); } if (strEQ(d,"unlink")) --- 1171,1181 ---- if (strEQ(d,"using")) OPERATOR(USING); if (strEQ(d,"until")) { ! yylval.ival = curcmd->c_line; OPERATOR(UNTIL); } if (strEQ(d,"unless")) { ! yylval.ival = curcmd->c_line; OPERATOR(UNLESS); } if (strEQ(d,"unlink")) *************** *** 1150,1156 **** case 'w': case 'W': SNARFWORD; if (strEQ(d,"while")) { ! yylval.ival = line; OPERATOR(WHILE); } if (strEQ(d,"warn")) --- 1205,1211 ---- case 'w': case 'W': SNARFWORD; if (strEQ(d,"while")) { ! yylval.ival = curcmd->c_line; OPERATOR(WHILE); } if (strEQ(d,"warn")) *************** *** 1206,1223 **** register char *s; char *what; { if (*s == '(') s++; while (s < bufend && isascii(*s) && isspace(*s)) s++; if (isascii(*s) && (isalpha(*s) || *s == '_')) { ! s++; while (isalpha(*s) || isdigit(*s) || *s == '_') s++; while (s < bufend && isspace(*s)) s++; ! if (*s == ',') fatal("No comma allowed after %s", what); } } --- 1261,1289 ---- register char *s; char *what; { + char *word; + if (*s == '(') s++; while (s < bufend && isascii(*s) && isspace(*s)) s++; if (isascii(*s) && (isalpha(*s) || *s == '_')) { ! word = s++; while (isalpha(*s) || isdigit(*s) || *s == '_') s++; while (s < bufend && isspace(*s)) s++; ! if (*s == ',') { ! *s = '\0'; ! word = instr( ! "tell eof times getlogin wait length shift umask getppid \ ! cos exp int log rand sin sqrt ord wantarray", ! word); ! *s = ','; ! if (word) ! return; fatal("No comma allowed after %s", what); + } } } *************** *** 1396,1403 **** } e = tokenbuf + len; for (d=tokenbuf; d < e; d++) { ! if ((*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') || ! (*d == '@' && d[-1] != '\\')) { register ARG *arg; spat->spat_runtime = arg = op_new(1); --- 1462,1471 ---- } e = tokenbuf + len; for (d=tokenbuf; d < e; d++) { ! if (*d == '\\') ! d++; ! else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') || ! (*d == '@')) { register ARG *arg; spat->spat_runtime = arg = op_new(1); *************** *** 1408,1418 **** d = scanreg(d,bufend,buf); (void)stabent(buf,TRUE); /* make sure it's created */ for (; d < e; d++) { ! if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') { d = scanreg(d,bufend,buf); (void)stabent(buf,TRUE); } ! else if (*d == '@' && d[-1] != '\\') { d = scanreg(d,bufend,buf); if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") || strEQ(buf,"SIG") || strEQ(buf,"INC")) --- 1476,1488 ---- d = scanreg(d,bufend,buf); (void)stabent(buf,TRUE); /* make sure it's created */ for (; d < e; d++) { ! if (*d == '\\') ! d++; ! else if (*d == '$' && d[1] && d[1] != '|' && d[1] != ')') { d = scanreg(d,bufend,buf); (void)stabent(buf,TRUE); } ! else if (*d == '@') { d = scanreg(d,bufend,buf); if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") || strEQ(buf,"SIG") || strEQ(buf,"INC")) *************** *** 1448,1454 **** if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) { fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD); spat->spat_regexp = regcomp(tokenbuf,tokenbuf+len, ! spat->spat_flags & SPAT_FOLD,1); /* Note that this regexp can still be used if someone says * something like /a/ && s//b/; so we can't delete it. */ --- 1518,1524 ---- if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) { fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD); spat->spat_regexp = regcomp(tokenbuf,tokenbuf+len, ! spat->spat_flags & SPAT_FOLD); /* Note that this regexp can still be used if someone says * something like /a/ && s//b/; so we can't delete it. */ *************** *** 1629,1640 **** int len; int *retlen; { ! char t[512]; register char *d = t; register int i; register char *send = s + len; ! while (s < send) { if (s[1] == '-' && s+2 < send) { for (i = s[0]; i <= s[2]; i++) *d++ = i; --- 1699,1710 ---- int len; int *retlen; { ! char t[520]; register char *d = t; register int i; register char *send = s + len; ! while (s < send && d - t <= 256) { if (s[1] == '-' && s+2 < send) { for (i = s[0]; i <= s[2]; i++) *d++ = i; *************** *** 1711,1716 **** --- 1781,1787 ---- bool alwaysdollar = FALSE; bool hereis = FALSE; STR *herewas; + STR *str; char *leave = "\\$@nrtfb0123456789[{]}"; /* which backslash sequences to keep */ int len; *************** *** 1764,1776 **** } } out: ! (void)sprintf(tokenbuf,"%ld",i); ! arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf)); ! #ifdef MICROPORT /* Microport 2.4 hack */ ! { double zz = str_2num(arg[1].arg_ptr.arg_str); } ! #else ! (void)str_2num(arg[1].arg_ptr.arg_str); ! #endif /* Microport 2.4 hack */ } break; case '1': case '2': case '3': case '4': case '5': --- 1835,1848 ---- } } out: ! str = Str_new(92,0); ! str_numset(str,(double)i); ! if (str->str_ptr) { ! Safefree(str->str_ptr); ! str->str_ptr = Nullch; ! str->str_len = str->str_cur = 0; ! } ! arg[1].arg_ptr.arg_str = str; } break; case '1': case '2': case '3': case '4': case '5': *************** *** 1801,1812 **** *d++ = *s++; } *d = '\0'; ! arg[1].arg_ptr.arg_str = str_make(tokenbuf, d - tokenbuf); ! #ifdef MICROPORT /* Microport 2.4 hack */ ! { double zz = str_2num(arg[1].arg_ptr.arg_str); } ! #else ! (void)str_2num(arg[1].arg_ptr.arg_str); ! #endif /* Microport 2.4 hack */ break; case '<': if (*++s == '<') { --- 1873,1886 ---- *d++ = *s++; } *d = '\0'; ! str = Str_new(92,0); ! str_numset(str,atof(tokenbuf)); ! if (str->str_ptr) { ! Safefree(str->str_ptr); ! str->str_ptr = Nullch; ! str->str_len = str->str_cur = 0; ! } ! arg[1].arg_ptr.arg_str = str; break; case '<': if (*++s == '<') { *************** *** 1873,1880 **** --- 1947,1956 ---- } else { arg[1].arg_type = A_READ; + #ifdef NOTDEF if (rsfp == stdin && (strEQ(d,"stdin") || strEQ(d,"STDIN"))) yyerror("Can't get both program and data from "); + #endif arg[1].arg_ptr.arg_stab = stabent(d,TRUE); if (!stab_io(arg[1].arg_ptr.arg_stab)) stab_io(arg[1].arg_ptr.arg_stab) = stio_new(); *************** *** 1919,1925 **** STR *tmpstr; char *tmps; ! multi_start = line; if (hereis) multi_open = multi_close = '<'; else { --- 1995,2001 ---- STR *tmpstr; char *tmps; ! multi_start = curcmd->c_line; if (hereis) multi_open = multi_close = '<'; else { *************** *** 1936,1945 **** while (s < bufend && (*s != term || bcmp(s,tokenbuf,len) != 0) ) { if (*s++ == '\n') ! line++; } if (s >= bufend) { ! line = multi_start; fatal("EOF in string"); } str_nset(tmpstr,d+1,s-d); --- 2012,2021 ---- while (s < bufend && (*s != term || bcmp(s,tokenbuf,len) != 0) ) { if (*s++ == '\n') ! curcmd->c_line++; } if (s >= bufend) { ! curcmd->c_line = multi_start; fatal("EOF in string"); } str_nset(tmpstr,d+1,s-d); *************** *** 1950,1955 **** --- 2026,2033 ---- bufend = linestr->str_ptr + linestr->str_cur; hereis = FALSE; } + else + str_nset(tmpstr,"",0); /* avoid "uninitialized" warning */ } else s = str_append_till(tmpstr,s+1,bufend,term,leave); *************** *** 1956,1970 **** while (s >= bufend) { /* multiple line string? */ if (!rsfp || !(oldoldbufptr = oldbufptr = s = str_gets(linestr, rsfp, 0))) { ! line = multi_start; fatal("EOF in string"); } ! line++; if (perldb) { STR *str = Str_new(88,0); str_sset(str,linestr); ! astore(lineary,(int)line,str); } bufend = linestr->str_ptr + linestr->str_cur; if (hereis) { --- 2034,2048 ---- while (s >= bufend) { /* multiple line string? */ if (!rsfp || !(oldoldbufptr = oldbufptr = s = str_gets(linestr, rsfp, 0))) { ! curcmd->c_line = multi_start; fatal("EOF in string"); } ! curcmd->c_line++; if (perldb) { STR *str = Str_new(88,0); str_sset(str,linestr); ! astore(lineary,(int)curcmd->c_line,str); } bufend = linestr->str_ptr + linestr->str_cur; if (hereis) { *************** *** 1982,1988 **** else s = str_append_till(tmpstr,s,bufend,term,leave); } ! multi_end = line; s++; if (tmpstr->str_cur + 5 < tmpstr->str_len) { tmpstr->str_len = tmpstr->str_cur + 1; --- 2060,2066 ---- else s = str_append_till(tmpstr,s,bufend,term,leave); } ! multi_end = curcmd->c_line; s++; if (tmpstr->str_cur + 5 < tmpstr->str_len) { tmpstr->str_len = tmpstr->str_cur + 1; *************** *** 1997,2003 **** send = s + tmpstr->str_cur; while (s < send) { /* see if we can make SINGLE */ if (*s == '\\' && s[1] && isdigit(s[1]) && !isdigit(s[2]) && ! !alwaysdollar ) *s = '$'; /* grandfather \digit in subst */ if ((*s == '$' || *s == '@') && s+1 < send && (alwaysdollar || (s[1] != ')' && s[1] != '|'))) { --- 2075,2081 ---- send = s + tmpstr->str_cur; while (s < send) { /* see if we can make SINGLE */ if (*s == '\\' && s[1] && isdigit(s[1]) && !isdigit(s[2]) && ! !alwaysdollar && s[1] != '0') *s = '$'; /* grandfather \digit in subst */ if ((*s == '$' || *s == '@') && s+1 < send && (alwaysdollar || (s[1] != ')' && s[1] != '|'))) { *************** *** 2100,2111 **** Zero(&froot, 1, FCMD); s = bufptr; while (s < bufend || (s = str_gets(linestr,rsfp, 0)) != Nullch) { ! line++; if (perldb) { STR *tmpstr = Str_new(89,0); str_sset(tmpstr,linestr); ! astore(lineary,(int)line,tmpstr); } if (in_eval && !rsfp) { eol = index(s,'\n'); --- 2178,2189 ---- Zero(&froot, 1, FCMD); s = bufptr; while (s < bufend || (s = str_gets(linestr,rsfp, 0)) != Nullch) { ! curcmd->c_line++; if (perldb) { STR *tmpstr = Str_new(89,0); str_sset(tmpstr,linestr); ! astore(lineary,(int)curcmd->c_line,tmpstr); } if (in_eval && !rsfp) { eol = index(s,'\n'); *************** *** 2188,2199 **** again: if (s >= bufend && (s = str_gets(linestr, rsfp, 0)) == Nullch) goto badform; ! line++; if (perldb) { STR *tmpstr = Str_new(90,0); str_sset(tmpstr,linestr); ! astore(lineary,(int)line,tmpstr); } if (in_eval && !rsfp) { eol = index(s,'\n'); --- 2266,2277 ---- again: if (s >= bufend && (s = str_gets(linestr, rsfp, 0)) == Nullch) goto badform; ! curcmd->c_line++; if (perldb) { STR *tmpstr = Str_new(90,0); str_sset(tmpstr,linestr); ! astore(lineary,(int)curcmd->c_line,tmpstr); } if (in_eval && !rsfp) { eol = index(s,'\n'); *************** *** 2214,2220 **** str = flinebeg->f_unparsed = Str_new(91,eol - s); str->str_u.str_hash = curstash; str_nset(str,"(",1); ! flinebeg->f_line = line; eol[-1] = '\0'; if (!flinebeg->f_next->f_type || index(s, ',')) { eol[-1] = '\n'; --- 2292,2298 ---- str = flinebeg->f_unparsed = Str_new(91,eol - s); str->str_u.str_hash = curstash; str_nset(str,"(",1); ! flinebeg->f_line = curcmd->c_line; eol[-1] = '\0'; if (!flinebeg->f_next->f_type || index(s, ',')) { eol[-1] = '\n'; *** End of Patch 26 ***