lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (11/10/90)
System: perl version 3.0
Patch #: 38
Priority:
Subject: various portability fixes
Subject: new arbitrary precision libraries from Mark Biggar
Subject: added alarm function
Subject: socket, recv, select, socketpair, setsockopt didn't eval all args
Subject: random cleanup
Subject: optimized join('',...)
Subject: printf cleaned up
Subject: -e _ was wrong if last stat failed
Subject: more msdos/os2 upgrades
Subject: temp string values are now copied less often
Subject: sort parameters are now in the right package
Subject: couldn't return from sort routine
Subject: added hooks for unexec()
Subject: array slurps are now faster and take less memory
Subject: initial revision
Subject: the debugger wouldn't stop correctly or do action routines
Subject: syslog.pl was referencing an absolute path
Subject: documented tr///cds
Subject: references to $0 produced core dumps
Subject: patterns with multiple constant strings occasionally malfed
Subject: patterns like /foo.*foo/ sped up some
Subject: patterns like /^foo.*bar/ sped up some
Subject: /[^whatever]+/ could scan past end of string
Subject: fixed a memory leakage on local(*foo)
Subject: tr was busted in metacharacters on signed char machines
Subject: sequence of s/^x//; s/x$//; could screw up malloc
Description:
Forget the description, it's too late at night...
Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source
directory. Outside of rn, say "cd DIR; patch -p -N <thisarticle".
If you don't have the patch program, apply the following by hand,
or get patch (version 2.0, latest patchlevel).
After patching:
*** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #40 FIRST ***
If patch indicates that patchlevel is the wrong version, you may need
to apply one or more previous patches, or the patch may already
have been applied. See the patchlevel.h file to find out what has or
has not been applied. In any event, don't continue with the patch.
If you are missing previous patches they can be obtained from me:
Larry Wall
lwall@jpl-devvax.jpl.nasa.gov
If you send a mail message of the following form it will greatly speed
processing:
Subject: Command
@SH mailpatch PATH perl 3.0 LIST
^ note the c
where PATH is a return path FROM ME TO YOU either in Internet notation,
or in bang notation from some well-known host, and LIST is the number
of one or more patches you need, separated by spaces, commas, and/or
hyphens. Saying 35- says everything from 35 to the end.
You can also get the patches via anonymous FTP from
jpl-devvax.jpl.nasa.gov (128.149.1.143).
Index: patchlevel.h
Prereq: 37
1c1
< #define PATCHLEVEL 37
---
> #define PATCHLEVEL 38
Index: Configure
Prereq: 3.0.1.11
*** Configure.old Sat Nov 10 02:20:57 1990
--- Configure Sat Nov 10 02:21:14 1990
***************
*** 8,14 ****
# 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 $
#
# Yes, you may rip this off to use in other distribution packages.
# (Note: this Configure script was generated automatically. Rather than
--- 8,14 ----
# 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.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,1409 ****
--- 1404,1412 ----
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,1455 ****
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
if $contains '^printf$' libc.list >/dev/null 2>&1; then
echo "done"
else
--- 1452,1458 ----
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/^.* [ATDS] *_[_.]*//p' -e 's/^.* [ATDS] //p' <libc.tmp >libc.list
if $contains '^printf$' libc.list >/dev/null 2>&1; then
echo "done"
else
Index: MANIFEST
*** MANIFEST.old Sat Nov 10 02:21:33 1990
--- MANIFEST Sat Nov 10 02:21:36 1990
***************
*** 85,90 ****
--- 85,93 ----
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,137 ****
--- 135,141 ----
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,189 ****
--- 188,194 ----
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,259 ****
--- 262,265 ----
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.
Index: Makefile.SH
Prereq: 3.0.1.10
*** Makefile.SH.old Sat Nov 10 01:26:16 1990
--- Makefile.SH Sat Nov 10 01:26:18 1990
***************
*** 25,33 ****
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 $
#
# $Log: Makefile.SH,v $
# Revision 3.0.1.10 90/10/20 01:59:21 lwall
# patch37: added cryptlib support to Makefile
#
--- 25,36 ----
echo "Extracting Makefile (with variable substitutions)"
cat >Makefile <<!GROK!THIS!
! # $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,383 ****
cd x2p; $(MAKE) depend
test: perl
! - chmod +x t/TEST t/base.* t/comp.* t/cmd.* t/io.* t/op.*; \
cd t && (rm -f perl; $(SLN) ../perl .) && ./perl TEST
clist:
--- 380,386 ----
cd x2p; $(MAKE) depend
test: perl
! - 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:
Index: x2p/Makefile.SH
Prereq: 3.0.1.6
*** x2p/Makefile.SH.old Sat Nov 10 02:39:10 1990
--- x2p/Makefile.SH Sat Nov 10 02:39:17 1990
***************
*** 18,26 ****
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 $
#
# $Log: Makefile.SH,v $
# Revision 3.0.1.6 90/10/16 11:28:18 lwall
# patch29: various portability fixes
#
--- 18,29 ----
esac
echo "Extracting x2p/Makefile (with variable substitutions)"
cat >Makefile <<!GROK!THIS!
! # $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,147 ****
fi
clean:
! rm -f *.o
realclean: clean
! rm -f a2p *.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.
--- 141,150 ----
fi
clean:
! rm -f a2p *.o
realclean: clean
! 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.
Index: README
*** README.old Sat Nov 10 02:21:48 1990
--- README Sat Nov 10 02:21:52 1990
***************
*** 102,114 ****
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.
MIPS machines may need to turn off -O on perly.c and tperly.c.
SCO Xenix may need -m25000 for yacc.
! Xenix 386 needs -Sm10000 for yacc.
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.
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.
--- 102,118 ----
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 -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.
Index: os2/README.OS2
*** os2/README.OS2.old Sat Nov 10 02:29:05 1990
--- os2/README.OS2 Sat Nov 10 02:29:08 1990
***************
*** 336,341 ****
--- 336,342 ----
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,356 ****
rommel@lan.informatik.tu-muenchen.dbp.de
Breslauer Str. 25
D-8756 Kahl/Main
! West (yes, still!) Germany
--- 354,381 ----
rommel@lan.informatik.tu-muenchen.dbp.de
Breslauer Str. 25
D-8756 Kahl/Main
!
! + 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
Index: t/TEST
Prereq: 3.0.1.1
*** t/TEST.old Sat Nov 10 02:36:58 1990
--- t/TEST Sat Nov 10 02:37:00 1990
***************
*** 1,6 ****
#!./perl
! # $Header: TEST,v 3.0.1.1 89/11/11 04:58:01 lwall Locked $
# This is written in a peculiar style, since we're trying to avoid
# most of the constructs we'll be testing for.
--- 1,6 ----
#!./perl
! # $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,25 ****
chdir 't' if -f 't/TEST';
if ($ARGV[0] eq '') {
! @ARGV = split(/[ \n]/,`echo base.* comp.* cmd.* io.* op.*`);
}
! open(config,"../config.sh");
! while (<config>) {
if (/sharpbang='(.*)'/) {
$sharpbang = ($1 eq '#!');
last;
--- 15,25 ----
chdir 't' if -f 't/TEST';
if ($ARGV[0] eq '') {
! @ARGV = split(/[ \n]/,`echo base.* comp.* cmd.* io.* op.* lib.*`);
}
! open(CONFIG,"../config.sh");
! while (<CONFIG>) {
if (/sharpbang='(.*)'/) {
$sharpbang = ($1 eq '#!');
last;
Index: os2/a2p.cs
*** os2/a2p.cs.old Sat Nov 10 02:29:16 1990
--- os2/a2p.cs Sat Nov 10 02:29:17 1990
***************
*** 2,8 ****
(-W1 -Od -Ocgelt hash.c str.c util.c walk.c)
setargv.obj
! a2p.def
a2p.exe
-AL -LB -S0xA000
--- 2,8 ----
(-W1 -Od -Ocgelt hash.c str.c util.c walk.c)
setargv.obj
! ..\os2\a2p.def
a2p.exe
-AL -LB -S0xA000
Index: arg.h
Prereq: 3.0.1.7
*** arg.h.old Sat Nov 10 02:22:08 1990
--- arg.h Sat Nov 10 02:22:16 1990
***************
*** 1,4 ****
! /* $Header: arg.h,v 3.0.1.7 90/10/15 14:53:59 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: arg.h,v 3.0.1.8 90/11/10 01:04:36 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,15 ----
* 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,316 ****
#define O_FTATIME 264
#define O_FTCTIME 265
#define O_WAITPID 266
! #define MAXO 267
#ifndef DOINIT
extern char *opname[];
--- 314,321 ----
#define O_FTATIME 264
#define O_FTCTIME 265
#define O_WAITPID 266
! #define O_ALARM 267
! #define MAXO 268
#ifndef DOINIT
extern char *opname[];
***************
*** 583,589 ****
"FTATIME",
"FTCTIME",
"WAITPID",
! "264"
};
#endif
--- 588,595 ----
"FTATIME",
"FTCTIME",
"WAITPID",
! "ALARM",
! "268"
};
#endif
***************
*** 889,903 ****
A(0,0,0), /* DUMP */
A(0,3,0), /* REVERSE */
A(1,0,0), /* ADDROF */
! A(1,1,1), /* 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 */
A(0,3,0), /* DBSUBR */
A(1,0,0), /* DEFINED */
A(1,0,0), /* UNDEF */
--- 895,909 ----
A(0,0,0), /* DUMP */
A(0,3,0), /* REVERSE */
A(1,0,0), /* ADDROF */
! 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 */
! 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,958 ****
A(0,0,0), /* GETLOGIN */
A(1,3,0), /* SYSCALL */
A(1,1,1), /* GSOCKOPT */
! A(1,1,1), /* SSOCKOPT */
A(1,0,0), /* GETSOCKNAME */
A(1,0,0), /* GETPEERNAME */
A(0,3,3), /* LSLICE */
--- 958,964 ----
A(0,0,0), /* GETLOGIN */
A(1,3,0), /* SYSCALL */
A(1,1,1), /* GSOCKOPT */
! A5(1,1,1,1,0), /* SSOCKOPT */
A(1,0,0), /* GETSOCKNAME */
A(1,0,0), /* GETPEERNAME */
A(0,3,3), /* LSLICE */
***************
*** 981,986 ****
--- 987,993 ----
A(1,0,0), /* FTATIME */
A(1,0,0), /* FTCTIME */
A(1,1,0), /* WAITPID */
+ A(1,0,0), /* ALARM */
0
};
#undef A
Index: lib/bigfloat.pl
*** lib/bigfloat.pl.old Sat Nov 10 02:27:54 1990
--- lib/bigfloat.pl Sat Nov 10 02:27:56 1990
***************
*** 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;
Index: lib/bigint.pl
*** lib/bigint.pl.old Sat Nov 10 02:28:02 1990
--- lib/bigint.pl Sat Nov 10 02:28:06 1990
***************
*** 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;
Index: lib/bigrat.pl
*** lib/bigrat.pl.old Sat Nov 10 02:28:15 1990
--- lib/bigrat.pl Sat Nov 10 02:28:19 1990
***************
*** 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;
Index: cmd.c
Prereq: 3.0.1.10
No differences encountered
Index: t/comp.cpp
Prereq: 3.0.1.1
*** t/comp.cpp.old Sat Nov 10 02:37:07 1990
--- t/comp.cpp Sat Nov 10 02:37:09 1990
***************
*** 1,6 ****
#!./perl -P
! # $Header: comp.cpp,v 3.0.1.1 90/08/09 05:25:34 lwall Locked $
print "1..3\n";
--- 1,6 ----
#!./perl -P
! # $Header: comp.cpp,v 3.0.1.2 90/11/10 02:10:17 lwall Locked $
print "1..3\n";
***************
*** 15,35 ****
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.inc") || (die "Can't open temp include file.");
! print try '#define OK "ok 3\n"'; print try "\n";
! close try;
$pwd=`pwd`;
$pwd =~ s/\n//;
! $x = `./perl -P -I$pwd Comp.cpp.tmp`;
print $x;
unlink "Comp.cpp.tmp", "Comp.cpp.inc";
--- 15,39 ----
print "not ok 2\n";
#endif
! open(TRY,">Comp.cpp.tmp") || die "Can't open temp perl file.";
! ($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 Comp.cpp.tmp`;
print $x;
unlink "Comp.cpp.tmp", "Comp.cpp.inc";
Index: config_h.SH
No differences encountered
Index: cons.c
Prereq: 3.0.1.8
*** cons.c.old Sat Nov 10 02:23:51 1990
--- cons.c Sat Nov 10 02:23:59 1990
***************
*** 1,4 ****
! /* $Header: cons.c,v 3.0.1.8 90/10/15 15:41:09 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: cons.c,v 3.0.1.9 90/11/10 01:10:50 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,14 ----
* 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,455 ****
{
register CMD *cmd;
register CMD *head = cur->c_head;
- register ARG *arg;
STR *str;
if (!head)
--- 452,457 ----
Index: os2/dir.h
*** os2/dir.h.old Sat Nov 10 02:29:23 1990
--- os2/dir.h Sat Nov 10 02:29:24 1990
***************
*** 7,17 ****
*
* Enhanced and ported to OS/2 by Kai Uwe Rommel; added scandir() prototype
* December 1989, February 1990
*/
! #define MAXNAMLEN 12
! #define MAXPATHLEN 128
#define A_RONLY 0x01
#define A_HIDDEN 0x02
--- 7,18 ----
*
* 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 256
! #define MAXPATHLEN 256
#define A_RONLY 0x01
#define A_HIDDEN 0x02
***************
*** 23,34 ****
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 */
};
/* The fields d_size and d_mode are extensions by me (Kai Uwe Rommel).
--- 24,38 ----
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 */
! /* 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,47 ****
{
char *_d_entry;
long _d_size;
! int _d_mode;
struct _dircontents *_d_next;
};
--- 45,51 ----
{
char *_d_entry;
long _d_size;
! unsigned _d_mode, _d_time, _d_date;
struct _dircontents *_d_next;
};
***************
*** 55,60 ****
--- 59,66 ----
DIR;
+ extern int attributes;
+
extern DIR *opendir(char *);
extern struct direct *readdir(DIR *);
extern void seekdir(DIR *, long);
***************
*** 68,163 ****
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)
- */
--- 74,76 ----
*** End of Patch 38 ***