From: Larry Wall Date: Thu, 6 Jun 1991 23:27:54 +0000 (+0000) Subject: perl 4.0 patch 5: patch #4, continued X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2b317908ea5309ab202d1cdbadccfdf42d10e2b1;p=p5sagit%2Fp5-mst-13.2.git perl 4.0 patch 5: patch #4, continued See patch #4. --- diff --git a/arg.h b/arg.h index 16e4a05..ee5aade 100644 --- a/arg.h +++ b/arg.h @@ -1,11 +1,16 @@ -/* $Header: arg.h,v 4.0 91/03/20 01:03:09 lwall Locked $ +/* $RCSfile: arg.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:18:30 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, Larry Wall * - * You may distribute under the terms of the GNU General Public License - * as specified in the README file that comes with the perl 3.0 kit. + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. * * $Log: arg.h,v $ + * Revision 4.0.1.1 91/06/07 10:18:30 lwall + * patch4: length($`), length($&), length($') now optimized to avoid string copy + * patch4: new copyright notice + * patch4: many, many itty-bitty portability fixes + * * Revision 4.0 91/03/20 01:03:09 lwall * 4.0 baseline. * @@ -270,7 +275,7 @@ #define O_SGRENT 256 #define O_EGRENT 257 #define O_GETLOGIN 258 -#define O_OPENDIR 259 +#define O_OPEN_DIR 259 #define O_READDIR 260 #define O_TELLDIR 261 #define O_SEEKDIR 262 @@ -576,6 +581,7 @@ char *opname[] = { #define A_STAR 18 #define A_LSTAR 19 #define A_WANTARRAY 20 +#define A_LENSTAB 21 #define A_MASK 31 #define A_DONT 32 /* or this into type to suppress evaluation */ @@ -605,7 +611,8 @@ char *argname[] = { "STAR", "LSTAR", "WANTARRAY", - "21" + "LENSTAB", + "22" }; #endif @@ -634,6 +641,7 @@ bool hoistable[] = 1, /* STAR */ 1, /* LSTAR */ 1, /* WANTARRAY */ + 0, /* LENSTAB */ 0, /* 21 */ }; #endif diff --git a/array.c b/array.c index ae64d85..e2561d7 100644 --- a/array.c +++ b/array.c @@ -1,11 +1,14 @@ -/* $Header: array.c,v 4.0 91/03/20 01:03:32 lwall Locked $ +/* $RCSfile: array.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:19:08 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, Larry Wall * - * You may distribute under the terms of the GNU General Public License - * as specified in the README file that comes with the perl 3.0 kit. + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. * * $Log: array.c,v $ + * Revision 4.0.1.1 91/06/07 10:19:08 lwall + * patch4: new copyright notice + * * Revision 4.0 91/03/20 01:03:32 lwall * 4.0 baseline. * diff --git a/array.h b/array.h index 49ded9b..980672d 100644 --- a/array.h +++ b/array.h @@ -1,11 +1,14 @@ -/* $Header: array.h,v 4.0 91/03/20 01:03:44 lwall Locked $ +/* $RCSfile: array.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:19:20 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, Larry Wall * - * You may distribute under the terms of the GNU General Public License - * as specified in the README file that comes with the perl 3.0 kit. + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. * * $Log: array.h,v $ + * Revision 4.0.1.1 91/06/07 10:19:20 lwall + * patch4: new copyright notice + * * Revision 4.0 91/03/20 01:03:44 lwall * 4.0 baseline. * diff --git a/cflags.SH b/cflags.SH index 52a122e..d01bad8 100644 --- a/cflags.SH +++ b/cflags.SH @@ -5,76 +5,116 @@ case $CONFIG in ln ../../config.sh . || \ ln ../../../config.sh . || \ (echo "Can't find config.sh."; exit 1) - fi 2>/dev/null - . ./config.sh + fi + . config.sh ;; esac +: This forces SH files to create target in same directory as SH file. +: This is so that make depend always knows where to find SH derivatives. case "$0" in */*) cd `expr X$0 : 'X\(.*\)/'` ;; esac +echo "Extracting cflags (with variable substitutions)" +: This section of the file will have variable substitutions done on it. +: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. +: Protect any dollar signs and backticks that you do not want interpreted +: by putting a backslash in front. You may delete these comments. +$spitshell >cflags <>cflags <<'!NO!SUBS!' +case "$0" in +*/*) cd `expr X$0 : 'X\(.*\)/'` ;; +esac +case $CONFIG in +'') + if test ! -f config.sh; then + ln ../config.sh . || \ + ln ../../config.sh . || \ + ln ../../../config.sh . || \ + (echo "Can't find config.sh."; exit 1) + fi 2>/dev/null + . ./config.sh + ;; +esac also=': ' case $# in -1) also='echo 1>&2 " CFLAGS = "' +1) also='echo 1>&2 " CCCMD = "' esac case $# in 0) set *.c; echo "The current C flags are:" ;; -*) set `echo "$* " | sed 's/\.o /.c /g'` esac + +set `echo "$* " | sed 's/\.[oc] / /g'` + for file do case "$#" in 1) ;; - *) echo $n " $file $c" ;; + *) echo $n " $file.c $c" ;; esac + : allow variables like toke_cflags to be evaluated + + eval 'eval ${'"${file}_cflags"'-""}' + + : or customize here + case "$file" in - array.c) ;; - cmd.c) ;; - cons.c) ;; - consarg.c) ;; - doarg.c) ;; - doio.c) ;; - dolist.c) ;; - dump.c) ;; - eval.c) ;; - form.c) ;; - hash.c) ;; - malloc.c) ;; - perl.c) ;; - perly.c) ;; - regcomp.c) ;; - regexec.c) ;; - stab.c) ;; - str.c) ;; - toke.c) ;; - usersub.c) ;; - util.c) ;; - tarray.c) ;; - tcmd.c) ;; - tcons.c) ;; - tconsarg.c) ;; - tdoarg.c) ;; - tdoio.c) ;; - tdolist.c) ;; - tdump.c) ;; - teval.c) ;; - tform.c) ;; - thash.c) ;; - tmalloc.c) ;; - tperl.c) ;; - tperly.c) ;; - tregcomp.c) ;; - tregexec.c) ;; - tstab.c) ;; - tstr.c) ;; - ttoke.c) ;; - tusersub.c) ;; - tutil.c) ;; + array) ;; + cmd) ;; + cons) ;; + consarg) ;; + doarg) ;; + doio) ;; + dolist) ;; + dump) ;; + eval) ;; + form) ;; + hash) ;; + malloc) ;; + perl) ;; + perly) ;; + regcomp) ;; + regexec) ;; + stab) ;; + str) ;; + toke) ;; + usersub) ;; + util) ;; + tarray) ;; + tcmd) ;; + tcons) ;; + tconsarg) ;; + tdoarg) ;; + tdoio) ;; + tdolist) ;; + tdump) ;; + teval) ;; + tform) ;; + thash) ;; + tmalloc) ;; + tperl) ;; + tperly) ;; + tregcomp) ;; + tregexec) ;; + tstab) ;; + tstr) ;; + ttoke) ;; + tusersub) ;; + tutil) ;; *) ;; esac - echo "$ccflags $optimize $large $split" - eval "$also $ccflags $optimize $large $split" + echo "$cc -c $ccflags $optimize $large $split" + eval "$also "'"$cc -c $ccflags $optimize $large $split"' + + . ./config.sh + done +!NO!SUBS! +chmod +x cflags +$eunicefix cflags diff --git a/cmd.c b/cmd.c index e8d3288..06951b5 100644 --- a/cmd.c +++ b/cmd.c @@ -1,11 +1,15 @@ -/* $RCSfile: cmd.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:36:16 $ +/* $RCSfile: cmd.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 10:26:45 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, Larry Wall * - * You may distribute under the terms of the GNU General Public License - * as specified in the README file that comes with the perl 3.0 kit. + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. * * $Log: cmd.c,v $ + * Revision 4.0.1.2 91/06/07 10:26:45 lwall + * patch4: new copyright notice + * patch4: made some allowances for "semi-standard" C + * * Revision 4.0.1.1 91/04/11 17:36:16 lwall * patch1: you may now use "die" and "caller" in a signal handler * @@ -27,7 +31,7 @@ void grow_dlevel(); /* do longjmps() clobber register variables? */ -#if defined(cray) || defined(__STDC__) +#if defined(cray) || defined(STANDARD_C) #define JMPCLOBBER #endif diff --git a/cmd.h b/cmd.h index 0a4f84e..be047ea 100644 --- a/cmd.h +++ b/cmd.h @@ -1,11 +1,15 @@ -/* $Header: cmd.h,v 4.0 91/03/20 01:04:34 lwall Locked $ +/* $RCSfile: cmd.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:28:50 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, Larry Wall * - * You may distribute under the terms of the GNU General Public License - * as specified in the README file that comes with the perl 3.0 kit. + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. * * $Log: cmd.h,v $ + * Revision 4.0.1.1 91/06/07 10:28:50 lwall + * patch4: new copyright notice + * patch4: length($`), length($&), length($') now optimized to avoid string copy + * * Revision 4.0 91/03/20 01:04:34 lwall * 4.0 baseline. * @@ -161,5 +165,5 @@ struct compcmd { }; void opt_arg(); -void evalstatic(); +ARG* evalstatic(); int cmd_exec(); diff --git a/config.H b/config.H index 34d9ac2..5303c03 100644 --- a/config.H +++ b/config.H @@ -29,7 +29,7 @@ * This symbol contains the number of bytes required to align a double. * Usual values are 2, 4, and 8. */ -#define ALIGNBYTES 4 /**/ +#define ALIGNBYTES 2 /**/ /* BIN * This symbol holds the name of the directory in which the user wants @@ -42,7 +42,7 @@ * This symbol contains an encoding of the order of bytes in a long. * Usual values (in octal) are 01234, 04321, 02143, 03412... */ -#define BYTEORDER 0x1234 /**/ +#define BYTEORDER 0x4321 /**/ /* CPPSTDIN * This symbol contains the first part of the string which will invoke @@ -55,8 +55,8 @@ * output. This symbol will have the value "-" if CPPSTDIN needs a minus * to specify standard input, otherwise the value is "". */ -#define CPPSTDIN "cc -E" -#define CPPMINUS "-" +#define CPPSTDIN "/usr/lib/cpp" +#define CPPMINUS "" /* HAS_BCMP * This symbol, if defined, indicates that the bcmp routine is available @@ -89,8 +89,8 @@ * 1 = couldn't cast < 0 * 2 = couldn't cast >= 0x80000000 */ -#define CASTNEGFLOAT /**/ -#define CASTFLAGS 0 /**/ +/*#undef CASTNEGFLOAT /**/ +#define CASTFLAGS 1 /**/ /* CHARSPRINTF * This symbol is defined if this system declares "char *sprintf()" in @@ -180,7 +180,7 @@ * This symbol, if defined, indicates that the gethostent() routine is * available to lookup host names in some data base or other. */ -#define HAS_GETHOSTENT /**/ +/*#undef HAS_GETHOSTENT /**/ /* HAS_GETPGRP * This symbol, if defined, indicates that the getpgrp() routine is @@ -439,8 +439,14 @@ * This symbol, if defined, indicates that the shmat() routine is * available to stat symbolic links. */ +/* VOID_SHMAT + * This symbol, if defined, indicates that the shmat() routine + * returns a pointer of type void*. + */ #define HAS_SHMAT /**/ +/*#undef VOIDSHMAT /**/ + /* HAS_SHMCTL * This symbol, if defined, indicates that the shmctl() routine is * available to stat symbolic links. @@ -537,8 +543,8 @@ * a signal handler using "TO_SIGNAL (*handler())()", and define the * handler using "TO_SIGNAL handler(sig)". */ -/*#undef VOIDSIG /**/ -#define TO_SIGNAL /**/ +#define VOIDSIG /**/ +#define TO_SIGNAL int /**/ /* HASVOLATILE * This symbol, if defined, indicates that this C compiler knows about @@ -557,8 +563,8 @@ * is up to the package author to declare vsprintf correctly based on the * symbol. */ -/*#undef HAS_VPRINTF /**/ -/*#undef CHARVSPRINTF /**/ +#define HAS_VPRINTF /**/ +#define CHARVSPRINTF /**/ /* HAS_WAIT4 * This symbol, if defined, indicates that wait4() exists. @@ -568,13 +574,19 @@ /* HAS_WAITPID * This symbol, if defined, indicates that waitpid() exists. */ -/*#undef HAS_WAITPID /**/ +#define HAS_WAITPID /**/ /* GIDTYPE * This symbol has a value like gid_t, int, ushort, or whatever type is * used to declare group ids in the kernel. */ -#define GIDTYPE int /**/ +#define GIDTYPE gid_t /**/ + +/* GROUPSTYPE + * This symbol has a value like gid_t, int, ushort, or whatever type is + * used in the return value of getgroups(). + */ +#define GROUPSTYPE int /**/ /* I_FCNTL * This manifest constant tells the C program to include . @@ -634,11 +646,11 @@ */ #define I_PWD /**/ /*#undef PWQUOTA /**/ -/*#undef PWAGE /**/ +#define PWAGE /**/ /*#undef PWCHANGE /**/ /*#undef PWCLASS /**/ /*#undef PWEXPIRE /**/ -/*#undef PWCOMMENT /**/ +#define PWCOMMENT /**/ /* I_SYS_FILE * This manifest constant tells the C program to include . @@ -673,7 +685,7 @@ * This symbol, if defined, indicates to the C program that it should * include utime.h. */ -/*#undef I_UTIME /**/ +#define I_UTIME /**/ /* I_VARARGS * This symbol, if defined, indicates to the C program that it should @@ -685,7 +697,7 @@ * This symbol, if defined, indicates to the C program that it should * include vfork.h. */ -/*#undef I_VFORK /**/ +#define I_VFORK /**/ /* INTSIZE * This symbol contains the size of an int, so that the C preprocessor @@ -725,6 +737,11 @@ /*#undef I_MY_DIR /**/ /*#undef DIRNAMLEN /**/ +/* MALLOCPTRTYPE + * This symbol defines the kind of ptr returned by malloc and realloc. + */ +#define MALLOCPTRTYPE char /**/ + /* RANDBITS * This symbol contains the number of bits of random number the rand() @@ -734,7 +751,7 @@ /* SCRIPTDIR * This symbol holds the name of the directory in which the user wants - * to put publicly executable scripts for the package in question. It + * to keep publicly executable scripts for the package in question. It * is often a directory that is mounted across diverse architectures. */ #define SCRIPTDIR "/usr/local/bin" /**/ @@ -742,13 +759,13 @@ /* SIG_NAME * This symbol contains an list of signal names in order. */ -#define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","IOT","EMT","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","URG","STOP","TSTP","CONT","CHLD","TTIN","TTOU","IO","XCPU","XFSZ","VTALRM","PROF","WINCH","LOST","USR1","USR2" /**/ +#define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","ABRT","EMT","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","URG","STOP","TSTP","CONT","CLD","TTIN","TTOU","IO","XCPU","XFSZ","VTALRM","PROF","WINCH","LOST","USR1","USR2" /**/ /* STDCHAR * This symbol is defined to be the type of char used in stdio.h. * It has the values "unsigned char" or "char". */ -#define STDCHAR char /**/ +#define STDCHAR unsigned char /**/ /* UIDTYPE * This symbol has a value like uid_t, int, ushort, or whatever type is @@ -788,9 +805,9 @@ * its value is "char *". */ #ifndef VOIDWANT -#define VOIDWANT 1 +#define VOIDWANT 7 #endif -#define VOIDHAVE 1 +#define VOIDHAVE 7 #if (VOIDHAVE & VOIDWANT) != VOIDWANT #define void int /* is void to be avoided? */ #define VOID diff --git a/config_h.SH b/config_h.SH index 57a0f1b..895703a 100644 --- a/config_h.SH +++ b/config_h.SH @@ -454,8 +454,14 @@ sed <config.h -e 's!^#undef!/\*#undef!' * This symbol, if defined, indicates that the shmat() routine is * available to stat symbolic links. */ +/* VOID_SHMAT + * This symbol, if defined, indicates that the shmat() routine + * returns a pointer of type void*. + */ #$d_shmat HAS_SHMAT /**/ +#$d_voidshmat VOIDSHMAT /**/ + /* HAS_SHMCTL * This symbol, if defined, indicates that the shmctl() routine is * available to stat symbolic links. @@ -760,7 +766,7 @@ sed <config.h -e 's!^#undef!/\*#undef!' /* SCRIPTDIR * This symbol holds the name of the directory in which the user wants - * to put publicly executable scripts for the package in question. It + * to keep publicly executable scripts for the package in question. It * is often a directory that is mounted across diverse architectures. */ #define SCRIPTDIR "$scriptdir" /**/ diff --git a/cons.c b/cons.c index c1d8f93..f8ff4a6 100644 --- a/cons.c +++ b/cons.c @@ -1,11 +1,15 @@ -/* $Header: cons.c,v 4.0 91/03/20 01:05:51 lwall Locked $ +/* $RCSfile: cons.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:31:15 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, Larry Wall * - * You may distribute under the terms of the GNU General Public License - * as specified in the README file that comes with the perl 3.0 kit. + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. * * $Log: cons.c,v $ + * Revision 4.0.1.1 91/06/07 10:31:15 lwall + * patch4: new copyright notice + * patch4: added global modifier for pattern matches + * * Revision 4.0 91/03/20 01:05:51 lwall * 4.0 baseline. * @@ -676,7 +680,9 @@ int acmd; arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) { if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) && (arg[2].arg_type & A_MASK) == A_SPAT && - arg[2].arg_ptr.arg_spat->spat_short ) { + arg[2].arg_ptr.arg_spat->spat_short && + (arg->arg_type == O_SUBST || arg->arg_type == O_NSUBST || + (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_GLOBAL) == 0 )) { cmd->c_stab = arg[1].arg_ptr.arg_stab; cmd->c_short = str_smake(arg[2].arg_ptr.arg_spat->spat_short); cmd->c_slen = arg[2].arg_ptr.arg_spat->spat_slen; diff --git a/consarg.c b/consarg.c index c606f8e..b338e6d 100644 --- a/consarg.c +++ b/consarg.c @@ -1,11 +1,15 @@ -/* $RCSfile: consarg.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:38:34 $ +/* $RCSfile: consarg.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 10:33:12 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, Larry Wall * - * You may distribute under the terms of the GNU General Public License - * as specified in the README file that comes with the perl 3.0 kit. + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. * * $Log: consarg.c,v $ + * Revision 4.0.1.2 91/06/07 10:33:12 lwall + * patch4: new copyright notice + * patch4: length($`), length($&), length($') now optimized to avoid string copy + * * Revision 4.0.1.1 91/04/11 17:38:34 lwall * patch1: fixed "Bad free" error * @@ -254,15 +258,15 @@ ARG *arg3; fprintf(stderr,")\n"); } #endif - evalstatic(arg); /* see if we can consolidate anything */ + arg = evalstatic(arg); /* see if we can consolidate anything */ return arg; } -void +ARG * evalstatic(arg) register ARG *arg; { - register STR *str; + static STR *str = Nullstr; register STR *s1; register STR *s2; double value; /* must not be register */ @@ -275,297 +279,347 @@ register ARG *arg; double sin(), cos(), atan2(), pow(); if (!arg || !arg->arg_len) - return; + return arg; - if ((arg[1].arg_type == A_SINGLE || arg->arg_type == O_AELEM) && - (arg->arg_len == 1 || arg[2].arg_type == A_SINGLE) ) { + if (!str) str = Str_new(20,0); + + if (arg[1].arg_type == A_SINGLE) s1 = arg[1].arg_ptr.arg_str; - if (arg->arg_len > 1) - s2 = arg[2].arg_ptr.arg_str; + else + s1 = Nullstr; + if (arg->arg_len >= 2 && arg[2].arg_type == A_SINGLE) + s2 = arg[2].arg_ptr.arg_str; + else + s2 = Nullstr; + +#define CHECK1 if (!s1) return arg +#define CHECK2 if (!s2) return arg +#define CHECK12 if (!s1 || !s2) return arg + + switch (arg->arg_type) { + default: + return arg; + case O_AELEM: + CHECK2; + i = (int)str_gnum(s2); + if (i < 32767 && i >= 0) { + arg->arg_type = O_ITEM; + arg->arg_len = 1; + arg[1].arg_type = A_ARYSTAB; /* $abc[123] is hoistable now */ + arg[1].arg_len = i; + str_free(s2); + Renew(arg, 2, ARG); + } + return arg; + case O_CONCAT: + CHECK12; + str_sset(str,s1); + str_scat(str,s2); + break; + case O_REPEAT: + CHECK12; + i = (int)str_gnum(s2); + tmps = str_get(s1); + str_nset(str,"",0); + STR_GROW(str, i * s1->str_cur + 1); + repeatcpy(str->str_ptr, tmps, s1->str_cur, i); + str->str_cur = i * s1->str_cur; + str->str_ptr[str->str_cur] = '\0'; + break; + case O_MULTIPLY: + CHECK12; + value = str_gnum(s1); + str_numset(str,value * str_gnum(s2)); + break; + case O_DIVIDE: + CHECK12; + value = str_gnum(s2); + if (value == 0.0) + yyerror("Illegal division by constant zero"); else - s2 = Nullstr; - switch (arg->arg_type) { - case O_AELEM: - i = (int)str_gnum(s2); - if (i < 32767 && i >= 0) { - arg->arg_type = O_ITEM; - arg->arg_len = 1; - arg[1].arg_type = A_ARYSTAB; /* $abc[123] is hoistable now */ - arg[1].arg_len = i; - str_free(s2); - arg[2].arg_type = A_NULL; - arg[2].arg_ptr.arg_str = Nullstr; - } - /* FALL THROUGH */ - default: - str_free(str); - str = Nullstr; /* can't be evaluated yet */ - break; - case O_CONCAT: - str_sset(str,s1); - str_scat(str,s2); - break; - case O_REPEAT: - i = (int)str_gnum(s2); - tmps = str_get(s1); - str_nset(str,"",0); - STR_GROW(str, i * s1->str_cur + 1); - repeatcpy(str->str_ptr, tmps, s1->str_cur, i); - str->str_cur = i * s1->str_cur; - str->str_ptr[str->str_cur] = '\0'; - break; - case O_MULTIPLY: - value = str_gnum(s1); - str_numset(str,value * str_gnum(s2)); - break; - case O_DIVIDE: - value = str_gnum(s2); - if (value == 0.0) - yyerror("Illegal division by constant zero"); - else #ifdef cray - /* insure that 20./5. == 4. */ - { - double x; - int k; - x = str_gnum(s1); - if ((double)(int)x == x && - (double)(int)value == value && - (k = (int)x/(int)value)*(int)value == (int)x) { - value = k; - } else { - value = x/value; - } - str_numset(str,value); + /* insure that 20./5. == 4. */ + { + double x; + int k; + x = str_gnum(s1); + if ((double)(int)x == x && + (double)(int)value == value && + (k = (int)x/(int)value)*(int)value == (int)x) { + value = k; + } else { + value = x/value; } + str_numset(str,value); + } #else - str_numset(str,str_gnum(s1) / value); + str_numset(str,str_gnum(s1) / value); #endif - break; - case O_MODULO: - tmplong = (unsigned long)str_gnum(s2); - if (tmplong == 0L) { - yyerror("Illegal modulus of constant zero"); - break; - } - tmp2 = (long)str_gnum(s1); + break; + case O_MODULO: + CHECK12; + tmplong = (unsigned long)str_gnum(s2); + if (tmplong == 0L) { + yyerror("Illegal modulus of constant zero"); + return arg; + } + tmp2 = (long)str_gnum(s1); #ifndef lint - if (tmp2 >= 0) - str_numset(str,(double)(tmp2 % tmplong)); - else - str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1)); + if (tmp2 >= 0) + str_numset(str,(double)(tmp2 % tmplong)); + else + str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1)); #else - tmp2 = tmp2; + tmp2 = tmp2; #endif - break; - case O_ADD: - value = str_gnum(s1); - str_numset(str,value + str_gnum(s2)); - break; - case O_SUBTRACT: - value = str_gnum(s1); - str_numset(str,value - str_gnum(s2)); - break; - case O_LEFT_SHIFT: - value = str_gnum(s1); - i = (int)str_gnum(s2); + break; + case O_ADD: + CHECK12; + value = str_gnum(s1); + str_numset(str,value + str_gnum(s2)); + break; + case O_SUBTRACT: + CHECK12; + value = str_gnum(s1); + str_numset(str,value - str_gnum(s2)); + break; + case O_LEFT_SHIFT: + CHECK12; + value = str_gnum(s1); + i = (int)str_gnum(s2); #ifndef lint - str_numset(str,(double)(((long)value) << i)); + str_numset(str,(double)(((long)value) << i)); #endif - break; - case O_RIGHT_SHIFT: - value = str_gnum(s1); - i = (int)str_gnum(s2); + break; + case O_RIGHT_SHIFT: + CHECK12; + value = str_gnum(s1); + i = (int)str_gnum(s2); #ifndef lint - str_numset(str,(double)(((long)value) >> i)); + str_numset(str,(double)(((long)value) >> i)); #endif - break; - case O_LT: - value = str_gnum(s1); - str_numset(str,(value < str_gnum(s2)) ? 1.0 : 0.0); - break; - case O_GT: - value = str_gnum(s1); - str_numset(str,(value > str_gnum(s2)) ? 1.0 : 0.0); - break; - case O_LE: - value = str_gnum(s1); - str_numset(str,(value <= str_gnum(s2)) ? 1.0 : 0.0); - break; - case O_GE: - value = str_gnum(s1); - str_numset(str,(value >= str_gnum(s2)) ? 1.0 : 0.0); - break; - case O_EQ: - if (dowarn) { - if ((!s1->str_nok && !looks_like_number(s1)) || - (!s2->str_nok && !looks_like_number(s2)) ) - warn("Possible use of == on string value"); - } - value = str_gnum(s1); - str_numset(str,(value == str_gnum(s2)) ? 1.0 : 0.0); - break; - case O_NE: - value = str_gnum(s1); - str_numset(str,(value != str_gnum(s2)) ? 1.0 : 0.0); - break; - case O_NCMP: - value = str_gnum(s1); - value -= str_gnum(s2); - if (value > 0.0) - value = 1.0; - else if (value < 0.0) - value = -1.0; - str_numset(str,value); - break; - case O_BIT_AND: - value = str_gnum(s1); + break; + case O_LT: + CHECK12; + value = str_gnum(s1); + str_numset(str,(value < str_gnum(s2)) ? 1.0 : 0.0); + break; + case O_GT: + CHECK12; + value = str_gnum(s1); + str_numset(str,(value > str_gnum(s2)) ? 1.0 : 0.0); + break; + case O_LE: + CHECK12; + value = str_gnum(s1); + str_numset(str,(value <= str_gnum(s2)) ? 1.0 : 0.0); + break; + case O_GE: + CHECK12; + value = str_gnum(s1); + str_numset(str,(value >= str_gnum(s2)) ? 1.0 : 0.0); + break; + case O_EQ: + CHECK12; + if (dowarn) { + if ((!s1->str_nok && !looks_like_number(s1)) || + (!s2->str_nok && !looks_like_number(s2)) ) + warn("Possible use of == on string value"); + } + value = str_gnum(s1); + str_numset(str,(value == str_gnum(s2)) ? 1.0 : 0.0); + break; + case O_NE: + CHECK12; + value = str_gnum(s1); + str_numset(str,(value != str_gnum(s2)) ? 1.0 : 0.0); + break; + case O_NCMP: + CHECK12; + value = str_gnum(s1); + value -= str_gnum(s2); + if (value > 0.0) + value = 1.0; + else if (value < 0.0) + value = -1.0; + str_numset(str,value); + break; + case O_BIT_AND: + CHECK12; + value = str_gnum(s1); #ifndef lint - str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2)))); + str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2)))); #endif - break; - case O_XOR: - value = str_gnum(s1); + break; + case O_XOR: + CHECK12; + value = str_gnum(s1); #ifndef lint - str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2)))); + str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2)))); #endif - break; - case O_BIT_OR: - value = str_gnum(s1); + break; + case O_BIT_OR: + CHECK12; + value = str_gnum(s1); #ifndef lint - str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2)))); + str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2)))); #endif - break; - case O_AND: - if (str_true(s1)) - str_sset(str,s2); - else - str_sset(str,s1); - break; - case O_OR: - if (str_true(s1)) - str_sset(str,s1); - else - str_sset(str,s2); - break; - case O_COND_EXPR: - if ((arg[3].arg_type & A_MASK) != A_SINGLE) { - str_free(str); - str = Nullstr; - } - else { - if (str_true(s1)) - str_sset(str,s2); - else - str_sset(str,arg[3].arg_ptr.arg_str); - str_free(arg[3].arg_ptr.arg_str); - arg[3].arg_ptr.arg_str = Nullstr; - } - break; - case O_NEGATE: - str_numset(str,(double)(-str_gnum(s1))); - break; - case O_NOT: - str_numset(str,(double)(!str_true(s1))); - break; - case O_COMPLEMENT: + break; + case O_AND: + CHECK12; + if (str_true(s1)) + str_sset(str,s2); + else + str_sset(str,s1); + break; + case O_OR: + CHECK12; + if (str_true(s1)) + str_sset(str,s1); + else + str_sset(str,s2); + break; + case O_COND_EXPR: + CHECK12; + if ((arg[3].arg_type & A_MASK) != A_SINGLE) + return arg; + if (str_true(s1)) + str_sset(str,s2); + else + str_sset(str,arg[3].arg_ptr.arg_str); + str_free(arg[3].arg_ptr.arg_str); + Renew(arg, 3, ARG); + break; + case O_NEGATE: + CHECK1; + str_numset(str,(double)(-str_gnum(s1))); + break; + case O_NOT: + CHECK1; + str_numset(str,(double)(!str_true(s1))); + break; + case O_COMPLEMENT: + CHECK1; #ifndef lint - str_numset(str,(double)(~U_L(str_gnum(s1)))); + str_numset(str,(double)(~U_L(str_gnum(s1)))); #endif - break; - case O_SIN: - str_numset(str,sin(str_gnum(s1))); - break; - case O_COS: - str_numset(str,cos(str_gnum(s1))); - break; - case O_ATAN2: - value = str_gnum(s1); - str_numset(str,atan2(value, str_gnum(s2))); - break; - case O_POW: - value = str_gnum(s1); - str_numset(str,pow(value, str_gnum(s2))); - break; - case O_LENGTH: - str_numset(str, (double)str_len(s1)); - break; - case O_SLT: - str_numset(str,(double)(str_cmp(s1,s2) < 0)); - break; - case O_SGT: - str_numset(str,(double)(str_cmp(s1,s2) > 0)); - break; - case O_SLE: - str_numset(str,(double)(str_cmp(s1,s2) <= 0)); - break; - case O_SGE: - str_numset(str,(double)(str_cmp(s1,s2) >= 0)); - break; - case O_SEQ: - str_numset(str,(double)(str_eq(s1,s2))); - break; - case O_SNE: - str_numset(str,(double)(!str_eq(s1,s2))); - break; - case O_SCMP: - str_numset(str,(double)(str_cmp(s1,s2))); - break; - case O_CRYPT: + break; + case O_SIN: + CHECK1; + str_numset(str,sin(str_gnum(s1))); + break; + case O_COS: + CHECK1; + str_numset(str,cos(str_gnum(s1))); + break; + case O_ATAN2: + CHECK12; + value = str_gnum(s1); + str_numset(str,atan2(value, str_gnum(s2))); + break; + case O_POW: + CHECK12; + value = str_gnum(s1); + str_numset(str,pow(value, str_gnum(s2))); + break; + case O_LENGTH: + if (arg[1].arg_type == A_STAB) { + arg->arg_type = O_ITEM; + arg[1].arg_type = A_LENSTAB; + return arg; + } + CHECK1; + str_numset(str, (double)str_len(s1)); + break; + case O_SLT: + CHECK12; + str_numset(str,(double)(str_cmp(s1,s2) < 0)); + break; + case O_SGT: + CHECK12; + str_numset(str,(double)(str_cmp(s1,s2) > 0)); + break; + case O_SLE: + CHECK12; + str_numset(str,(double)(str_cmp(s1,s2) <= 0)); + break; + case O_SGE: + CHECK12; + str_numset(str,(double)(str_cmp(s1,s2) >= 0)); + break; + case O_SEQ: + CHECK12; + str_numset(str,(double)(str_eq(s1,s2))); + break; + case O_SNE: + CHECK12; + str_numset(str,(double)(!str_eq(s1,s2))); + break; + case O_SCMP: + CHECK12; + str_numset(str,(double)(str_cmp(s1,s2))); + break; + case O_CRYPT: + CHECK12; #ifdef HAS_CRYPT - tmps = str_get(s1); - str_set(str,crypt(tmps,str_get(s2))); + tmps = str_get(s1); + str_set(str,crypt(tmps,str_get(s2))); #else - yyerror( - "The crypt() function is unimplemented due to excessive paranoia."); + yyerror( + "The crypt() function is unimplemented due to excessive paranoia."); #endif - break; - case O_EXP: - str_numset(str,exp(str_gnum(s1))); - break; - case O_LOG: - str_numset(str,log(str_gnum(s1))); - break; - case O_SQRT: - str_numset(str,sqrt(str_gnum(s1))); - break; - case O_INT: - value = str_gnum(s1); - if (value >= 0.0) - (void)modf(value,&value); - else { - (void)modf(-value,&value); - value = -value; - } - str_numset(str,value); - break; - case O_ORD: + break; + case O_EXP: + CHECK1; + str_numset(str,exp(str_gnum(s1))); + break; + case O_LOG: + CHECK1; + str_numset(str,log(str_gnum(s1))); + break; + case O_SQRT: + CHECK1; + str_numset(str,sqrt(str_gnum(s1))); + break; + case O_INT: + CHECK1; + value = str_gnum(s1); + if (value >= 0.0) + (void)modf(value,&value); + else { + (void)modf(-value,&value); + value = -value; + } + str_numset(str,value); + break; + case O_ORD: + CHECK1; #ifndef I286 - str_numset(str,(double)(*str_get(s1))); + str_numset(str,(double)(*str_get(s1))); #else - { - int zapc; - char *zaps; + { + int zapc; + char *zaps; - zaps = str_get(s1); - zapc = (int) *zaps; - str_numset(str,(double)(zapc)); - } -#endif - break; - } - if (str) { - arg->arg_type = O_ITEM; /* note arg1 type is already SINGLE */ - str_free(s1); - arg[1].arg_ptr.arg_str = str; - if (s2) { - str_free(s2); - arg[2].arg_ptr.arg_str = Nullstr; - arg[2].arg_type = A_NULL; - } + zaps = str_get(s1); + zapc = (int) *zaps; + str_numset(str,(double)(zapc)); } +#endif + break; + } + arg->arg_type = O_ITEM; /* note arg1 type is already SINGLE */ + str_free(s1); + arg[1].arg_ptr.arg_str = str; + if (s2) { + str_free(s2); + arg[2].arg_ptr.arg_str = Nullstr; + arg[2].arg_type = A_NULL; } + str = Nullstr; + + return arg; } ARG * diff --git a/hints/aix_rs.sh b/hints/aix_rs.sh index 5b67dab..8f31a03 100644 --- a/hints/aix_rs.sh +++ b/hints/aix_rs.sh @@ -1 +1,4 @@ -optimize='-g' +eval_cflags='optimize="-g"' +toke_cflags='optimize="-g"' +teval_cflags='optimize="-g"' +ttoke_cflags='optimize="-g"'; cflags="$cflags -D_NO_PROTO" diff --git a/hints/apollo_C6_7.sh b/hints/apollo_C6_7.sh index f85b4d2..fd9f44e 100644 --- a/hints/apollo_C6_7.sh +++ b/hints/apollo_C6_7.sh @@ -1 +1,4 @@ optimize='-opt 2' +cflags='-A nansi cpu,mathchip -O -U__STDC__' +echo "Some tests may fail unless you use 'chacl -B'. Also, op/stat" +echo "test 2 may fail because Apollo doesn't support mtime or ctime." diff --git a/hints/aux.sh b/hints/aux.sh index f34ed62..0f46f3e 100644 --- a/hints/aux.sh +++ b/hints/aux.sh @@ -1,2 +1,2 @@ optimize='-O' -ccflags="$ccflags -B/usr/lib/bin/' +ccflags="$ccflags -B/usr/lib/big/ -DPARAM_NEEDS_TYPES" diff --git a/msdos/chdir.c b/msdos/chdir.c index 6954f98..b650eb0 100644 --- a/msdos/chdir.c +++ b/msdos/chdir.c @@ -1,8 +1,8 @@ /* * (C) Copyright 1990, 1991 Tom Dinger * - * You may distribute under the terms of the GNU General Public License - * as specified in the README file that comes with the perl 4.0 kit. + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. * */ diff --git a/msdos/config.h b/msdos/config.h index f6998ea..d030c58 100644 --- a/msdos/config.h +++ b/msdos/config.h @@ -43,7 +43,7 @@ /* BIN * This symbol holds the name of the directory in which the user wants - * to put publicly executable images for the package in question. It + * to keep publicly executable images for the package in question. It * is most often a local directory such as /usr/local/bin. */ #define BIN "/usr/local/bin" /**/ @@ -590,11 +590,23 @@ */ #define GIDTYPE int /**/ +/* GROUPSTYPE + * This symbol has a value like gid_t, int, ushort, or whatever type is + * used in the return value of getgroups(). + */ +#define GROUPSTYPE int /**/ + /* I_FCNTL * This manifest constant tells the C program to include . */ #define I_FCNTL /**/ +/* I_GDBM + * This symbol, if defined, indicates that gdbm.h exists and should + * be included. + */ +/*#undef I_GDBM /**/ + /* I_GRP * This symbol, if defined, indicates to the C program that it should * include grp.h. @@ -733,6 +745,10 @@ /*#undef I_MY_DIR /**/ /*#undef DIRNAMLEN /**/ +/* MALLOCPTRTYPE + * This symbol defines the kind of ptr returned by malloc and realloc. + */ +#define MALLOCPTRTYPE void /**/ /* RANDBITS * This symbol contains the number of bits of random number the rand() diff --git a/patchlevel.h b/patchlevel.h index 82d4f62..51d80f3 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1 +1 @@ -#define PATCHLEVEL 4 +#define PATCHLEVEL 5 diff --git a/t/TEST b/t/TEST index 9885b75..abfa65a 100644 --- a/t/TEST +++ b/t/TEST @@ -1,6 +1,6 @@ #!./perl -# $Header: TEST,v 4.0 91/03/20 01:40:22 lwall Locked $ +# $RCSfile: TEST,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:59:30 $ # This is written in a peculiar style, since we're trying to avoid # most of the constructs we'll be testing for. @@ -56,6 +56,8 @@ while ($test = shift) { unless (/^#/) { if (/^1\.\.([0-9]+)/) { $max = $1; + $totmax += $max; + $files += 1; $next = 1; $ok = 1; } else { @@ -96,4 +98,5 @@ if ($bad == 0) { } } ($user,$sys,$cuser,$csys) = times; -print sprintf("u=%g s=%g cu=%g cs=%g\n",$user,$sys,$cuser,$csys); +print sprintf("u=%g s=%g cu=%g cs=%g files=%d tests=%d\n", + $user,$sys,$cuser,$csys,$files,$totmax); diff --git a/x2p/a2p.h b/x2p/a2p.h index 7b6f0d4..3e15b37 100644 --- a/x2p/a2p.h +++ b/x2p/a2p.h @@ -1,11 +1,14 @@ -/* $Header: a2p.h,v 4.0 91/03/20 01:57:07 lwall Locked $ +/* $RCSfile: a2p.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:12:27 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, Larry Wall * - * You may distribute under the terms of the GNU General Public License - * as specified in the README file that comes with the perl 3.0 kit. + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. * * $Log: a2p.h,v $ + * Revision 4.0.1.1 91/06/07 12:12:27 lwall + * patch4: new copyright notice + * * Revision 4.0 91/03/20 01:57:07 lwall * 4.0 baseline. * diff --git a/x2p/a2p.y b/x2p/a2p.y index 8b3dc8b..84026dd 100644 --- a/x2p/a2p.y +++ b/x2p/a2p.y @@ -1,12 +1,15 @@ %{ -/* $Header: a2p.y,v 4.0 91/03/20 01:57:21 lwall Locked $ +/* $RCSfile: a2p.y,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:12:41 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, Larry Wall * - * You may distribute under the terms of the GNU General Public License - * as specified in the README file that comes with the perl 3.0 kit. + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. * * $Log: a2p.y,v $ + * Revision 4.0.1.1 91/06/07 12:12:41 lwall + * patch4: new copyright notice + * * Revision 4.0 91/03/20 01:57:21 lwall * 4.0 baseline. * diff --git a/x2p/a2py.c b/x2p/a2py.c index bfdf6f0..b2ac121 100644 --- a/x2p/a2py.c +++ b/x2p/a2py.c @@ -1,11 +1,14 @@ -/* $Header: a2py.c,v 4.0 91/03/20 01:57:26 lwall Locked $ +/* $RCSfile: a2py.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:12:59 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, Larry Wall * - * You may distribute under the terms of the GNU General Public License - * as specified in the README file that comes with the perl 3.0 kit. + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. * * $Log: a2py.c,v $ + * Revision 4.0.1.1 91/06/07 12:12:59 lwall + * patch4: new copyright notice + * * Revision 4.0 91/03/20 01:57:26 lwall * 4.0 baseline. * diff --git a/x2p/cflags.SH b/x2p/cflags.SH new file mode 100644 index 0000000..2f78e2c --- /dev/null +++ b/x2p/cflags.SH @@ -0,0 +1,84 @@ +case $CONFIG in +'') + if test ! -f config.sh; then + ln ../config.sh . || \ + ln ../../config.sh . || \ + ln ../../../config.sh . || \ + (echo "Can't find config.sh."; exit 1) + fi + . config.sh + ;; +esac +: This forces SH files to create target in same directory as SH file. +: This is so that make depend always knows where to find SH derivatives. +case "$0" in +*/*) cd `expr X$0 : 'X\(.*\)/'` ;; +esac +echo "Extracting cflags (with variable substitutions)" +: This section of the file will have variable substitutions done on it. +: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. +: Protect any dollar signs and backticks that you do not want interpreted +: by putting a backslash in front. You may delete these comments. +$spitshell >cflags <>cflags <<'!NO!SUBS!' +case "$0" in +*/*) cd `expr X$0 : 'X\(.*\)/'` ;; +esac +case $CONFIG in +'') + if test ! -f config.sh; then + ln ../config.sh . || \ + ln ../../config.sh . || \ + ln ../../../config.sh . || \ + (echo "Can't find config.sh."; exit 1) + fi 2>/dev/null + . ./config.sh + ;; +esac + +also=': ' +case $# in +1) also='echo 1>&2 " CCCMD = "' +esac + +case $# in +0) set *.c; echo "The current C flags are:" ;; +esac + +set `echo "$* " | sed 's/\.[oc] / /g'` + +for file do + + case "$#" in + 1) ;; + *) echo $n " $file.c $c" ;; + esac + + : allow variables like str_cflags to be evaluated + + eval 'eval ${'"${file}_cflags"'-""}' + + : or customize here + + case "$file" in + a2p) ;; + a2py) ;; + hash) ;; + str) ;; + util) ;; + walk) ;; + *) ;; + esac + + echo "$cc -c $ccflags $optimize $large $split" + eval "$also "'"$cc -c $ccflags $optimize $large $split"' + + . ./config.sh + +done +!NO!SUBS! +chmod +x cflags +$eunicefix cflags