lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (11/18/89)
System: perl version 3.0 Patch #: 6 Subject: patch 5 continued Description: See patch 5. 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: rm config.sh # or remove gidtype entry Configure make depend make make test make install 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: 5 1c1 < #define PATCHLEVEL 5 --- > #define PATCHLEVEL 6 Index: perl.h Prereq: 3.0.1.2 *** perl.h.old Fri Nov 17 15:58:32 1989 --- perl.h Fri Nov 17 15:58:35 1989 *************** *** 1,4 **** ! /* $Header: perl.h,v 3.0.1.2 89/11/11 04:39:38 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: perl.h,v 3.0.1.3 89/11/17 15:28:57 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: perl.h,v $ + * Revision 3.0.1.3 89/11/17 15:28:57 lwall + * patch5: byteorder now is a hex value + * patch5: Configure now looks for <time.h> including <sys/time.h> + * * Revision 3.0.1.2 89/11/11 04:39:38 lwall * patch2: Configure may now set -DDEBUGGING * patch2: netinet/in.h needed sys/types.h some places *************** *** 35,41 **** # define vfork fork #endif ! #if defined(MEMCMP) && defined(mips) && BYTEORDER == 01234 #undef MEMCMP #endif --- 39,45 ---- # define vfork fork #endif ! #if defined(MEMCMP) && defined(mips) && BYTEORDER == 0x1234 #undef MEMCMP #endif *************** *** 67,78 **** #if defined(TMINSYS) || defined(I_SYSTIME) #include <sys/time.h> ! #ifdef TIMETOO #include <time.h> #endif #else #include <time.h> #endif #include <sys/times.h> --- 71,85 ---- #if defined(TMINSYS) || defined(I_SYSTIME) #include <sys/time.h> ! #ifdef I_TIMETOO #include <time.h> #endif #else #include <time.h> + #ifdef I_SYSTIMETOO + #include <time.h> #endif + #endif #include <sys/times.h> *************** *** 238,244 **** #define STR_GROW(str,len) if ((str)->str_len < (len)) str_grow(str,len) #ifndef BYTEORDER ! #define BYTEORDER 01234 #endif #if defined(htonl) && !defined(HTONL) --- 245,251 ---- #define STR_GROW(str,len) if ((str)->str_len < (len)) str_grow(str,len) #ifndef BYTEORDER ! #define BYTEORDER 0x1234 #endif #if defined(htonl) && !defined(HTONL) *************** *** 254,260 **** #define NTOHS #endif #ifndef HTONL ! #if (BYTEORDER != 04321) && (BYTEORDER != 087654321) #define HTONS #define HTONL #define NTOHS --- 261,267 ---- #define NTOHS #endif #ifndef HTONL ! #if (BYTEORDER != 0x4321) && (BYTEORDER != 0x87654321) #define HTONS #define HTONL #define NTOHS *************** *** 266,272 **** #define ntohl my_ntohl #endif #else ! #if (BYTEORDER == 04321) || (BYTEORDER == 087654321) #undef HTONS #undef HTONL #undef NTOHS --- 273,279 ---- #define ntohl my_ntohl #endif #else ! #if (BYTEORDER == 0x4321) || (BYTEORDER == 0x87654321) #undef HTONS #undef HTONL #undef NTOHS Index: perl.man.1 Prereq: 3.0.1.1 *** perl.man.1.old Fri Nov 17 15:58:51 1989 --- perl.man.1 Fri Nov 17 15:58:55 1989 *************** *** 1,7 **** .rn '' }` ! ''' $Header: perl.man.1,v 3.0.1.1 89/11/11 04:41:22 lwall Locked $ ''' ''' $Log: perl.man.1,v $ ''' Revision 3.0.1.1 89/11/11 04:41:22 lwall ''' patch2: explained about sh and ${1+"$@"} ''' patch2: documented that space must separate word and '' string --- 1,10 ---- .rn '' }` ! ''' $Header: perl.man.1,v 3.0.1.2 89/11/17 15:30:03 lwall Locked $ ''' ''' $Log: perl.man.1,v $ + ''' Revision 3.0.1.2 89/11/17 15:30:03 lwall + ''' patch5: fixed some manual typos and indent problems + ''' ''' Revision 3.0.1.1 89/11/11 04:41:22 lwall ''' patch2: explained about sh and ${1+"$@"} ''' patch2: documented that space must separate word and '' string *************** *** 413,419 **** as appropriate to the context. A scalar is interpreted as TRUE in the boolean sense if it is not the null string or 0. ! Booleans returned by operators are 1 for true and \'0\' or \'\' (the null string) for false. .PP There are actually two varieties of null string: defined and undefined. --- 416,422 ---- as appropriate to the context. A scalar is interpreted as TRUE in the boolean sense if it is not the null string or 0. ! Booleans returned by operators are 1 for true and 0 or \'\' (the null string) for false. .PP There are actually two varieties of null string: defined and undefined. *************** *** 831,837 **** .I perl are report formats and subroutines. See the sections below for more information on those declarations. ! All uninitialized objects user-created objects are assumed to start with a null or 0 value until they are defined by some explicit operation such as assignment. The sequence of commands is executed just once, unlike in --- 834,840 ---- .I perl are report formats and subroutines. See the sections below for more information on those declarations. ! All uninitialized user-created objects are assumed to start with a null or 0 value until they are defined by some explicit operation such as assignment. The sequence of commands is executed just once, unlike in *************** *** 1031,1039 **** .ne 6 foo: { ! $abc = 1, last foo if /^abc/; ! $def = 1, last foo if /^def/; ! $xyz = 1, last foo if /^xyz/; $nothing = 1; } --- 1034,1042 ---- .ne 6 foo: { ! $abc = 1, last foo if /^abc/; ! $def = 1, last foo if /^def/; ! $xyz = 1, last foo if /^xyz/; $nothing = 1; } Index: perl.man.2 Prereq: 3.0.1.1 *** perl.man.2.old Fri Nov 17 15:59:11 1989 --- perl.man.2 Fri Nov 17 15:59:17 1989 *************** *** 1,7 **** ''' Beginning of part 2 ! ''' $Header: perl.man.2,v 3.0.1.1 89/11/11 04:43:10 lwall Locked $ ''' ''' $Log: perl.man.2,v $ ''' Revision 3.0.1.1 89/11/11 04:43:10 lwall ''' patch2: made some line breaks depend on troff vs. nroff ''' patch2: example of unshift had args backwards --- 1,10 ---- ''' Beginning of part 2 ! ''' $Header: perl.man.2,v 3.0.1.2 89/11/17 15:30:16 lwall Locked $ ''' ''' $Log: perl.man.2,v $ + ''' Revision 3.0.1.2 89/11/17 15:30:16 lwall + ''' patch5: fixed some manual typos and indent problems + ''' ''' Revision 3.0.1.1 89/11/11 04:43:10 lwall ''' patch2: made some line breaks depend on troff vs. nroff ''' patch2: example of unshift had args backwards *************** *** 140,146 **** $uid{$login} = $uid; $gid{$login} = $gid; } ! @ary = <$pattern>; # get filenames if ($uid{$user} eq \'\') { die "$user not in passwd file"; } --- 143,149 ---- $uid{$login} = $uid; $gid{$login} = $gid; } ! @ary = <${pattern}>; # get filenames if ($uid{$user} eq \'\') { die "$user not in passwd file"; } Index: perl.man.3 Prereq: 3.0.1.1 *** perl.man.3.old Fri Nov 17 15:59:41 1989 --- perl.man.3 Fri Nov 17 15:59:47 1989 *************** *** 1,7 **** ''' Beginning of part 3 ! ''' $Header: perl.man.3,v 3.0.1.1 89/11/11 04:45:06 lwall Locked $ ''' ''' $Log: perl.man.3,v $ ''' Revision 3.0.1.1 89/11/11 04:45:06 lwall ''' patch2: made some line breaks depend on troff vs. nroff ''' --- 1,11 ---- ''' Beginning of part 3 ! ''' $Header: perl.man.3,v 3.0.1.2 89/11/17 15:31:05 lwall Locked $ ''' ''' $Log: perl.man.3,v $ + ''' Revision 3.0.1.2 89/11/17 15:31:05 lwall + ''' patch5: fixed some manual typos and indent problems + ''' patch5: added warning about print making an array context + ''' ''' Revision 3.0.1.1 89/11/11 04:45:06 lwall ''' patch2: made some line breaks depend on troff vs. nroff ''' *************** *** 288,293 **** --- 292,300 ---- To set the default output channel to something other than .I STDOUT use the select operation. + Note that, because print takes a LIST, anything in the LIST is evaluated + in an array context, and any subroutine that you call will have one or more + of its expressions evaluated in an array context. .Ip "printf(FILEHANDLE LIST)" 8 10 .Ip "printf(LIST)" 8 .Ip "printf FILEHANDLE LIST" 8 *************** *** 699,705 **** .fi produces the output \*(L'h:i:t:h:e:r:e\*(R'. ! .P The NUM parameter can be used to partially split a line .nf --- 706,712 ---- .fi produces the output \*(L'h:i:t:h:e:r:e\*(R'. ! .Sp The NUM parameter can be used to partially split a line .nf Index: perl.man.4 Prereq: 3.0.1.2 *** perl.man.4.old Fri Nov 17 16:00:13 1989 --- perl.man.4 Fri Nov 17 16:00:21 1989 *************** *** 1,7 **** ''' Beginning of part 4 ! ''' $Header: perl.man.4,v 3.0.1.2 89/11/11 04:46:40 lwall Locked $ ''' ''' $Log: perl.man.4,v $ ''' Revision 3.0.1.2 89/11/11 04:46:40 lwall ''' patch2: made some line breaks depend on troff vs. nroff ''' patch2: clarified operation of ^ and $ when $* is false --- 1,11 ---- ''' Beginning of part 4 ! ''' $Header: perl.man.4,v 3.0.1.3 89/11/17 15:32:25 lwall Locked $ ''' ''' $Log: perl.man.4,v $ + ''' Revision 3.0.1.3 89/11/17 15:32:25 lwall + ''' patch5: fixed some manual typos and indent problems + ''' patch5: clarified difference between $! and $@ + ''' ''' Revision 3.0.1.2 89/11/11 04:46:40 lwall ''' patch2: made some line breaks depend on troff vs. nroff ''' patch2: clarified operation of ^ and $ when $* is false *************** *** 49,70 **** Examples: .nf ! chdir $foo || die; # (chdir $foo) || die ! chdir($foo) || die; # (chdir $foo) || die ! chdir ($foo) || die; # (chdir $foo) || die ! chdir +($foo) || die; # (chdir $foo) || die but, because * is higher precedence than ||: ! chdir $foo * 20; # chdir ($foo * 20) ! chdir($foo) * 20; # (chdir $foo) * 20 ! chdir ($foo) * 20; # (chdir $foo) * 20 ! chdir +($foo) * 20; # chdir ($foo * 20) ! rand 10 * 20; # rand (10 * 20) ! rand(10) * 20; # (rand 10) * 20 ! rand (10) * 20; # (rand 10) * 20 ! rand +(10) * 20; # rand (10 * 20) .fi In the absence of parentheses, --- 53,74 ---- Examples: .nf ! chdir $foo || die;\h'|3i'# (chdir $foo) || die ! chdir($foo) || die;\h'|3i'# (chdir $foo) || die ! chdir ($foo) || die;\h'|3i'# (chdir $foo) || die ! chdir +($foo) || die;\h'|3i'# (chdir $foo) || die but, because * is higher precedence than ||: ! chdir $foo * 20;\h'|3i'# chdir ($foo * 20) ! chdir($foo) * 20;\h'|3i'# (chdir $foo) * 20 ! chdir ($foo) * 20;\h'|3i'# (chdir $foo) * 20 ! chdir +($foo) * 20;\h'|3i'# chdir ($foo * 20) ! rand 10 * 20;\h'|3i'# rand (10 * 20) ! rand(10) * 20;\h'|3i'# (rand 10) * 20 ! rand (10) * 20;\h'|3i'# (rand 10) * 20 ! rand +(10) * 20;\h'|3i'# rand (10 * 20) .fi In the absence of parentheses, *************** *** 801,806 **** --- 805,813 ---- .Ip $! 8 2 If used in a numeric context, yields the current value of errno, with all the usual caveats. + (This means that you shouldn't depend on the value of $! to be anything + in particular unless you've gotten a specific error return indicating a + system error.) If used in a string context, yields the corresponding system error string. You can assign to $! in order to set errno if, for instance, you want $! to return the string for error n, or you want *************** *** 807,814 **** to set the exit value for the die operator. (Mnemonic: What just went bang?) .Ip $@ 8 2 ! The error message from the last eval command. ! If null, the last eval parsed and executed correctly. (Mnemonic: Where was the syntax error \*(L"at\*(R"?) .Ip $< 8 2 The real uid of this process. --- 814,822 ---- to set the exit value for the die operator. (Mnemonic: What just went bang?) .Ip $@ 8 2 ! The perl syntax error message from the last eval command. ! If null, the last eval parsed and executed correctly (although the operations ! you invoked may have failed in the normal fashion). (Mnemonic: Where was the syntax error \*(L"at\*(R"?) .Ip $< 8 2 The real uid of this process. *************** *** 1041,1054 **** Don't be afraid to use loop labels\*(--they're there to enhance readability as well as to allow multi-level loop breaks. See last example. ! .Ip 6. 4 4 For portability, when using features that may not be implemented on every machine, test the construct in an eval to see if it fails. If you know what version or patchlevel a particular feature was implemented, you can test $] to see if it will be there. - .Ip 4. 4 4 - Choose mnemonic identifiers. .Ip 5. 4 4 Be consistent. .Sh "Debugging" If you invoke --- 1049,1062 ---- Don't be afraid to use loop labels\*(--they're there to enhance readability as well as to allow multi-level loop breaks. See last example. ! .Ip 4. 4 4 For portability, when using features that may not be implemented on every machine, test the construct in an eval to see if it fails. If you know what version or patchlevel a particular feature was implemented, you can test $] to see if it will be there. .Ip 5. 4 4 + Choose mnemonic identifiers. + .Ip 6. 4 4 Be consistent. .Sh "Debugging" If you invoke Index: perly.c Prereq: 3.0.1.1 *** perly.c.old Fri Nov 17 16:00:37 1989 --- perly.c Fri Nov 17 16:00:41 1989 *************** *** 1,4 **** ! char rcsid[] = "$Header: perly.c,v 3.0.1.1 89/11/11 04:50:04 lwall Locked $\nPatch level: ###\n"; /* * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! char rcsid[] = "$Header: perly.c,v 3.0.1.2 89/11/17 15:34:42 lwall Locked $\nPatch level: ###\n"; /* * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perly.c,v $ + * Revision 3.0.1.2 89/11/17 15:34:42 lwall + * patch5: fixed possible confusion about current effective gid + * * Revision 3.0.1.1 89/11/11 04:50:04 lwall * patch2: moved yydebug to where its type didn't matter * *************** *** 426,432 **** fatal("Can't do setuid\n"); } ! if (statbuf.st_mode & S_ISGID && statbuf.st_gid != getegid()) #ifdef SETEGID (void)setegid(statbuf.st_gid); #else --- 429,435 ---- fatal("Can't do setuid\n"); } ! if (statbuf.st_mode & S_ISGID && statbuf.st_gid != egid) #ifdef SETEGID (void)setegid(statbuf.st_gid); #else *************** *** 458,464 **** --- 461,470 ---- setuid((UIDTYPE)uid); #endif #endif + uid = (int)getuid(); euid = (int)geteuid(); + gid = (int)getgid(); + egid = (int)getegid(); if (!cando(S_IEXEC,TRUE,&statbuf)) fatal("Permission denied\n"); /* they can't do this */ } Index: x2p/s2p.SH Prereq: 3.0.1.1 *** x2p/s2p.SH.old Fri Nov 17 16:02:38 1989 --- x2p/s2p.SH Fri Nov 17 16:02:40 1989 *************** *** 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.1 89/11/11 05:08:25 lwall Locked $ # # $Log: s2p.SH,v $ # Revision 3.0.1.1 89/11/11 05:08:25 lwall # patch2: in s2p, + within patterns needed backslashing # patch2: s2p was printing out some debugging info to the output file --- 28,40 ---- : In the following dollars and backticks do not need the extra backslash. $spitshell >>s2p <<'!NO!SUBS!' ! # $Header: s2p.SH,v 3.0.1.2 89/11/17 15:51:27 lwall Locked $ # # $Log: s2p.SH,v $ + # Revision 3.0.1.2 89/11/17 15:51:27 lwall + # patch5: in s2p, line labels without a subsequent statement were done wrong + # patch5: s2p left residue in /tmp + # # Revision 3.0.1.1 89/11/11 05:08:25 lwall # patch2: in s2p, + within patterns needed backslashing # patch2: s2p was printing out some debugging info to the output file *************** *** 109,115 **** $toplabel = $label; } $_ = "$label:"; ! if ($lastlinewaslabel++) {$_ .= "\t;";} if ($indent >= 2) { $indent -= 2; $indmod = 2; --- 113,123 ---- $toplabel = $label; } $_ = "$label:"; ! if ($lastlinewaslabel++) { ! $indent += 4; ! print body "\t" x ($indent / 8), ' ' x ($indent % 8), ";\n"; ! $indent -= 4; ! } if ($indent >= 2) { $indent -= 2; $indmod = 2; *************** *** 198,203 **** --- 206,216 ---- 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) { *************** *** 259,268 **** } } ! unlink "/tmp/sperl$$", "/tmp/sperl2$$"; sub Die { ! unlink "/tmp/sperl$$", "/tmp/sperl2$$"; die $_[0]; } sub make_filehandle { --- 272,281 ---- } } ! unlink "/tmp/sperl$$", "/tmp/sperl2$$", "/tmp/sperl2$$.c"; sub Die { ! unlink "/tmp/sperl$$", "/tmp/sperl2$$", "/tmp/sperl2$$.c"; die $_[0]; } sub make_filehandle { Index: stab.c Prereq: 3.0.1.1 *** stab.c.old Fri Nov 17 16:00:59 1989 --- stab.c Fri Nov 17 16:01:02 1989 *************** *** 1,4 **** ! /* $Header: stab.c,v 3.0.1.1 89/11/11 04:55:07 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: stab.c,v 3.0.1.2 89/11/17 15:35:37 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.c,v $ + * Revision 3.0.1.2 89/11/17 15:35:37 lwall + * patch5: sighandler() needed to be static + * * Revision 3.0.1.1 89/11/11 04:55:07 lwall * patch2: sys_errlist[sys_nerr] is illegal * *************** *** 19,26 **** #include <signal.h> - /* This oughta be generated by Configure. */ - static char *sig_name[] = { SIG_NAME,0 }; --- 22,27 ---- *************** *** 188,194 **** STAB *stab = mstr->str_u.str_stab; char *s; int i; ! int sighandler(); switch (mstr->str_rare) { case 'E': --- 189,195 ---- STAB *stab = mstr->str_u.str_stab; char *s; int i; ! static int sighandler(); switch (mstr->str_rare) { case 'E': *************** *** 421,426 **** --- 422,428 ---- return 0; } + static int sighandler(sig) int sig; { Index: str.c Prereq: 3.0.1.2 *** str.c.old Fri Nov 17 16:01:14 1989 --- str.c Fri Nov 17 16:01:20 1989 *************** *** 1,4 **** ! /* $Header: str.c,v 3.0.1.2 89/11/11 04:56:22 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: str.c,v 3.0.1.3 89/11/17 15:38:23 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.3 89/11/17 15:38:23 lwall + * patch5: some machines typedef unchar too + * patch5: substitution on leading components occasionally caused <> corruption + * * Revision 3.0.1.2 89/11/11 04:56:22 lwall * patch2: uchar gives Crays fits * *************** *** 666,671 **** --- 670,676 ---- bpx = bp - str->str_ptr; /* prepare for possible relocation */ if (get_paragraph && oldbp) obpx = oldbp - str->str_ptr; + str->str_cur = bpx; STR_GROW(str, bpx + cnt + 2); bp = str->str_ptr + bpx; /* reconstitute our pointer */ if (get_paragraph && oldbp) *************** *** 843,849 **** else if (*d == '[' && s[-1] == ']') { /* char class? */ int weight = 2; /* let's weigh the evidence */ char seen[256]; ! unsigned char unchar = 0, lastunchar; Zero(seen,256,char); *--s = '\0'; --- 848,854 ---- else if (*d == '[' && s[-1] == ']') { /* char class? */ int weight = 2; /* let's weigh the evidence */ char seen[256]; ! unsigned char un_char = 0, last_un_char; Zero(seen,256,char); *--s = '\0'; *************** *** 860,871 **** weight -= 100; } for (d++; d < s; d++) { ! lastunchar = unchar; ! unchar = (unsigned char)*d; switch (*d) { case '&': case '$': ! weight -= seen[unchar] * 10; if (isalpha(d[1]) || isdigit(d[1]) || d[1] == '_') { d = scanreg(d,s,tokenbuf); --- 865,876 ---- weight -= 100; } for (d++; d < s; d++) { ! last_un_char = un_char; ! un_char = (unsigned char)*d; switch (*d) { case '&': case '$': ! weight -= seen[un_char] * 10; if (isalpha(d[1]) || isdigit(d[1]) || d[1] == '_') { d = scanreg(d,s,tokenbuf); *************** *** 883,889 **** } break; case '\\': ! unchar = 254; if (d[1]) { if (index("wds",d[1])) weight += 100; --- 888,894 ---- } break; case '\\': ! un_char = 254; if (d[1]) { if (index("wds",d[1])) weight += 100; *************** *** 901,908 **** weight += 100; break; case '-': ! if (lastunchar < d[1] || d[1] == '\\') { ! if (index("aA01! ",lastunchar)) weight += 30; if (index("zZ79~",d[1])) weight += 30; --- 906,913 ---- weight += 100; break; case '-': ! if (last_un_char < d[1] || d[1] == '\\') { ! if (index("aA01! ",last_un_char)) weight += 30; if (index("zZ79~",d[1])) weight += 30; *************** *** 916,927 **** weight -= 150; d = bufptr; } ! if (unchar == lastunchar + 1) weight += 5; ! weight -= seen[unchar]; break; } ! seen[unchar]++; } #ifdef DEBUGGING if (debug & 512) --- 921,932 ---- weight -= 150; d = bufptr; } ! if (un_char == last_un_char + 1) weight += 5; ! weight -= seen[un_char]; break; } ! seen[un_char]++; } #ifdef DEBUGGING if (debug & 512) Index: toke.c Prereq: 3.0.1.2 *** toke.c.old Fri Nov 17 16:01:53 1989 --- toke.c Fri Nov 17 16:01:59 1989 *************** *** 1,4 **** ! /* $Header: toke.c,v 3.0.1.2 89/11/11 05:04:42 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: toke.c,v 3.0.1.3 89/11/17 15:43:15 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,16 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: toke.c,v $ + * Revision 3.0.1.3 89/11/17 15:43:15 lwall + * patch5: IBM PC/RT compiler can't deal with UNI() and LOP() macros + * patch5: } misadjusted expection of subsequent term or operator + * patch5: y/abcde// didn't work + * * Revision 3.0.1.2 89/11/11 05:04:42 lwall * patch2: fixed a CLINE macro conflict * *************** *** 78,83 **** --- 83,134 ---- return s; } + #ifdef CRIPPLED_CC + + #undef UNI + #undef LOP + #define UNI(f) return uni(f,s) + #define LOP(f) return lop(f,s) + + int + uni(f,s) + int f; + char *s; + { + yylval.ival = f; + expectterm = TRUE; + bufptr = s; + if (*s == '(') + return FUNC1; + s = skipspace(s); + if (*s == '(') + return FUNC1; + else + return UNIOP; + } + + int + lop(f,s) + int f; + char *s; + { + if (*s != '(') + s = skipspace(s); + if (*s == '(') { + *s = META('('); + bufptr = oldbufptr; + return '('; + } + else { + yylval.ival=f; + expectterm = TRUE; + bufptr = s; + return LISTOP; + } + } + + #endif /* CRIPPLED_CC */ + yylex() { register char *s = bufptr; *************** *** 309,319 **** TERM(tmp); case '}': tmp = *s++; ! for (d = s; *d == ' ' || *d == '\t'; d++) ; ! if (*d == '\n' || *d == '#') ! OPERATOR(tmp); /* block end */ ! else ! TERM(tmp); /* associative array end */ case '&': s++; tmp = *s++; --- 360,366 ---- TERM(tmp); case '}': tmp = *s++; ! RETURN(tmp); case '&': s++; tmp = *s++; *************** *** 1547,1553 **** yylval.arg = arg; if (!*r) { Safefree(r); ! r = t; } for (i = 0, j = 0; i < tlen; i++,j++) { if (j >= rlen) --- 1594,1600 ---- yylval.arg = arg; if (!*r) { Safefree(r); ! r = t; rlen = tlen; } for (i = 0, j = 0; i < tlen; i++,j++) { if (j >= rlen) Index: util.c Prereq: 3.0.1.1 *** util.c.old Fri Nov 17 16:02:13 1989 --- util.c Fri Nov 17 16:02:18 1989 *************** *** 1,4 **** ! /* $Header: util.c,v 3.0.1.1 89/11/11 05:06:13 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: util.c,v 3.0.1.2 89/11/17 15:46:35 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: util.c,v $ + * Revision 3.0.1.2 89/11/17 15:46:35 lwall + * patch5: BZERO separate from BCOPY now + * patch5: byteorder now is a hex value + * * Revision 3.0.1.1 89/11/11 05:06:13 lwall * patch2: made dup2 a little better * *************** *** 911,918 **** } #endif - #ifndef BCOPY #ifndef MEMCPY char * bcopy(from,to,len) register char *from; --- 915,922 ---- } #endif #ifndef MEMCPY + #ifndef BCOPY char * bcopy(from,to,len) register char *from; *************** *** 925,931 **** --- 929,937 ---- *to++ = *from++; return retval; } + #endif + #ifndef BZERO char * bzero(loc,len) register char *loc; *************** *** 979,985 **** #endif /* VARARGS */ #ifdef MYSWAP ! #if BYTEORDER != 04321 short my_swap(s) short s; --- 985,991 ---- #endif /* VARARGS */ #ifdef MYSWAP ! #if BYTEORDER != 0x4321 short my_swap(s) short s; *************** *** 1000,1009 **** { union { long result; ! char c[4]; } u; ! #if BYTEORDER == 01234 u.c[0] = (l >> 24) & 255; u.c[1] = (l >> 16) & 255; u.c[2] = (l >> 8) & 255; --- 1006,1015 ---- { union { long result; ! char c[sizeof(long)]; } u; ! #if BYTEORDER == 0x1234 u.c[0] = (l >> 24) & 255; u.c[1] = (l >> 16) & 255; u.c[2] = (l >> 8) & 255; *************** *** 1010,1023 **** u.c[3] = l & 255; return u.result; #else ! #if ((BYTEORDER - 01111) & 0444) || !(BYTEORDER & 7) fatal("Unknown BYTEORDER\n"); #else register int o; register int s; ! for (o = BYTEORDER - 01111, s = 0; s < 32; o >>= 3, s += 8) { ! u.c[o & 7] = (l >> s) & 255; } return u.result; #endif --- 1016,1029 ---- u.c[3] = l & 255; return u.result; #else ! #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf) fatal("Unknown BYTEORDER\n"); #else register int o; register int s; ! for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) { ! u.c[o & 0xf] = (l >> s) & 255; } return u.result; #endif *************** *** 1030,1039 **** { union { long l; ! char c[4]; } u; ! #if BYTEORDER == 01234 u.c[0] = (l >> 24) & 255; u.c[1] = (l >> 16) & 255; u.c[2] = (l >> 8) & 255; --- 1036,1045 ---- { union { long l; ! char c[sizeof(long)]; } u; ! #if BYTEORDER == 0x1234 u.c[0] = (l >> 24) & 255; u.c[1] = (l >> 16) & 255; u.c[2] = (l >> 8) & 255; *************** *** 1040,1046 **** u.c[3] = l & 255; return u.l; #else ! #if ((BYTEORDER - 01111) & 0444) || !(BYTEORDER & 7) fatal("Unknown BYTEORDER\n"); #else register int o; --- 1046,1052 ---- u.c[3] = l & 255; return u.l; #else ! #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf) fatal("Unknown BYTEORDER\n"); #else register int o; *************** *** 1048,1055 **** u.l = l; l = 0; ! for (o = BYTEORDER - 01111, s = 0; s < 32; o >>= 3, s += 8) { ! l |= (u.c[o & 7] & 255) << s; } return l; #endif --- 1054,1061 ---- u.l = l; l = 0; ! for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) { ! l |= (u.c[o & 0xf] & 255) << s; } return l; #endif *************** *** 1056,1062 **** #endif } ! #endif /* BYTEORDER != 04321 */ #endif /* HTONS */ FILE * --- 1062,1068 ---- #endif } ! #endif /* BYTEORDER != 0x4321 */ #endif /* HTONS */ FILE * Index: util.h Prereq: 3.0.1.1 *** util.h.old Fri Nov 17 16:02:25 1989 --- util.h Fri Nov 17 16:02:26 1989 *************** *** 1,4 **** ! /* $Header: util.h,v 3.0.1.1 89/10/26 23:28:25 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: util.h,v 3.0.1.2 89/11/17 15:48:01 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: util.h,v $ + * Revision 3.0.1.2 89/11/17 15:48:01 lwall + * patch5: BZERO separate from BCOPY now + * * Revision 3.0.1.1 89/10/26 23:28:25 lwall * patch1: declared bcopy if necessary * *************** *** 33,40 **** char *nsavestr(); FILE *mypopen(); int mypclose(); - #ifndef BCOPY #ifndef MEMCPY char *bcopy(); #endif #endif --- 36,46 ---- char *nsavestr(); FILE *mypopen(); int mypclose(); #ifndef MEMCPY + #ifndef BCOPY char *bcopy(); + #endif + #ifndef BZERO + char *bzero(); #endif #endif Index: x2p/walk.c Prereq: 3.0.1.1 *** x2p/walk.c.old Fri Nov 17 16:02:54 1989 --- x2p/walk.c Fri Nov 17 16:02:59 1989 *************** *** 1,4 **** ! /* $Header: walk.c,v 3.0.1.1 89/11/11 05:09:33 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: walk.c,v 3.0.1.2 89/11/17 15:53:00 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: walk.c,v $ + * Revision 3.0.1.2 89/11/17 15:53:00 lwall + * patch5: on Pyramids, index(s, '}' + 128) doesn't find meta-} + * * Revision 3.0.1.1 89/11/11 05:09:33 lwall * patch2: in a2p, awk script with no line actions still needs main loop * *************** *** 1419,1428 **** if (!s) fatal("Illegal for loop: %s",d); *s++ = '\0'; ! t = index(s,'}' + 128); ! if (!t) ! t = index(s,']' + 128); ! if (t) *t = '\0'; str = str_new(0); str_set(str,d+1); --- 1422,1433 ---- if (!s) fatal("Illegal for loop: %s",d); *s++ = '\0'; ! for (t = s; i = *t; t++) { ! i &= 127; ! if (i == '}' || i == ']') ! break; ! } ! if (*t) *t = '\0'; str = str_new(0); str_set(str,d+1);