Update to the 1995/09/20 version. Previous version was 1993/12/17.

17 files changed, 277 insertions, 95 deletions

diff --git a/lib/libF77/F77_aloc.c b/lib/libF77/F77_aloc.c
new file mode 100644
index 0000000..18a345f
--- /dev/null
+++ b/lib/libF77/F77_aloc.c
@@ -0,0 +1,32 @@
+#include "f2c.h"
+#undef abs
+#undef min
+#undef max
+#include "stdio.h"
+
+static integer memfailure = 3;
+
+#ifdef KR_headers
+extern char *malloc();
+extern void exit_();
+
+ char *
+F77_aloc(Len, whence) integer Len; char *whence;
+#else
+#include "stdlib.h"
+extern void exit_(integer*);
+
+ char *
+F77_aloc(integer Len, char *whence)
+#endif
+{
+	char *rv;
+	unsigned int uLen = (unsigned int) Len;	/* for K&R C */
+
+	if (!(rv = malloc(uLen))) {
+		fprintf(stderr, "malloc(%u) failure in %s\n",
+			uLen, whence);
+		exit_(&memfailure);
+		}
+	return rv;
+	}
diff --git a/lib/libF77/README b/lib/libF77/README
index b5b0b81..a575124 100644
--- a/lib/libF77/README
+++ b/lib/libF77/README
@@ -87,8 +87,10 @@ for use with INTEGER*8.  To use it, you must modify f2c.h to
 declare longint appropriately; then add pow_qq.o to the POW =
 line in the makefile.
 
-If you wish to allow the target of a (character string) concatenation
-to be appear on its right-hand (at the cost of extra overhead for
-all run-time concatenations), change "s_cat.o" to "s_catow.o" in
-the makefile.  Note that the Fortran 77 Standard explicitly forbids
-the target of a concatenation from appearing on its right-hand side.
+Following Fortran 90, s_cat.c and s_copy.c allow the target of a
+(character string) assignment to be appear on its right-hand, at
+the cost of some extra overhead for all run-time concatenations.
+If you prefer the  extra efficiency that comes with the Fortran 77
+requirement that the left-hand side of a character assignment not
+be involved in the right-hand side, compile s_cat.c and s_copy.c
+with -DNO_OVERWRITE .
diff --git a/lib/libF77/Version.c b/lib/libF77/Version.c
index bbc6110..df2434a 100644
--- a/lib/libF77/Version.c
+++ b/lib/libF77/Version.c
@@ -1,4 +1,4 @@
-static char junk[] = "\n@(#)LIBF77 VERSION 2.01 19 Sept. 1994\n";
+static char junk[] = "\n@(#)LIBF77 VERSION 2.01 6 Sept. 1995\n";
 
 /*
 2.00	11 June 1980.  File version.c added to library.
@@ -27,4 +27,15 @@ static char junk[] = "\n@(#)LIBF77 VERSION 2.01 19 Sept. 1994\n";
 	 2 June 1994: adjust so abnormal terminations invoke f_exit just once
 	16 Sept. 1994: s_cmp: treat characters as unsigned in comparisons.
 	19 Sept. 1994: s_paus: flush after end of PAUSE; add -DMSDOS
+	12 Jan. 1995:	pow_[dhiqrz][hiq]: adjust x**i to work on machines
+			that sign-extend right shifts when i is the most
+			negative integer.
+	26 Jan. 1995: adjust s_cat.c, s_copy.c to permit the left-hand side
+			of character assignments to appear on the right-hand
+			side (unless compiled with -DNO_OVERWRITE).
+	27 Jan. 1995: minor tweak to s_copy.c: copy forward whenever
+			possible (for better cache behavior).
+	30 May 1995:  added subroutine exit(rc) integer rc. Version not changed.
+	29 Aug. 1995: add F77_aloc.c; use it in s_cat.c and system_.c.
+	6 Sept. 1995: fix return type of system_ under -DKR_headers.
 */
