See patch #38.
-/* $Header: doarg.c,v 3.0.1.8 90/10/15 16:04:04 lwall Locked $
+/* $Header: doarg.c,v 3.0.1.9 90/11/10 01:14:31 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: doarg.c,v $
+ * Revision 3.0.1.9 90/11/10 01:14:31 lwall
+ * patch38: random cleanup
+ * patch38: optimized join('',...)
+ * patch38: printf cleaned up
+ *
* Revision 3.0.1.8 90/10/15 16:04:04 lwall
* patch29: @ENV = () now works
* patch29: added caller
str_sset(str,*st++);
else
str_set(str,"");
- for (; items > 0; items--,st++) {
- str_ncat(str,delim,delimlen);
- str_scat(str,*st);
+ if (delimlen) {
+ for (; items > 0; items--,st++) {
+ str_ncat(str,delim,delimlen);
+ str_scat(str,*st);
+ }
+ }
+ else {
+ for (; items > 0; items--,st++)
+ str_scat(str,*st);
}
STABSET(str);
}
break;
case 'X':
shrink:
- str->str_cur -= len;
- if (str->str_cur < 0)
+ if (str->str_cur < len)
fatal("X outside of string");
+ str->str_cur -= len;
str->str_ptr[str->str_cur] = '\0';
break;
case 'x':
{
register char *s;
register char *t;
+ register char *f;
bool dolong;
char ch;
static STR *sargnull = &str_no;
str_set(str,"");
len--; /* don't count pattern string */
- origs = s = str_get(*sarg);
+ origs = t = s = str_get(*sarg);
send = s + (*sarg)->str_cur;
sarg++;
- for ( ; s < send; len--) {
+ for ( ; ; len--) {
if (len <= 0 || !*sarg) {
sarg = &sargnull;
len = 0;
}
- dolong = FALSE;
- for (t = s; t < send && *t != '%'; t++) ;
+ for ( ; t < send && *t != '%'; t++) ;
if (t >= send)
- break; /* not enough % patterns, oh well */
- for (t++; *sarg && t < send && t != s; t++) {
+ break; /* end of format string, ignore extra args */
+ f = t;
+ *buf = '\0';
+ xs = buf;
+ dolong = FALSE;
+ for (t++; t < send; t++) {
switch (*t) {
default:
ch = *(++t);
*t = '\0';
- (void)sprintf(buf,s);
- s = t;
- *(t--) = ch;
+ (void)sprintf(xs,f);
len++;
break;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
- case '.': case '#': case '-': case '+':
- break;
+ case '.': case '#': case '-': case '+': case ' ':
+ continue;
case 'l':
dolong = TRUE;
- break;
+ continue;
case 'c':
ch = *(++t);
*t = '\0';
xlen = (int)str_gnum(*(sarg++));
- if (strEQ(t-2,"%c")) { /* some printfs fail on null chars */
- *buf = xlen;
- str_ncat(str,s,t - s - 2);
- str_ncat(str,buf,1); /* so handle simple case */
- *buf = '\0';
+ if (strEQ(f,"%c")) { /* some printfs fail on null chars */
+ *xs = xlen;
+ xs[1] = '\0';
}
else
- (void)sprintf(buf,s,xlen);
- s = t;
- *(t--) = ch;
+ (void)sprintf(xs,f,xlen);
break;
case 'D':
dolong = TRUE;
ch = *(++t);
*t = '\0';
if (dolong)
- (void)sprintf(buf,s,(long)str_gnum(*(sarg++)));
+ (void)sprintf(xs,f,(long)str_gnum(*(sarg++)));
else
- (void)sprintf(buf,s,(int)str_gnum(*(sarg++)));
- s = t;
- *(t--) = ch;
+ (void)sprintf(xs,f,(int)str_gnum(*(sarg++)));
break;
case 'X': case 'O':
dolong = TRUE;
*t = '\0';
value = str_gnum(*(sarg++));
if (dolong)
- (void)sprintf(buf,s,U_L(value));
+ (void)sprintf(xs,f,U_L(value));
else
- (void)sprintf(buf,s,U_I(value));
- s = t;
- *(t--) = ch;
+ (void)sprintf(xs,f,U_I(value));
break;
case 'E': case 'e': case 'f': case 'G': case 'g':
ch = *(++t);
*t = '\0';
- (void)sprintf(buf,s,str_gnum(*(sarg++)));
- s = t;
- *(t--) = ch;
+ (void)sprintf(xs,f,str_gnum(*(sarg++)));
break;
case 's':
ch = *(++t);
xlen = strlen(tokenbuf);
str_free(tmpstr);
}
- if (strEQ(t-2,"%s")) { /* some printfs fail on >128 chars */
- *buf = '\0';
- str_ncat(str,s,t - s - 2);
- *t = ch;
- str_ncat(str,xs,xlen); /* so handle simple case */
- }
- else {
- if (origs == xs) { /* sprintf($s,...$s...) */
- strcpy(tokenbuf+64,s);
- s = tokenbuf+64;
- *t = ch;
- }
- (void)sprintf(buf,s,xs);
- }
sarg++;
- s = t;
- *(t--) = ch;
+ if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */
+ break; /* so handle simple case */
+ }
+ strcpy(tokenbuf+64,f); /* sprintf($s,...$s...) */
+ *t = ch;
+ (void)sprintf(buf,tokenbuf+64,xs);
+ xs = buf;
break;
}
- }
- if (s < t && t >= send) {
- str_cat(str,s);
+ /* end of switch, copy results */
+ *t = ch;
+ xlen = strlen(xs);
+ STR_GROW(str, str->str_cur + (f - s) + len + 1);
+ str_ncat(str, s, f - s);
+ str_ncat(str, xs, xlen);
s = t;
- break;
+ break; /* break from for loop */
}
- str_cat(str,buf);
- }
- if (*s) {
- (void)sprintf(buf,s,0,0,0,0);
- str_cat(str,buf);
}
+ str_ncat(str, s, t - s);
STABSET(str);
}
-/* $Header: doio.c,v 3.0.1.12 90/10/20 02:04:18 lwall Locked $
+/* $Header: doio.c,v 3.0.1.13 90/11/10 01:17:37 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: doio.c,v $
+ * Revision 3.0.1.13 90/11/10 01:17:37 lwall
+ * patch38: -e _ was wrong if last stat failed
+ * patch38: more msdos/os2 upgrades
+ *
* Revision 3.0.1.12 90/10/20 02:04:18 lwall
* patch37: split out separate Sys V IPC features
*
#include <fcntl.h>
#endif
+int laststatval = -1;
+
bool
do_open(stab,name,len)
STAB *stab;
if (optype == O_IOCTL)
retval = ioctl(fileno(stio->ifp), func, s);
else
+#ifdef MSDOS
+ fatal("fcntl is not implemented");
+#else
#ifdef I_FCNTL
retval = fcntl(fileno(stio->ifp), func, s);
#else
fatal("fcntl is not implemented");
#endif
+#endif
#else /* lint */
retval = 0;
#endif /* lint */
register ARRAY *ary = stack;
register int sp = arglast[0] + 1;
int max = 13;
- register int i;
if ((arg[1].arg_type & A_MASK) == A_WORD) {
tmpstab = arg[1].arg_ptr.arg_stab;
if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
fstat(fileno(stab_io(tmpstab)->ifp),&statcache) < 0) {
max = 0;
+ laststatval = -1;
}
}
+ else if (laststatval < 0)
+ max = 0;
}
else {
str_sset(statname,ary->ary_array[sp]);
statstab = Nullstab;
#ifdef LSTAT
if (arg->arg_type == O_LSTAT)
- i = lstat(str_get(statname),&statcache);
+ laststatval = lstat(str_get(statname),&statcache);
else
#endif
- i = stat(str_get(statname),&statcache);
- if (i < 0)
+ laststatval = stat(str_get(statname),&statcache);
+ if (laststatval < 0)
max = 0;
}
if (stio && stio->ifp) {
statstab = arg[1].arg_ptr.arg_stab;
str_set(statname,"");
- return fstat(fileno(stio->ifp), &statcache);
+ return (laststatval = fstat(fileno(stio->ifp), &statcache));
}
else {
if (arg[1].arg_ptr.arg_stab == defstab)
- return 0;
+ return laststatval;
if (dowarn)
warn("Stat on unopened file <%s>",
stab_name(arg[1].arg_ptr.arg_stab));
statstab = Nullstab;
str_set(statname,"");
- return -1;
+ return (laststatval = -1);
}
}
else {
statstab = Nullstab;
str_sset(statname,str);
- return stat(str_get(str),&statcache);
+ return (laststatval = stat(str_get(str),&statcache));
}
}
-/* $Header: dolist.c,v 3.0.1.10 90/10/15 16:19:48 lwall Locked $
+/* $Header: dolist.c,v 3.0.1.11 90/11/10 01:29:49 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: dolist.c,v $
+ * Revision 3.0.1.11 90/11/10 01:29:49 lwall
+ * patch38: temp string values are now copied less often
+ * patch38: sort parameters are now in the right package
+ *
* Revision 3.0.1.10 90/10/15 16:19:48 lwall
* patch29: added caller
* patch29: added scalar reverse
for (m = s; m < strend && !isspace(*m); m++) ;
if (m >= strend)
break;
- if (realarray)
- dstr = Str_new(30,m-s);
- else
- dstr = str_static(&str_undef);
+ dstr = Str_new(30,m-s);
str_nset(dstr,s,m-s);
+ if (!realarray)
+ str_2static(dstr);
(void)astore(ary, ++sp, dstr);
for (s = m + 1; s < strend && isspace(*s); s++) ;
}
m++;
if (m >= strend)
break;
- if (realarray)
- dstr = Str_new(30,m-s);
- else
- dstr = str_static(&str_undef);
+ dstr = Str_new(30,m-s);
str_nset(dstr,s,m-s);
+ if (!realarray)
+ str_2static(dstr);
(void)astore(ary, ++sp, dstr);
s = m;
}
for (m = s; m < strend && *m != i; m++) ;
if (m >= strend)
break;
- if (realarray)
- dstr = Str_new(30,m-s);
- else
- dstr = str_static(&str_undef);
+ dstr = Str_new(30,m-s);
str_nset(dstr,s,m-s);
+ if (!realarray)
+ str_2static(dstr);
(void)astore(ary, ++sp, dstr);
s = m + 1;
}
spat->spat_short)) )
#endif
{
- if (realarray)
- dstr = Str_new(31,m-s);
- else
- dstr = str_static(&str_undef);
+ dstr = Str_new(31,m-s);
str_nset(dstr,s,m-s);
+ if (!realarray)
+ str_2static(dstr);
(void)astore(ary, ++sp, dstr);
s = m + i;
}
strend = s + (strend - m);
}
m = spat->spat_regexp->startp[0];
- if (realarray)
- dstr = Str_new(32,m-s);
- else
- dstr = str_static(&str_undef);
+ dstr = Str_new(32,m-s);
str_nset(dstr,s,m-s);
+ if (!realarray)
+ str_2static(dstr);
(void)astore(ary, ++sp, dstr);
if (spat->spat_regexp->nparens) {
for (i = 1; i <= spat->spat_regexp->nparens; i++) {
s = spat->spat_regexp->startp[i];
m = spat->spat_regexp->endp[i];
- if (realarray)
- dstr = Str_new(33,m-s);
- else
- dstr = str_static(&str_undef);
+ dstr = Str_new(33,m-s);
str_nset(dstr,s,m-s);
+ if (!realarray)
+ str_2static(dstr);
(void)astore(ary, ++sp, dstr);
}
}
if (iters > maxiters)
fatal("Split loop");
if (s < strend || origlimit) { /* keep field after final delim? */
- if (realarray)
- dstr = Str_new(34,strend-s);
- else
- dstr = str_static(&str_undef);
+ dstr = Str_new(34,strend-s);
str_nset(dstr,s,strend-s);
+ if (!realarray)
+ str_2static(dstr);
(void)astore(ary, ++sp, dstr);
iters++;
}
register int len;
/* These must not be in registers: */
- char achar;
short ashort;
int aint;
long along;
- unsigned char auchar;
unsigned short aushort;
unsigned int auint;
unsigned long aulong;
}
int
-do_reverse(str,gimme,arglast)
-STR *str;
-int gimme;
+do_reverse(arglast)
int *arglast;
{
STR **st = stack->ary_array;
}
int
-do_sreverse(str,gimme,arglast)
+do_sreverse(str,arglast)
STR *str;
-int gimme;
int *arglast;
{
STR **st = stack->ary_array;
}
static CMD *sortcmd;
+static HASH *sortstash = Null(HASH*);
static STAB *firststab = Nullstab;
static STAB *secondstab = Nullstab;
fatal("Undefined subroutine \"%s\" in sort", stab_name(stab));
if (!sortstack) {
sortstack = anew(Nullstab);
+ astore(sortstack, 0, Nullstr);
+ aclear(sortstack);
sortstack->ary_flags = 0;
}
oldstack = stack;
stack = sortstack;
tmps_base = tmps_max;
- if (!firststab) {
+ if (sortstash != stab_stash(stab)) {
firststab = stabent("a",TRUE);
secondstab = stabent("b",TRUE);
+ sortstash = stab_stash(stab);
}
oldfirst = stab_val(firststab);
oldsecond = stab_val(secondstab);
while (!str->str_nok && str->str_cur <= final->str_cur &&
strNE(str->str_ptr,tmps) ) {
(void)astore(ary, ++sp, str);
- str = str_static(str);
+ str = str_2static(str_smake(str));
str_inc(str);
}
if (strEQ(str->str_ptr,tmps))
str_2static(str_nmake((double)csv->curcmd->c_line)) );
if (!maxarg)
return sp;
- str = str_static(&str_undef);
+ str = Str_new(49,0);
stab_fullname(str, csv->stab);
- (void)astore(stack,++sp, str);
+ (void)astore(stack,++sp, str_2static(str));
(void)astore(stack,++sp,
str_2static(str_nmake((double)csv->hasargs)) );
(void)astore(stack,++sp,
-/* $Header: eval.c,v 3.0.1.9 90/10/15 16:46:13 lwall Locked $
+/* $Header: eval.c,v 3.0.1.10 90/11/10 01:33:22 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: eval.c,v $
+ * Revision 3.0.1.10 90/11/10 01:33:22 lwall
+ * patch38: random cleanup
+ * patch38: couldn't return from sort routine
+ * patch38: added hooks for unexec()
+ * patch38: added alarm function
+ *
* Revision 3.0.1.9 90/10/15 16:46:13 lwall
* patch29: added caller
* patch29: added scalar
goto array_return;
case O_REVERSE:
if (gimme == G_ARRAY)
- sp = do_reverse(str,
- gimme,arglast);
+ sp = do_reverse(arglast);
else
- sp = do_sreverse(str,
- gimme,arglast);
+ sp = do_sreverse(str, arglast);
goto array_return;
case O_WARN:
if (arglast[2] - arglast[1] != 1) {
case O_RETURN:
tmps = "_SUB_"; /* just fake up a "last _SUB_" */
optype = O_LAST;
- if (curcsv->wantarray == G_ARRAY) {
+ if (curcsv && curcsv->wantarray == G_ARRAY) {
lastretstr = Nullstr;
lastspbase = arglast[1];
lastsize = arglast[2] - arglast[1];
goto_targ = Nullch; /* just restart from top */
if (optype == O_DUMP) {
do_undump = 1;
- abort();
+ my_unexec();
}
longjmp(top_env, 1);
case O_INDEX:
value = (double) (anum & 255);
#endif
goto donumset;
+ case O_ALARM:
+ if (maxarg < 1)
+ tmps = str_get(stab_val(defstab));
+ else
+ tmps = str_get(st[1]);
+ if (!tmps)
+ tmps = "0";
+ anum = alarm((unsigned int)atoi(tmps));
+ if (anum < 0)
+ goto say_undef;
+ value = (double)anum;
+ goto donumset;
case O_SLEEP:
if (maxarg < 1)
tmps = Nullch;
* kit sizes from getting too big.
*/
-/* $Header: evalargs.xc,v 3.0.1.7 90/10/15 16:48:11 lwall Locked $
+/* $Header: evalargs.xc,v 3.0.1.8 90/11/10 01:35:49 lwall Locked $
*
* $Log: evalargs.xc,v $
+ * Revision 3.0.1.8 90/11/10 01:35:49 lwall
+ * patch38: array slurps are now faster and take less memory
+ *
* Revision 3.0.1.7 90/10/15 16:48:11 lwall
* patch29: non-existent array values no longer cause core dumps
* patch29: added caller
astore(stack, sp, Nullstr);
st = stack->ary_array;
}
- st[sp] = str_static(&str_undef);
- if (str_gets(st[sp],fp,0) == Nullch) {
+ str = st[sp] = Str_new(56,80);
+ if (str_gets(str,fp,0) == Nullch) {
sp--;
break;
}
+ if (str->str_len - str->str_cur > 20) {
+ str->str_len = str->str_cur+1;
+ Renew(str->str_ptr, str->str_len, char);
+ }
+ str_2static(str);
}
}
statusvalue = mypclose(fp);
if (anum > 1) /* assign to scalar */
gimme = G_SCALAR; /* force context to scalar */
if (gimme == G_ARRAY)
- str = str_static(&str_undef);
+ str = Str_new(57,0);
++sp;
fp = Nullfp;
if (stab_io(last_in_stab)) {
record_separator = old_record_separator;
if (gimme == G_ARRAY) {
--sp;
+ str_2static(str);
goto array_return;
}
break;
goto keepgoing; /* unmatched wildcard? */
}
if (gimme == G_ARRAY) {
+ if (str->str_len - str->str_cur > 20) {
+ str->str_len = str->str_cur+1;
+ Renew(str->str_ptr, str->str_len, char);
+ }
+ str_2static(str);
if (++sp > stack->ary_max) {
astore(stack, sp, Nullstr);
st = stack->ary_array;
}
- str = str_static(&str_undef);
+ str = Str_new(58,80);
goto keepgoing;
}
}
%isatype = ('char',1,'short',1,'int',1,'long',1);
foreach $file (@ARGV) {
- ($outfile = $file) =~ s/\.h$/.ph/;
+ ($outfile = $file) =~ s/\.h$/.ph/ || next;
print "$file -> $outfile\n";
if ($file =~ m|^(.*)/|) {
$dir = $1;
* MS-DOS. Written by Michael Rendell ({uunet,utai}michael@garfield),
* August 1897
* Ported to OS/2 by Kai Uwe Rommel
- * December 1989
+ * December 1989, February 1990
+ * Change for HPFS support, October 1990
*/
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/dir.h>
+#include <stdlib.h>
#include <stdio.h>
#include <malloc.h>
#include <string.h>
+#include <ctype.h>
#define INCL_NOPM
#include <os2.h>
static HDIR hdir;
static USHORT count;
static FILEFINDBUF find;
+static BOOL lower;
DIR *opendir(char *name)
dp.d_namlen = dp.d_reclen =
strlen(strcpy(dp.d_name, dirp -> dd_cp -> _d_entry));
- strlwr(dp.d_name); /* JF */
dp.d_ino = 0;
dp.d_size = dirp -> dd_cp -> _d_size;
}
+static int IsFileSystemFAT(char *dir)
+{
+ USHORT nDrive;
+ ULONG lMap;
+ BYTE bData[64], bName[3];
+ USHORT cbData;
+
+ if ( _osmode == DOS_MODE )
+ return TRUE;
+ else
+ {
+ /* We separate FAT and HPFS file systems here.
+ * Filenames read from a FAT system are converted to lower case
+ * while the case of filenames read from a HPFS (and other future
+ * file systems, like Unix-compatibles) is preserved.
+ */
+
+ if ( isalpha(dir[0]) && (dir[1] == ':') )
+ nDrive = toupper(dir[0]) - '@';
+ else
+ DosQCurDisk(&nDrive, &lMap);
+
+ bName[0] = (char) (nDrive + '@');
+ bName[1] = ':';
+ bName[2] = 0;
+
+ cbData = sizeof(bData);
+
+ if ( !DosQFSAttach(bName, 0U, 1U, bData, &cbData, 0L) )
+ return !strcmp(bData + (*(USHORT *) (bData + 2) + 7), "FAT");
+ else
+ return FALSE;
+
+ /* End of this ugly code */
+ }
+}
+
+
static char *getdirent(char *dir)
{
int done;
if (dir != NULL)
{ /* get first entry */
+ lower = IsFileSystemFAT(dir);
+
hdir = HDIR_CREATE;
count = 1;
done = DosFindFirst(dir, &hdir, attributes,
else /* get next entry */
done = DosFindNext(hdir, &find, sizeof(find), &count);
+ if ( lower )
+ strlwr(find.achName);
+
if (done == 0)
return find.achName;
else
-/* $Header: os2.c,v 3.0.1.1 90/10/15 17:49:55 lwall Locked $
+/* $Header: os2.c,v 3.0.1.2 90/11/10 01:42:38 lwall Locked $
*
* (C) Copyright 1989, 1990 Diomidis Spinellis.
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: os2.c,v $
+ * Revision 3.0.1.2 90/11/10 01:42:38 lwall
+ * patch38: more msdos/os2 upgrades
+ *
* Revision 3.0.1.1 90/10/15 17:49:55 lwall
* patch29: Initial revision
*
int chdir(char *path)
{
if ( path[0] != 0 && path[1] == ':' )
- DosSelectDisk(tolower(path[0]) - '@');
+ DosSelectDisk(toupper(path[0]) - '@');
DosChDir(path, 0L);
}
DOSFLAGPROCESS
DOSSETPRTY
DOSGETPRTY
+DOSQFSATTACH
hash.c perl.c perly.c regcomp.c regexec.c stab.c str.c util.c
)
(-W1 -Od -Olt -B2C2L -B3C3L -DDEBUGGING eval.c{evalargs.xc} toke.c)
-(-W1 -Od -Olt os2.c popen.c mktemp.c director.c suffix.c)
+(-W1 -Od -Olt -I.
+os2\os2.c os2\popen.c os2\mktemp.c os2\director.c os2\suffix.c
+)
setargv.obj
-perl.def
-perl.bad
+os2\perl.def
+os2\perl.bad
perl.exe
--AL -LB -S0x9000
+-AL -LB -S0x8800
NAME PERL WINDOWCOMPAT NEWFILES
-DESCRIPTION 'PERL 3.0, patchlevel 28 - for MS-DOS and OS/2'
+DESCRIPTION 'PERL 3.0, patchlevel 37 - for MS-DOS and OS/2'
-#define PATCHLEVEL 38
+#define PATCHLEVEL 39
-/* $Header: perl.h,v 3.0.1.9 90/10/15 17:59:41 lwall Locked $
+/* $Header: perl.h,v 3.0.1.10 90/11/10 01:44:13 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perl.h,v $
+ * Revision 3.0.1.10 90/11/10 01:44:13 lwall
+ * patch38: more msdos/os2 upgrades
+ *
* Revision 3.0.1.9 90/10/15 17:59:41 lwall
* patch29: some machines didn't like unsigned C preprocessor values
*
#ifndef MSDOS
#define TMPPATH "/tmp/perl-eXXXXXX"
#else
-#define TMPPATH "/tmp/plXXXXXX"
+#define TMPPATH "plXXXXXX"
#endif /* MSDOS */
EXT char *e_tmpname;
EXT FILE *e_fp INIT(Nullfp);
.rn '' }`
-''' $Header: perl_man.1,v 3.0.1.9 90/10/20 02:14:24 lwall Locked $
+''' $Header: perl_man.1,v 3.0.1.10 90/11/10 01:45:16 lwall Locked $
'''
''' $Log: perl.man.1,v $
+''' Revision 3.0.1.10 90/11/10 01:45:16 lwall
+''' patch38: random cleanup
+'''
''' Revision 3.0.1.9 90/10/20 02:14:24 lwall
''' patch37: fixed various typos in man page
'''
In addition, the token __END__ may be used to indicate the logical end of the
script before the actual end of file.
Any following text is ignored (but may be read via the DATA filehandle).
-The two control characters ^D and ^Z are synomyms for __END__.
+The two control characters ^D and ^Z are synonyms for __END__.
.PP
A word that doesn't have any other interpretation in the grammar will be
treated as if it had single quotes around it.
switch.)
.PP
A declaration can be put anywhere a command can, but has no effect on the
-execution of the primary sequence of commands--declarations all take effect
+execution of the primary sequence of commands\(*--declarations all take effect
at compile time.
Typically all the declarations are put at the beginning or the end of the script.
.PP
''' Beginning of part 2
-''' $Header: perl_man.2,v 3.0.1.9 90/10/15 18:17:37 lwall Locked $
+''' $Header: perl_man.2,v 3.0.1.10 90/11/10 01:46:29 lwall Locked $
'''
''' $Log: perl.man.2,v $
+''' Revision 3.0.1.10 90/11/10 01:46:29 lwall
+''' patch38: random cleanup
+''' patch38: added alarm function
+'''
''' Revision 3.0.1.9 90/10/15 18:17:37 lwall
''' patch29: added caller
''' patch29: index and substr now have optional 3rd args
Does the same thing that the accept system call does.
Returns true if it succeeded, false otherwise.
See example in section on Interprocess Communication.
+.Ip "alarm(SECONDS)" 8 4
+.Ip "alarm SECONDS" 8
+Arranges to have a SIGALRM delivered to this process after the specified number
+of seconds (minus 1, actually) have elapsed. Thus, alarm(15) will cause
+a SIGALRM at some point more than 14 seconds in the future.
+Only one timer may be counting at once. Each call disables the previous
+timer, and an argument of 0 may be supplied to cancel the previous timer
+without starting a new one.
+The returned value is the amount of time remaining on the previous timer.
.Ip "atan2(X,Y)" 8 2
Returns the arctangent of X/Y in the range
.if t \-\(*p to \(*p.
Saying undef %ARRAY is faster yet.)
.Ip "die(LIST)" 8
.Ip "die LIST" 8
-Prints the value of LIST to
+Outside of an eval, prints the value of LIST to
.I STDERR
and exits with the current value of $!
(errno).
If $! is 0, exits with the value of ($? >> 8) (\`command\` status).
If ($? >> 8) is 0, exits with 255.
+Inside an eval, the error message is stuffed into $@ and the eval is terminated
+with the undefined value.
+.Sp
Equivalent examples:
.nf
any variable settings, subroutine or format definitions remain afterwards.
The value returned is the value of the last expression evaluated, just
as with subroutines.
-If there is a syntax error or runtime error, a null string is returned by
+If there is a syntax error or runtime error, or a die statement is
+executed, an undefined value is returned by
eval, and $@ is set to the error message.
-If there was no error, $@ is null.
+If there was no error, $@ is guaranteed to be a null string.
If EXPR is omitted, evaluates $_.
The final semicolon, if any, may be omitted from the expression.
.Sp
Note that, since eval traps otherwise-fatal errors, it is useful for
determining whether a particular feature
(such as dbmopen or symlink) is implemented.
+It is also Perl's exception trapping mechanism, where the die operator is
+used to raise exceptions.
.Ip "exec(LIST)" 8 8
.Ip "exec LIST" 8 6
If there is more than one argument in LIST, or if LIST is an array with
.fi
first to get the correct function definitions.
-If fcntl.h doesn't exist or doesn't have the correct definitions
+If fcntl.ph doesn't exist or doesn't have the correct definitions
you'll have to roll
your own, based on your C header files such as <sys/fcntl.h>.
-(There is a perl script called makelib that comes with the perl kit
+(There is a perl script called h2ph that comes with the perl kit
which may help you in this.)
Argument processing and value return works just like ioctl below.
Note that fcntl will produce a fatal error if used on a machine that doesn't implement
.fi
first to get the correct function definitions.
-If ioctl.h doesn't exist or doesn't have the correct definitions
+If ioctl.ph doesn't exist or doesn't have the correct definitions
you'll have to roll
your own, based on your C header files such as <sys/ioctl.h>.
-(There is a perl script called makelib that comes with the perl kit
+(There is a perl script called h2ph that comes with the perl kit
which may help you in this.)
SCALAR will be read and/or written depending on the FUNCTION\*(--a pointer
to the string value of SCALAR will be passed as the third argument of
--- /dev/null
+#!./perl
+require "../lib/bigint.pl";
+
+$test = 0;
+$| = 1;
+print "1..246\n";
+while (<DATA>) {
+ chop;
+ if (/^&/) {
+ $f = $_;
+ } else {
+ ++$test;
+ @args = split(/:/,$_,99);
+ $ans = pop(@args);
+ $try = "$f('" . join("','", @args) . "');";
+ if (($ans1 = eval($try)) eq $ans) {
+ print "ok $test\n";
+ } else {
+ print "not ok $test\n";
+ print "# '$try' expected: '$ans' got: '$ans1'\n";
+ }
+ }
+}
+__END__
+&bnorm
+abc:NaN
+ 1 a:NaN
+1bcd2:NaN
+11111b:NaN
++1z:NaN
+-1z:NaN
+0:+0
++0:+0
++00:+0
++0 0 0:+0
+000000 0000000 00000:+0
+-0:+0
+-0000:+0
++1:+1
++01:+1
++001:+1
++00000100000:+100000
+123456789:+123456789
+-1:-1
+-01:-1
+-001:-1
+-123456789:-123456789
+-00000100000:-100000
+&bneg
+abd:NaN
++0:+0
++1:-1
+-1:+1
++123456789:-123456789
+-123456789:+123456789
+&babs
+abc:NaN
++0:+0
++1:+1
+-1:+1
++123456789:+123456789
+-123456789:+123456789
+&bcmp
+abc:abc:
+abc:+0:
++0:abc:
++0:+0:0
+-1:+0:-1
++0:-1:1
++1:+0:1
++0:+1:-1
+-1:+1:-1
++1:-1:1
+-1:-1:0
++1:+1:0
++123:+123:0
++123:+12:1
++12:+123:-1
+-123:-123:0
+-123:-12:-1
+-12:-123:1
++123:+124:-1
++124:+123:1
+-123:-124:1
+-124:-123:-1
+&badd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++1:+0:+1
++0:+1:+1
++1:+1:+2
+-1:+0:-1
++0:-1:-1
+-1:-1:-2
+-1:+1:+0
++1:-1:+0
++9:+1:+10
++99:+1:+100
++999:+1:+1000
++9999:+1:+10000
++99999:+1:+100000
++999999:+1:+1000000
++9999999:+1:+10000000
++99999999:+1:+100000000
++999999999:+1:+1000000000
++9999999999:+1:+10000000000
++99999999999:+1:+100000000000
++10:-1:+9
++100:-1:+99
++1000:-1:+999
++10000:-1:+9999
++100000:-1:+99999
++1000000:-1:+999999
++10000000:-1:+9999999
++100000000:-1:+99999999
++1000000000:-1:+999999999
++10000000000:-1:+9999999999
++123456789:+987654321:+1111111110
+-123456789:+987654321:+864197532
+-123456789:-987654321:-1111111110
++123456789:-987654321:-864197532
+&bsub
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++1:+0:+1
++0:+1:-1
++1:+1:+0
+-1:+0:-1
++0:-1:+1
+-1:-1:+0
+-1:+1:-2
++1:-1:+2
++9:+1:+8
++99:+1:+98
++999:+1:+998
++9999:+1:+9998
++99999:+1:+99998
++999999:+1:+999998
++9999999:+1:+9999998
++99999999:+1:+99999998
++999999999:+1:+999999998
++9999999999:+1:+9999999998
++99999999999:+1:+99999999998
++10:-1:+11
++100:-1:+101
++1000:-1:+1001
++10000:-1:+10001
++100000:-1:+100001
++1000000:-1:+1000001
++10000000:-1:+10000001
++100000000:-1:+100000001
++1000000000:-1:+1000000001
++10000000000:-1:+10000000001
++123456789:+987654321:-864197532
+-123456789:+987654321:-1111111110
+-123456789:-987654321:+864197532
++123456789:-987654321:+1111111110
+&bmul
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++0:+1:+0
++1:+0:+0
++0:-1:+0
+-1:+0:+0
++123456789123456789:+0:+0
++0:+123456789123456789:+0
+-1:-1:+1
+-1:+1:-1
++1:-1:-1
++1:+1:+1
++2:+3:+6
+-2:+3:-6
++2:-3:-6
+-2:-3:+6
++111:+111:+12321
++10101:+10101:+102030201
++1001001:+1001001:+1002003002001
++100010001:+100010001:+10002000300020001
++10000100001:+10000100001:+100002000030000200001
++11111111111:+9:+99999999999
++22222222222:+9:+199999999998
++33333333333:+9:+299999999997
++44444444444:+9:+399999999996
++55555555555:+9:+499999999995
++66666666666:+9:+599999999994
++77777777777:+9:+699999999993
++88888888888:+9:+799999999992
++99999999999:+9:+899999999991
+&bdiv
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+1
+-1:-1:+1
++1:-1:-1
+-1:+1:-1
++1:+2:+0
++2:+1:+2
++1000000000:+9:+111111111
++2000000000:+9:+222222222
++3000000000:+9:+333333333
++4000000000:+9:+444444444
++5000000000:+9:+555555555
++6000000000:+9:+666666666
++7000000000:+9:+777777777
++8000000000:+9:+888888888
++9000000000:+9:+1000000000
++35500000:+113:+314159
++71000000:+226:+314159
++106500000:+339:+314159
++1000000000:+3:+333333333
++10:+5:+2
++100:+4:+25
++1000:+8:+125
++10000:+16:+625
++999999999999:+9:+111111111111
++999999999999:+99:+10101010101
++999999999999:+999:+1001001001
++999999999999:+9999:+100010001
++999999999999999:+99999:+10000100001
+&bmod
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+0
+-1:-1:+0
++1:-1:+0
+-1:+1:+0
++1:+2:+1
++2:+1:+0
++1000000000:+9:+1
++2000000000:+9:+2
++3000000000:+9:+3
++4000000000:+9:+4
++5000000000:+9:+5
++6000000000:+9:+6
++7000000000:+9:+7
++8000000000:+9:+8
++9000000000:+9:+0
++35500000:+113:+33
++71000000:+226:+66
++106500000:+339:+99
++1000000000:+3:+1
++10:+5:+0
++100:+4:+0
++1000:+8:+0
++10000:+16:+0
++999999999999:+9:+0
++999999999999:+99:+0
++999999999999:+999:+0
++999999999999:+9999:+0
++999999999999999:+99999:+0
+&bgcd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++0:+1:+1
++1:+0:+1
++1:+1:+1
++2:+3:+1
++3:+2:+1
++100:+625:+25
++4096:+81:+1
projects / p5sagit/p5-mst-13.2.git / commitdiff