perl 3.0 patch #26
Larry Wall
lwall at jpl-devvax.JPL.NASA.GOV
Sat Aug 11 07:30:42 AEST 1990
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 <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 #27 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 at 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: 25
1c1
< #define PATCHLEVEL 25
---
> #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 <os2.h>
+ #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 <STDIN>");
+ #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 ***
More information about the Comp.sources.bugs
mailing list