Forget the description, it's too late at night...
# 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
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
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
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
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
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
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.
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
#
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:
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.
-/* $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
*
* 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
#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[];
"FTATIME",
"FTCTIME",
"WAITPID",
- "264"
+ "ALARM",
+ "268"
};
#endif
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 */
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 */
A(1,0,0), /* FTATIME */
A(1,0,0), /* FTCTIME */
A(1,1,0), /* WAITPID */
+ A(1,0,0), /* ALARM */
0
};
#undef A
-/* $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
*
* 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
{
register CMD *cmd;
register CMD *head = cur->c_head;
- register ARG *arg;
STR *str;
if (!head)
--- /dev/null
+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
+\f
+# 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);
+ }
+}
+\f
+# 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);
+ }
+}
+\f
+# 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);
+ }
+ }
+}
+\f
+# 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
+ }
+ }
+}
+\f
+# 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;
--- /dev/null
+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
+#
+\f
+# 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/^-/+/;
+ $_;
+}
+\f
+# 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;
+ }
+}
+\f
+# 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];
+}
+\f
+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;
--- /dev/null
+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
+\f
+# 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));
+}
+\f
+# 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;
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
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
(-W1 -Od -Ocgelt hash.c str.c util.c walk.c)
setargv.obj
-a2p.def
+..\os2\a2p.def
a2p.exe
-AL -LB -S0xA000
*
* 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
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).
{
char *_d_entry;
long _d_size;
- int _d_mode;
+ unsigned _d_mode, _d_time, _d_date;
struct _dircontents *_d_next;
};
DIR;
+extern int attributes;
+
extern DIR *opendir(char *);
extern struct direct *readdir(DIR *);
extern void seekdir(DIR *, long);
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)
-*/
-#define PATCHLEVEL 37
+#define PATCHLEVEL 38
#!./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.
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;
#!./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";
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";
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
#
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.
projects / p5sagit/p5-mst-13.2.git / commitdiff