diff --git a/lib/libF77/exit.c b/lib/libF77/exit.c
new file mode 100644
index 0000000..da3ab5c
--- /dev/null
+++ b/lib/libF77/exit.c
@@ -0,0 +1,37 @@
+/* This gives the effect of
+
+	subroutine exit(rc)
+	integer*4 rc
+	stop
+	end
+
+ * with the added side effect of supplying rc as the program's exit code.
+ */
+
+#include "f2c.h"
+#undef abs
+#undef min
+#undef max
+#ifndef KR_headers
+#include "stdlib.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern void f_exit(void);
+#endif
+
+ void
+#ifdef KR_headers
+exit_(rc) integer *rc;
+#else
+exit_(integer *rc)
+#endif
+{
+#ifdef NO_ONEXIT
+	f_exit();
+#endif
+	exit(*rc);
+	}
+#ifdef __cplusplus
+}
+#endif
diff --git a/lib/libF77/libF77.xsum b/lib/libF77/libF77.xsum
index faf4a24..fe3fbfc 100644
--- a/lib/libF77/libF77.xsum
+++ b/lib/libF77/libF77.xsum
@@ -1,6 +1,7 @@
+F77_aloc.c	fc8e8844	536
 Notice	1211689a	1195
-README	1c4c3814	4053
-Version.c	10d0f4c6	1447
+README	1d306d9d	4130
+Version.c	f329c4b2	2060
 abort_.c	eaf90dc0	239
 c_abs.c	ecce7a47	205
 c_cos.c	f2338a46	260
@@ -39,6 +40,7 @@ ef1asc_.c	f14b3469	453
 ef1cmc_.c	1e0b86e3	360
 erf_.c	7a407d	158
 erfc_.c	fb488e22	163
+exit.c	eaf1e4de	476
 f2ch.add	fed3bb7b	6056
 getarg_.c	edcf61f8	495
 getenv_.c	eaafcc11	975
@@ -67,16 +69,16 @@ l_ge.c	5b7cb55	267
 l_gt.c	ad1b388	266
 l_le.c	f5407149	267
 l_lt.c	f81a93f8	266
-main.c	ec7fc5ad	2012
-makefile	1f2ebd87	3036
+main.c	1144a505	2064
+makefile	e4156396	3063
 pow_ci.c	f593b0b9	345
 pow_dd.c	e451857d	209
-pow_di.c	f5c04524	360
-pow_hh.c	feb3b910	401
-pow_ii.c	fe444c9b	395
-pow_qq.c	fdf1dc33	395
-pow_ri.c	ea06b62d	348
-pow_zi.c	f21e1934	694
+pow_di.c	11a1842e	381
+pow_hh.c	e0cb1b69	422
+pow_ii.c	17c60a01	421
+pow_qq.c	ffbbdec9	449
+pow_ri.c	eacf8350	369
+pow_zi.c	fe9073e4	715
 pow_zz.c	f0e5f141	482
 r_abs.c	1a4e3da	139
 r_acos.c	ca67f96	166
@@ -100,16 +102,15 @@ r_sinh.c	f21a38b8	166
 r_sqrt.c	f24b8aa4	166
 r_tan.c	e60b7778	162
 r_tanh.c	f22ec5c	166
-s_cat.c	e53641	408
-s_catow.c	538ae5a	1222
+s_cat.c	151033e2	1304
 s_cmp.c	ff4f2982	655
-s_copy.c	f50c7ec9	397
+s_copy.c	e10dd76f	957
 s_paus.c	e726a719	1552
 s_rnge.c	1d6cada2	680
 s_stop.c	1f5aaac8	511
 sig_die.c	e934624a	634
-signal_.c	1b0b75f3	327
-system_.c	c910b8a	396
+signal_.c	fde97f5f	395
+system_.c	e4ed54ab	579
 z_abs.c	f71a28c1	201
 z_cos.c	110bc444	269
 z_div.c	ff56b823	675
diff --git a/lib/libF77/main.c b/lib/libF77/main.c
index 24c2f22..79f1943 100644
--- a/lib/libF77/main.c
+++ b/lib/libF77/main.c
@@ -10,15 +10,21 @@
 #endif
 
 #ifndef KR_headers
+#undef VOID
 #include "stdlib.h"
 #endif
