From pa.dec.com!decwrl!sdd.hp.com!cs.utexas.edu!uunet!sparky!kent Sun Jun 30 14:43:39 PDT 1991 Article: 2448 of comp.sources.misc Path: pa.dec.com!decwrl!sdd.hp.com!cs.utexas.edu!uunet!sparky!kent From: lwall@netlabs.com (Larry Wall) Newsgroups: comp.sources.misc Subject: v20i057: perl - The perl programming language, Patch05 Summary: This is an official patch for perl 4.0. Please apply it. Message-ID: <1991Jun20.030423.8601@sparky.IMD.Sterling.COM> Date: 20 Jun 91 03:04:23 GMT References: Sender: kent@sparky.IMD.Sterling.COM (Kent Landfield) Organization: NetLabs, Inc. Lines: 1992 Approved: kent@sparky.imd.sterling.com X-Md4-Signature: bbf43d3f808ca91ba3e3a2f3a38761b7 Submitted-by: Larry Wall 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 #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 <>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 <>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 . */ --- 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 . */ *************** *** 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 . --- 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 . *************** *** 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 . */ #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@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@uunet.uu.net.