summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLarry Wall <lwall@netlabs.com>1992-06-08 04:52:53 +0000
committerLarry Wall <lwall@netlabs.com>1992-06-08 04:52:53 +0000
commit68decaef0a08fcd5db3193f825cfdfc539b67ccb (patch)
treea16d0390e7acc0fcc16eba0be8259a2214efd9fe
parentbf10efe7e35fa48859e575b890018da16608a9d7 (diff)
downloadperl-68decaef0a08fcd5db3193f825cfdfc539b67ccb.tar.gz
perl 4.0 patch 22: patch #20, continued
See patch #20.
-rw-r--r--atarist/atarist.c282
-rw-r--r--atarist/test/ccon5
-rw-r--r--c2ph.SH3
-rw-r--r--cflags.SH1
-rw-r--r--cmd.c25
-rw-r--r--cmd.h9
-rw-r--r--config.H95
-rw-r--r--consarg.c48
-rw-r--r--hints/cray.sh3
-rw-r--r--lib/bigfloat.pl25
-rw-r--r--lib/bigint.pl40
-rw-r--r--lib/chat2.pl6
-rw-r--r--lib/ctime.pl3
-rw-r--r--msdos/config.h88
-rw-r--r--patchlevel.h2
-rw-r--r--t/comp/cpp.t14
-rw-r--r--usub/bsdcurses.mus20
-rw-r--r--x2p/cflags.SH1
18 files changed, 570 insertions, 100 deletions
diff --git a/atarist/atarist.c b/atarist/atarist.c
new file mode 100644
index 0000000000..2d69c9db62
--- /dev/null
+++ b/atarist/atarist.c
@@ -0,0 +1,282 @@
+/*
+ * random stuff for atariST
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+/* call back stuff, atari specific stuff below */
+/* Be sure to refetch the stack pointer after calling these routines. */
+
+int
+callback(subname, sp, gimme, hasargs, numargs)
+char *subname;
+int sp; /* stack pointer after args are pushed */
+int gimme; /* called in array or scalar context */
+int hasargs; /* whether to create a @_ array for routine */
+int numargs; /* how many args are pushed on the stack */
+{
+ static ARG myarg[3]; /* fake syntax tree node */
+ int arglast[3];
+
+ arglast[2] = sp;
+ sp -= numargs;
+ arglast[1] = sp--;
+ arglast[0] = sp;
+
+ if (!myarg[0].arg_ptr.arg_str)
+ myarg[0].arg_ptr.arg_str = str_make("",0);
+
+ myarg[1].arg_type = A_WORD;
+ myarg[1].arg_ptr.arg_stab = stabent(subname, FALSE);
+
+ myarg[2].arg_type = hasargs ? A_EXPR : A_NULL;
+
+ return do_subr(myarg, gimme, arglast);
+}
+
+int
+callv(subname, sp, gimme, argv)
+char *subname;
+register int sp; /* current stack pointer */
+int gimme; /* called in array or scalar context */
+register char **argv; /* null terminated arg list, NULL for no arglist */
+{
+ register int items = 0;
+ int hasargs = (argv != 0);
+
+ astore(stack, ++sp, Nullstr); /* reserve spot for 1st return arg */
+ if (hasargs) {
+ while (*argv) {
+ astore(stack, ++sp, str_2mortal(str_make(*argv,0)));
+ items++;
+ argv++;
+ }
+ }
+ return callback(subname, sp, gimme, hasargs, items);
+}
+
+#include <process.h>
+#include <stdio.h>
+
+long _stksize = 64*1024L;
+unsigned long __DEFAULT_BUFSIZ__ = 4 * 1024L;
+
+/*
+ * The following code is based on the do_exec and do_aexec functions
+ * in file doio.c
+ */
+int
+do_aspawn(really,arglast)
+STR *really;
+int *arglast;
+{
+ register STR **st = stack->ary_array;
+ register int sp = arglast[1];
+ register int items = arglast[2] - sp;
+ register char **a;
+ char **argv;
+ char *tmps;
+ int status;
+
+ if (items) {
+ New(1101,argv, items+1, char*);
+ a = argv;
+ for (st += ++sp; items > 0; items--,st++) {
+ if (*st)
+ *a++ = str_get(*st);
+ else
+ *a++ = "";
+ }
+ *a = Nullch;
+ if (really && *(tmps = str_get(really)))
+ status = spawnvp(-P_WAIT,tmps,argv); /* -P_WAIT is a hack, see spawnvp.c in the lib */
+ else
+ status = spawnvp(-P_WAIT,argv[0],argv);
+ Safefree(argv);
+ }
+ return status;
+}
+
+
+int
+do_spawn(cmd)
+char *cmd;
+{
+ return system(cmd);
+}
+
+#if 0 /* patchlevel 79 onwards we can */
+/*
+ * we unfortunately cannot use the super efficient fread/write from the lib
+ */
+size_t fread(void *data, size_t size, size_t count, FILE *fp)
+{
+ size_t i, j;
+ unsigned char *buf = (unsigned char *)data;
+ int c;
+
+ for(i = 0; i < count; i++)
+ {
+ for(j = 0; j < size; j++)
+ {
+ if((c = getc(fp)) == EOF)
+ return 0;
+ *buf++ = c;
+ }
+ }
+ return i;
+}
+
+size_t fwrite(const void *data, size_t size, size_t count, FILE *fp)
+{
+ size_t i, j;
+ const unsigned char *buf = (const unsigned char *)data;
+
+ for(i = 0; i < count; i++)
+ {
+ for(j = 0; j < size; j++)
+ {
+ if(fputc(*buf++, fp) == EOF)
+ return 0;
+ }
+ }
+ return i;
+}
+#endif
+
+#ifdef HAS_SYSCALL
+#define __NO_INLINE__
+#include <osbind.h> /* must include this for proper protos */
+
+/* these must match osbind.pl */
+#define TRAP_1_W 1
+#define TRAP_1_WW 2
+#define TRAP_1_WL 3
+#define TRAP_1_WLW 4
+#define TRAP_1_WWW 5
+#define TRAP_1_WLL 6
+#define TRAP_1_WWLL 7
+#define TRAP_1_WLWW 8
+#define TRAP_1_WWLLL 9
+#define TRAP_13_W 10
+#define TRAP_13_WW 11
+#define TRAP_13_WL 12
+#define TRAP_13_WWW 13
+#define TRAP_13_WWL 14
+#define TRAP_13_WWLWWW 15
+#define TRAP_14_W 16
+#define TRAP_14_WW 17
+#define TRAP_14_WL 18
+#define TRAP_14_WWW 19
+#define TRAP_14_WWL 20
+#define TRAP_14_WWLL 21
+#define TRAP_14_WLLW 22
+#define TRAP_14_WLLL 23
+#define TRAP_14_WWWL 24
+#define TRAP_14_WWWWL 25
+#define TRAP_14_WLLWW 26
+#define TRAP_14_WWWWWWW 27
+#define TRAP_14_WLLWWWWW 28
+#define TRAP_14_WLLWWWWLW 29
+#define TRAP_14_WLLWWWWWLW 30
+
+int syscall(trap, fn, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 )
+unsigned long trap, fn, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12;
+{
+ /* for now */
+ switch(trap)
+ {
+ case TRAP_1_W:
+ return trap_1_w(fn);
+
+ case TRAP_1_WW:
+ return trap_1_ww(fn, a1);
+
+ case TRAP_1_WL:
+ return trap_1_wl(fn, a1);
+
+ case TRAP_1_WLW:
+ return trap_1_wlw(fn, a1, a2);
+
+ case TRAP_1_WWW:
+ return trap_1_www(fn, a1, a2);
+
+ case TRAP_1_WLL:
+ return trap_1_wll(fn, a1, a2);
+
+ case TRAP_1_WWLL:
+ return trap_1_wwll(fn, a1, a2, a3);
+
+ case TRAP_1_WLWW:
+ return trap_1_wlww(fn, a1, a2, a3);
+
+ case TRAP_1_WWLLL:
+ return trap_1_wwlll(fn, a1, a2, a3, a4);
+
+ case TRAP_13_W:
+ return trap_13_w(fn);
+
+ case TRAP_13_WW:
+ return trap_13_ww(fn, a1);
+
+ case TRAP_13_WL:
+ return trap_13_wl(fn, a1);
+
+ case TRAP_13_WWW:
+ return trap_13_www(fn, a1, a2);
+
+ case TRAP_13_WWL:
+ return trap_13_wwl(fn, a1, a2);
+
+ case TRAP_13_WWLWWW:
+ return trap_13_wwlwww(fn, a1, a2, a3, a4, a5);
+
+ case TRAP_14_W:
+ return trap_14_w(fn);
+
+ case TRAP_14_WW:
+ return trap_14_ww(fn, a1);
+
+ case TRAP_14_WL:
+ return trap_14_wl(fn, a1);
+
+ case TRAP_14_WWW:
+ return trap_14_www(fn, a1, a2);
+
+ case TRAP_14_WWL:
+ return trap_14_wwl(fn, a1, a2);
+
+ case TRAP_14_WWLL:
+ return trap_14_wwll(fn, a1, a2, a3);
+
+ case TRAP_14_WLLW:
+ return trap_14_wllw(fn, a1, a2, a3);
+
+ case TRAP_14_WLLL:
+ return trap_14_wlll(fn, a1, a2, a3);
+
+ case TRAP_14_WWWL:
+ return trap_14_wwwl(fn, a1, a2, a3);
+
+ case TRAP_14_WWWWL:
+ return trap_14_wwwwl(fn, a1, a2, a3, a4);
+
+ case TRAP_14_WLLWW:
+ return trap_14_wllww(fn, a1, a2, a3, a4);
+
+ case TRAP_14_WWWWWWW:
+ return trap_14_wwwwwww(fn, a1, a2, a3, a4, a5, a6);
+
+ case TRAP_14_WLLWWWWW:
+ return trap_14_wllwwwww(fn, a1, a2, a3, a4, a5, a6, a7);
+
+ case TRAP_14_WLLWWWWLW:
+ return trap_14_wllwwwwlw(fn, a1, a2, a3, a4, a5, a6, a7, a8);
+
+ case TRAP_14_WLLWWWWWLW:
+ return trap_14_wllwwwwwlw(fn, a1, a2, a3, a4, a5, a6, a7, a8, a9);
+ }
+}
+#endif
+
diff --git a/atarist/test/ccon b/atarist/test/ccon
new file mode 100644
index 0000000000..47bc8e2f05
--- /dev/null
+++ b/atarist/test/ccon
@@ -0,0 +1,5 @@
+require 'osbind.pl';
+
+ &Cconws("Hello World\r\n");
+ $str = "This is a string being printed by Fwrite Gemdos trap\r\n";
+ &Fwrite(1, length($str), $str);
diff --git a/c2ph.SH b/c2ph.SH
index 4bf52be556..13d70ed34c 100644
--- a/c2ph.SH
+++ b/c2ph.SH
@@ -19,6 +19,7 @@ echo "Extracting c2ph (with variable substitutions)"
: 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.
+rm -f c2ph
$spitshell >c2ph <<!GROK!THIS!
#!$bin/perl
#
@@ -36,7 +37,7 @@ $spitshell >>c2ph <<'!NO!SUBS!'
# See the usage message for more. If this isn't enough, read the code.
#
-$RCSID = '$RCSfile: c2ph.SH,v $$Revision: 4.0.1.1 $$Date: 91/11/05 16:02:29 $';
+$RCSID = '$RCSfile: c2ph.SH,v $$Revision: 4.0.1.2 $$Date: 92/06/08 11:56:08 $';
######################################################################
diff --git a/cflags.SH b/cflags.SH
index df07083561..c1510ea85e 100644
--- a/cflags.SH
+++ b/cflags.SH
@@ -19,6 +19,7 @@ echo "Extracting cflags (with variable substitutions)"
: 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.
+rm -f cflags
$spitshell >cflags <<!GROK!THIS!
!GROK!THIS!
diff --git a/cmd.c b/cmd.c
index 0e51f22f26..a4f310a110 100644
--- a/cmd.c
+++ b/cmd.c
@@ -1,4 +1,4 @@
-/* $RCSfile: cmd.c,v $$Revision: 4.0.1.4 $$Date: 91/11/11 16:29:33 $
+/* $RCSfile: cmd.c,v $$Revision: 4.0.1.5 $$Date: 92/06/08 12:00:39 $
*
* Copyright (c) 1991, Larry Wall
*
@@ -6,6 +6,10 @@
* License or the Artistic License, as specified in the README file.
*
* $Log: cmd.c,v $
+ * Revision 4.0.1.5 92/06/08 12:00:39 lwall
+ * patch20: the switch optimizer didn't do anything in subroutines
+ * patch20: removed implicit int declarations on funcions
+ *
* Revision 4.0.1.4 91/11/11 16:29:33 lwall
* patch19: do {$foo ne "bar";} returned wrong value
* patch19: some earlier patches weren't propagated to alternate 286 code
@@ -34,7 +38,7 @@
# include <varargs.h>
#endif
-static STR str_chop;
+static STR strchop;
void grow_dlevel();
@@ -81,6 +85,10 @@ VOLATILE int sp;
tail_recursion_entry:
#ifdef DEBUGGING
dlevel = entdlevel;
+ if (debug & 4)
+ deb("mortals = (%d/%d) stack, = (%d/%d)\n",
+ tmps_max, tmps_base,
+ savestack->ary_fill, firstsave);
#endif
#ifdef TAINT
tainted = 0; /* Each statement is presumed innocent */
@@ -575,12 +583,12 @@ until_loop:
match = (retstr->str_cur != 0);
tmps = str_get(retstr);
tmps += retstr->str_cur - match;
- str_nset(&str_chop,tmps,match);
+ str_nset(&strchop,tmps,match);
*tmps = '\0';
retstr->str_nok = 0;
retstr->str_cur = tmps - retstr->str_ptr;
STABSET(retstr);
- retstr = &str_chop;
+ retstr = &strchop;
goto flipmaybe;
case CFT_ARRAY:
match = cmd->c_short->str_u.str_useful; /* just to get register */
@@ -728,6 +736,10 @@ until_loop:
}
goto doswitch;
case C_CSWITCH:
+ if (multiline) {
+ cmd = cmd->c_next; /* can't assume anything */
+ goto tail_recursion_entry;
+ }
match = *(str_get(STAB_STR(cmd->c_stab))) & 255;
doswitch:
match -= cmd->ucmd.scmd.sc_offset;
@@ -942,7 +954,7 @@ until_loop:
#ifdef DEBUGGING
# ifndef I_VARARGS
/*VARARGS1*/
-deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
+void deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
char *pat;
{
register int i;
@@ -954,7 +966,7 @@ char *pat;
}
# else
/*VARARGS1*/
-deb(va_alist)
+void deb(va_alist)
va_dcl
{
va_list args;
@@ -973,6 +985,7 @@ va_dcl
# endif
#endif
+int
copyopt(cmd,which)
register CMD *cmd;
register CMD *which;
diff --git a/cmd.h b/cmd.h
index be047eaadb..3260335219 100644
--- a/cmd.h
+++ b/cmd.h
@@ -1,4 +1,4 @@
-/* $RCSfile: cmd.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:28:50 $
+/* $RCSfile: cmd.h,v $$Revision: 4.0.1.2 $$Date: 92/06/08 12:01:02 $
*
* Copyright (c) 1991, Larry Wall
*
@@ -6,6 +6,9 @@
* License or the Artistic License, as specified in the README file.
*
* $Log: cmd.h,v $
+ * Revision 4.0.1.2 92/06/08 12:01:02 lwall
+ * patch20: removed implicit int declarations on funcions
+ *
* 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
@@ -167,3 +170,7 @@ struct compcmd {
void opt_arg();
ARG* evalstatic();
int cmd_exec();
+#ifdef DEBUGGING
+void deb();
+#endif
+int copyopt();
diff --git a/config.H b/config.H
index 5303c03701..d3a0e57208 100644
--- a/config.H
+++ b/config.H
@@ -9,6 +9,7 @@
* that running config.h.SH again will wipe out any changes you've made.
* For a more permanent change edit config.sh and rerun config.h.SH.
*/
+ /*SUPPRESS 460*/
/* EUNICE
@@ -25,11 +26,16 @@
/*#undef EUNICE /**/
/*#undef VMS /**/
+/* LOC_SED
+ * This symbol holds the complete pathname to the sed program.
+ */
+#define LOC_SED "/bin/sed" /**/
+
/* ALIGNBYTES
* This symbol contains the number of bytes required to align a double.
* Usual values are 2, 4, and 8.
*/
-#define ALIGNBYTES 2 /**/
+#define ALIGNBYTES 8 /**/
/* BIN
* This symbol holds the name of the directory in which the user wants
@@ -40,7 +46,7 @@
/* BYTEORDER
* This symbol contains an encoding of the order of bytes in a long.
- * Usual values (in octal) are 01234, 04321, 02143, 03412...
+ * Usual values (in hex) are 0x1234, 0x4321, 0x2143, 0x3412...
*/
#define BYTEORDER 0x4321 /**/
@@ -68,8 +74,16 @@
/* HAS_BCOPY
* This symbol, if defined, indicates that the bcopy routine is available
* to copy blocks of memory. Otherwise you should probably use memcpy().
+ * If neither is defined, roll your own.
+ */
+/* SAFE_BCOPY
+ * This symbol, if defined, indicates that the bcopy routine is available
+ * to copy potentially overlapping copy blocks of bcopy. Otherwise you
+ * should probably use memmove() or memcpy(). If neither is defined,
+ * roll your own.
*/
#define HAS_BCOPY /**/
+#define SAFE_BCOPY /**/
/* HAS_BZERO
* This symbol, if defined, indicates that the bzero routine is available
@@ -89,8 +103,8 @@
* 1 = couldn't cast < 0
* 2 = couldn't cast >= 0x80000000
*/
-/*#undef CASTNEGFLOAT /**/
-#define CASTFLAGS 1 /**/
+#define CASTNEGFLOAT /**/
+#define CASTFLAGS 0 /**/
/* CHARSPRINTF
* This symbol is defined if this system declares "char *sprintf()" in
@@ -180,7 +194,7 @@
* This symbol, if defined, indicates that the gethostent() routine is
* available to lookup host names in some data base or other.
*/
-/*#undef HAS_GETHOSTENT /**/
+#define HAS_GETHOSTENT /**/
/* HAS_GETPGRP
* This symbol, if defined, indicates that the getpgrp() routine is
@@ -232,6 +246,12 @@
/*#undef index strchr /* cultural */
/*#undef rindex strrchr /* differences? */
+/* HAS_ISASCII
+ * This symbol, if defined, indicates that the isascii routine is available
+ * to test characters for asciiness.
+ */
+#define HAS_ISASCII /**/
+
/* HAS_KILLPG
* This symbol, if defined, indicates that the killpg routine is available
* to kill process groups. If unavailable, you probably should use kill
@@ -256,7 +276,27 @@
* to copy blocks of memory. Otherwise you should probably use bcopy().
* If neither is defined, roll your own.
*/
+/* SAFE_MEMCPY
+ * This symbol, if defined, indicates that the memcpy routine is available
+ * to copy potentially overlapping copy blocks of memory. Otherwise you
+ * should probably use memmove() or bcopy(). If neither is defined,
+ * roll your own.
+ */
#define HAS_MEMCPY /**/
+/*#undef SAFE_MEMCPY /**/
+
+/* HAS_MEMMOVE
+ * This symbol, if defined, indicates that the memmove routine is available
+ * to move potentially overlapping blocks of memory. Otherwise you
+ * should use bcopy() or roll your own.
+ */
+/*#undef HAS_MEMMOVE /**/
+
+/* HAS_MEMSET
+ * This symbol, if defined, indicates that the memset routine is available
+ * to set a block of memory to a character. If undefined, roll your own.
+ */
+#define HAS_MEMSET /**/
/* HAS_MKDIR
* This symbol, if defined, indicates that the mkdir routine is available
@@ -273,25 +313,25 @@
/* HAS_MSGCTL
* This symbol, if defined, indicates that the msgctl() routine is
- * available to stat symbolic links.
+ * available to control message passing.
*/
#define HAS_MSGCTL /**/
/* HAS_MSGGET
* This symbol, if defined, indicates that the msgget() routine is
- * available to stat symbolic links.
+ * available to get messages.
*/
#define HAS_MSGGET /**/
/* HAS_MSGRCV
* This symbol, if defined, indicates that the msgrcv() routine is
- * available to stat symbolic links.
+ * available to receive messages.
*/
#define HAS_MSGRCV /**/
/* HAS_MSGSND
* This symbol, if defined, indicates that the msgsnd() routine is
- * available to stat symbolic links.
+ * available to send messages.
*/
#define HAS_MSGSND /**/
@@ -326,6 +366,12 @@
*/
#define HAS_RENAME /**/
+/* HAS_REWINDDIR
+ * This symbol, if defined, indicates that the rewindir routine is
+ * available to rewind directories.
+ */
+#define HAS_REWINDDIR /**/
+
/* HAS_RMDIR
* This symbol, if defined, indicates that the rmdir routine is available
* to remove directories. Otherwise you should fork off a new process to
@@ -333,6 +379,12 @@
*/
#define HAS_RMDIR /**/
+/* HAS_SEEKDIR
+ * This symbol, if defined, indicates that the seekdir routine is
+ * available to seek into directories.
+ */
+#define HAS_SEEKDIR /**/
+
/* HAS_SELECT
* This symbol, if defined, indicates that the select() subroutine
* exists.
@@ -347,19 +399,19 @@
/* HAS_SEMCTL
* This symbol, if defined, indicates that the semctl() routine is
- * available to stat symbolic links.
+ * available to control semaphores.
*/
#define HAS_SEMCTL /**/
/* HAS_SEMGET
* This symbol, if defined, indicates that the semget() routine is
- * available to stat symbolic links.
+ * available to get semaphores ids.
*/
#define HAS_SEMGET /**/
/* HAS_SEMOP
* This symbol, if defined, indicates that the semop() routine is
- * available to stat symbolic links.
+ * available to perform semaphore operations.
*/
#define HAS_SEMOP /**/
@@ -437,7 +489,7 @@
/* HAS_SHMAT
* This symbol, if defined, indicates that the shmat() routine is
- * available to stat symbolic links.
+ * available to attach a shared memory segment.
*/
/* VOID_SHMAT
* This symbol, if defined, indicates that the shmat() routine
@@ -449,19 +501,19 @@
/* HAS_SHMCTL
* This symbol, if defined, indicates that the shmctl() routine is
- * available to stat symbolic links.
+ * available to control a shared memory segment.
*/
#define HAS_SHMCTL /**/
/* HAS_SHMDT
* This symbol, if defined, indicates that the shmdt() routine is
- * available to stat symbolic links.
+ * available to detach a shared memory segment.
*/
#define HAS_SHMDT /**/
/* HAS_SHMGET
* This symbol, if defined, indicates that the shmget() routine is
- * available to stat symbolic links.
+ * available to get a shared memory segment id.
*/
#define HAS_SHMGET /**/
@@ -520,6 +572,12 @@
*/
#define HAS_SYSCALL /**/
+/* HAS_TELLDIR
+ * This symbol, if defined, indicates that the telldir routine is
+ * available to tell your location in directories.
+ */
+#define HAS_TELLDIR /**/
+
/* HAS_TRUNCATE
* This symbol, if defined, indicates that the truncate routine is
* available to truncate files.
@@ -737,9 +795,14 @@
/*#undef I_MY_DIR /**/
/*#undef DIRNAMLEN /**/
+/* MYMALLOC
+ * This symbol, if defined, indicates that we're using our own malloc.
+ */
/* MALLOCPTRTYPE
* This symbol defines the kind of ptr returned by malloc and realloc.
*/
+#define MYMALLOC /**/
+
#define MALLOCPTRTYPE char /**/
diff --git a/consarg.c b/consarg.c
index 2ff52d9959..fe4542b3da 100644
--- a/consarg.c
+++ b/consarg.c
@@ -1,4 +1,4 @@
-/* $RCSfile: consarg.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 16:21:16 $
+/* $RCSfile: consarg.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 12:26:27 $
*
* Copyright (c) 1991, Larry Wall
*
@@ -6,6 +6,12 @@
* License or the Artistic License, as specified in the README file.
*
* $Log: consarg.c,v $
+ * Revision 4.0.1.4 92/06/08 12:26:27 lwall
+ * patch20: new warning for use of x with non-numeric right operand
+ * patch20: modulus with highest bit in left operand set didn't always work
+ * patch20: illegal lvalue message could be followed by core dump
+ * patch20: deleted some minor memory leaks
+ *
* Revision 4.0.1.3 91/11/05 16:21:16 lwall
* patch11: random cleanup
* patch11: added eval {}
@@ -57,12 +63,14 @@ ARG *limarg;
}
else {
arg[3].arg_flags = 0;
+ arg[3].arg_len = 0;
arg[3].arg_type = A_EXPR;
arg[3].arg_ptr.arg_arg = limarg;
}
}
else {
arg[3].arg_flags = 0;
+ arg[3].arg_len = 0;
arg[3].arg_type = A_NULL;
arg[3].arg_ptr.arg_arg = Nullarg;
}
@@ -344,7 +352,10 @@ register ARG *arg;
str_scat(str,s2);
break;
case O_REPEAT:
- CHECK12;
+ CHECK2;
+ if (dowarn && !s2->str_nok && !looks_like_number(s2))
+ warn("Right operand of x is not numeric");
+ CHECK1;
i = (int)str_gnum(s2);
tmps = str_get(s1);
str_nset(str,"",0);
@@ -392,12 +403,14 @@ register ARG *arg;
yyerror("Illegal modulus of constant zero");
return arg;
}
- tmp2 = (long)str_gnum(s1);
+ value = str_gnum(s1);
#ifndef lint
- if (tmp2 >= 0)
- str_numset(str,(double)(tmp2 % tmplong));
- else
+ if (value >= 0.0)
+ str_numset(str,(double)(((unsigned long)value) % tmplong));
+ else {
+ tmp2 = (long)value;
str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1));
+ }
#else
tmp2 = tmp2;
#endif
@@ -847,6 +860,7 @@ register ARG *arg;
(void)sprintf(tokenbuf,
"Illegal expression (%s) as lvalue",opname[arg1->arg_type]);
yyerror(tokenbuf);
+ return arg;
}
arg[1].arg_type = A_LEXPR | (arg[1].arg_type & A_DONT);
if (arg->arg_type == O_ASSIGN && (arg1[1].arg_flags & AF_ARYOK)) {
@@ -871,6 +885,7 @@ register ARG *arg;
(void)sprintf(tokenbuf,
"Illegal item (%s) as lvalue",argname[arg[1].arg_type&A_MASK]);
yyerror(tokenbuf);
+ return arg;
}
arg[1].arg_type = A_LVAL | (arg[1].arg_type & A_DONT);
#ifdef DEBUGGING
@@ -897,6 +912,7 @@ ARG *arg;
return arg;
}
+void
dehoist(arg,i)
ARG *arg;
{
@@ -976,26 +992,14 @@ register ARG *arg;
node = arg;
arg = op_new(i);
tmpstr = arg->arg_ptr.arg_str;
-#ifdef STRUCTCOPY
- *arg = *node; /* copy everything except the STR */
-#else
- (void)bcopy((char *)node, (char *)arg, sizeof(ARG));
-#endif
+ StructCopy(node, arg, ARG); /* copy everything except the STR */
arg->arg_ptr.arg_str = tmpstr;
for (j = i; ; ) {
-#ifdef STRUCTCOPY
- arg[j] = node[2];
-#else
- (void)bcopy((char *)(node+2), (char *)(arg+j), sizeof(ARG));
-#endif
+ StructCopy(node+2, arg+j, ARG);
arg[j].arg_flags |= AF_ARYOK;
--j; /* Bug in Xenix compiler */
if (j < 2) {
-#ifdef STRUCTCOPY
- arg[1] = node[1];
-#else
- (void)bcopy((char *)(node+1), (char *)(arg+1), sizeof(ARG));
-#endif
+ StructCopy(node+1, arg+1, ARG);
free_arg(node);
break;
}
@@ -1008,6 +1012,8 @@ register ARG *arg;
arg[2].arg_flags |= AF_ARYOK;
arg->arg_type = O_LIST;
arg->arg_len = i;
+ str_free(arg->arg_ptr.arg_str);
+ arg->arg_ptr.arg_str = Nullstr;
return arg;
}
diff --git a/hints/cray.sh b/hints/cray.sh
new file mode 100644
index 0000000000..952a0219e1
--- /dev/null
+++ b/hints/cray.sh
@@ -0,0 +1,3 @@
+case `uname -r` in
+6.1*) shellflags="-m+65536" ;;
+esac
diff --git a/lib/bigfloat.pl b/lib/bigfloat.pl
index 99a00794bb..52fb7e3880 100644
--- a/lib/bigfloat.pl
+++ b/lib/bigfloat.pl
@@ -1,8 +1,9 @@
package bigfloat;
require "bigint.pl";
-
# Arbitrary length float math package
#
+# by Mark Biggar
+#
# number format
# canonical strings have the form /[+-]\d+E[+-]\d+/
# Input values can have inbedded whitespace
@@ -66,14 +67,15 @@ sub norm { #(mantissa, exponent) return fnum_str
# negation
sub main'fneg { #(fnum_str) return fnum_str
local($_) = &'fnorm($_[0]);
- substr($_,0,1) =~ tr/+-/-+/ if ($_ ne '+0E+0'); # flip sign
+ vec($_,0,8) =^ ord('+') ^ ord('-') unless $_ eq '+0E+0'; # flip sign
+ s/^H/N/;
$_;
}
# absolute value
sub main'fabs { #(fnum_str) return fnum_str
local($_) = &'fnorm($_[0]);
- substr($_,0,1) = '+' unless $_ eq 'NaN'; # mash sign
+ s/^-/+/; # mash sign
$_;
}
@@ -198,18 +200,13 @@ sub main'fcmp #(fnum_str, fnum_str) return cond_code
local($x, $y) = (&'fnorm($_[0]),&'fnorm($_[1]));
if ($x eq "NaN" || $y eq "NaN") {
undef;
- } elsif ($x eq $y) {
- 0;
- } elsif (ord($x) != ord($y)) {
- (ord($y) - ord($x)); # based on signs
} else {
- local($xm,$xe) = split('E',$x);
- local($ym,$ye) = split('E',$y);
- if ($xe ne $ye) {
- ($xe - $ye) * (substr($x,0,1).'1');
- } else {
- &bigint'cmp($xm,$ym); # based on value
- }
+ ord($y) <=> ord($x)
+ ||
+ ( local($xm,$xe,$ym,$ye) = split('E', $x."E$y"),
+ (($xe <=> $ye) * (substr($x,0,1).'1')
+ || &bigint'cmp($xm,$ym))
+ );
}
}
diff --git a/lib/bigint.pl b/lib/bigint.pl
index 503c7837c2..9a52fb76fd 100644
--- a/lib/bigint.pl
+++ b/lib/bigint.pl
@@ -138,19 +138,15 @@ sub main'bsub { #(num_str, num_str) return num_str
# GCD -- Euclids algorithm Knuth Vol 2 pg 296
sub main'bgcd { #(num_str, num_str) return num_str
local($x,$y) = (&'bnorm($_[0]),&'bnorm($_[1]));
- if ($x eq 'NaN') {
- 'NaN';
- }
- elsif ($y eq 'NaN') {
+ if ($x eq 'NaN' || $y eq 'NaN') {
'NaN';
- }
- else {
+ } else {
($x, $y) = ($y,&'bmod($x,$y)) while $y ne '+0';
$x;
}
}
-# routine to add two base 100000 numbers
+# routine to add two base 1e5 numbers
# stolen from Knuth Vol 2 Algorithm A pg 231
# there are separate routines to add and sub as per Kunth pg 233
sub add { #(int_num_array, int_num_array) return int_num_array
@@ -158,22 +154,22 @@ sub add { #(int_num_array, int_num_array) return int_num_array
$car = 0;
for $x (@x) {
last unless @y || $car;
- $x -= 100000 if $car = (($x += shift @y + $car) >= 100000);
+ $x -= 1e5 if $car = (($x += shift @y + $car) >= 1e5);
}
for $y (@y) {
last unless $car;
- $y -= 100000 if $car = (($y += $car) >= 100000);
+ $y -= 1e5 if $car = (($y += $car) >= 1e5);
}
(@x, @y, $car);
}
-# subtract base 100000 numbers -- stolen from Knuth Vol 2 pg 232, $x > $y
+# subtract base 1e5 numbers -- stolen from Knuth Vol 2 pg 232, $x > $y
sub sub { #(int_num_array, int_num_array) return int_num_array
local(*sx, *sy) = @_;
$bar = 0;
for $sx (@sx) {
last unless @y || $bar;
- $sx += 100000 if $bar = (($sx -= shift @sy + $bar) < 0);
+ $sx += 1e5 if $bar = (($sx -= shift @sy + $bar) < 0);
}
@sx;
}
@@ -195,7 +191,7 @@ sub main'bmul { #(num_str, num_str) return num_str
for $y (@y) {
$prod = $x * $y + $prod[$cty] + $car;
$prod[$cty++] =
- $prod - ($car = int($prod * (1/100000))) * 100000;
+ $prod - ($car = int($prod * 1e-5)) * 1e5;
}
$prod[$cty] += $car if $car;
$x = shift @prod;
@@ -218,15 +214,15 @@ sub main'bdiv { #(dividend: num_str, divisor: num_str) return num_str
$srem = $y[0];
$sr = (shift @x ne shift @y) ? '-' : '+';
$car = $bar = $prd = 0;
- if (($dd = int(100000/($y[$#y]+1))) != 1) {
+ if (($dd = int(1e5/($y[$#y]+1))) != 1) {
for $x (@x) {
$x = $x * $dd + $car;
- $x -= ($car = int($x * (1/100000))) * 100000;
+ $x -= ($car = int($x * 1e-5)) * 1e5;
}
push(@x, $car); $car = 0;
for $y (@y) {
$y = $y * $dd + $car;
- $y -= ($car = int($y * (1/100000))) * 100000;
+ $y -= ($car = int($y * 1e-5)) * 1e5;
}
}
else {
@@ -235,20 +231,20 @@ sub main'bdiv { #(dividend: num_str, divisor: num_str) return num_str
@q = (); ($v2,$v1) = @y[$#y-1,$#y];
while ($#x > $#y) {
($u2,$u1,$u0) = @x[($#x-2)..$#x];
- $q = (($u0 == $v1) ? 99999 : int(($u0*100000+$u1)/$v1));
- --$q while ($v2*$q > ($u0*100000+$u1-$q*$v1)*100000+$u2);
+ $q = (($u0 == $v1) ? 99999 : int(($u0*1e5+$u1)/$v1));
+ --$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*1e5+$u2);
if ($q) {
($car, $bar) = (0,0);
for ($y = 0, $x = $#x-$#y-1; $y <= $#y; ++$y,++$x) {
$prd = $q * $y[$y] + $car;
- $prd -= ($car = int($prd * (1/100000))) * 100000;
- $x[$x] += 100000 if ($bar = (($x[$x] -= $prd + $bar) < 0));
+ $prd -= ($car = int($prd * 1e-5)) * 1e5;
+ $x[$x] += 1e5 if ($bar = (($x[$x] -= $prd + $bar) < 0));
}
if ($x[$#x] < $car + $bar) {
$car = 0; --$q;
for ($y = 0, $x = $#x-$#y-1; $y <= $#y; ++$y,++$x) {
- $x[$x] -= 100000
- if ($car = (($x[$x] += $y[$y] + $car) > 100000));
+ $x[$x] -= 1e5
+ if ($car = (($x[$x] += $y[$y] + $car) > 1e5));
}
}
}
@@ -259,7 +255,7 @@ sub main'bdiv { #(dividend: num_str, divisor: num_str) return num_str
if ($dd != 1) {
$car = 0;
for $x (reverse @x) {
- $prd = $car * 100000 + $x;
+ $prd = $car * 1e5 + $x;
$car = $prd - ($tmp = int($prd / $dd)) * $dd;
unshift(@d, $tmp);
}
diff --git a/lib/chat2.pl b/lib/chat2.pl
index 916b9756af..662872c2d3 100644
--- a/lib/chat2.pl
+++ b/lib/chat2.pl
@@ -108,6 +108,7 @@ sub open_proc { ## public
die "Cannot exec @cmd: $!";
}
close(TTY);
+ $PID{$next} = $pid;
$next; # return symbol for switcharound
}
@@ -258,10 +259,15 @@ sub print { ## public
## like close $handle
sub close { ## public
+ local($pid);
if ($_[0] =~ /$nextpat/) {
+ $pid = $PID{$_[0]};
*S = shift;
+ } else {
+ $pid = $PID{$next};
}
close(S);
+ waitpid($pid,0);
if (defined $S{"needs_close"}) { # is it a listen socket?
local(*NS) = $S{"needs_close"};
delete $S{"needs_close"};
diff --git a/lib/ctime.pl b/lib/ctime.pl
index 988d05a841..6000d29a19 100644
--- a/lib/ctime.pl
+++ b/lib/ctime.pl
@@ -3,7 +3,7 @@
;# Waldemar Kebsch, Federal Republic of Germany, November 1988
;# kebsch.pad@nixpbe.UUCP
;# Modified March 1990, Feb 1991 to properly handle timezones
-;# $Id: ctime.pl,v 1.8 91/02/04 18:28:12 hakanson Exp $
+;# $RCSfile: ctime.pl,v $$Revision: 4.0.1.1 $$Date: 92/06/08 13:38:06 $
;# Marion Hakanson (hakanson@cse.ogi.edu)
;# Oregon Graduate Institute of Science and Technology
;#
@@ -24,6 +24,7 @@ sub ctime {
package ctime;
local($time) = @_;
+ local($[) = 0;
local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
# Determine what time zone is in effect.
diff --git a/msdos/config.h b/msdos/config.h
index d030c5835a..7131d6338e 100644
--- a/msdos/config.h
+++ b/msdos/config.h
@@ -79,8 +79,16 @@
/* HAS_BCOPY
* This symbol, if defined, indicates that the bcopy routine is available
* to copy blocks of memory. Otherwise you should probably use memcpy().
+ * If neither is defined, roll your own.
+ */
+/* SAFE_BCOPY
+ * This symbol, if defined, indicates that the bcopy routine is available
+ * to copy potentially overlapping copy blocks of bcopy. Otherwise you
+ * should probably use memmove() or memcpy(). If neither is defined,
+ * roll your own.
*/
/*#undef HAS_BCOPY /**/
+/*#undef SAFE_BCOPY /**/
/* HAS_BZERO
* This symbol, if defined, indicates that the bzero routine is available
@@ -243,6 +251,12 @@
#define index strchr /* cultural */
#define rindex strrchr /* differences? */
+/* HAS_ISASCII
+ * This symbol, if defined, indicates that the isascii routine is available
+ * to test characters for asciiness.
+ */
+#define HAS_ISASCII /**/
+
/* HAS_KILLPG
* This symbol, if defined, indicates that the killpg routine is available
* to kill process groups. If unavailable, you probably should use kill
@@ -267,7 +281,27 @@
* to copy blocks of memory. Otherwise you should probably use bcopy().
* If neither is defined, roll your own.
*/
+/* SAFE_MEMCPY
+ * This symbol, if defined, indicates that the memcpy routine is available
+ * to copy potentially overlapping copy blocks of memory. Otherwise you
+ * should probably use memmove() or bcopy(). If neither is defined,
+ * roll your own.
+ */
#define HAS_MEMCPY /**/
+/*#undef SAFE_MEMCPY /**/
+
+/* HAS_MEMMOVE
+ * This symbol, if defined, indicates that the memmove routine is available
+ * to move potentially overlapping blocks of memory. Otherwise you
+ * should use bcopy() or roll your own.
+ */
+/*#undef HAS_MEMMOVE /**/
+
+/* HAS_MEMSET
+ * This symbol, if defined, indicates that the memset routine is available
+ * to set a block of memory to a character. If undefined, roll your own.
+ */
+#define HAS_MEMSET /**/
/* HAS_MKDIR
* This symbol, if defined, indicates that the mkdir routine is available
@@ -284,25 +318,25 @@
/* HAS_MSGCTL
* This symbol, if defined, indicates that the msgctl() routine is
- * available to stat symbolic links.
+ * available to control message passing.
*/
/*#undef HAS_MSGCTL /**/
/* HAS_MSGGET
* This symbol, if defined, indicates that the msgget() routine is
- * available to stat symbolic links.
+ * available to get messages.
*/
/*#undef HAS_MSGGET /**/
/* HAS_MSGRCV
* This symbol, if defined, indicates that the msgrcv() routine is
- * available to stat symbolic links.
+ * available to receive messages.
*/
/*#undef HAS_MSGRCV /**/
/* HAS_MSGSND
* This symbol, if defined, indicates that the msgsnd() routine is
- * available to stat symbolic links.
+ * available to send messages.
*/
/*#undef HAS_MSGSND /**/
@@ -337,6 +371,12 @@
*/
#define HAS_RENAME /**/
+/* HAS_REWINDDIR
+ * This symbol, if defined, indicates that the rewindir routine is
+ * available to rewind directories.
+ */
+#define HAS_REWINDDIR /**/
+
/* HAS_RMDIR
* This symbol, if defined, indicates that the rmdir routine is available
* to remove directories. Otherwise you should fork off a new process to
@@ -344,6 +384,12 @@
*/
#define HAS_RMDIR /**/
+/* HAS_SEEKDIR
+ * This symbol, if defined, indicates that the seekdir routine is
+ * available to seek into directories.
+ */
+#define HAS_SEEKDIR /**/
+
/* HAS_SELECT
* This symbol, if defined, indicates that the select() subroutine
* exists.
@@ -358,19 +404,19 @@
/* HAS_SEMCTL
* This symbol, if defined, indicates that the semctl() routine is
- * available to stat symbolic links.
+ * available to control semaphores.
*/
/*#undef HAS_SEMCTL /**/
/* HAS_SEMGET
* This symbol, if defined, indicates that the semget() routine is
- * available to stat symbolic links.
+ * available to get semaphores ids.
*/
/*#undef HAS_SEMGET /**/
/* HAS_SEMOP
* This symbol, if defined, indicates that the semop() routine is
- * available to stat symbolic links.
+ * available to perform semaphore operations.
*/
/*#undef HAS_SEMOP /**/
@@ -448,25 +494,31 @@
/* HAS_SHMAT
* This symbol, if defined, indicates that the shmat() routine is
- * available to stat symbolic links.
+ * available to attach a shared memory segment.
+ */
+/* VOID_SHMAT
+ * This symbol, if defined, indicates that the shmat() routine
+ * returns a pointer of type void*.
*/
/*#undef HAS_SHMAT /**/
+/*#undef VOIDSHMAT /**/
+
/* HAS_SHMCTL
* This symbol, if defined, indicates that the shmctl() routine is
- * available to stat symbolic links.
+ * available to control a shared memory segment.
*/
/*#undef HAS_SHMCTL /**/
/* HAS_SHMDT
* This symbol, if defined, indicates that the shmdt() routine is
- * available to stat symbolic links.
+ * available to detach a shared memory segment.
*/
/*#undef HAS_SHMDT /**/
/* HAS_SHMGET
* This symbol, if defined, indicates that the shmget() routine is
- * available to stat symbolic links.
+ * available to get a shared memory segment id.
*/
/*#undef HAS_SHMGET /**/
@@ -528,6 +580,12 @@
*/
/*#undef HAS_SYSCALL /**/
+/* HAS_TELLDIR
+ * This symbol, if defined, indicates that the telldir routine is
+ * available to tell your location in directories.
+ */
+#define HAS_TELLDIR /**/
+
/* HAS_TRUNCATE
* This symbol, if defined, indicates that the truncate routine is
* available to truncate files.
@@ -745,11 +803,17 @@
/*#undef I_MY_DIR /**/
/*#undef DIRNAMLEN /**/
+/* MYMALLOC
+ * This symbol, if defined, indicates that we're using our own malloc.
+ */
/* MALLOCPTRTYPE
* This symbol defines the kind of ptr returned by malloc and realloc.
*/
+#define MYMALLOC /**/
+
#define MALLOCPTRTYPE void /**/
+
/* RANDBITS
* This symbol contains the number of bits of random number the rand()
* function produces. Usual values are 15, 16, and 31.
@@ -758,7 +822,7 @@
/* SCRIPTDIR
* This symbol holds the name of the directory in which the user wants
- * to put publicly executable scripts for the package in question. It
+ * to keep publicly executable scripts for the package in question. It
* is often a directory that is mounted across diverse architectures.
*/
#define SCRIPTDIR "C:/bin/perl" /**/
diff --git a/patchlevel.h b/patchlevel.h
index 49ea5df60a..7c3da2cb8a 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 21
+#define PATCHLEVEL 22
diff --git a/t/comp/cpp.t b/t/comp/cpp.t
index 0e2b6fa681..dca25d358b 100644
--- a/t/comp/cpp.t
+++ b/t/comp/cpp.t
@@ -1,6 +1,18 @@
#!./perl -P
-# $Header: cpp.t,v 4.0 91/03/20 01:50:05 lwall Locked $
+# $RCSfile: cpp.t,v $$Revision: 4.0.1.1 $$Date: 92/06/08 15:42:08 $
+
+open(CONFIG,"../config.sh") || die;
+while (<CONFIG>) {
+ if (/^cppstdin/) {
+ if (/^cppstdin='(.*cppstdin)'/ && ! -e $1) {
+ print "1..0\n";
+ exit; # Can't test till after install, alas.
+ }
+ last;
+ }
+}
+close CONFIG;
print "1..3\n";
diff --git a/usub/bsdcurses.mus b/usub/bsdcurses.mus
index 48e2df7f34..9b0be3d78f 100644
--- a/usub/bsdcurses.mus
+++ b/usub/bsdcurses.mus
@@ -1,6 +1,9 @@
-/* $RCSfile: bsdcurses.mus,v $$Revision: 4.0.1.1 $$Date: 91/11/05 19:04:53 $
+/* $RCSfile: bsdcurses.mus,v $$Revision: 4.0.1.2 $$Date: 92/06/08 16:05:28 $
*
* $Log: bsdcurses.mus,v $
+ * Revision 4.0.1.2 92/06/08 16:05:28 lwall
+ * patch20: &getcap eventually dumped core in bsdcurses
+ *
* Revision 4.0.1.1 91/11/05 19:04:53 lwall
* initial checkin
*
@@ -476,9 +479,18 @@ END
CASE int erasechar
END
-CASE char* getcap
-I char* str
-END
+ case US_getcap:
+ if (items != 1)
+ fatal("Usage: &getcap($str)");
+ else {
+ char* retval;
+ char* str = (char*) str_get(st[1]);
+ char output[50], *outputp = output;
+
+ retval = tgetstr(str, &outputp);
+ str_set(st[0], (char*) retval);
+ }
+ return sp;
case US_getyx:
if (items != 3)
diff --git a/x2p/cflags.SH b/x2p/cflags.SH
index 2f78e2caf0..db857c0492 100644
--- a/x2p/cflags.SH
+++ b/x2p/cflags.SH
@@ -19,6 +19,7 @@ echo "Extracting cflags (with variable substitutions)"
: 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.
+rm -f cflags
$spitshell >cflags <<!GROK!THIS!
!GROK!THIS!