+
+#ifndef VOID
+#define VOID void
+#endif
+
 #ifdef __cplusplus
 extern "C" {
 #endif
 
 #ifdef NO__STDC
 #define ONEXIT onexit
-extern void f_exit();
+extern VOID f_exit();
 #else
 #ifndef KR_headers
 extern void f_exit(void);
@@ -29,13 +35,13 @@ extern int atexit(void (*)(void));
 #else
 #ifndef NO_ONEXIT
 #define ONEXIT onexit
-extern void f_exit();
+extern VOID f_exit();
 #endif
 #endif
 #endif
 
 #ifdef KR_headers
-extern void f_init(), sig_die();
+extern VOID f_init(), sig_die();
 extern int MAIN__();
 #define Int /* int */
 #else
@@ -44,37 +50,37 @@ extern int MAIN__(void);
 #define Int int
 #endif
 
-static void sigfdie(Int n)
+static VOID sigfdie(Int n)
 {
 sig_die("Floating Exception", 1);
 }
 
 
-static void sigidie(Int n)
+static VOID sigidie(Int n)
 {
 sig_die("IOT Trap", 1);
 }
 
 #ifdef SIGQUIT
-static void sigqdie(Int n)
+static VOID sigqdie(Int n)
 {
 sig_die("Quit signal", 1);
 }
 #endif
 
 
-static void sigindie(Int n)
+static VOID sigindie(Int n)
 {
 sig_die("Interrupt", 0);
 }
 
-static void sigtdie(Int n)
+static VOID sigtdie(Int n)
 {
 sig_die("Killed", 0);
 }
 
 #ifdef SIGTRAP
-static void sigtrdie(Int n)
+static VOID sigtrdie(Int n)
 {
 sig_die("Trace trap", 1);
 }
diff --git a/lib/libF77/makefile b/lib/libF77/makefile
index 405128d..6e7cc68 100644
--- a/lib/libF77/makefile
+++ b/lib/libF77/makefile
@@ -18,9 +18,9 @@ CFLAGS = -O
 	ld -r -x -o $*.xxx $*.o
 	mv $*.xxx $*.o
 
-MISC =	Version.o main.o s_rnge.o abort_.o getarg_.o iargc_.o getenv_.o\
-	signal_.o s_stop.o s_paus.o system_.o cabs.o\
-	derf_.o derfc_.o erf_.o erfc_.o sig_die.o
+MISC =	F77_aloc.o Version.o main.o s_rnge.o abort_.o getarg_.o iargc_.o \
+	getenv_.o signal_.o s_stop.o s_paus.o system_.o cabs.o\
+	derf_.o derfc_.o erf_.o erfc_.o sig_die.o exit.o
 POW =	pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o  pow_ri.o pow_zi.o pow_zz.o
 CX =	c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o
 DCX =	z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o
@@ -58,12 +58,12 @@ clean:
 	rm -f libF77.a *.o
 
 check:
-	xsum Notice README Version.c abort_.c c_abs.c c_cos.c c_div.c \
-	c_exp.c c_log.c c_sin.c c_sqrt.c cabs.c d_abs.c d_acos.c \
+	xsum Notice README F77_aloc.c Version.c abort_.c c_abs.c c_cos.c \
+	c_div.c c_exp.c c_log.c c_sin.c c_sqrt.c cabs.c d_abs.c d_acos.c \
 	d_asin.c d_atan.c d_atn2.c d_cnjg.c d_cos.c d_cosh.c d_dim.c \
 	d_exp.c d_imag.c d_int.c d_lg10.c d_log.c d_mod.c d_nint.c \
 	d_prod.c d_sign.c d_sin.c d_sinh.c d_sqrt.c d_tan.c d_tanh.c \
-	derf_.c derfc_.c ef1asc_.c ef1cmc_.c erf_.c erfc_.c f2ch.add \
+	derf_.c derfc_.c ef1asc_.c ef1cmc_.c erf_.c erfc_.c exit.c f2ch.add \
 	getarg_.c getenv_.c h_abs.c h_dim.c h_dnnt.c h_indx.c h_len.c \
 	h_mod.c h_nint.c h_sign.c hl_ge.c hl_gt.c hl_le.c hl_lt.c \
 	i_abs.c i_dim.c i_dnnt.c i_indx.c i_len.c i_mod.c i_nint.c \
@@ -72,7 +72,7 @@ check:
 	pow_zi.c pow_zz.c r_abs.c r_acos.c r_asin.c r_atan.c r_atn2.c \
 	r_cnjg.c r_cos.c r_cosh.c r_dim.c r_exp.c r_imag.c r_int.c r_lg10.c \
 	r_log.c r_mod.c r_nint.c r_sign.c r_sin.c r_sinh.c r_sqrt.c \
-	r_tan.c r_tanh.c s_cat.c s_catow.c s_cmp.c s_copy.c s_paus.c s_rnge.c \
-	s_stop.c sig_die.c signal_.c system_.c z_abs.c z_cos.c z_div.c \
-	z_exp.c z_log.c z_sin.c z_sqrt.c >zap
+	r_tan.c r_tanh.c s_cat.c s_cmp.c s_copy.c \
+	s_paus.c s_rnge.c s_stop.c sig_die.c signal_.c system_.c \
+	z_abs.c z_cos.c z_div.c z_exp.c z_log.c z_sin.c z_sqrt.c >zap
 	cmp zap libF77.xsum && rm zap || diff libF77.xsum zap
diff --git a/lib/libF77/pow_di.c b/lib/libF77/pow_di.c
index 7af69a7..affed62 100644
--- a/lib/libF77/pow_di.c
+++ b/lib/libF77/pow_di.c
@@ -8,6 +8,7 @@ double pow_di(doublereal *ap, integer *bp)
 {
 double pow, x;
 integer n;
+unsigned long u;
 
 pow = 1;
 x = *ap;
@@ -20,11 +21,11 @@ if(n != 0)
 		n = -n;
 		x = 1/x;
 		}
-	for( ; ; )
+	for(u = n; ; )
 		{
-		if(n & 01)
+		if(u & 01)
 			pow *= x;
-		if(n >>= 1)
+		if(u >>= 1)
 			x *= x;
 		else
 			break;
diff --git a/lib/libF77/pow_hh.c b/lib/libF77/pow_hh.c
index e1a503c..24a0197 100644
--- a/lib/libF77/pow_hh.c
+++ b/lib/libF77/pow_hh.c
@@ -7,6 +7,7 @@ shortint pow_hh(shortint *ap, shortint *bp)
 #endif
 {
 	shortint pow, x, n;
+	unsigned u;
 
 	x = *ap;
 	n = *bp;
@@ -18,11 +19,12 @@ shortint pow_hh(shortint *ap, shortint *bp)
 			return x == 0 ? 1/x : 0;
 		n = -n;
 		}
+	u = n;
 	for(pow = 1; ; )
 		{
-		if(n & 01)
+		if(u & 01)
 			pow *= x;
-		if(n >>= 1)
+		if(u >>= 1)
 			x *= x;
 		else
 			break;
diff --git a/lib/libF77/pow_ii.c b/lib/libF77/pow_ii.c
index e794877..84d1c7e 100644
--- a/lib/libF77/pow_ii.c
+++ b/lib/libF77/pow_ii.c
@@ -7,6 +7,7 @@ integer pow_ii(integer *ap, integer *bp)
 #endif
 {
 	integer pow, x, n;
+	unsigned long u;
 
 	x = *ap;
 	n = *bp;
@@ -18,11 +19,12 @@ integer pow_ii(integer *ap, integer *bp)
 			return x == 0 ? 1/x : 0;
 		n = -n;
 		}
+	u = n;
 	for(pow = 1; ; )
 		{
-		if(n & 01)
+		if(u & 01)
 			pow *= x;
-		if(n >>= 1)
+		if(u >>= 1)
 			x *= x;
 		else
 			break;
diff --git a/lib/libF77/pow_qq.c b/lib/libF77/pow_qq.c
index d80c40a9..3bc80e0 100644
--- a/lib/libF77/pow_qq.c
+++ b/lib/libF77/pow_qq.c
@@ -7,6 +7,7 @@ longint pow_qq(longint *ap, longint *bp)
 #endif
 {
 	longint pow, x, n;
+	unsigned long long u;	/* system-dependent */
 
 	x = *ap;
 	n = *bp;
@@ -18,11 +19,12 @@ longint pow_qq(longint *ap, longint *bp)
 			return x == 0 ? 1/x : 0;
 		n = -n;
 		}
+	u = n;
 	for(pow = 1; ; )
 		{
-		if(n & 01)
+		if(u & 01)
 			pow *= x;
-		if(n >>= 1)
+		if(u >>= 1)
 			x *= x;
 		else
 			break;
diff --git a/lib/libF77/pow_ri.c b/lib/libF77/pow_ri.c
index 3a3c4cf..6e5816b 100644
--- a/lib/libF77/pow_ri.c
+++ b/lib/libF77/pow_ri.c
@@ -8,6 +8,7 @@ double pow_ri(real *ap, integer *bp)
 {
 double pow, x;
 integer n;
+unsigned long u;
 
 pow = 1;
 x = *ap;
@@ -20,11 +21,11 @@ if(n != 0)
 		n = -n;
 		x = 1/x;
 		}
-	for( ; ; )
+	for(u = n; ; )
 		{
-		if(n & 01)
+		if(u & 01)
 			pow *= x;
-		if(n >>= 1)
+		if(u >>= 1)
 			x *= x;
 		else
 			break;
diff --git a/lib/libF77/pow_zi.c b/lib/libF77/pow_zi.c
index 8dd6006..167e6ac 100644
--- a/lib/libF77/pow_zi.c
+++ b/lib/libF77/pow_zi.c
@@ -9,6 +9,7 @@ void pow_zi(doublecomplex *p, doublecomplex *a, integer *b) 	/* p = a**b  */
 #endif
 {
 integer n;
+unsigned long u;
 double t;
 doublecomplex x;
 static doublecomplex one = {1.0, 0.0};
@@ -30,15 +31,15 @@ else
 	x.i = a->i;
 	}
 
-for( ; ; )
+for(u = n; ; )
 	{
-	if(n & 01)
+	if(u & 01)
 		{
 		t = p->r * x.r - p->i * x.i;
 		p->i = p->r * x.i + p->i * x.r;
 		p->r = t;
 		}
-	if(n >>= 1)
+	if(u >>= 1)
 		{
 		t = x.r * x.r - x.i * x.i;
 		x.i = 2 * x.r * x.i;
diff --git a/lib/libF77/s_cat.c b/lib/libF77/s_cat.c
index 7f55cd5..1d6fd24 100644
--- a/lib/libF77/s_cat.c
+++ b/lib/libF77/s_cat.c
@@ -1,25 +1,71 @@
+/* Unless compiled with -DNO_OVERWRITE, this variant of s_cat allows the
+ * target of a concatenation to appear on its right-hand side (contrary
+ * to the Fortran 77 Standard, but in accordance with Fortran 90).
+ */
+
 #include "f2c.h"
+#ifndef NO_OVERWRITE
+#include "stdio.h"
+#undef abs
+#ifdef KR_headers
+ extern char *F77_aloc();
+ extern void free();
+ extern void exit_();
+#else
+#include "stdlib.h"
+ extern char *F77_aloc(ftnlen, char*);
+#endif
+#include "string.h"
+#endif /* NO_OVERWRITE */
 
+ VOID
 #ifdef KR_headers
-VOID s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnlen rnp[], *np, ll;
+s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnlen rnp[], *np, ll;
 #else
-VOID s_cat(char *lp, char *rpp[], ftnlen rnp[], ftnlen *np, ftnlen ll)
+s_cat(char *lp, char *rpp[], ftnlen rnp[], ftnlen *np, ftnlen ll)
 #endif
 {
-ftnlen i, n, nc;
-char *f__rp;
+	ftnlen i, nc;
+	char *rp;
+	ftnlen n = *np;
+#ifndef NO_OVERWRITE
+	ftnlen L, m;
+	char *lp0, *lp1;
 
-n = *np;
-for(i = 0 ; i < n ; ++i)
-	{
-	nc = ll;
-	if(rnp[i] < nc)
-		nc = rnp[i];
-	ll -= nc;
-	f__rp = rpp[i];
-	while(--nc >= 0)
-		*lp++ = *f__rp++;
+	lp0 = 0;
+	lp1 = lp;
+	L = ll;
+	i = 0;
+	while(i < n) {
+		rp = rpp[i];
+		m = rnp[i++];
+		if (rp >= lp1 || rp + m <= lp) {
+			if ((L -= m) <= 0) {
+				n = i;
+				break;
+				}
+			lp1 += m;
+			continue;
+			}
+		lp0 = lp;
+		lp = lp1 = F77_aloc(L = ll, "s_cat");
+		}
+#endif /* NO_OVERWRITE */
+	for(i = 0 ; i < n ; ++i) {
+		nc = ll;
+		if(rnp[i] < nc)
+			nc = rnp[i];
+		ll -= nc;
+		rp = rpp[i];
+		while(--nc >= 0)
+			*lp++ = *rp++;
+		}
+	while(--ll >= 0)
+		*lp++ = ' ';
+#ifndef NO_OVERWRITE
+	if (lp0) {
+		memcpy(lp0, lp1, L);
+		free(lp1);
+		}
+#endif
 	}
-while(--ll >= 0)
-	*lp++ = ' ';
-}
diff --git a/lib/libF77/s_copy.c b/lib/libF77/s_copy.c
index 989f5dd..d167351 100644
--- a/lib/libF77/s_copy.c
+++ b/lib/libF77/s_copy.c
@@ -1,3 +1,9 @@
+/* Unless compiled with -DNO_OVERWRITE, this variant of s_copy allows the
+ * target of an assignment to appear on its right-hand side (contrary
+ * to the Fortran 77 Standard, but in accordance with Fortran 90),
+ * as in  a(2:5) = a(4:7) .
+ */
+
 #include "f2c.h"
 
 /* assign strings:  a = b */
@@ -8,20 +14,38 @@ VOID s_copy(a, b, la, lb) register char *a, *b; ftnlen la, lb;
 void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb)
 #endif
 {
-register char *aend, *bend;
+	register char *aend, *bend;
 
-aend = a + la;
+	aend = a + la;
 
-if(la <= lb)
-	while(a < aend)
-		*a++ = *b++;
+	if(la <= lb)
+#ifndef NO_OVERWRITE
+		if (a <= b || a >= b + la)
+#endif
+			while(a < aend)
+				*a++ = *b++;
+#ifndef NO_OVERWRITE
+		else
+			for(b += la; a < aend; )
+				*--aend = *--b;
+#endif
 
-else
-	{
-	bend = b + lb;
-	while(b < bend)
-		*a++ = *b++;
-	while(a < aend)
-		*a++ = ' ';
+	else {
+		bend = b + lb;
+#ifndef NO_OVERWRITE
+		if (a <= b || a >= bend)
+#endif
+			while(b < bend)
+				*a++ = *b++;
+#ifndef NO_OVERWRITE
+		else {
+			a += lb;
+			while(b < bend)
+				*--a = *--bend;
+			a += lb;
+			}
+#endif
+		while(a < aend)
+			*a++ = ' ';
+		}
 	}
-}
diff --git a/lib/libF77/signal_.c b/lib/libF77/signal_.c
index 90ec7ea..8f06c91 100644
--- a/lib/libF77/signal_.c
+++ b/lib/libF77/signal_.c
@@ -1,19 +1,21 @@
 #include "f2c.h"
 
 #ifdef KR_headers
-typedef int (*sig_type)();
+typedef VOID (*sig_type)();
 extern sig_type signal();
+typedef int (*sig_proc)();
 
 ftnint signal_(sigp, proc) integer *sigp; sig_type proc;
 #else
 #include "signal.h"
 typedef void (*sig_type)(int);
+typedef int (*sig_proc)(int);
 
-ftnint signal_(integer *sigp, sig_type proc)
+ftnint signal_(integer *sigp, sig_proc proc)
 #endif
 {
 	int sig;
 	sig = (int)*sigp;
 
-	return (ftnint)signal(sig, proc);
+	return (ftnint)signal(sig, (sig_type)proc);
 	}
diff --git a/lib/libF77/system_.c b/lib/libF77/system_.c
index 6f8a71d..e6b3a02 100644
--- a/lib/libF77/system_.c
+++ b/lib/libF77/system_.c
@@ -3,22 +3,34 @@
 #include "f2c.h"
 
 #ifdef KR_headers
+extern char *F77_aloc();
+
+ integer
 system_(s, n) register char *s; ftnlen n;
 #else
 #undef abs
 #undef min
 #undef max
 #include "stdlib.h"
+extern char *F77_aloc(ftnlen, char*);
+
+ integer
 system_(register char *s, ftnlen n)
 #endif
 {
-char buff[1000];
-register char *bp, *blast;
+	char buff0[256], *buff;
+	register char *bp, *blast;
+	integer rv;
 
-blast = buff + (n < 1000 ? n : 1000);
+	buff = bp = n < sizeof(buff0)
+			? buff0 : F77_aloc(n+1, "system_");
+	blast = bp + n;
 
-for(bp = buff ; bp<blast && *s!='\0' ; )
-	*bp++ = *s++;
-*bp = '\0';
-return system(buff);
-}
+	while(bp < blast && *s)
+		*bp++ = *s++;
+	*bp = 0;
+	rv = system(buff);
+	if (buff != buff0)
+		free(buff);
+	return rv;
+	}