perl 3.0 patch #38 (combined patch)

Forget the description, it's too late at night...

16 files changed, 767 insertions, 140 deletions

diff --git a/Configure b/Configure
index c1cdf6bc55..572659ad5a 100755
--- a/Configure
+++ b/Configure
@@ -8,7 +8,7 @@
 # and edit it to reflect your system.  Some packages may include samples
 # of config.h for certain machines, so you might look for one of those.)
 #
-# $Header: Configure,v 3.0.1.11 90/10/20 01:55:30 lwall Locked $
+# $Header: Configure,v 3.0.1.12 90/11/10 00:57:30 lwall Locked $
 #
 # Yes, you may rip this off to use in other distribution packages.
 # (Note: this Configure script was generated automatically.  Rather than
@@ -1404,6 +1404,9 @@ if test -f "$1"; then
     libc="$1"
 elif test -f $libc; then
     echo "Your C library is in $libc, like you said before."
+    if test $libc = "/lib/libc"; then
+	libc="$libc /lib/clib"
+    fi
 elif test -f /lib/libc.a; then
     echo "Your C library is in /lib/libc.a.  You're normal."
     libc=/lib/libc.a
@@ -1449,7 +1452,7 @@ echo " "
 set `echo $libc $libnames | tr ' ' '\012' | sort | uniq`
 $echo $n "Extracting names from $* for later perusal...$c"
 nm $* 2>/dev/null >libc.tmp
-$sed -n -e 's/^.* [ATD]  *_[_.]*//p' -e 's/^.* [ATD] //p' <libc.tmp >libc.list
+$sed -n -e 's/^.* [ATDS]  *_[_.]*//p' -e 's/^.* [ATDS] //p' <libc.tmp >libc.list
 if $contains '^printf$' libc.list >/dev/null 2>&1; then
     echo "done"
 else
diff --git a/MANIFEST b/MANIFEST
index ecc18bede8..4b3b6492fd 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -85,6 +85,9 @@ hash.c			Associative arrays
 hash.h			Public declarations for the above
 ioctl.pl		Sample ioctl.pl
 lib/abbrev.pl		An abbreviation table builder
+lib/bigfloat.pl		An arbitrary precision floating point package
+lib/bigint.pl		An arbitrary precision integer arithmetic package
+lib/bigrat.pl		An arbitrary precision rational arithmetic package
 lib/cacheout.pl		Manages output filehandles when you need too many
 lib/complete.pl		A command completion subroutine
 lib/ctime.pl		A ctime workalike
@@ -132,6 +135,7 @@ os2/os2.c		Unix compatibility functions
 os2/perl.bad		names of protect-only API calls for BIND
 os2/perl.cs		Compiler script for perl
 os2/perl.def		Linker defs for perl
+os2/perldb.dif		Changes to make the debugger work
 os2/perlglob.cs		Compiler script for perlglob
 os2/perlglob.def	Linker defs for perlglob
 os2/perlsh.cmd		Poor man's shell for os2
@@ -184,6 +188,7 @@ t/io.inplace		See if inplace editing works
 t/io.pipe		See if secure pipes work
 t/io.print		See if print commands work
 t/io.tell		See if file seeking works
+t/lib.big		See if lib/bigint.pl works
 t/op.append		See if . works
 t/op.array		See if array operations work
 t/op.auto		See if autoincrement et all work
@@ -257,3 +262,4 @@ x2p/str.h		Public declarations for the above
 x2p/util.c		Utility routines
 x2p/util.h		Public declarations for the above
 x2p/walk.c		Parse tree walker
+config_h.SH	Produces config.h.
diff --git a/Makefile.SH b/Makefile.SH
index 3197d60c9e..700f229249 100644
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -25,9 +25,12 @@ esac
 
 echo "Extracting Makefile (with variable substitutions)"
 cat >Makefile <<!GROK!THIS!
-# $Header: Makefile.SH,v 3.0.1.10 90/10/20 01:59:21 lwall Locked $
+# $Header: Makefile.SH,v 3.0.1.11 90/11/10 01:25:51 lwall Locked $
 #
 # $Log:	Makefile.SH,v $
+# Revision 3.0.1.11  90/11/10  01:25:51  lwall
+# patch38: new arbitrary precision libraries from Mark Biggar
+# 
 # Revision 3.0.1.10  90/10/20  01:59:21  lwall
 # patch37: added cryptlib support to Makefile
 # 
@@ -377,7 +380,7 @@ depend: makedepend
 	cd x2p; $(MAKE) depend
 
 test: perl
-	- chmod +x t/TEST t/base.* t/comp.* t/cmd.* t/io.* t/op.*; \
+	- chmod +x t/TEST t/base.* t/comp.* t/cmd.* t/io.* t/op.* t/lib.*; \
 	cd t && (rm -f perl; $(SLN) ../perl .) && ./perl TEST
 
 clist:
diff --git a/README b/README
index 1b96f88322..9a3c7e26e5 100644
--- a/README
+++ b/README
@@ -102,13 +102,17 @@ Installation
     SGI machines may need -Ddouble="long float".
     Ultrix (2.3) may need to hand assemble teval.s with a -J switch.
     Ultrix on MIPS machines may need -DLANGUAGE_C.
+    Ultrix 3.[01] on MIPS needs to undefine WAITPID--the system call is busted.
+    MIPS machines may need to undef d_volatile.
     MIPS machines may need to turn off -O on perly.c and tperly.c.
+    Some MIPS machines may need to undefine CASTNEGFLOAT.
     SCO Xenix may need -m25000 for yacc.
