See patch #4.
-/* $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.
*
#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
#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 */
"STAR",
"LSTAR",
"WANTARRAY",
- "21"
+ "LENSTAB",
+ "22"
};
#endif
1, /* STAR */
1, /* LSTAR */
1, /* WANTARRAY */
+ 0, /* LENSTAB */
0, /* 21 */
};
#endif
-/* $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.
*
-/* $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.
*
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 <<!GROK!THIS!
+!GROK!THIS!
+
+: In the following dollars and backticks do not need the extra backslash.
+$spitshell >>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
-/* $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
*
/* do longjmps() clobber register variables? */
-#if defined(cray) || defined(__STDC__)
+#if defined(cray) || defined(STANDARD_C)
#define JMPCLOBBER
#endif
-/* $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.
*
};
void opt_arg();
-void evalstatic();
+ARG* evalstatic();
int cmd_exec();
* 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
* 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
* 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
* 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
* 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
* 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.
* 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
* 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.
/* 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 <fcntl.h>.
*/
#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 <sys/file.h>.
* 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
* 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
/*#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()
/* 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" /**/
/* 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
* 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
* 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.
/* 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" /**/
-/* $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.
*
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;
-/* $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
*
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 */
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 *
-optimize='-g'
+eval_cflags='optimize="-g"'
+toke_cflags='optimize="-g"'
+teval_cflags='optimize="-g"'
+ttoke_cflags='optimize="-g"'; cflags="$cflags -D_NO_PROTO"
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."
optimize='-O'
-ccflags="$ccflags -B/usr/lib/bin/'
+ccflags="$ccflags -B/usr/lib/big/ -DPARAM_NEEDS_TYPES"
/*
* (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.
*
*/
/* 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" /**/
*/
#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 <fcntl.h>.
*/
#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.
/*#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()
-#define PATCHLEVEL 4
+#define PATCHLEVEL 5
#!./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.
unless (/^#/) {
if (/^1\.\.([0-9]+)/) {
$max = $1;
+ $totmax += $max;
+ $files += 1;
$next = 1;
$ok = 1;
} else {
}
}
($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);
-/* $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.
*
%{
-/* $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.
*
-/* $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.
*
--- /dev/null
+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 <<!GROK!THIS!
+!GROK!THIS!
+
+: In the following dollars and backticks do not need the extra backslash.
+$spitshell >>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
projects / p5sagit/p5-mst-13.2.git / commitdiff