This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 4.0 patch 22: patch #20, continued
authorLarry Wall <lwall@netlabs.com>
Mon, 8 Jun 1992 04:52:53 +0000 (04:52 +0000)
committerLarry Wall <lwall@netlabs.com>
Mon, 8 Jun 1992 04:52:53 +0000 (04:52 +0000)
See patch #20.

18 files changed:
atarist/atarist.c [new file with mode: 0644]
atarist/test/ccon [new file with mode: 0644]
c2ph.SH
cflags.SH
cmd.c
cmd.h
config.H
consarg.c
hints/cray.sh [new file with mode: 0644]
lib/bigfloat.pl
lib/bigint.pl
lib/chat2.pl
lib/ctime.pl
msdos/config.h
patchlevel.h
t/comp/cpp.t
usub/bsdcurses.mus
x2p/cflags.SH

diff --git a/atarist/atarist.c b/atarist/atarist.c
new file mode 100644 (file)
index 0000000..2d69c9d
--- /dev/null
@@ -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 (file)
index 0000000..47bc8e2
--- /dev/null
@@ -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 4bf52be..13d70ed 100644 (file)
--- 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 $';
 
 
 ######################################################################
index df07083..c1510ea 100644 (file)
--- 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 0e51f22..a4f310a 100644 (file)
--- 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 be047ea..3260335 100644 (file)
--- 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();
index 5303c03..d3a0e57 100644 (file)
--- 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
 /*#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               /**/
 
 /* 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
  *             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
  *     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
 /*#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
  *     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
 
 /* 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              /**/
 
  */
 #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
  */
 #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.
 
 /* 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               /**/
 
 
 /* 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
 
 /* 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              /**/
 
  */
 #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.
 /*#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         /**/
 
 
index 2ff52d9..fe4542b 100644 (file)
--- 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 (file)
index 0000000..952a021
--- /dev/null
@@ -0,0 +1,3 @@
+case `uname -r` in
+6.1*) shellflags="-m+65536" ;;
+esac
index 99a0079..52fb7e3 100644 (file)
@@ -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))
+       );
     }
 }
 \f
index 503c783..9a52fb7 100644 (file)
@@ -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;
     }
 }
 \f
-# 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);
            }
index 916b975..662872c 100644 (file)
@@ -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"};
index 988d05a..6000d29 100644 (file)
@@ -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.
index d030c58..7131d63 100644 (file)
 /* 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
 #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
  *     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
 
 /* 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              /**/
 
  */
 #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
  */
 #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.
 
 /* 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               /**/
 
 
 /* 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              /**/
 
  */
 /*#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.
 /*#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.
 
 /* 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"             /**/
index 49ea5df..7c3da2c 100644 (file)
@@ -1 +1 @@
-#define PATCHLEVEL 21
+#define PATCHLEVEL 22
index 0e2b6fa..dca25d3 100644 (file)
@@ -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";
 
index 48e2df7..9b0be3d 100644 (file)
@@ -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)
index 2f78e2c..db857c0 100644 (file)
@@ -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!