-    Xenix 386 needs -Sm10000 for yacc.
+    Xenix 386 needs -Sm11000 for yacc, and may need -UM_I86.
     Genix needs to use libc rather than libc_s, or #undef VARARGS.
     NCR Tower 32 (OS 2.01.01) may need -W2,-Sl,2000 and #undef MKDIR.
     A/UX may need -ZP -DPOSIX, and -g if big cc is used.
     FPS machines may need -J and -DBADSWITCH.
+    UTS may need one or more of -DCRIPPLED_CC, -K or -g, and undef LSTAT.
     If you get syntax errors on '(', try -DCRIPPLED_CC or -DBADSWITCH or both.
     Machines with half-implemented dbm routines will need to #undef ODBM & NDBM.
     C's that don't try to restore registers on longjmp() may need -DJMPCLOBBER.
diff --git a/arg.h b/arg.h
index df139dbbca..8947baac3c 100644
--- a/arg.h
+++ b/arg.h
@@ -1,4 +1,4 @@
-/* $Header: arg.h,v 3.0.1.7 90/10/15 14:53:59 lwall Locked $
+/* $Header: arg.h,v 3.0.1.8 90/11/10 01:04:36 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	arg.h,v $
+ * Revision 3.0.1.8  90/11/10  01:04:36  lwall
+ * patch38: added alarm function
+ * patch38: socket, recv, select, socketpair, setsockopt didn't eval all args
+ * 
  * Revision 3.0.1.7  90/10/15  14:53:59  lwall
  * patch29: added SysV IPC
  * patch29: added waitpid
@@ -310,7 +314,8 @@
 #define O_FTATIME 264
 #define O_FTCTIME 265
 #define O_WAITPID 266
-#define MAXO 267
+#define O_ALARM 267
+#define MAXO 268
 
 #ifndef DOINIT
 extern char *opname[];
@@ -583,7 +588,8 @@ char *opname[] = {
     "FTATIME",
     "FTCTIME",
     "WAITPID",
-    "264"
+    "ALARM",
+    "268"
 };
 #endif
 
@@ -889,15 +895,15 @@ unsigned short opargs[MAXO+1] = {
 	A(0,0,0),	/* DUMP */
 	A(0,3,0),	/* REVERSE */
 	A(1,0,0),	/* ADDROF */
-	A(1,1,1),	/* SOCKET */
+	A5(1,1,1,1,0),	/* SOCKET */
 	A(1,1,0),	/* BIND */
 	A(1,1,0),	/* CONNECT */
 	A(1,1,0),	/* LISTEN */
 	A(1,1,0),	/* ACCEPT */
 	A(1,1,3),	/* SEND */
-	A(1,1,3),	/* RECV */
-	A(1,1,1),	/* SSELECT */
-	A(1,1,1),	/* SOCKPAIR */
+	A5(1,1,1,1,0),	/* RECV */
+	A5(1,1,1,1,0),	/* SSELECT */
+	A5(1,1,1,1,1),	/* SOCKPAIR */
 	A(0,3,0),	/* DBSUBR */
 	A(1,0,0),	/* DEFINED */
 	A(1,0,0),	/* UNDEF */
