v20i057: perl - The perl programming language, Patch05
Larry Wall
lwall at netlabs.com
Thu Jun 20 13:04:23 AEST 1991
Submitted-by: Larry Wall <lwall at netlabs.com>
Posting-number: Volume 20, Issue 57
Archive-name: perl/patch05
Patch-To: perl: Volume 18, Issue 19-54
System: perl version 4.0
Patch #: 5
Priority: High
Subject: patch #4, continued
Description:
See patch #4.
Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source
directory. Outside of rn, say "cd DIR; patch -p -N <thisarticle".
If you don't have the patch program, apply the following by hand,
or get patch (version 2.0, latest patchlevel).
After patching:
*** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #09 FIRST ***
If patch indicates that patchlevel is the wrong version, you may need
to apply one or more previous patches, or the patch may already
have been applied. See the patchlevel.h file to find out what has or
has not been applied. In any event, don't continue with the patch.
If you are missing previous patches they can be obtained from me:
Larry Wall
lwall at netlabs.com
If you send a mail message of the following form it will greatly speed
processing:
Subject: Command
@SH mailpatch PATH perl 4.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.
Index: patchlevel.h
Prereq: 4
1c1
< #define PATCHLEVEL 4
---
> #define PATCHLEVEL 5
Index: t/TEST
Prereq: 4.0
*** t/TEST.old Fri Jun 7 12:27:03 1991
--- t/TEST Fri Jun 7 12:27:03 1991
***************
*** 1,6 ****
#!./perl
! # $Header: TEST,v 4.0 91/03/20 01:40:22 lwall Locked $
# This is written in a peculiar style, since we're trying to avoid
# most of the constructs we'll be testing for.
--- 1,6 ----
#!./perl
! # $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,61 ****
--- 56,63 ----
unless (/^#/) {
if (/^1\.\.([0-9]+)/) {
$max = $1;
+ $totmax += $max;
+ $files += 1;
$next = 1;
$ok = 1;
} else {
***************
*** 96,99 ****
}
}
($user,$sys,$cuser,$csys) = times;
! print sprintf("u=%g s=%g cu=%g cs=%g\n",$user,$sys,$cuser,$csys);
--- 98,102 ----
}
}
($user,$sys,$cuser,$csys) = times;
! print sprintf("u=%g s=%g cu=%g cs=%g files=%d tests=%d\n",
! $user,$sys,$cuser,$csys,$files,$totmax);
Index: x2p/a2p.h
Prereq: 4.0
*** x2p/a2p.h.old Fri Jun 7 12:27:43 1991
--- x2p/a2p.h Fri Jun 7 12:27:44 1991
***************
*** 1,11 ****
! /* $Header: a2p.h,v 4.0 91/03/20 01:57:07 lwall Locked $
*
! * Copyright (c) 1989, 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.
*
* $Log: a2p.h,v $
* Revision 4.0 91/03/20 01:57:07 lwall
* 4.0 baseline.
*
--- 1,14 ----
! /* $RCSfile: a2p.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:12:27 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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.
*
Index: x2p/a2p.y
Prereq: 4.0
*** x2p/a2p.y.old Fri Jun 7 12:27:47 1991
--- x2p/a2p.y Fri Jun 7 12:27:47 1991
***************
*** 1,12 ****
%{
! /* $Header: a2p.y,v 4.0 91/03/20 01:57:21 lwall Locked $
*
! * Copyright (c) 1989, 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.
*
* $Log: a2p.y,v $
* Revision 4.0 91/03/20 01:57:21 lwall
* 4.0 baseline.
*
--- 1,15 ----
%{
! /* $RCSfile: a2p.y,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:12:41 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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.
*
Index: x2p/a2py.c
Prereq: 4.0
*** x2p/a2py.c.old Fri Jun 7 12:27:50 1991
--- x2p/a2py.c Fri Jun 7 12:27:51 1991
***************
*** 1,11 ****
! /* $Header: a2py.c,v 4.0 91/03/20 01:57:26 lwall Locked $
*
! * Copyright (c) 1989, 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.
*
* $Log: a2py.c,v $
* Revision 4.0 91/03/20 01:57:26 lwall
* 4.0 baseline.
*
--- 1,14 ----
! /* $RCSfile: a2py.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:12:59 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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.
*
Index: hints/aix_rs.sh
*** hints/aix_rs.sh.old Fri Jun 7 12:24:20 1991
--- hints/aix_rs.sh Fri Jun 7 12:24:20 1991
***************
*** 1 ****
! optimize='-g'
--- 1,4 ----
! eval_cflags='optimize="-g"'
! toke_cflags='optimize="-g"'
! teval_cflags='optimize="-g"'
! ttoke_cflags='optimize="-g"'; cflags="$cflags -D_NO_PROTO"
Index: hints/apollo_C6_7.sh
*** hints/apollo_C6_7.sh.old Fri Jun 7 12:24:22 1991
--- hints/apollo_C6_7.sh Fri Jun 7 12:24:23 1991
***************
*** 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."
Index: arg.h
Prereq: 4.0
*** arg.h.old Fri Jun 7 12:22:41 1991
--- arg.h Fri Jun 7 12:22:42 1991
***************
*** 1,11 ****
! /* $Header: arg.h,v 4.0 91/03/20 01:03:09 lwall Locked $
*
! * Copyright (c) 1989, 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.
*
* $Log: arg.h,v $
* Revision 4.0 91/03/20 01:03:09 lwall
* 4.0 baseline.
*
--- 1,16 ----
! /* $RCSfile: arg.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:18:30 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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,276 ****
#define O_SGRENT 256
#define O_EGRENT 257
#define O_GETLOGIN 258
! #define O_OPENDIR 259
#define O_READDIR 260
#define O_TELLDIR 261
#define O_SEEKDIR 262
--- 275,281 ----
#define O_SGRENT 256
#define O_EGRENT 257
#define O_GETLOGIN 258
! #define O_OPEN_DIR 259
#define O_READDIR 260
#define O_TELLDIR 261
#define O_SEEKDIR 262
***************
*** 576,581 ****
--- 581,587 ----
#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,611 ****
"STAR",
"LSTAR",
"WANTARRAY",
! "21"
};
#endif
--- 611,618 ----
"STAR",
"LSTAR",
"WANTARRAY",
! "LENSTAB",
! "22"
};
#endif
***************
*** 634,639 ****
--- 641,647 ----
1, /* STAR */
1, /* LSTAR */
1, /* WANTARRAY */
+ 0, /* LENSTAB */
0, /* 21 */
};
#endif
Index: array.c
Prereq: 4.0
*** array.c.old Fri Jun 7 12:22:44 1991
--- array.c Fri Jun 7 12:22:45 1991
***************
*** 1,11 ****
! /* $Header: array.c,v 4.0 91/03/20 01:03:32 lwall Locked $
*
! * Copyright (c) 1989, 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.
*
* $Log: array.c,v $
* Revision 4.0 91/03/20 01:03:32 lwall
* 4.0 baseline.
*
--- 1,14 ----
! /* $RCSfile: array.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:19:08 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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.
*
Index: array.h
Prereq: 4.0
*** array.h.old Fri Jun 7 12:22:47 1991
--- array.h Fri Jun 7 12:22:48 1991
***************
*** 1,11 ****
! /* $Header: array.h,v 4.0 91/03/20 01:03:44 lwall Locked $
*
! * Copyright (c) 1989, 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.
*
* $Log: array.h,v $
* Revision 4.0 91/03/20 01:03:44 lwall
* 4.0 baseline.
*
--- 1,14 ----
! /* $RCSfile: array.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:19:20 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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.
*
Index: hints/aux.sh
*** hints/aux.sh.old Fri Jun 7 12:24:25 1991
--- hints/aux.sh Fri Jun 7 12:24:26 1991
***************
*** 1,2 ****
optimize='-O'
! ccflags="$ccflags -B/usr/lib/bin/'
--- 1,2 ----
optimize='-O'
! ccflags="$ccflags -B/usr/lib/big/ -DPARAM_NEEDS_TYPES"
Index: cflags.SH
*** cflags.SH.old Fri Jun 7 12:22:50 1991
--- cflags.SH Fri Jun 7 12:22:50 1991
***************
*** 5,80 ****
ln ../../config.sh . || \
ln ../../../config.sh . || \
(echo "Can't find config.sh."; exit 1)
! fi 2>/dev/null
! . ./config.sh
;;
esac
case "$0" in
*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
esac
also=': '
case $# in
! 1) also='echo 1>&2 " CFLAGS = "'
esac
case $# in
0) set *.c; echo "The current C flags are:" ;;
- *) set `echo "$* " | sed 's/\.o /.c /g'`
esac
for file do
case "$#" in
1) ;;
! *) echo $n " $file $c" ;;
esac
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) ;;
*) ;;
esac
! echo "$ccflags $optimize $large $split"
! eval "$also $ccflags $optimize $large $split"
done
--- 5,120 ----
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 toke_cflags to be evaluated
+
+ eval 'eval ${'"${file}_cflags"'-""}'
+
+ : or customize here
+
case "$file" in
! 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 "$cc -c $ccflags $optimize $large $split"
! eval "$also "'"$cc -c $ccflags $optimize $large $split"'
!
! . ./config.sh
!
done
+ !NO!SUBS!
+ chmod +x cflags
+ $eunicefix cflags
Index: x2p/cflags.SH
*** x2p/cflags.SH.old Fri Jun 7 12:27:53 1991
--- x2p/cflags.SH Fri Jun 7 12:27:54 1991
***************
*** 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 <<!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
Index: msdos/chdir.c
*** msdos/chdir.c.old Fri Jun 7 12:25:32 1991
--- msdos/chdir.c Fri Jun 7 12:25:33 1991
***************
*** 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.
*
*/
--- 1,8 ----
/*
* (C) Copyright 1990, 1991 Tom Dinger
*
! * You may distribute under the terms of either the GNU General Public
! * License or the Artistic License, as specified in the README file.
*
*/
Index: cmd.c
*** cmd.c.old Fri Jun 7 12:22:53 1991
--- cmd.c Fri Jun 7 12:22:55 1991
***************
*** 1,11 ****
! /* $RCSfile: cmd.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:36:16 $
*
! * Copyright (c) 1989, 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.
*
* $Log: cmd.c,v $
* Revision 4.0.1.1 91/04/11 17:36:16 lwall
* patch1: you may now use "die" and "caller" in a signal handler
*
--- 1,15 ----
! /* $RCSfile: cmd.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 10:26:45 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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,33 ****
/* do longjmps() clobber register variables? */
! #if defined(cray) || defined(__STDC__)
#define JMPCLOBBER
#endif
--- 31,37 ----
/* do longjmps() clobber register variables? */
! #if defined(cray) || defined(STANDARD_C)
#define JMPCLOBBER
#endif
Index: cmd.h
Prereq: 4.0
*** cmd.h.old Fri Jun 7 12:22:58 1991
--- cmd.h Fri Jun 7 12:22:59 1991
***************
*** 1,11 ****
! /* $Header: cmd.h,v 4.0 91/03/20 01:04:34 lwall Locked $
*
! * Copyright (c) 1989, 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.
*
* $Log: cmd.h,v $
* Revision 4.0 91/03/20 01:04:34 lwall
* 4.0 baseline.
*
--- 1,15 ----
! /* $RCSfile: cmd.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:28:50 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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,165 ****
};
void opt_arg();
! void evalstatic();
int cmd_exec();
--- 165,169 ----
};
void opt_arg();
! ARG* evalstatic();
int cmd_exec();
Index: config.H
*** config.H.old Fri Jun 7 12:23:01 1991
--- config.H Fri Jun 7 12:23:02 1991
***************
*** 29,35 ****
* This symbol contains the number of bytes required to align a double.
* Usual values are 2, 4, and 8.
*/
! #define ALIGNBYTES 4 /**/
/* BIN
* This symbol holds the name of the directory in which the user wants
--- 29,35 ----
* This symbol contains the number of bytes required to align a double.
* Usual values are 2, 4, and 8.
*/
! #define ALIGNBYTES 2 /**/
/* BIN
* This symbol holds the name of the directory in which the user wants
***************
*** 42,48 ****
* 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 /**/
/* CPPSTDIN
* This symbol contains the first part of the string which will invoke
--- 42,48 ----
* This symbol contains an encoding of the order of bytes in a long.
* Usual values (in octal) are 01234, 04321, 02143, 03412...
*/
! #define BYTEORDER 0x4321 /**/
/* CPPSTDIN
* This symbol contains the first part of the string which will invoke
***************
*** 55,62 ****
* 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 "-"
/* HAS_BCMP
* This symbol, if defined, indicates that the bcmp routine is available
--- 55,62 ----
* output. This symbol will have the value "-" if CPPSTDIN needs a minus
* to specify standard input, otherwise the value is "".
*/
! #define CPPSTDIN "/usr/lib/cpp"
! #define CPPMINUS ""
/* HAS_BCMP
* This symbol, if defined, indicates that the bcmp routine is available
***************
*** 89,96 ****
* 1 = couldn't cast < 0
* 2 = couldn't cast >= 0x80000000
*/
! #define CASTNEGFLOAT /**/
! #define CASTFLAGS 0 /**/
/* CHARSPRINTF
* This symbol is defined if this system declares "char *sprintf()" in
--- 89,96 ----
* 1 = couldn't cast < 0
* 2 = couldn't cast >= 0x80000000
*/
! /*#undef CASTNEGFLOAT /**/
! #define CASTFLAGS 1 /**/
/* CHARSPRINTF
* This symbol is defined if this system declares "char *sprintf()" in
***************
*** 180,186 ****
* This symbol, if defined, indicates that the gethostent() routine is
* available to lookup host names in some data base or other.
*/
! #define HAS_GETHOSTENT /**/
/* HAS_GETPGRP
* This symbol, if defined, indicates that the getpgrp() routine is
--- 180,186 ----
* This symbol, if defined, indicates that the gethostent() routine is
* available to lookup host names in some data base or other.
*/
! /*#undef HAS_GETHOSTENT /**/
/* HAS_GETPGRP
* This symbol, if defined, indicates that the getpgrp() routine is
***************
*** 439,446 ****
--- 439,452 ----
* 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,544 ****
* a signal handler using "TO_SIGNAL (*handler())()", and define the
* handler using "TO_SIGNAL handler(sig)".
*/
! /*#undef VOIDSIG /**/
! #define TO_SIGNAL /**/
/* HASVOLATILE
* This symbol, if defined, indicates that this C compiler knows about
--- 543,550 ----
* a signal handler using "TO_SIGNAL (*handler())()", and define the
* handler using "TO_SIGNAL handler(sig)".
*/
! #define VOIDSIG /**/
! #define TO_SIGNAL int /**/
/* HASVOLATILE
* This symbol, if defined, indicates that this C compiler knows about
***************
*** 557,564 ****
* is up to the package author to declare vsprintf correctly based on the
* symbol.
*/
! /*#undef HAS_VPRINTF /**/
! /*#undef CHARVSPRINTF /**/
/* HAS_WAIT4
* This symbol, if defined, indicates that wait4() exists.
--- 563,570 ----
* is up to the package author to declare vsprintf correctly based on the
* symbol.
*/
! #define HAS_VPRINTF /**/
! #define CHARVSPRINTF /**/
/* HAS_WAIT4
* This symbol, if defined, indicates that wait4() exists.
***************
*** 568,581 ****
/* HAS_WAITPID
* This symbol, if defined, indicates that waitpid() exists.
*/
! /*#undef 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 /**/
/* I_FCNTL
* This manifest constant tells the C program to include <fcntl.h>.
*/
--- 574,593 ----
/* HAS_WAITPID
* This symbol, if defined, indicates that waitpid() exists.
*/
! #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 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>.
*/
***************
*** 634,644 ****
*/
#define I_PWD /**/
/*#undef PWQUOTA /**/
! /*#undef PWAGE /**/
/*#undef PWCHANGE /**/
/*#undef PWCLASS /**/
/*#undef PWEXPIRE /**/
! /*#undef PWCOMMENT /**/
/* I_SYS_FILE
* This manifest constant tells the C program to include <sys/file.h>.
--- 646,656 ----
*/
#define I_PWD /**/
/*#undef PWQUOTA /**/
! #define PWAGE /**/
/*#undef PWCHANGE /**/
/*#undef PWCLASS /**/
/*#undef PWEXPIRE /**/
! #define PWCOMMENT /**/
/* I_SYS_FILE
* This manifest constant tells the C program to include <sys/file.h>.
***************
*** 673,679 ****
* This symbol, if defined, indicates to the C program that it should
* include utime.h.
*/
! /*#undef I_UTIME /**/
/* I_VARARGS
* This symbol, if defined, indicates to the C program that it should
--- 685,691 ----
* This symbol, if defined, indicates to the C program that it should
* include utime.h.
*/
! #define I_UTIME /**/
/* I_VARARGS
* This symbol, if defined, indicates to the C program that it should
***************
*** 685,691 ****
* This symbol, if defined, indicates to the C program that it should
* include vfork.h.
*/
! /*#undef I_VFORK /**/
/* INTSIZE
* This symbol contains the size of an int, so that the C preprocessor
--- 697,703 ----
* This symbol, if defined, indicates to the C program that it should
* include vfork.h.
*/
! #define I_VFORK /**/
/* INTSIZE
* This symbol contains the size of an int, so that the C preprocessor
***************
*** 725,731 ****
--- 737,748 ----
/*#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()
* function produces. Usual values are 15, 16, and 31.
***************
*** 734,740 ****
/* 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
* is often a directory that is mounted across diverse architectures.
*/
#define SCRIPTDIR "/usr/local/bin" /**/
--- 751,757 ----
/* SCRIPTDIR
* This symbol holds the name of the directory in which the user wants
! * 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,754 ****
/* 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" /**/
/* 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 /**/
/* UIDTYPE
* This symbol has a value like uid_t, int, ushort, or whatever type is
--- 759,771 ----
/* SIG_NAME
* This symbol contains an list of signal names in order.
*/
! #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 unsigned char /**/
/* UIDTYPE
* This symbol has a value like uid_t, int, ushort, or whatever type is
***************
*** 788,796 ****
* its value is "char *".
*/
#ifndef VOIDWANT
! #define VOIDWANT 1
#endif
! #define VOIDHAVE 1
#if (VOIDHAVE & VOIDWANT) != VOIDWANT
#define void int /* is void to be avoided? */
#define VOID
--- 805,813 ----
* its value is "char *".
*/
#ifndef VOIDWANT
! #define VOIDWANT 7
#endif
! #define VOIDHAVE 7
#if (VOIDHAVE & VOIDWANT) != VOIDWANT
#define void int /* is void to be avoided? */
#define VOID
Index: msdos/config.h
*** msdos/config.h.old Fri Jun 7 12:25:35 1991
--- msdos/config.h Fri Jun 7 12:25:36 1991
***************
*** 43,49 ****
/* 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
* is most often a local directory such as /usr/local/bin.
*/
#define BIN "/usr/local/bin" /**/
--- 43,49 ----
/* BIN
* This symbol holds the name of the directory in which the user wants
! * 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,600 ****
--- 590,612 ----
*/
#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.
***************
*** 733,738 ****
--- 745,754 ----
/*#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()
Index: config_h.SH
*** config_h.SH.old Fri Jun 7 12:23:06 1991
--- config_h.SH Fri Jun 7 12:23:07 1991
***************
*** 454,461 ****
--- 454,467 ----
* 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,766 ****
/* 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
* is often a directory that is mounted across diverse architectures.
*/
#define SCRIPTDIR "$scriptdir" /**/
--- 766,772 ----
/* SCRIPTDIR
* This symbol holds the name of the directory in which the user wants
! * to keep publicly executable scripts for the package in question. It
* is often a directory that is mounted across diverse architectures.
*/
#define SCRIPTDIR "$scriptdir" /**/
Index: cons.c
Prereq: 4.0
*** cons.c.old Fri Jun 7 12:23:11 1991
--- cons.c Fri Jun 7 12:23:12 1991
***************
*** 1,11 ****
! /* $Header: cons.c,v 4.0 91/03/20 01:05:51 lwall Locked $
*
! * Copyright (c) 1989, 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.
*
* $Log: cons.c,v $
* Revision 4.0 91/03/20 01:05:51 lwall
* 4.0 baseline.
*
--- 1,15 ----
! /* $RCSfile: cons.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:31:15 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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,682 ****
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 ) {
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;
--- 680,688 ----
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->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;
Index: consarg.c
*** consarg.c.old Fri Jun 7 12:23:16 1991
--- consarg.c Fri Jun 7 12:23:17 1991
***************
*** 1,11 ****
! /* $RCSfile: consarg.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:38:34 $
*
! * Copyright (c) 1989, 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.
*
* $Log: consarg.c,v $
* Revision 4.0.1.1 91/04/11 17:38:34 lwall
* patch1: fixed "Bad free" error
*
--- 1,15 ----
! /* $RCSfile: consarg.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 10:33:12 $
*
! * Copyright (c) 1991, Larry Wall
*
! * 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,268 ****
fprintf(stderr,")\n");
}
#endif
! evalstatic(arg); /* see if we can consolidate anything */
return arg;
}
! void
evalstatic(arg)
register ARG *arg;
{
! register STR *str;
register STR *s1;
register STR *s2;
double value; /* must not be register */
--- 258,272 ----
fprintf(stderr,")\n");
}
#endif
! arg = evalstatic(arg); /* see if we can consolidate anything */
return arg;
}
! ARG *
evalstatic(arg)
register ARG *arg;
{
! static STR *str = Nullstr;
register STR *s1;
register STR *s2;
double value; /* must not be register */
***************
*** 275,571 ****
double sin(), cos(), atan2(), pow();
if (!arg || !arg->arg_len)
! return;
! if ((arg[1].arg_type == A_SINGLE || arg->arg_type == O_AELEM) &&
! (arg->arg_len == 1 || arg[2].arg_type == A_SINGLE) ) {
str = Str_new(20,0);
s1 = arg[1].arg_ptr.arg_str;
! if (arg->arg_len > 1)
! s2 = arg[2].arg_ptr.arg_str;
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);
}
#else
! 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);
#ifndef lint
! if (tmp2 >= 0)
! str_numset(str,(double)(tmp2 % tmplong));
! else
! str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1));
#else
! 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);
#ifndef lint
! str_numset(str,(double)(((long)value) << i));
#endif
! break;
! case O_RIGHT_SHIFT:
! value = str_gnum(s1);
! i = (int)str_gnum(s2);
#ifndef lint
! 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);
#ifndef lint
! str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2))));
#endif
! break;
! case O_XOR:
! value = str_gnum(s1);
#ifndef lint
! str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
#endif
! break;
! case O_BIT_OR:
! value = str_gnum(s1);
#ifndef lint
! 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:
#ifndef lint
! 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:
#ifdef HAS_CRYPT
! tmps = str_get(s1);
! str_set(str,crypt(tmps,str_get(s2)));
#else
! 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:
#ifndef I286
! str_numset(str,(double)(*str_get(s1)));
#else
! {
! 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;
! }
! }
}
}
ARG *
--- 279,625 ----
double sin(), cos(), atan2(), pow();
if (!arg || !arg->arg_len)
! return arg;
! if (!str)
str = Str_new(20,0);
+
+ if (arg[1].arg_type == A_SINGLE)
s1 = arg[1].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
#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);
+ }
#else
! str_numset(str,str_gnum(s1) / value);
#endif
! 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));
#else
! tmp2 = tmp2;
#endif
! 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));
#endif
! break;
! case O_RIGHT_SHIFT:
! CHECK12;
! value = str_gnum(s1);
! i = (int)str_gnum(s2);
#ifndef lint
! str_numset(str,(double)(((long)value) >> i));
#endif
! 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))));
#endif
! break;
! case O_XOR:
! CHECK12;
! value = str_gnum(s1);
#ifndef lint
! str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
#endif
! break;
! case O_BIT_OR:
! CHECK12;
! value = str_gnum(s1);
#ifndef lint
! str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2))));
#endif
! 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))));
#endif
! 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)));
#else
! yyerror(
! "The crypt() function is unimplemented due to excessive paranoia.");
#endif
! 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)));
#else
! {
! int zapc;
! char *zaps;
! 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 *
*** End of Patch 5 ***
exit 0 # Just in case...
--
Kent Landfield INTERNET: kent at sparky.IMD.Sterling.COM
Sterling Software, IMD UUCP: uunet!sparky!kent
Phone: (402) 291-8300 FAX: (402) 291-4362
Please send comp.sources.misc-related mail to kent at uunet.uu.net.
More information about the Comp.sources.misc
mailing list