perl 3.0 beta to gamma upgrade kit [3/4]
Larry Wall
lwall at jato.Jpl.Nasa.Gov
Sat Sep 16 10:04:27 AEST 1989
Apply these to a virgin perl 3.0 beta directory to produce a perl 3.0 gamma
directory. Recommended patch switches are -p1 -N.
Larry Wall
lwall at jpl-devvax.jpl.nasa.gov
diff -c -r beta/dolist.c gamma/dolist.c
*** beta/dolist.c Fri Sep 15 16:07:06 1989
--- gamma/dolist.c Fri Sep 15 16:11:39 1989
***************
*** 241,246 ****
--- 241,247 ----
int i;
char *orig;
int origlimit = limit;
+ int realarray = 0;
if (!spat || !s)
fatal("panic: do_split");
***************
*** 274,279 ****
--- 275,281 ----
if (gimme != G_ARRAY) {
ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab);
if (ary) {
+ realarray = 1;
ary->ary_fill = -1;
sp = -1; /* temporarily switch stacks */
}
***************
*** 295,301 ****
for (m = s; m < strend && *m != i; m++) ;
if (m >= strend)
break;
! dstr = str_new(m-s);
str_nset(dstr,s,m-s);
(void)astore(ary, ++sp, dstr);
s = m + 1;
--- 297,306 ----
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);
str_nset(dstr,s,m-s);
(void)astore(ary, ++sp, dstr);
s = m + 1;
***************
*** 308,314 ****
spat->spat_short)) )
#endif
{
! dstr = str_new(m-s);
str_nset(dstr,s,m-s);
(void)astore(ary, ++sp, dstr);
s = m + i;
--- 313,322 ----
spat->spat_short)) )
#endif
{
! if (realarray)
! dstr = Str_new(31,m-s);
! else
! dstr = str_static(&str_undef);
str_nset(dstr,s,m-s);
(void)astore(ary, ++sp, dstr);
s = m + i;
***************
*** 327,333 ****
strend = s + (strend - m);
}
m = spat->spat_regexp->startp[0];
! dstr = str_new(m-s);
str_nset(dstr,s,m-s);
(void)astore(ary, ++sp, dstr);
if (spat->spat_regexp->nparens) {
--- 335,344 ----
strend = s + (strend - m);
}
m = spat->spat_regexp->startp[0];
! if (realarray)
! dstr = Str_new(32,m-s);
! else
! dstr = str_static(&str_undef);
str_nset(dstr,s,m-s);
(void)astore(ary, ++sp, dstr);
if (spat->spat_regexp->nparens) {
***************
*** 334,340 ****
for (i = 1; i <= spat->spat_regexp->nparens; i++) {
s = spat->spat_regexp->startp[i];
m = spat->spat_regexp->endp[i];
! dstr = str_new(m-s);
str_nset(dstr,s,m-s);
(void)astore(ary, ++sp, dstr);
}
--- 345,354 ----
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);
str_nset(dstr,s,m-s);
(void)astore(ary, ++sp, dstr);
}
***************
*** 349,355 ****
if (iters > 9999)
fatal("Split loop");
if (s < strend || origlimit) { /* keep field after final delim? */
! dstr = str_new(0); /* if they interpolate, it's null anyway */
str_nset(dstr,s,strend-s);
(void)astore(ary, ++sp, dstr);
iters++;
--- 363,372 ----
if (iters > 9999)
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);
str_nset(dstr,s,strend-s);
(void)astore(ary, ++sp, dstr);
iters++;
***************
*** 440,446 ****
case 'a':
if (s + len > strend)
len = strend - s;
! str = str_new(len);
str_nset(str,s,len);
s += len;
if (datumtype == 'A') {
--- 457,463 ----
case 'a':
if (s + len > strend)
len = strend - s;
! str = Str_new(35,len);
str_nset(str,s,len);
s += len;
if (datumtype == 'A') {
***************
*** 452,458 ****
str->str_cur = s - str->str_ptr;
s = aptr; /* unborrow register */
}
! (void)astore(stack, ++sp, str);
break;
case 'c':
while (len-- > 0) {
--- 469,475 ----
str->str_cur = s - str->str_ptr;
s = aptr; /* unborrow register */
}
! (void)astore(stack, ++sp, str_2static(str));
break;
case 'c':
while (len-- > 0) {
***************
*** 462,473 ****
bcopy(s,(char*)&achar,sizeof(char));
s += sizeof(char);
}
! str = str_new(0);
aint = achar;
if (aint >= 128) /* fake up signed chars */
aint -= 256;
str_numset(str,(double)aint);
! (void)astore(stack, ++sp, str);
}
break;
case 'C':
--- 479,490 ----
bcopy(s,(char*)&achar,sizeof(char));
s += sizeof(char);
}
! str = Str_new(36,0);
aint = achar;
if (aint >= 128) /* fake up signed chars */
aint -= 256;
str_numset(str,(double)aint);
! (void)astore(stack, ++sp, str_2static(str));
}
break;
case 'C':
***************
*** 478,486 ****
bcopy(s,(char*)&auchar,sizeof(unsigned char));
s += sizeof(unsigned char);
}
! str = str_new(0);
str_numset(str,(double)auchar);
! (void)astore(stack, ++sp, str);
}
break;
case 's':
--- 495,503 ----
bcopy(s,(char*)&auchar,sizeof(unsigned char));
s += sizeof(unsigned char);
}
! str = Str_new(37,0);
str_numset(str,(double)auchar);
! (void)astore(stack, ++sp, str_2static(str));
}
break;
case 's':
***************
*** 491,499 ****
bcopy(s,(char*)&ashort,sizeof(short));
s += sizeof(short);
}
! str = str_new(0);
str_numset(str,(double)ashort);
! (void)astore(stack, ++sp, str);
}
break;
case 'n':
--- 508,516 ----
bcopy(s,(char*)&ashort,sizeof(short));
s += sizeof(short);
}
! str = Str_new(38,0);
str_numset(str,(double)ashort);
! (void)astore(stack, ++sp, str_2static(str));
}
break;
case 'n':
***************
*** 505,517 ****
bcopy(s,(char*)&aushort,sizeof(unsigned short));
s += sizeof(unsigned short);
}
! str = str_new(0);
#ifdef NTOHS
if (datumtype == 'n')
aushort = ntohs(aushort);
#endif
str_numset(str,(double)aushort);
! (void)astore(stack, ++sp, str);
}
break;
case 'i':
--- 522,534 ----
bcopy(s,(char*)&aushort,sizeof(unsigned short));
s += sizeof(unsigned short);
}
! str = Str_new(39,0);
#ifdef NTOHS
if (datumtype == 'n')
aushort = ntohs(aushort);
#endif
str_numset(str,(double)aushort);
! (void)astore(stack, ++sp, str_2static(str));
}
break;
case 'i':
***************
*** 522,530 ****
bcopy(s,(char*)&aint,sizeof(int));
s += sizeof(int);
}
! str = str_new(0);
str_numset(str,(double)aint);
! (void)astore(stack, ++sp, str);
}
break;
case 'I':
--- 539,547 ----
bcopy(s,(char*)&aint,sizeof(int));
s += sizeof(int);
}
! str = Str_new(40,0);
str_numset(str,(double)aint);
! (void)astore(stack, ++sp, str_2static(str));
}
break;
case 'I':
***************
*** 535,543 ****
bcopy(s,(char*)&auint,sizeof(unsigned int));
s += sizeof(unsigned int);
}
! str = str_new(0);
str_numset(str,(double)auint);
! (void)astore(stack, ++sp, str);
}
break;
case 'l':
--- 552,560 ----
bcopy(s,(char*)&auint,sizeof(unsigned int));
s += sizeof(unsigned int);
}
! str = Str_new(41,0);
str_numset(str,(double)auint);
! (void)astore(stack, ++sp, str_2static(str));
}
break;
case 'l':
***************
*** 548,556 ****
bcopy(s,(char*)&along,sizeof(long));
s += sizeof(long);
}
! str = str_new(0);
str_numset(str,(double)along);
! (void)astore(stack, ++sp, str);
}
break;
case 'N':
--- 565,573 ----
bcopy(s,(char*)&along,sizeof(long));
s += sizeof(long);
}
! str = Str_new(42,0);
str_numset(str,(double)along);
! (void)astore(stack, ++sp, str_2static(str));
}
break;
case 'N':
***************
*** 562,574 ****
bcopy(s,(char*)&aulong,sizeof(unsigned long));
s += sizeof(unsigned long);
}
! str = str_new(0);
#ifdef NTOHL
if (datumtype == 'N')
aulong = ntohl(aulong);
#endif
str_numset(str,(double)aulong);
! (void)astore(stack, ++sp, str);
}
break;
case 'p':
--- 579,591 ----
bcopy(s,(char*)&aulong,sizeof(unsigned long));
s += sizeof(unsigned long);
}
! str = Str_new(43,0);
#ifdef NTOHL
if (datumtype == 'N')
aulong = ntohl(aulong);
#endif
str_numset(str,(double)aulong);
! (void)astore(stack, ++sp, str_2static(str));
}
break;
case 'p':
***************
*** 579,588 ****
bcopy(s,(char*)&aptr,sizeof(char*));
s += sizeof(char*);
}
! str = str_new(0);
if (aptr)
str_set(str,aptr);
! (void)astore(stack, ++sp, str);
}
break;
}
--- 596,605 ----
bcopy(s,(char*)&aptr,sizeof(char*));
s += sizeof(char*);
}
! str = Str_new(44,0);
if (aptr)
str_set(str,aptr);
! (void)astore(stack, ++sp, str_2static(str));
}
break;
}
***************
*** 826,837 ****
return 1;
if (str1->str_cur < str2->str_cur) {
! if (retval = bcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
return retval;
else
return 1;
}
! else if (retval = bcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
return retval;
else if (str1->str_cur == str2->str_cur)
return 0;
--- 843,854 ----
return 1;
if (str1->str_cur < str2->str_cur) {
! if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
return retval;
else
return 1;
}
! else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
return retval;
else if (str1->str_cur == str2->str_cur)
return 0;
***************
*** 883,894 ****
#endif
#ifndef lint
! (void)astore(stack,++sp,str_nmake(((double)timesbuf.tms_utime)/HZ));
! (void)astore(stack,++sp,str_nmake(((double)timesbuf.tms_stime)/HZ));
! (void)astore(stack,++sp,str_nmake(((double)timesbuf.tms_cutime)/HZ));
! (void)astore(stack,++sp,str_nmake(((double)timesbuf.tms_cstime)/HZ));
#else
! (void)astore(stack,++sp,str_nmake(0.0));
#endif
return sp;
}
--- 900,916 ----
#endif
#ifndef lint
! (void)astore(stack,++sp,
! str_2static(str_nmake(((double)timesbuf.tms_utime)/HZ)));
! (void)astore(stack,++sp,
! str_2static(str_nmake(((double)timesbuf.tms_stime)/HZ)));
! (void)astore(stack,++sp,
! str_2static(str_nmake(((double)timesbuf.tms_cutime)/HZ)));
! (void)astore(stack,++sp,
! str_2static(str_nmake(((double)timesbuf.tms_cstime)/HZ)));
#else
! (void)astore(stack,++sp,
! str_2static(str_nmake(0.0)));
#endif
return sp;
}
***************
*** 910,924 ****
st[++sp] = str;
return sp;
}
! (void)astore(ary,++sp,str_nmake((double)tmbuf->tm_sec));
! (void)astore(ary,++sp,str_nmake((double)tmbuf->tm_min));
! (void)astore(ary,++sp,str_nmake((double)tmbuf->tm_hour));
! (void)astore(ary,++sp,str_nmake((double)tmbuf->tm_mday));
! (void)astore(ary,++sp,str_nmake((double)tmbuf->tm_mon));
! (void)astore(ary,++sp,str_nmake((double)tmbuf->tm_year));
! (void)astore(ary,++sp,str_nmake((double)tmbuf->tm_wday));
! (void)astore(ary,++sp,str_nmake((double)tmbuf->tm_yday));
! (void)astore(ary,++sp,str_nmake((double)tmbuf->tm_isdst));
return sp;
}
--- 932,946 ----
st[++sp] = str;
return sp;
}
! (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_sec)));
! (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_min)));
! (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_hour)));
! (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mday)));
! (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mon)));
! (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_year)));
! (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_wday)));
! (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_yday)));
! (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_isdst)));
return sp;
}
***************
*** 933,939 ****
register ARRAY *ary = stack;
STR **st = ary->ary_array;
register int sp = arglast[0];
- int max = 0;
int i;
register HENT *entry;
char *tmps;
--- 955,960 ----
***************
*** 950,961 ****
(void)hiterinit(hash);
while (entry = hiternext(hash)) {
if (dokeys) {
- max++;
tmps = hiterkey(entry,&i);
! (void)astore(ary,++sp,str_make(tmps,i));
}
if (dovalues) {
! tmpstr = str_new(0);
#ifdef DEBUGGING
if (debug & 8192) {
sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
--- 971,981 ----
(void)hiterinit(hash);
while (entry = hiternext(hash)) {
if (dokeys) {
tmps = hiterkey(entry,&i);
! (void)astore(ary,++sp,str_2static(str_make(tmps,i)));
}
if (dovalues) {
! tmpstr = Str_new(45,0);
#ifdef DEBUGGING
if (debug & 8192) {
sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
***************
*** 965,971 ****
else
#endif
str_sset(tmpstr,hiterval(hash,entry));
! (void)astore(ary,++sp,tmpstr);
}
}
return sp;
--- 985,991 ----
else
#endif
str_sset(tmpstr,hiterval(hash,entry));
! (void)astore(ary,++sp,str_2static(tmpstr));
}
}
return sp;
Common subdirectories: beta/eg and gamma/eg
diff -c -r beta/eval.c gamma/eval.c
*** beta/eval.c Fri Sep 15 16:05:50 1989
--- gamma/eval.c Fri Sep 15 16:10:06 1989
***************
*** 14,19 ****
--- 14,23 ----
#include <signal.h>
#include <errno.h>
+ #ifdef sparc
+ # include <vfork.h>
+ #endif
+
extern int errno;
#ifdef VOIDSIG
***************
*** 33,38 ****
--- 37,44 ----
double sin(), cos(), atan2(), pow();
+ char *getlogin();
+
extern int sys_nerr;
extern char *sys_errlist[];
***************
*** 85,91 ****
}
#endif
! #include "evalargs.xc";
st += arglast[0];
switch (optype) {
--- 91,97 ----
}
#endif
! #include "evalargs.xc"
st += arglast[0];
switch (optype) {
***************
*** 121,127 ****
STR_SSET(str,st[1]);
anum = (int)str_gnum(st[2]);
if (anum >= 1) {
! tmpstr = str_new(0);
str_sset(tmpstr,str);
while (--anum > 0)
str_scat(str,tmpstr);
--- 127,133 ----
STR_SSET(str,st[1]);
anum = (int)str_gnum(st[2]);
if (anum >= 1) {
! tmpstr = Str_new(50,0);
str_sset(tmpstr,str);
while (--anum > 0)
str_scat(str,tmpstr);
***************
*** 411,418 ****
case O_WRITE:
if (maxarg == 0)
stab = defoutstab;
! else if ((arg[1].arg_type & A_MASK) == A_WORD)
! stab = arg[1].arg_ptr.arg_stab;
else
stab = stabent(str_get(st[1]),TRUE);
if (!stab_io(stab)) {
--- 417,426 ----
case O_WRITE:
if (maxarg == 0)
stab = defoutstab;
! else if ((arg[1].arg_type & A_MASK) == A_WORD) {
! if (!(stab = arg[1].arg_ptr.arg_stab))
! stab = defoutstab;
! }
else
stab = stabent(str_get(st[1]),TRUE);
if (!stab_io(stab)) {
***************
*** 607,630 ****
if (arglast[2] - arglast[1] != 1)
str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
else {
! str = str_new(0); /* must copy the STR */
str_sset(str,st[2]);
(void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
}
break;
case O_POP:
! str = apop(stab_array(arg[1].arg_ptr.arg_stab));
! if (!str)
! goto say_undef;
! str_free(arg->arg_ptr.arg_str);
! arg->arg_ptr.arg_str = str;
! break;
case O_SHIFT:
! str = ashift(stab_array(arg[1].arg_ptr.arg_stab));
if (!str)
goto say_undef;
! str_free(arg->arg_ptr.arg_str);
! arg->arg_ptr.arg_str = str;
break;
case O_UNPACK:
sp = do_unpack(str,gimme,arglast);
--- 615,635 ----
if (arglast[2] - arglast[1] != 1)
str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
else {
! str = Str_new(51,0); /* must copy the STR */
str_sset(str,st[2]);
(void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
}
break;
case O_POP:
! str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
! goto staticalization;
case O_SHIFT:
! str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
! staticalization:
if (!str)
goto say_undef;
! if (ary->ary_flags & ARF_REAL)
! (void)str_2static(str);
break;
case O_UNPACK:
sp = do_unpack(str,gimme,arglast);
***************
*** 1358,1363 ****
--- 1363,1369 ----
goto say_zero;
}
errno = 0;
+ goto say_zero;
}
else
value = 1.0;
***************
*** 1475,1481 ****
if (arglast[2] - arglast[1] != 1)
do_unshift(ary,arglast);
else {
! str = str_new(0); /* must copy the STR */
str_sset(str,st[2]);
aunshift(ary,1);
(void)astore(ary,0,str);
--- 1481,1487 ----
if (arglast[2] - arglast[1] != 1)
do_unshift(ary,arglast);
else {
! str = Str_new(52,0); /* must copy the STR */
str_sset(str,st[2]);
aunshift(ary,1);
(void)astore(ary,0,str);
***************
*** 1766,1771 ****
--- 1772,1804 ----
(void)do_spair(stab,stab2,arglast);
#endif
goto donumset;
+ case O_SHUTDOWN:
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(st[1]),TRUE);
+ #ifndef lint
+ value = (double)do_shutdown(stab,arglast);
+ #else
+ (void)do_shutdown(stab,arglast);
+ #endif
+ goto donumset;
+ case O_GSOCKOPT:
+ case O_SSOCKOPT:
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(st[1]),TRUE);
+ sp = do_sopt(optype,stab,arglast);
+ goto array_return;
+ case O_GETSOCKNAME:
+ case O_GETPEERNAME:
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(st[1]),TRUE);
+ sp = do_getsockname(optype,stab,arglast);
+ goto array_return;
#else /* SOCKET not defined */
case O_SOCKET:
***************
*** 1795,1800 ****
--- 1828,1838 ----
case O_ENETENT:
case O_EPROTOENT:
case O_ESERVENT:
+ case O_SHUTDOWN:
+ case O_GSOCKOPT:
+ case O_SSOCKOPT:
+ case O_GETSOCKNAME:
+ case O_GETPEERNAME:
badsock:
fatal("Unsupported socket function");
#endif /* SOCKET */
***************
*** 1814,1819 ****
--- 1852,1901 ----
case O_VEC:
sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
goto array_return;
+ case O_GPWNAM:
+ case O_GPWUID:
+ case O_GPWENT:
+ sp = do_gpwent(optype,
+ gimme,arglast);
+ goto array_return;
+ case O_SPWENT:
+ value = (double) setpwent();
+ goto donumset;
+ case O_EPWENT:
+ value = (double) endpwent();
+ goto donumset;
+ case O_GGRNAM:
+ case O_GGRGID:
+ case O_GGRENT:
+ sp = do_ggrent(optype,
+ gimme,arglast);
+ goto array_return;
+ case O_SGRENT:
+ value = (double) setgrent();
+ goto donumset;
+ case O_EGRENT:
+ value = (double) endgrent();
+ goto donumset;
+ case O_GETLOGIN:
+ if (!(tmps = getlogin()))
+ goto say_undef;
+ str_set(str,tmps);
+ break;
+ case O_OPENDIR:
+ case O_READDIR:
+ case O_TELLDIR:
+ case O_SEEKDIR:
+ case O_REWINDDIR:
+ case O_CLOSEDIR:
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(st[1]),TRUE);
+ sp = do_dirop(optype,stab,gimme,arglast);
+ goto array_return;
+ case O_SYSCALL:
+ value = (double)do_syscall(arglast);
+ goto donumset;
}
normal_return:
diff -c -r beta/evalargs.xc gamma/evalargs.xc
*** beta/evalargs.xc Fri Sep 15 16:06:40 1989
--- gamma/evalargs.xc Fri Sep 15 16:12:07 1989
***************
*** 237,243 ****
else if (argtype == A_GLOB) {
(void) interp(str,stab_val(last_in_stab),sp);
st = stack->ary_array;
! tmpstr = str_new(0);
if (csh > 0) {
str_set(tmpstr,"/bin/csh -cf 'set nonomatch; glob ");
str_scat(tmpstr,str);
--- 237,243 ----
else if (argtype == A_GLOB) {
(void) interp(str,stab_val(last_in_stab),sp);
st = stack->ary_array;
! tmpstr = Str_new(55,0);
if (csh > 0) {
str_set(tmpstr,"/bin/csh -cf 'set nonomatch; glob ");
str_scat(tmpstr,str);
diff -c -r beta/form.c gamma/form.c
*** beta/form.c Fri Sep 15 16:07:32 1989
--- gamma/form.c Fri Sep 15 16:12:08 1989
***************
*** 39,45 ****
fatal("Too many field values");
dehoist(arg,i);
fcmd->f_expr = make_op(O_ITEM,1,
! arg[i].arg_ptr.arg_arg,Nullarg,Nullarg,0);
if (fcmd->f_flags & FC_CHOP) {
if ((fcmd->f_expr[1].arg_type & A_MASK) == A_STAB)
fcmd->f_expr[1].arg_type = A_LVAL;
--- 39,45 ----
fatal("Too many field values");
dehoist(arg,i);
fcmd->f_expr = make_op(O_ITEM,1,
! arg[i].arg_ptr.arg_arg,Nullarg,Nullarg);
if (fcmd->f_flags & FC_CHOP) {
if ((fcmd->f_expr[1].arg_type & A_MASK) == A_STAB)
fcmd->f_expr[1].arg_type = A_LVAL;
diff -c -r beta/handy.h gamma/handy.h
*** beta/handy.h Fri Sep 15 16:08:11 1989
--- gamma/handy.h Fri Sep 15 16:12:40 1989
***************
*** 50,55 ****
--- 50,59 ----
#endif
#ifndef lint
+ #ifndef LEAKTEST
+ char *safemalloc();
+ char *saferealloc();
+ void safefree();
#define New(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n) * sizeof(t))))
#define Newc(x,v,n,t,c) (v = (c*)safemalloc((MEM_SIZE)((n) * sizeof(t))))
#define Newz(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n) * sizeof(t)))), \
***************
*** 56,64 ****
bzero((char*)(v), (n) * sizeof(t))
#define Renew(v,n,t) (v = (t*)saferealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
#define Renewc(v,n,t,c) (v = (c*)saferealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
#define Copy(s,d,n,t) (void)bcopy((char*)(s),(char*)(d), (n) * sizeof(t))
#define Zero(d,n,t) (void)bzero((char*)(d), (n) * sizeof(t))
- #define Safefree(d) safefree((char*)d)
#else /* lint */
#define New(x,v,n,s) (v = Null(s *))
#define Newc(x,v,n,s,c) (v = Null(s *))
--- 60,85 ----
bzero((char*)(v), (n) * sizeof(t))
#define Renew(v,n,t) (v = (t*)saferealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
#define Renewc(v,n,t,c) (v = (c*)saferealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
+ #define Safefree(d) safefree((char*)d)
+ #define Str_new(x,len) str_new(len)
+ #else /* LEAKTEST */
+ char *safexmalloc();
+ char *safexrealloc();
+ void safexfree();
+ #define New(x,v,n,t) (v = (t*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t))))
+ #define Newc(x,v,n,t,c) (v = (c*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t))))
+ #define Newz(x,v,n,t) (v = (t*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t)))), \
+ bzero((char*)(v), (n) * sizeof(t))
+ #define Renew(v,n,t) (v = (t*)safexrealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
+ #define Renewc(v,n,t,c) (v = (c*)safexrealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
+ #define Safefree(d) safexfree((char*)d)
+ #define Str_new(x,len) str_new(x,len)
+ #define MAXXCOUNT 1200
+ long xcount[MAXXCOUNT];
+ long lastxcount[MAXXCOUNT];
+ #endif /* LEAKTEST */
#define Copy(s,d,n,t) (void)bcopy((char*)(s),(char*)(d), (n) * sizeof(t))
#define Zero(d,n,t) (void)bzero((char*)(d), (n) * sizeof(t))
#else /* lint */
#define New(x,v,n,s) (v = Null(s *))
#define Newc(x,v,n,s,c) (v = Null(s *))
diff -c -r beta/hash.c gamma/hash.c
*** beta/hash.c Fri Sep 15 16:07:12 1989
--- gamma/hash.c Fri Sep 15 16:11:47 1989
***************
*** 71,77 ****
dkey.dsize = klen;
dcontent = dbm_fetch(tb->tbl_dbm,dkey);
if (dcontent.dptr) { /* found one */
! str = str_new(dcontent.dsize);
str_nset(str,dcontent.dptr,dcontent.dsize);
hstore(tb,key,klen,str,hash); /* cache it */
return str;
--- 71,77 ----
dkey.dsize = klen;
dcontent = dbm_fetch(tb->tbl_dbm,dkey);
if (dcontent.dptr) { /* found one */
! str = Str_new(60,dcontent.dsize);
str_nset(str,dcontent.dptr,dcontent.dsize);
hstore(tb,key,klen,str,hash); /* cache it */
return str;
***************
*** 79,85 ****
}
#endif
if (lval) { /* gonna assign to this, so it better be there */
! str = str_new(0);
hstore(tb,key,klen,str,hash);
return str;
}
--- 79,85 ----
}
#endif
if (lval) { /* gonna assign to this, so it better be there */
! str = Str_new(61,0);
hstore(tb,key,klen,str,hash);
return str;
}
***************
*** 436,442 ****
key.dsize = entry->hent_klen;
content = dbm_fetch(tb->tbl_dbm,key);
if (!entry->hent_val)
! entry->hent_val = str_new(0);
str_nset(entry->hent_val,content.dptr,content.dsize);
}
#endif
--- 436,442 ----
key.dsize = entry->hent_klen;
content = dbm_fetch(tb->tbl_dbm,key);
if (!entry->hent_val)
! entry->hent_val = Str_new(62,0);
str_nset(entry->hent_val,content.dptr,content.dsize);
}
#endif
Only in beta: hdef
Common subdirectories: beta/lib and gamma/lib
diff -c -r beta/malloc.c gamma/malloc.c
*** beta/malloc.c Fri Sep 15 16:06:47 1989
--- gamma/malloc.c Fri Sep 15 16:11:58 1989
***************
*** 6,12 ****
--- 6,14 ----
#ifndef lint
static char sccsid[] = "@(#)malloc.c 4.3 (Berkeley) 9/16/83";
+ #ifdef DEBUGGING
#define RCHECK
+ #endif
/*
* malloc.c (Caltech) 2/21/82
* Chris Kingsley, kingsley at cit-20.
***************
*** 227,233 ****
ASSERT(op->ov_magic == MAGIC); /* make sure it was in use */
#else
if (op->ov_magic != MAGIC) {
! fprintf(stderr,"%s free() ignored\n",
op->ov_magic == OLDMAGIC ? "Duplicate" : "Bad");
return; /* sanity */
}
--- 229,235 ----
ASSERT(op->ov_magic == MAGIC); /* make sure it was in use */
#else
if (op->ov_magic != MAGIC) {
! warn("%s free() ignored",
op->ov_magic == OLDMAGIC ? "Duplicate" : "Bad");
return; /* sanity */
}
Only in beta: munch
diff -c -r beta/perl.h gamma/perl.h
*** beta/perl.h Fri Sep 15 16:07:17 1989
--- gamma/perl.h Fri Sep 15 16:11:55 1989
***************
*** 24,32 ****
#ifdef MEMCPY
extern char *memcpy(), *memset();
#define bcopy(s1,s2,l) memcpy(s2,s1,l)
- #define bcmp(s1,s2,l) memcmp(s1,s2,l)
#define bzero(s,l) memset(s,0,l)
#endif
#include <stdio.h>
#include <ctype.h>
--- 24,34 ----
#ifdef MEMCPY
extern char *memcpy(), *memset();
#define bcopy(s1,s2,l) memcpy(s2,s1,l)
#define bzero(s,l) memset(s,0,l)
#endif
+ #ifndef BCMP /* prefer bcmp slightly 'cuz it doesn't order */
+ #define bcmp(s1,s2,l) memcmp(s1,s2,l)
+ #endif
#include <stdio.h>
#include <ctype.h>
***************
*** 53,70 ****
#include <sys/times.h>
! #ifdef IOCTL
#ifndef _IOCTL_
#include <sys/ioctl.h>
#endif
#endif
#ifdef NDBM
#include <ndbm.h>
#define SOME_DBM
#else
#ifdef ODBM
#include <dbm.h>
#define SOME_DBM
#define dbm_fetch(db,dkey) fetch(dkey)
#define dbm_delete(db,dkey) delete(dkey)
--- 55,88 ----
#include <sys/times.h>
! #ifdef I_SYSIOCTL
#ifndef _IOCTL_
#include <sys/ioctl.h>
#endif
#endif
+ #if defined(mc300) || defined(mc500) || defined(mc700) /* MASSCOMP */
+ #ifdef SOCKETPAIR
+ #undef SOCKETPAIR
+ #endif
#ifdef NDBM
+ #undef NDBM
+ #endif
+ #endif
+
+ #ifdef NDBM
#include <ndbm.h>
#define SOME_DBM
#else
#ifdef ODBM
+ #ifdef NULL
+ #undef NULL /* suppress redefinition message */
+ #endif
#include <dbm.h>
+ #ifdef NULL
+ #undef NULL
+ #endif
+ #define NULL 0 /* silly thing is, we don't even use this */
#define SOME_DBM
#define dbm_fetch(db,dkey) fetch(dkey)
#define dbm_delete(db,dkey) delete(dkey)
***************
*** 86,91 ****
--- 104,119 ----
#define ntohi ntohl
#endif
+ #ifdef I_DIRENT
+ #include <dirent.h>
+ #define DIRENT dirent
+ #else
+ #ifdef I_SYSDIR
+ #include <sys/dir.h>
+ #define DIRENT direct
+ #endif
+ #endif
+
typedef struct arg ARG;
typedef struct cmd CMD;
typedef struct formcmd FCMD;
***************
*** 137,143 ****
(Str->str_nok ? (Str->str_u.str_nval != 0.0) : 0 ) ))
#ifdef DEBUGGING
! #define str_peek(str) (Str = (str), (Str->str_pok ? Str->str_ptr : (Str->str_nok ? (sprintf(tokenbuf,"num(%g)",Str->str_u.str_nval),(char*)tokenbuf) : "" )))
#endif
#ifdef CRIPPLED_CC
--- 165,177 ----
(Str->str_nok ? (Str->str_u.str_nval != 0.0) : 0 ) ))
#ifdef DEBUGGING
! #define str_peek(str) (Str = (str), \
! (Str->str_pok ? \
! Str->str_ptr : \
! (Str->str_nok ? \
! (sprintf(tokenbuf,"num(%g)",Str->str_u.str_nval), \
! (char*)tokenbuf) : \
! "" )))
#endif
#ifdef CRIPPLED_CC
diff -c -r beta/perl.man.2 gamma/perl.man.2
*** beta/perl.man.2 Fri Sep 15 16:06:25 1989
--- gamma/perl.man.2 Fri Sep 15 16:10:40 1989
***************
*** 36,45 ****
--- 36,54 ----
This is a useful optimization when you only want to see the first occurrence of
something in each file of a set of files, for instance.
Only ?? patterns local to the current package are reset.
+ .Ip "accept(NEWSOCKET,GENERICSOCKET)" 8 2
+ 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 "atan2(X,Y)" 8 2
Returns the arctangent of X/Y in the range
.if t \-\(*p to \(*p.
.if n \-PI to PI.
+ .Ip "bind(SOCKET,NAME)" 8 2
+ Does the same thing that the bind system call does.
+ Returns true if it succeeded, false otherwise.
+ NAME should be a packed address of the proper type for the socket.
+ See example in section on Interprocess Communication.
.Ip "chdir(EXPR)" 8 2
.Ip "chdir EXPR" 8 2
Changes the working directory to EXPR, if possible.
***************
*** 110,116 ****
print "Files: "
$pattern = <STDIN>;
chop($pattern);
! open(pass, \'/etc/passwd\') || die "Can't open passwd: $!\n";
while (<pass>) {
($login,$pass,$uid,$gid) = split(/:/);
$uid{$login} = $uid;
--- 119,125 ----
print "Files: "
$pattern = <STDIN>;
chop($pattern);
! open(pass, \'/etc/passwd\') || die "Can't open passwd: $!\en";
while (<pass>) {
($login,$pass,$uid,$gid) = split(/:/);
$uid{$login} = $uid;
***************
*** 154,159 ****
--- 163,176 ----
.fi
FILEHANDLE may be an expression whose value gives the real filehandle name.
+ .Ip "closedir(DIRHANDLE)" 8 5
+ .Ip "closedir DIRHANDLE" 8
+ Closes a directory opened by opendir().
+ .Ip "connect(SOCKET,NAME)" 8 2
+ Does the same thing that the connect system call does.
+ Returns true if it succeeded, false otherwise.
+ NAME should be a package address of the proper type for the socket.
+ See example in section on Interprocess Communication.
.Ip "cos(EXPR)" 8 6
.Ip "cos EXPR" 8 6
Returns the cosine of EXPR (expressed in radians).
***************
*** 579,600 ****
--- 596,657 ----
Returns the next character from the input file attached to FILEHANDLE, or
a null string at EOF.
If FILEHANDLE is omitted, reads from STDIN.
+ .Ip "getlogin" 8 3
+ Returns the current login from /etc/utmp, if any.
+ If null, use getpwuid.
+
+ ($login = getlogin) || (($login) = getpwuid($<));
+
+ .Ip "getpeername(SOCKET)" 8 3
+ Returns the packed sockaddr address of other end of the SOCKET connection.
+ .nf
+
+ .ne 4
+ # An internet sockaddr
+ $sockaddr = 'S n a4 x8';
+ $hersockaddr = getpeername(S);
+ ($family, $port, $heraddr) = unpack($sockaddr,$hersockaddr);
+
+ .fi
+ .Ip "getpgrp(PID)" 8 4
+ .Ip "getpgrp PID" 8
+ Returns the current process group for the specified PID, 0 for the current
+ process.
+ Will produce a fatal error if used on a machine that doesn't implement
+ getpgrp(2).
+ .Ip "getppid" 8 4
+ Returns the process id of the parent process.
+ .Ip "getpriority(WHICH,WHO)" 8 4
+ Returns the current priority for a process, a process group, or a user.
+ (See getpriority(2).)
+ Will produce a fatal error if used on a machine that doesn't implement
+ getpriority(2).
+ .Ip "getpwnam(NAME)" 8
+ .Ip "getgrnam(NAME)" 8
.Ip "gethostbyname(NAME)" 8
.Ip "getnetbyname(NAME)" 8
.Ip "getprotobyname(NAME)" 8
+ .Ip "getpwuid(UID)" 8
+ .Ip "getgrgid(GID)" 8
.Ip "getservbyname(NAME,PROTO)" 8
.Ip "gethostbyaddr(ADDR,ADDRTYPE)" 8
.Ip "getnetbyaddr(ADDR,ADDRTYPE)" 8
.Ip "getprotobynumber(NUMBER)" 8
.Ip "getservbyport(PORT,PROTO)" 8
+ .Ip "getpwent()" 8
+ .Ip "getgrent()" 8
.Ip "gethostent()" 8
.Ip "getnetent()" 8
.Ip "getprotoent()" 8
.Ip "getservent()" 8
+ .Ip "setpwent()" 8
+ .Ip "setgrent()" 8
.Ip "sethostent(STAYOPEN)" 8
.Ip "setnetent(STAYOPEN)" 8
.Ip "setprotoent(STAYOPEN)" 8
.Ip "setservent(STAYOPEN)" 8
+ .Ip "endpwent()" 8
+ .Ip "endgrent()" 8
.Ip "endhostent()" 8
.Ip "endnetent()" 8
.Ip "endprotoent()" 8
***************
*** 601,609 ****
.Ip "endservent()" 8
These routines perform the same functions as their counterparts in the
system library.
! The return values from the get routines are as follows:
.nf
($name,$aliases,$addrtype,$length, at addrs) = gethost.\|.\|.
($name,$aliases,$addrtype,$net) = getnet.\|.\|.
($name,$aliases,$proto) = getproto.\|.\|.
--- 658,669 ----
.Ip "endservent()" 8
These routines perform the same functions as their counterparts in the
system library.
! The return values from the various get routines are as follows:
.nf
+ ($name,$passwd,$uid,$gid,
+ $quota,$comment,$gcos,$dir,$shell) = getpw.\|.\|.
+ ($name,$passwd,$gid,$members) = getgr.\|.\|.
($name,$aliases,$addrtype,$length, at addrs) = gethost.\|.\|.
($name,$aliases,$addrtype,$net) = getnet.\|.\|.
($name,$aliases,$proto) = getproto.\|.\|.
***************
*** 610,628 ****
($name,$aliases,$port,$proto) = getserv.\|.\|.
.fi
! .Ip "getpgrp(PID)" 8 4
! .Ip "getpgrp PID" 8
! Returns the current process group for the specified PID, 0 for the current
! process.
! Will produce a fatal error if used on a machine that doesn't implement
! getpgrp(2).
! .Ip "getppid" 8 4
! Returns the process id of the parent process.
! .Ip "getpriority(WHICH,WHO)" 8 4
! Returns the current priority for a process, a process group, or a user.
! (See getpriority(2).)
! Will produce a fatal error if used on a machine that doesn't implement
! getpriority(2).
.Ip "gmtime(EXPR)" 8 4
.Ip "gmtime EXPR" 8
Converts a time as returned by the time function to a 9-element array with
--- 670,700 ----
($name,$aliases,$port,$proto) = getserv.\|.\|.
.fi
! The $members value returned by getgr.\|.\|. is a space separated list
! of the login names of the members of the group.
! .Sp
! The @addrs value returned by the gethost.\|.\|. functions is a list of the
! raw addresses returned by the corresponding system library call.
! In the Internet domain, each address is four bytes long and you can unpack
! it by saying something like:
! .nf
!
! ($a,$b,$c,$d) = unpack('C4',$addr[0]);
!
! .fi
! .Ip "getsockname(SOCKET)" 8 3
! Returns the packed sockaddr address of this end of the SOCKET connection.
! .nf
!
! .ne 4
! # An internet sockaddr
! $sockaddr = 'S n a4 x8';
! $mysockaddr = getsockname(S);
! ($family, $port, $myaddr) = unpack($sockaddr,$mysockaddr);
!
! .fi
! .Ip "getsockopt(SOCKET,LEVEL,OPTNAME)" 8 3
! Returns the socket option requested, or undefined if there is an error.
.Ip "gmtime(EXPR)" 8 4
.Ip "gmtime EXPR" 8
Converts a time as returned by the time function to a 9-element array with
***************
*** 786,791 ****
--- 858,867 ----
.Ip "link(OLDFILE,NEWFILE)" 8 2
Creates a new filename linked to the old filename.
Returns 1 for success, 0 otherwise.
+ .Ip "listen(SOCKET,QUEUESIZE)" 8 2
+ Does the same thing that the listen system call does.
+ Returns true if it succeeded, false otherwise.
+ See example in section on Interprocess Communication.
.Ip "local(LIST)" 8 4
Declares the listed variables to be local to the enclosing block,
subroutine, eval or \*(L"do\*(R".
***************
*** 857,862 ****
--- 933,944 ----
Returns logarithm (base
.IR e )
of EXPR.
+ .Ip "lstat(FILEHANDLE)" 8 6
+ .Ip "lstat FILEHANDLE" 8
+ .Ip "lstat(EXPR)" 8
+ Does the same thing as the stat() function, but stats a symbolic link
+ instead of the file the symbolic link points to.
+ If symbolic links are unimplemented on your system, a normal stat is done.
.Ip "m/PATTERN/io" 8 4
.Ip "/PATTERN/io" 8
Searches a string for a pattern match, and returns true (1) or false (\'\').
diff -c -r beta/perl.man.3 gamma/perl.man.3
*** beta/perl.man.3 Fri Sep 15 16:06:01 1989
--- gamma/perl.man.3 Fri Sep 15 16:10:33 1989
***************
*** 64,70 ****
.ne 3
$article = 100;
! open article || die "Can't find article $article: $!\n";
while (<article>) {\|.\|.\|.
open(LOG, \'>>/usr/spool/news/twitlog\'\|); # (log is reserved)
--- 64,70 ----
.ne 3
$article = 100;
! open article || die "Can't find article $article: $!\en";
while (<article>) {\|.\|.\|.
open(LOG, \'>>/usr/spool/news/twitlog\'\|); # (log is reserved)
***************
*** 161,166 ****
--- 161,171 ----
.fi
Explicitly closing any piped filehandle causes the parent process to wait for the
child to finish, and returns the status value in $?.
+ .Ip "opendir(DIRHANDLE,EXPR)" 8 3
+ Opens a directory named EXPR for processing by readdir(), telldir(), seekdir(),
+ rewinddir() and closedir().
+ Returns true if successful.
+ DIRHANDLEs have their own namespace separate from FILEHANDLEs.
.Ip "ord(EXPR)" 8 4
.Ip "ord EXPR" 8
Returns the ascii value of the first character of EXPR.
***************
*** 299,313 ****
FILEHANDLE.
Returns the number of bytes actually read.
SCALAR will be grown or shrunk to the length actually read.
.Ip "readlink(EXPR)" 8 6
.Ip "readlink EXPR" 8
Returns the value of a symbolic link, if symbolic links are implemented.
If not, gives a fatal error.
If there is some system error, returns the undefined value and sets $! (errno).
! .Ip "recv(FILEHANDLE,SCALAR,LEN,FLAGS)" 8 4
Receives a message on a socket.
Attempts to receive LENGTH bytes of data into variable SCALAR from the specified
! FILEHANDLE.
Returns the address of the sender, or the undefined value if there's an error.
SCALAR will be grown or shrunk to the length actually read.
Takes the same flags as the system call of the same name.
--- 304,324 ----
FILEHANDLE.
Returns the number of bytes actually read.
SCALAR will be grown or shrunk to the length actually read.
+ .Ip "readdir(DIRHANDLE)" 8 3
+ Returns the next directory entry for a directory opened by opendir().
+ If used in an array context, returns all the rest of the entries in the
+ directory.
+ If there are no more entries, returns an undefined value in a scalar context
+ or a null list in an array context.
.Ip "readlink(EXPR)" 8 6
.Ip "readlink EXPR" 8
Returns the value of a symbolic link, if symbolic links are implemented.
If not, gives a fatal error.
If there is some system error, returns the undefined value and sets $! (errno).
! .Ip "recv(SOCKET,SCALAR,LEN,FLAGS)" 8 4
Receives a message on a socket.
Attempts to receive LENGTH bytes of data into variable SCALAR from the specified
! SOCKET filehandle.
Returns the address of the sender, or the undefined value if there's an error.
SCALAR will be grown or shrunk to the length actually read.
Takes the same flags as the system call of the same name.
***************
*** 389,394 ****
--- 400,408 ----
.Ip "reverse(LIST)" 8 4
.Ip "reverse LIST" 8
Returns an array value consisting of the elements of LIST in the opposite order.
+ .Ip "rewinddir(DIRHANDLE)" 8 5
+ .Ip "rewinddir DIRHANDLE" 8
+ Sets the current position to the beginning of the directory for the readdir() routine on DIRHANDLE.
.Ip "rindex(STR,SUBSTR)" 8 4
Works just like index except that it
returns the position of the LAST occurrence of SUBSTR in STR.
***************
*** 446,451 ****
--- 460,470 ----
call of stdio.
FILEHANDLE may be an expression whose value gives the name of the filehandle.
Returns 1 upon success, 0 otherwise.
+ .Ip "seekdir(DIRHANDLE,POS)" 8 3
+ Sets the current position for the readdir() routine on DIRHANDLE.
+ POS must be a value returned by seekdir().
+ Has the same caveats about possible directory compaction as the corresponding
+ system library routine.
.Ip "select(FILEHANDLE)" 8 3
Sets the current default filehandle for output.
This has two effects: first, a
***************
*** 512,519 ****
process.
Will produce a fatal error if used on a machine that doesn't implement
setpgrp(2).
! .Ip "send(FILEHANDLE,MSG,FLAGS,TO)" 8 4
! .Ip "send(FILEHANDLE,MSG,FLAGS)" 8
Sends a message on a socket.
Takes the same flags as the system call of the same name.
On unconnected sockets you must specify a destination so send TO.
--- 531,538 ----
process.
Will produce a fatal error if used on a machine that doesn't implement
setpgrp(2).
! .Ip "send(SOCKET,MSG,FLAGS,TO)" 8 4
! .Ip "send(SOCKET,MSG,FLAGS)" 8
Sends a message on a socket.
Takes the same flags as the system call of the same name.
On unconnected sockets you must specify a destination so send TO.
***************
*** 524,529 ****
--- 543,552 ----
(See setpriority(2).)
Will produce a fatal error if used on a machine that doesn't implement
setpriority(2).
+ .Ip "setsockopt(SOCKET,LEVEL,OPTNAME,OPTVAL)" 8 3
+ Sets the socket option requested.
+ Returns undefined if there is an error.
+ OPTVAL may be specified as undef if you don't want to pass an argument.
.Ip "shift(ARRAY)" 8 6
.Ip "shift ARRAY" 8
.Ip "shift" 8
***************
*** 530,539 ****
Shifts the first value of the array off and returns it,
shortening the array by 1 and moving everything down.
If there are no elements in the array, returns the undefined value.
! If ARRAY is omitted, shifts the ARGV array.
See also unshift(), push() and pop().
Shift() and unshift() do the same thing to the left end of an array that push()
and pop() do to the right end.
.Ip "sin(EXPR)" 8 4
.Ip "sin EXPR" 8
Returns the sine of EXPR (expressed in radians).
--- 553,566 ----
Shifts the first value of the array off and returns it,
shortening the array by 1 and moving everything down.
If there are no elements in the array, returns the undefined value.
! If ARRAY is omitted, shifts the @ARGV array in the main program, and the @_
! array in subroutines.
See also unshift(), push() and pop().
Shift() and unshift() do the same thing to the left end of an array that push()
and pop() do to the right end.
+ .Ip "shutdown(SOCKET,HOW)" 8 3
+ Shuts down a socket connection in the manner indicated by HOW, which has
+ the same interpretation as in the system call of the same name.
.Ip "sin(EXPR)" 8 4
.Ip "sin EXPR" 8
Returns the sine of EXPR (expressed in radians).
***************
*** 543,548 ****
--- 570,590 ----
Causes the script to sleep for EXPR seconds, or forever if no EXPR.
May be interrupted by sending the process a SIGALARM.
Returns the number of seconds actually slept.
+ .Ip "socket(SOCKET,DOMAIN,TYPE,PROTOCOL)" 8 3
+ Opens a socket of the specified kind and attaches it to filehandle SOCKET.
+ DOMAIN, TYPE and PROTOCOL are specified the same as for the system call
+ of the same name.
+ You may need to run makelib on sys/socket.h to get the proper values handy
+ in a perl library file.
+ Return true if successful.
+ See the example in the section on Interprocess Communication.
+ .Ip "socketpair(SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL)" 8 3
+ Creates an unnamed pair of sockets in the specified domain, of the specified
+ type.
+ DOMAIN, TYPE and PROTOCOL are specified the same as for the system call
+ of the same name.
+ If unimplemented, yields a fatal error.
+ Return true if successful.
.Ip "sort(SUBROUTINE LIST)" 8 9
.Ip "sort(LIST)" 8
.Ip "sort SUBROUTINE LIST" 8
***************
*** 774,779 ****
--- 816,840 ----
if you assign something longer than LEN, the string will grow to accomodate it.
To keep the string the same length you may need to pad or chop your value using
sprintf().
+ .Ip "syscall(LIST)" 8 6
+ .Ip "syscall LIST" 8
+ Calls the system call specified as the first element of the list, passing
+ the remaining elements as arguments to the system call.
+ If unimplemented, produces a fatal error.
+ The arguments are interpreted as follows: if a given argument is numeric,
+ the argument is passed as an int.
+ If not, the pointer to the string value is passed.
+ You are responsible to make sure a string is pre-extended long enough
+ to receive any result that might be written into a string.
+ If your integer arguments are not literals and have never been interpreted
+ in a numeric context, you may need to add 0 to them to force them to look
+ like numbers.
+ .nf
+
+ do 'syscall.h'; # may need to run makelib
+ syscall(&SYS_write, fileno(STDOUT), "hi there\en", 9);
+
+ .fi
.Ip "system(LIST)" 8 6
.Ip "system LIST" 8
Does exactly the same thing as \*(L"exec LIST\*(R" except that a fork
***************
*** 802,807 ****
--- 863,875 ----
FILEHANDLE may be an expression whose value gives the name of the actual
filehandle.
If FILEHANDLE is omitted, assumes the file last read.
+ .Ip "telldir(DIRHANDLE)" 8 5
+ .Ip "telldir DIRHANDLE" 8
+ Returns the current position of the readdir() routines on DIRHANDLE.
+ Value may be given to seekdir() to access a particular location in
+ a directory.
+ Has the same caveats about possible directory compaction as the corresponding
+ system library routine.
.Ip "time" 8 4
Returns the number of non-leap seconds since January 1, 1970, UTC.
Suitable for feeding to gmtime() and localtime().
diff -c -r beta/perl.man.4 gamma/perl.man.4
*** beta/perl.man.4 Fri Sep 15 16:05:55 1989
--- gamma/perl.man.4 Fri Sep 15 16:10:19 1989
***************
*** 98,103 ****
--- 98,105 ----
.PP
Any arguments passed to the routine come in as array @_,
that is ($_[0], $_[1], .\|.\|.).
+ The array @_ is a local array, but its values are references to the
+ actual scalar parameters.
The return value of the subroutine is the value of the last expression
evaluated, and can be either an array value or a scalar value.
Alternately, a return statement may be used to specify the returned value and
***************
*** 159,164 ****
--- 161,169 ----
}
.fi
+ This also has the effect of turning call-by-reference into call-by-value,
+ since the assignment copies the values.
+ .Sp
Subroutines may be called recursively.
If a subroutine is called using the & form, the argument list is optional.
If omitted, no @_ array is set up for the subroutine; the @_ array at the
***************
*** 174,180 ****
.fi
.Sh "Passing By Reference"
! Sometimes you don't want to pass the value of something to a subroutine but
rather the name of it, so that the subroutine can modify the global copy
of it rather than working with a local copy.
In perl you can refer to all the objects of a particular name by prefixing
--- 179,185 ----
.fi
.Sh "Passing By Reference"
! Sometimes you don't want to pass the value of an array to a subroutine but
rather the name of it, so that the subroutine can modify the global copy
of it rather than working with a local copy.
In perl you can refer to all the objects of a particular name by prefixing
***************
*** 200,205 ****
--- 205,218 ----
You can actually assign to *name anywhere, but the previous referent of
*name may be stranded forever.
This may or may not bother you.
+ .Sp
+ Note that scalars are already passed by reference, so you can modify scalar
+ arguments without using this mechanism by refering explicitly to the $_[nnn]
+ in question.
+ You can modify all the elements of an array by passing all the elements
+ as scalars, but you have to use the * mechanism to push, pop or change the
+ size of an array.
+ The * mechanism will probably be more efficient in any case.
.Sh "Regular Expressions"
The patterns used in pattern matching are regular expressions such as
those supplied in the Version 8 regexp routines.
***************
*** 419,424 ****
--- 432,529 ----
using the reset operator between records.
Not only is it more efficient, but it can prevent the bug of adding another
field and forgetting to zero it.
+ .Sh "Interprocess Communication"
+ The IPC facilities of perl are built on the Berkeley socket mechanism.
+ If you don't have sockets, you can ignore this section.
+ The calls have the same names as the corresponding system calls,
+ but the arguments tend to differ, for two reasons.
+ First, perl file handles work differently than C file descriptors.
+ Second, perl already knows the length of its strings, so you don't need
+ to pass that information.
+ Here is a sample client (untested):
+ .nf
+
+ ($them,$port) = @ARGV;
+ $port = 2345 unless $port;
+ $them = 'localhost' unless $them;
+
+ $SIG{'INT'} = 'dokill';
+ sub dokill { kill 9,$child if $child; }
+
+ do 'sys/socket.h' || die "Can't do sys/socket.h: $@";
+
+ $sockaddr = 'S n a4 x8';
+ chop($hostname = `hostname`);
+
+ ($name, $aliases, $proto) = getprotobyname('tcp');
+ ($name, $aliases, $port) = getservbyname($port, 'tcp')
+ unless $port =~ /^\d+$/;;
+ ($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
+ ($name, $aliases, $type, $len, $thataddr) = gethostbyname($them);
+
+ $this = pack($sockaddr, &AF_INET, 0, $thisaddr);
+ $that = pack($sockaddr, &AF_INET, $port, $thataddr);
+
+ socket(S, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
+ bind(S, $this) || die "bind: $!";
+ connect(S, $that) || die "connect: $!";
+
+ select(S); $| = 1; select(stdout);
+
+ if ($child = fork) {
+ while (<>) {
+ print S;
+ }
+ sleep 3;
+ do dokill();
+ }
+ else {
+ while (<S>) {
+ print;
+ }
+ }
+
+ .fi
+ And here's a server:
+ .nf
+
+ ($port) = @ARGV;
+ $port = 2345 unless $port;
+
+ do 'sys/socket.h' || die "Can't do sys/socket.h: $@";
+
+ $sockaddr = 'S n a4 x8';
+
+ ($name, $aliases, $proto) = getprotobyname('tcp');
+ ($name, $aliases, $port) = getservbyname($port, 'tcp')
+ unless $port =~ /^\d+$/;;
+
+ $this = pack($sockaddr, &AF_INET, $port, "\0\0\0\0");
+
+ select(NS); $| = 1; select(stdout);
+
+ socket(S, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
+ bind(S, $this) || die "bind: $!";
+ listen(S, 5) || die "connect: $!";
+
+ select(S); $| = 1; select(stdout);
+
+ for (;;) {
+ print "Listening again\n";
+ ($addr = accept(NS,S)) || die $!;
+ print "accept ok\n";
+
+ ($af,$port,$inetaddr) = unpack($pat,$addr);
+ @inetaddr = unpack('C4',$inetaddr);
+ print "$af $port @inetaddr\n";
+
+ while (<NS>) {
+ print;
+ print NS;
+ }
+ }
+
+ .fi
.Sh "Predefined Names"
The following names have special meaning to
.IR perl .
***************
*** 796,802 ****
You can use this to print out all the variables in a package, for instance.
Here is dumpvar.pl from the perl library:
.nf
!
package dumpvar;
sub main'dumpvar {
--- 901,907 ----
You can use this to print out all the variables in a package, for instance.
Here is dumpvar.pl from the perl library:
.nf
! .ne 11
package dumpvar;
sub main'dumpvar {
***************
*** 805,830 ****
\& while (($key,$val) = each(%stab)) {
\& {
\& local(*entry) = $val;
! .ne 3
! \& eval <<'.' if defined $entry;
! print "\$$key = '$entry'\n";
! .
.ne 7
! \& eval <<'.' if defined @entry;
! print "\@$key = (\n";
! foreach $num ($[ .. $#entry) {
! \& print " $num\t'",$entry[$num],"'\n";
! }
! print ")\n";
! .
.ne 10
! \& eval <<'.' if $key ne "_$package" && defined %entry;
! print "\%$key = (\n";
! foreach $key (sort keys(%entry)) {
! \& print " $key\t'",$entry{$key},"'\n";
! }
! print ")\n";
! .
\& }
\& }
}
--- 910,934 ----
\& while (($key,$val) = each(%stab)) {
\& {
\& local(*entry) = $val;
! \& if (defined $entry) {
! \& print "\e$$key = '$entry'\en";
! \& }
.ne 7
! \& if (defined @entry) {
! \& print "\e@$key = (\en";
! \& foreach $num ($[ .. $#entry) {
! \& print " $num\et'",$entry[$num],"'\en";
! \& }
! \& print ")\en";
! \& }
.ne 10
! \& if ($key ne "_$package" && defined %entry) {
! \& print "\e%$key = (\en";
! \& foreach $key (sort keys(%entry)) {
! \& print " $key\et'",$entry{$key},"'\en";
! \& }
! \& print ")\en";
! \& }
\& }
\& }
}
***************
*** 899,905 ****
switch, your script will be run under a debugging monitor.
It will halt before the first executable statement and ask you for a
command, such as:
! .Ip "?" 12 4
Prints out a help message.
.Ip "s" 12 4
Single step.
--- 1003,1009 ----
switch, your script will be run under a debugging monitor.
It will halt before the first executable statement and ask you for a
command, such as:
! .Ip "h" 12 4
Prints out a help message.
.Ip "s" 12 4
Single step.
***************
*** 964,970 ****
If number is omitted, redoes the previous command.
.Ip "! -number" 12 4
Redo the command that was that many commands ago.
! .Ip "h -number" 12 4
Display last n commands.
Only commands longer than one character are listed.
If number is omitted, lists them all.
--- 1068,1074 ----
If number is omitted, redoes the previous command.
.Ip "! -number" 12 4
Redo the command that was that many commands ago.
! .Ip "H -number" 12 4
Display last n commands.
Only commands longer than one character are listed.
If number is omitted, lists them all.
More information about the Alt.sources
mailing list