@@ -952,7 +958,7 @@ unsigned short opargs[MAXO+1] = {
 	A(0,0,0),	/* GETLOGIN */
 	A(1,3,0),	/* SYSCALL */
 	A(1,1,1),	/* GSOCKOPT */
-	A(1,1,1),	/* SSOCKOPT */
+	A5(1,1,1,1,0),	/* SSOCKOPT */
 	A(1,0,0),	/* GETSOCKNAME */
 	A(1,0,0),	/* GETPEERNAME */
 	A(0,3,3),	/* LSLICE */
@@ -981,6 +987,7 @@ unsigned short opargs[MAXO+1] = {
 	A(1,0,0),	/* FTATIME */
 	A(1,0,0),	/* FTCTIME */
 	A(1,1,0),	/* WAITPID */
+	A(1,0,0),	/* ALARM */
 	0
 };
 #undef A
diff --git a/cons.c b/cons.c
index 3938b994d3..638cb0a415 100644
--- a/cons.c
+++ b/cons.c
@@ -1,4 +1,4 @@
-/* $Header: cons.c,v 3.0.1.8 90/10/15 15:41:09 lwall Locked $
+/* $Header: cons.c,v 3.0.1.9 90/11/10 01:10:50 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	cons.c,v $
+ * Revision 3.0.1.9  90/11/10  01:10:50  lwall
+ * patch38: random cleanup
+ * 
  * Revision 3.0.1.8  90/10/15  15:41:09  lwall
  * patch29: added caller
  * patch29: scripts now run at almost full speed under the debugger
@@ -449,7 +452,6 @@ CMD *cur;
 {
     register CMD *cmd;
     register CMD *head = cur->c_head;
-    register ARG *arg;
     STR *str;
 
     if (!head)
diff --git a/lib/bigfloat.pl b/lib/bigfloat.pl
new file mode 100644
index 0000000000..feaaa6e494
--- /dev/null
+++ b/lib/bigfloat.pl
@@ -0,0 +1,236 @@
+package bigfloat;
+require "bigint.pl";
+
+# Arbitrary length float math package
+#
+# number format
+#   canonical strings have the form /[+-]\d+E[+-]\d+/
+#   Input values can have inbedded whitespace
+# Error returns
+#   'NaN'           An input parameter was "Not a Number" or 
+#                       divide by zero or sqrt of negative number
+# Division is computed to 
+#   max($div_scale,length(dividend).length(divisor)) 
+#   digits by default.
+# Also used for default sqrt scale
+
+$div_scale = 40;
+
+# Rounding modes one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'.
+
+$rnd_mode = 'even';
+
+#   bigfloat routines
+#
+#   fadd(NSTR, NSTR) return NSTR            addition
+#   fsub(NSTR, NSTR) return NSTR            subtraction
+#   fmul(NSTR, NSTR) return NSTR            multiplication
+#   fdiv(NSTR, NSTR[,SCALE]) returns NSTR   division to SCALE places
+#   fneg(NSTR) return NSTR                  negation
+#   fabs(NSTR) return NSTR                  absolute value
+#   fcmp(NSTR,NSTR) return CODE             compare undef,<0,=0,>0
+#   fround(NSTR, SCALE) return NSTR         round to SCALE digits
+#   ffround(NSTR, SCALE) return NSTR        round at SCALEth place
+#   fnorm(NSTR) return (NSTR)               normalize
+#   fsqrt(NSTR[, SCALE]) return NSTR        sqrt to SCALE places
+
+# Convert a number to canonical string form.
+#   Takes something that looks like a number and converts it to
+#   the form /^[+-]\d+E[+-]\d+$/.
+sub main'fnorm { #(string) return fnum_str
+    local($_) = @_;
+    s/\s+//g;                               # strip white space
+    if (/^([+-]?)(\d*)(\.(\d*))?([Ee]([+-]?\d+))?$/ && "$2$4" ne '') {
+	&norm(($1 ? "$1$2$4" : "+$2$4"),(($4 ne '') ? $6-length($4) : $6));
+    } else {
+	'NaN';
+    }
+}
+
+# normalize number -- for internal use
+sub norm { #(mantissa, exponent) return fnum_str
+    local($_, $exp) = @_;
+    if ($_ eq 'NaN') {
+	'NaN';
+    } else {
+	s/^([+-])0+/$1/;                        # strip leading zeros
+	if (length($_) == 1) {
+	    '+0E+0';
+	} else {
+	    $exp += length($1) if (s/(0+)$//);  # strip trailing zeros
+	    sprintf("%sE%+ld", $_, $exp);
+	}
+    }
+}
+
+# negation
+sub main'fneg { #(fnum_str) return fnum_str
+    local($_) = &'fnorm($_[0]);
+    substr($_,0,1) =~ tr/+-/-+/ if ($_ ne '+0E+0'); # flip sign
+    $_;
+}
+
+# absolute value
+sub main'fabs { #(fnum_str) return fnum_str
+    local($_) = &'fnorm($_[0]);
+    substr($_,0,1) = '+';                       # mash sign
+    $_;
+}
+
+# multiplication
+sub main'fmul { #(fnum_str, fnum_str) return fnum_str
+    local($x,$y) = (&'fnorm($_[0]),&'fnorm($_[1]));
+    if ($x eq 'NaN' || $y eq 'NaN') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	local($ym,$ye) = split('E',$y);
+	&norm(&'bmul($xm,$ym),$xe+$ye);
+    }
+}
+
+# addition
+sub main'fadd { #(fnum_str, fnum_str) return fnum_str
+    local($x,$y) = (&'fnorm($_[0]),&'fnorm($_[1]));
+    if ($x eq 'NaN' || $y eq 'NaN') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	local($ym,$ye) = split('E',$y);
+	($xm,$xe,$ym,$ye) = ($ym,$ye,$xm,$xe) if ($xe < $ye);
+	&norm(&'badd($ym,$xm.('0' x ($xe-$ye))),$ye);
+    }
+}
+
+# subtraction
+sub main'fsub { #(fnum_str, fnum_str) return fnum_str
+    &'fadd($_[0],&'fneg($_[1]));    
+}
+
+# division
+#   args are dividend, divisor, scale (optional)
+#   result has at most max(scale, length(dividend), length(divisor)) digits
+sub main'fdiv #(fnum_str, fnum_str[,scale]) return fnum_str
+{
+    local($x,$y,$scale) = (&'fnorm($_[0]),&'fnorm($_[1]),$_[2]);
+    if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0E+0') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	local($ym,$ye) = split('E',$y);
+	$scale = $div_scale if (!$scale);
+	$scale = length($xm)-1 if (length($xm)-1 > $scale);
+	$scale = length($ym)-1 if (length($ym)-1 > $scale);
+	$scale = $scale + length($ym) - length($xm);
+	&norm(&round(&'bdiv($xm.('0' x $scale),$ym),$ym),
+	    $xe-$ye-$scale);
+    }
+}
+
+# round int $q based on fraction $r/$base using $rnd_mode
+sub round { #(int_str, int_str, int_str) return int_str
+    local($q,$r,$base) = @_;
+    if ($q eq 'NaN' || $r eq 'NaN') {
+	'NaN';
+    } elsif ($rnd_mode eq 'trunc') {
+	$q;                         # just truncate
+    } else {
+	local($cmp) = &'bcmp(&'bmul($r,'+2'),$base);
+	if ( $cmp < 0 ||
+		 ($cmp == 0 &&
+		  ( $rnd_mode eq 'zero'                             ||
+		   ($rnd_mode eq '-inf' && (substr($q,0,1) eq '+')) ||
+		   ($rnd_mode eq '+inf' && (substr($q,0,1) eq '-')) ||
+		   ($rnd_mode eq 'even' && $q =~ /[24680]$/)        ||
+		   ($rnd_mode eq 'odd'  && $q =~ /[13579]$/)        )) ) {
+	    $q;                     # round down
+	} else {
+	    &'badd($q, ((substr($q,0,1) eq '-') ? '-1' : '+1'));
+				    # round up
+	}
+    }
+}
+
+# round the mantissa of $x to $scale digits
+sub main'fround { #(fnum_str, scale) return fnum_str
+    local($x,$scale) = (&'fnorm($_[0]),$_[1]);
+    if ($x eq 'NaN' || $scale <= 0) {
+	$x;
+    } else {
+	local($xm,$xe) = split('E',$x);
+	if (length($xm)-1 <= $scale) {
+	    $x;
+	} else {
+	    &norm(&round(substr($xm,0,$scale+1),
+			 "+0".substr($xm,$scale+1,1),"+10"),
+		  $xe+length($xm)-$scale-1);
+	}
+    }
+}
+
+# round $x at the 10 to the $scale digit place
+sub main'ffround { #(fnum_str, scale) return fnum_str
+    local($x,$scale) = (&'fnorm($_[0]),$_[1]);
+    if ($x eq 'NaN') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	if ($xe >= $scale) {
+	    $x;
+	} else {
+	    $xe = length($xm)+$xe-$scale;
+	    if ($xe < 1) {
+		'+0E+0';
+	    } elsif ($xe == 1) {
+		&norm(&round('+0',"+0".substr($xm,1,1),"+10"), $scale);
+	    } else {
+		&norm(&round(substr($xm,0,$trunc),
+		      "+0".substr($xm,$trunc,1),"+10"), $scale);
+	    }
+	}
+    }
+}
+    
+# compare 2 values returns one of undef, <0, =0, >0
+#   returns undef if either or both input value are not numbers
+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
+	}
+    }
+}
+
+# square root by Newtons method.
+sub main'fsqrt { #(fnum_str[, scale]) return fnum_str
+    local($x, $scale) = (&'fnorm($_[0]), $_[1]);
+    if ($x eq 'NaN' || $x =~ /^-/) {
+	'NaN';
+    } elsif ($x eq '+0E+0') {
+	'+0E+0';
+    } else {
+	local($xm, $xe) = split('E',$x);
+	$scale = $div_scale if (!$scale);
+	$scale = length($xm)-1 if ($scale < length($xm)-1);
+	local($gs, $guess) = (1, sprintf("1E%+d", (length($xm)+$xe-1)/2));
+	while ($gs < 2*$scale) {
+	    $guess = &'fmul(&'fadd($guess,&'fdiv($x,$guess,$gs*2)),".5");
+	    $gs *= 2;
+	}
+	&'fround($guess, $scale);
+    }
+}
+
+1;
diff --git a/lib/bigint.pl b/lib/bigint.pl
new file mode 100644
index 0000000000..503c7837c2
--- /dev/null
+++ b/lib/bigint.pl
@@ -0,0 +1,275 @@
+package bigint;
+
+# arbitrary size integer math package
+#
+# by Mark Biggar
+#
+# Canonical Big integer value are strings of the form
+#       /^[+-]\d+$/ with leading zeros suppressed
+# Input values to these routines may be strings of the form
+#       /^\s*[+-]?[\d\s]+$/.
+# Examples:
+#   '+0'                            canonical zero value
+#   '   -123 123 123'               canonical value '-123123123'
+#   '1 23 456 7890'                 canonical value '+1234567890'
+# Output values always always in canonical form
+#
+# Actual math is done in an internal format consisting of an array
+#   whose first element is the sign (/^[+-]$/) and whose remaining 
+#   elements are base 100000 digits with the least significant digit first.
+# The string 'NaN' is used to represent the result when input arguments 
+#   are not numbers, as well as the result of dividing by zero
+#
+# routines provided are:
+#
+#   bneg(BINT) return BINT              negation
+#   babs(BINT) return BINT              absolute value
+#   bcmp(BINT,BINT) return CODE         compare numbers (undef,<0,=0,>0)
+#   badd(BINT,BINT) return BINT         addition
+#   bsub(BINT,BINT) return BINT         subtraction
+#   bmul(BINT,BINT) return BINT         multiplication
+#   bdiv(BINT,BINT) return (BINT,BINT)  division (quo,rem) just quo if scalar
+#   bmod(BINT,BINT) return BINT         modulus
+#   bgcd(BINT,BINT) return BINT         greatest common divisor
+#   bnorm(BINT) return BINT             normalization
+#
+
+# normalize string form of number.   Strip leading zeros.  Strip any
+#   white space and add a sign, if missing.
+# Strings that are not numbers result the value 'NaN'.
+sub main'bnorm { #(num_str) return num_str
+    local($_) = @_;
+    s/\s+//g;                           # strip white space
+    if (s/^([+-]?)0*(\d+)$/$1$2/) {     # test if number
+	substr($_,0,0) = '+' unless $1; # Add missing sign
+	s/^-0/+0/;
+	$_;
+    } else {
+	'NaN';
+    }
+}
+
+# Convert a number from string format to internal base 100000 format.
+#   Assumes normalized value as input.
+sub internal { #(num_str) return int_num_array
+    local($d) = @_;
+    ($is,$il) = (substr($d,0,1),length($d)-2);
+    substr($d,0,1) = '';
+    ($is, reverse(unpack("a" . ($il%5+1) . ("a5" x ($il/5)), $d)));
+}
+
+# Convert a number from internal base 100000 format to string format.
+#   This routine scribbles all over input array.
+sub external { #(int_num_array) return num_str
+    $es = shift;
+    grep($_ > 9999 || ($_ = substr('0000'.$_,-5)), @_);   # zero pad
+    &'bnorm(join('', $es, reverse(@_)));    # reverse concat and normalize
+}
+
+# Negate input value.
+sub main'bneg { #(num_str) return num_str
+    local($_) = &'bnorm(@_);
+    vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0';
+    s/^H/N/;
+    $_;
+}
+
+# Returns the absolute value of the input.
+sub main'babs { #(num_str) return num_str
+    &abs(&'bnorm(@_));
+}
+
+sub abs { # post-normalized abs for internal use
+    local($_) = @_;
+    s/^-/+/;
+    $_;
+}
+
+# Compares 2 values.  Returns one of undef, <0, =0, >0. (suitable for sort)
+sub main'bcmp { #(num_str, num_str) return cond_code
+    local($x,$y) = (&'bnorm($_[0]),&'bnorm($_[1]));
+    if ($x eq 'NaN') {
+	undef;
+    } elsif ($y eq 'NaN') {
+	undef;
+    } else {
+	&cmp($x,$y);
+    }
+}
+
+sub cmp { # post-normalized compare for internal use
+    local($cx, $cy) = @_;
+    $cx cmp $cy
+    &&
+    (
+	ord($cy) <=> ord($cx)
+	||
+	($cx cmp ',') * (length($cy) <=> length($cx) || $cy cmp $cx)
+    );
+}
+
+sub main'badd { #(num_str, num_str) return num_str
+    local(*x, *y); ($x, $y) = (&'bnorm($_[0]),&'bnorm($_[1]));
+    if ($x eq 'NaN') {
+	'NaN';
+    } elsif ($y eq 'NaN') {
+	'NaN';
+    } else {
+	@x = &internal($x);             # convert to internal form
+	@y = &internal($y);
+	local($sx, $sy) = (shift @x, shift @y); # get signs
+	if ($sx eq $sy) {
+	    &external($sx, &add(*x, *y)); # if same sign add
+	} else {
+	    ($x, $y) = (&abs($x),&abs($y)); # make abs
+	    if (&cmp($y,$x) > 0) {
+		&external($sy, &sub(*y, *x));
+	    } else {
+		&external($sx, &sub(*x, *y));
+	    }
+	}
+    }
+}
+
+sub main'bsub { #(num_str, num_str) return num_str
+    &'badd($_[0],&'bneg($_[1]));    
+}
+
+# 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') {
+	'NaN';
+    }
+    else {
+	($x, $y) = ($y,&'bmod($x,$y)) while $y ne '+0';
+	$x;
+    }
+}
+
+# routine to add two base 100000 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
+    local(*x, *y) = @_;
+    $car = 0;
+    for $x (@x) {
+	last unless @y || $car;
+	$x -= 100000 if $car = (($x += shift @y + $car) >= 100000);
+    }
+    for $y (@y) {
+	last unless $car;
+	$y -= 100000 if $car = (($y += $car) >= 100000);
+    }
+    (@x, @y, $car);
+}
+
+# subtract base 100000 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;
+}
+
+# multiply two numbers -- stolen from Knuth Vol 2 pg 233
+sub main'bmul { #(num_str, num_str) return num_str
+    local(*x, *y); ($x, $y) = (&'bnorm($_[0]), &'bnorm($_[1]));
+    if ($x eq 'NaN') {
+	'NaN';
+    } elsif ($y eq 'NaN') {
+	'NaN';
+    } else {
+	@x = &internal($x);
+	@y = &internal($y);
+	local($signr) = (shift @x ne shift @y) ? '-' : '+';
+	@prod = ();
+	for $x (@x) {
+	    ($car, $cty) = (0, 0);
+	    for $y (@y) {
+		$prod = $x * $y + $prod[$cty] + $car;
+		$prod[$cty++] =
+		    $prod - ($car = int($prod * (1/100000))) * 100000;
+	    }
+	    $prod[$cty] += $car if $car;
+	    $x = shift @prod;
+	}
+	&external($signr, @x, @prod);
+    }
+}
+
+# modulus
+sub main'bmod { #(num_str, num_str) return num_str
+    (&'bdiv(@_))[1];
+}
+
+sub main'bdiv { #(dividend: num_str, divisor: num_str) return num_str
+    local (*x, *y); ($x, $y) = (&'bnorm($_[0]), &'bnorm($_[1]));
+    return wantarray ? ('NaN','NaN') : 'NaN'
+	if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0');
+    return wantarray ? ('+0',$x) : '+0' if (&cmp(&abs($x),&abs($y)) < 0);
+    @x = &internal($x); @y = &internal($y);
+    $srem = $y[0];
+    $sr = (shift @x ne shift @y) ? '-' : '+';
+    $car = $bar = $prd = 0;
+    if (($dd = int(100000/($y[$#y]+1))) != 1) {
+	for $x (@x) {
+	    $x = $x * $dd + $car;
+	    $x -= ($car = int($x * (1/100000))) * 100000;
+	}
+	push(@x, $car); $car = 0;
+	for $y (@y) {
+	    $y = $y * $dd + $car;
+	    $y -= ($car = int($y * (1/100000))) * 100000;
+	}
+    }
+    else {
+	push(@x, 0);
+    }
+    @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);
+	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));
+	    }
+	    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));
+		}
+	    }   
+	}
+	pop(@x); unshift(@q, $q);
+    }
+    if (wantarray) {
+	@d = ();
+	if ($dd != 1) {
+	    $car = 0;
+	    for $x (reverse @x) {
+		$prd = $car * 100000 + $x;
+		$car = $prd - ($tmp = int($prd / $dd)) * $dd;
+		unshift(@d, $tmp);
+	    }
+	}
+	else {
+	    @d = @x;
+	}
+	(&external($sr, @q), &external($srem, @d, 0));
+    } else {
+	&external($sr, @q);
+    }
+}
+1;
diff --git a/lib/bigrat.pl b/lib/bigrat.pl
new file mode 100644
index 0000000000..3157cf8244
--- /dev/null
+++ b/lib/bigrat.pl
@@ -0,0 +1,146 @@
+package bigrat;
+require "bigint.pl";
+
+# Arbitrary size rational math package
+#
+# Input values to these routines consist of strings of the form 
+#   m|^\s*[+-]?[\d\s]+(/[\d\s]+)?$|.
+# Examples:
+#   "+0/1"                          canonical zero value
+#   "3"                             canonical value "+3/1"
+#   "   -123/123 123"               canonical value "-1/1001"
+#   "123 456/7890"                  canonical value "+20576/1315"
+# Output values always include a sign and no leading zeros or
+#   white space.
+# This package makes use of the bigint package.
+# The string 'NaN' is used to represent the result when input arguments 
+#   that are not numbers, as well as the result of dividing by zero and
+#       the sqrt of a negative number.
+# Extreamly naive algorthims are used.
+#
+# Routines provided are:
+#
+#   rneg(RAT) return RAT                negation
+#   rabs(RAT) return RAT                absolute value
+#   rcmp(RAT,RAT) return CODE           compare numbers (undef,<0,=0,>0)
+#   radd(RAT,RAT) return RAT            addition
+#   rsub(RAT,RAT) return RAT            subtraction
+#   rmul(RAT,RAT) return RAT            multiplication
+#   rdiv(RAT,RAT) return RAT            division
+#   rmod(RAT) return (RAT,RAT)          integer and fractional parts
+#   rnorm(RAT) return RAT               normalization
+#   rsqrt(RAT, cycles) return RAT       square root
+
+# Convert a number to the canonical string form m|^[+-]\d+/\d+|.
+sub main'rnorm { #(string) return rat_num
+    local($_) = @_;
+    s/\s+//g;
+    if (m#^([+-]?\d+)(/(\d*[1-9]0*))?$#) {
+	&norm($1, $3 ? $3 : '+1');
+    } else {
+	'NaN';
+    }
+}
+
+# Normalize by reducing to lowest terms
+sub norm { #(bint, bint) return rat_num
+    local($num,$dom) = @_;
+    if ($num eq 'NaN') {
+	'NaN';
+    } elsif ($dom eq 'NaN') {
+	'NaN';
+    } elsif ($dom =~ /^[+-]?0+$/) {
+	'NaN';
+    } else {
+	local($gcd) = &'bgcd($num,$dom);
+	if ($gcd ne '+1') { 
+	    $num = &'bdiv($num,$gcd);
+	    $dom = &'bdiv($dom,$gcd);
+	} else {
+	    $num = &'bnorm($num);
+	    $dom = &'bnorm($dom);
+	}
+	substr($dom,0,1) = '';
+	"$num/$dom";
+    }
+}
+
+# negation
+sub main'rneg { #(rat_num) return rat_num
+    local($_) = &'rnorm($_[0]);
+    tr/-+/+-/ if ($_ ne '+0/1');
+    $_;
+}
+
+# absolute value
+sub main'rabs { #(rat_num) return $rat_num
+    local($_) = &'rnorm($_[0]);
+    substr($_,0,1) = '+';
+    $_;
+}
+
+# multipication
+sub main'rmul { #(rat_num, rat_num) return rat_num
+    local($xn,$xd) = split('/',&'rnorm($_[0]));
+    local($yn,$yd) = split('/',&'rnorm($_[1]));
+    &norm(&'bmul($xn,$yn),&'bmul($xd,$yd));
+}
+
+# division
+sub main'rdiv { #(rat_num, rat_num) return rat_num
+    local($xn,$xd) = split('/',&'rnorm($_[0]));
+    local($yn,$yd) = split('/',&'rnorm($_[1]));
+    &norm(&'bmul($xn,$yd),&'bmul($xd,$yn));
+}
+
+# addition
+sub main'radd { #(rat_num, rat_num) return rat_num
+    local($xn,$xd) = split('/',&'rnorm($_[0]));
+    local($yn,$yd) = split('/',&'rnorm($_[1]));
+    &norm(&'badd(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
+}
+
+# subtraction
+sub main'rsub { #(rat_num, rat_num) return rat_num
+    local($xn,$xd) = split('/',&'rnorm($_[0]));
+    local($yn,$yd) = split('/',&'rnorm($_[1]));
+    &norm(&'bsub(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
+}
+
+# comparison
+sub main'rcmp { #(rat_num, rat_num) return cond_code
+    local($xn,$xd) = split('/',&'rnorm($_[0]));
+    local($yn,$yd) = split('/',&'rnorm($_[1]));
+    &bigint'cmp(&'bmul($xn,$yd),&'bmul($yn,$xd));
+}
+
+# int and frac parts
+sub main'rmod { #(rat_num) return (rat_num,rat_num)
+    local($xn,$xd) = split('/',&'rnorm($_[0]));
+    local($i,$f) = &'bdiv($xn,$xd);
+    if (wantarray) {
+	("$i/1", "$f/$xd");
+    } else {
+	"$i/1";
+    }   
+}
+
+# square root by Newtons method.
+#   cycles specifies the number of iterations default: 5
+sub main'rsqrt { #(fnum_str[, cycles]) return fnum_str
+    local($x, $scale) = (&'rnorm($_[0]), $_[1]);
+    if ($x eq 'NaN') {
+	'NaN';
+    } elsif ($x =~ /^-/) {
+	'NaN';
+    } else {
+	local($gscale, $guess) = (0, '+1/1');
+	$scale = 5 if (!$scale);
+	while ($gscale++ < $scale) {
+	    $guess = &'rmul(&'radd($guess,&'rdiv($x,$guess)),"+1/2");
+	}
+	"$guess";          # quotes necessary due to perl bug
+    }
+}
+
+1;
diff --git a/os2/README.OS2 b/os2/README.OS2
index 99cd9a24c1..11ff14c4d4 100644
--- a/os2/README.OS2
+++ b/os2/README.OS2
@@ -336,6 +336,7 @@ a2p.def           linker definition file for a2p
 makefile          Makefile, not tested
 
 perlsh.cmd        the converted perlsh
+perldb.dif        changes required for perldb.pl (change for your needs)
 selfrun.cmd       sample selfrunning perl script for OS/2
 selfrun.bat       sample selfrunning perl script for DOS mode
 
@@ -353,4 +354,28 @@ especially not with -DDEBUGGING
                                 rommel@lan.informatik.tu-muenchen.dbp.de
                                 Breslauer Str. 25
                                 D-8756 Kahl/Main
-                                West (yes, still!) Germany
+  
++ I have verified with patchlevel 37, that the OS/2 port compiles,
+  after doing two minor changes. HPFS filenames support was also added.
+  Some bugs were fixed.
++ To compile,
+  - you need the bison parser generator
+  - copy config.h from os2 into the main perl directory (important !)
+  - copy perl.cs and perlglob.cs from the os2 subdir to the main dir
+  - copy a2p.cs from os2 to x2p
+  - say "bison -d perl.y"
+      "ren perl_tab.c perl.c" and
+      "ren perl_tab.h perly.h"	in the main directory
+  - say "cs perl" and
+      "cs perlglob" in the main directory
+  - say "cs a2p" in the x2p subdir
++ If you don't have CS or don't want to use it, you have to
+  construct a makefile ...
++ If you have GNU gdbm, you can define NDBM in config.h and link with a
+  large model library of gdbm.
++ I am not shure if I can verify the OS/2 port with each release
+  from Larry Wall. Therefore, in future releases there may be
+  changes required to compile perl for OS/2.
+ 				October 1990
+				Kai Uwe Rommel
+				rommel@lan.informatik.tu-muenchen.dbp.de
diff --git a/os2/a2p.cs b/os2/a2p.cs
index 1141c4ff17..c12e226efa 100644
--- a/os2/a2p.cs
+++ b/os2/a2p.cs
@@ -2,7 +2,7 @@
 (-W1 -Od -Ocgelt hash.c str.c util.c walk.c)
 
 setargv.obj
-a2p.def
+..\os2\a2p.def
 a2p.exe
 
 -AL -LB -S0xA000
diff --git a/os2/dir.h b/os2/dir.h
index 92c6923ac3..8ebfae988a 100644
--- a/os2/dir.h
+++ b/os2/dir.h
@@ -7,11 +7,12 @@
  *
  *  Enhanced and ported to OS/2 by Kai Uwe Rommel; added scandir() prototype
  *  December 1989, February 1990
+ *  Change of MAXPATHLEN for HPFS, October 1990
  */
 
 
-#define MAXNAMLEN  12
-#define MAXPATHLEN 128
+#define MAXNAMLEN  256
+#define MAXPATHLEN 256
 
 #define A_RONLY    0x01
 #define A_HIDDEN   0x02
@@ -23,12 +24,15 @@
 
 struct direct
 {
-  ino_t d_ino;                   /* a bit of a farce */
-  int   d_reclen;                /* more farce */
-  int   d_namlen;                /* length of d_name */
-  char  d_name[MAXNAMLEN + 1];   /* null terminated */
-  long  d_size;                  /* size in bytes */
-  int   d_mode;                  /* DOS or OS/2 file attributes */
+  ino_t    d_ino;                   /* a bit of a farce */
+  int      d_reclen;                /* more farce */
+  int      d_namlen;                /* length of d_name */
+  char     d_name[MAXNAMLEN + 1];   /* null terminated */
+  /* nonstandard fields */
+  long     d_size;                  /* size in bytes */
+  unsigned d_mode;                  /* DOS or OS/2 file attributes */
+  unsigned d_time;
+  unsigned d_date;
 };
 
 /* The fields d_size and d_mode are extensions by me (Kai Uwe Rommel).
@@ -41,7 +45,7 @@ struct _dircontents
 {
   char *_d_entry;
   long _d_size;
-  int _d_mode;
+  unsigned _d_mode, _d_time, _d_date;
   struct _dircontents *_d_next;
 };
 
@@ -55,6 +59,8 @@ typedef struct _dirdesc
 DIR;
 
 
+extern int attributes;
+
 extern DIR *opendir(char *);
 extern struct direct *readdir(DIR *);
 extern void seekdir(DIR *, long);
@@ -68,96 +74,3 @@ extern int scandir(char *, struct direct ***,
 
 extern int getfmode(char *);
 extern int setfmode(char *, unsigned);
-
-/*
-NAME
-     opendir, readdir, telldir, seekdir, rewinddir, closedir -
-     directory operations
-
-SYNTAX
-     #include <sys/types.h>
-     #include <sys/dir.h>
-
-     DIR *opendir(filename)
-     char *filename;
-
-     struct direct *readdir(dirp)
-     DIR *dirp;
-
-     long telldir(dirp)
-     DIR *dirp;
-
-     seekdir(dirp, loc)
-     DIR *dirp;
-     long loc;
-
-     rewinddir(dirp)
-     DIR *dirp;
-
-     int closedir(dirp)
-     DIR *dirp;
-
-DESCRIPTION
-     The opendir library routine opens the directory named by
-     filename and associates a directory stream with it.  A
-     pointer is returned to identify the directory stream in sub-
-     sequent operations.  The pointer NULL is returned if the
-     specified filename can not be accessed, or if insufficient
-     memory is available to open the directory file.
-
-     The readdir routine returns a pointer to the next directory
-     entry.  It returns NULL upon reaching the end of the direc-
-     tory or on detecting an invalid seekdir operation.  The
-     readdir routine uses the getdirentries system call to read
-     directories. Since the readdir routine returns NULL upon
-     reaching the end of the directory or on detecting an error,
-     an application which wishes to detect the difference must
-     set errno to 0 prior to calling readdir.
-
-     The telldir routine returns the current location associated
-     with the named directory stream. Values returned by telldir
-     are good only for the lifetime of the DIR pointer from which
-     they are derived.  If the directory is closed and then reo-
-     pened, the telldir value may be invalidated due to
-     undetected directory compaction.
-
-     The seekdir routine sets the position of the next readdir
-     operation on the directory stream. Only values returned by
-     telldir should be used with seekdir.
-
-     The rewinddir routine resets the position of the named
-     directory stream to the beginning of the directory.
-
-     The closedir routine closes the named directory stream and
-     returns a value of 0 if successful. Otherwise, a value of -1
-     is returned and errno is set to indicate the error.  All
-     resources associated with this directory stream are
-     released.
-
-EXAMPLE
-     The following sample code searches a directory for the entry
-     name.
-
-     len = strlen(name);
-
-     dirp = opendir(".");
-
-     for (dp = readdir(dirp); dp != NULL; dp = readdir(dirp))
-
-     if (dp->d_namlen == len && !strcmp(dp->d_name, name)) {
-
-               closedir(dirp);
-
-               return FOUND;
-
-          }
-
-     closedir(dirp);
-
-     return NOT_FOUND;
-
-
-SEE ALSO
-     close(2), getdirentries(2), lseek(2), open(2), read(2),
-     dir(5)
-*/
diff --git a/patchlevel.h b/patchlevel.h
index 1bff899020..6f96c1efde 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 37
+#define PATCHLEVEL 38
diff --git a/t/TEST b/t/TEST
index a554c3491e..0d91a47f35 100644
--- a/t/TEST
+++ b/t/TEST
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: TEST,v 3.0.1.1 89/11/11 04:58:01 lwall Locked $
+# $Header: TEST,v 3.0.1.2 90/11/10 02:09:07 lwall Locked $
 
 # This is written in a peculiar style, since we're trying to avoid
 # most of the constructs we'll be testing for.
@@ -15,11 +15,11 @@ if ($ARGV[0] eq '-v') {
 chdir 't' if -f 't/TEST';
 
 if ($ARGV[0] eq '') {
-    @ARGV = split(/[ \n]/,`echo base.* comp.* cmd.* io.* op.*`);
+    @ARGV = split(/[ \n]/,`echo base.* comp.* cmd.* io.* op.* lib.*`);
 }
 
-open(config,"../config.sh");
-while (<config>) {
+open(CONFIG,"../config.sh");
+while (<CONFIG>) {
     if (/sharpbang='(.*)'/) {
 	$sharpbang = ($1 eq '#!');
 	last;
diff --git a/t/comp.cpp b/t/comp.cpp
index 0464108d9e..9e8b1d3378 100644
--- a/t/comp.cpp
+++ b/t/comp.cpp
@@ -1,6 +1,6 @@
 #!./perl -P
 
-# $Header: comp.cpp,v 3.0.1.1 90/08/09 05:25:34 lwall Locked $
+# $Header: comp.cpp,v 3.0.1.2 90/11/10 02:10:17 lwall Locked $
 
 print "1..3\n";
 
@@ -15,21 +15,25 @@ print MESS;
 	print "not ok 2\n";
 #endif
 
-open(try,">Comp.cpp.tmp") || die "Can't open temp perl file.";
-print try '$ok = "not ok 3\n";'; print try "\n";
-print try "#include <Comp.cpp.inc>\n";
-print try "#ifdef OK\n";
-print try '$ok = OK;'; print try "\n";
-print try "#endif\n";
-print try 'print $ok;'; print try "\n";
-close try;
+open(TRY,">Comp.cpp.tmp") || die "Can't open temp perl file.";
 
-open(try,">Comp.cpp.inc") || (die "Can't open temp include file.");
-print try '#define OK "ok 3\n"'; print try "\n";
-close try;
+($prog = <<'END') =~ s/X//g;
+X$ok = "not ok 3\n";
+X#include "Comp.cpp.inc"
+X#ifdef OK
+X$ok = OK;
+X#endif
+Xprint $ok;
+END
+print TRY $prog;
+close TRY;
+
+open(TRY,">Comp.cpp.inc") || (die "Can't open temp include file.");
+print TRY '#define OK "ok 3\n"' . "\n";
+close TRY;
 
 $pwd=`pwd`;
 $pwd =~ s/\n//;
-$x = `./perl -P -I$pwd Comp.cpp.tmp`;
+$x = `./perl -P Comp.cpp.tmp`;
 print $x;
 unlink "Comp.cpp.tmp", "Comp.cpp.inc";
diff --git a/x2p/Makefile.SH b/x2p/Makefile.SH
index 673a639727..119a60dae2 100644
--- a/x2p/Makefile.SH
+++ b/x2p/Makefile.SH
@@ -18,9 +18,12 @@ case "$mallocsrc" in
 esac
 echo "Extracting x2p/Makefile (with variable substitutions)"
 cat >Makefile <<!GROK!THIS!
-# $Header: Makefile.SH,v 3.0.1.6 90/10/16 11:28:18 lwall Locked $
+# $Header: Makefile.SH,v 3.0.1.7 90/11/10 02:20:15 lwall Locked $
 #
 # $Log:	Makefile.SH,v $
+# Revision 3.0.1.7  90/11/10  02:20:15  lwall
+# patch38: random cleanup
+# 
 # Revision 3.0.1.6  90/10/16  11:28:18  lwall
 # patch29: various portability fixes
 # 
@@ -138,10 +141,10 @@ done; \
 fi
 
 clean:
-	rm -f *.o
+	rm -f a2p *.o
 
 realclean: clean
-	rm -f a2p *.orig */*.orig core $(addedbyconf) a2p.c s2p all
+	rm -f *.orig */*.orig core $(addedbyconf) a2p.c s2p all
 
 # The following lint has practically everything turned on.  Unfortunately,
 # you have to wade through a lot of mumbo jumbo that can't be suppressed.