lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (10/17/90)
System: perl version 3.0 Patch #: 31 Priority: HIGH Subject: patch #29, continued Description: See patch #29. 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 #36 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: 30 1c1 < #define PATCHLEVEL 30 --- > #define PATCHLEVEL 31 Index: doio.c Prereq: 3.0.1.10 *** doio.c.old Tue Oct 16 11:49:17 1990 --- doio.c Tue Oct 16 11:49:28 1990 *************** *** 1,4 **** ! /* $Header: doio.c,v 3.0.1.10 90/08/13 22:14:29 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: doio.c,v 3.0.1.11 90/10/15 16:16:11 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,19 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: doio.c,v $ + * Revision 3.0.1.11 90/10/15 16:16:11 lwall + * patch29: added SysV IPC + * patch29: file - didn't auto-close cleanly + * patch29: close; core dumped + * patch29: more MSDOS and OS/2 updates, from Kai Uwe Rommel + * patch29: various portability fixes + * patch29: *foo now prints as *package'foo + * * Revision 3.0.1.10 90/08/13 22:14:29 lwall * patch28: close-on-exec problems on dup'ed file descriptors * patch28: F_FREESP wasn't implemented the way I thought *************** *** 75,80 **** --- 83,95 ---- #include <sys/select.h> #endif + #ifdef SYSVIPC + #include <sys/ipc.h> + #include <sys/msg.h> + #include <sys/sem.h> + #include <sys/shm.h> + #endif + #ifdef I_PWD #include <pwd.h> #endif *************** *** 112,126 **** fd = fileno(stio->ifp); if (stio->type == '|') result = mypclose(stio->ifp); else if (stio->ifp != stio->ofp) { ! if (stio->ofp) ! fclose(stio->ofp); ! result = fclose(stio->ifp); } - else if (stio->type != '-') - result = fclose(stio->ifp); else ! result = 0; if (result == EOF && fd > 2) fprintf(stderr,"Warning: unable to close filehandle %s properly.\n", stab_name(stab)); --- 127,144 ---- fd = fileno(stio->ifp); if (stio->type == '|') result = mypclose(stio->ifp); + else if (stio->type == '-') + result = 0; else if (stio->ifp != stio->ofp) { ! if (stio->ofp) { ! result = fclose(stio->ofp); ! fclose(stio->ifp); /* clear stdio, fd already closed */ ! } ! else ! result = fclose(stio->ifp); } else ! result = fclose(stio->ifp); if (result == EOF && fd > 2) fprintf(stderr,"Warning: unable to close filehandle %s properly.\n", stab_name(stab)); *************** *** 391,399 **** bool explicit; { bool retval = FALSE; ! register STIO *stio = stab_io(stab); int status; if (!stio) { /* never opened */ if (dowarn && explicit) warn("Close on unopened file <%s>",stab_name(stab)); --- 409,422 ---- bool explicit; { bool retval = FALSE; ! register STIO *stio; int status; + if (!stab) + stab = argvstab; + if (!stab) + return FALSE; + stio = stab_io(stab); if (!stio) { /* never opened */ if (dowarn && explicit) warn("Close on unopened file <%s>",stab_name(stab)); *************** *** 408,416 **** else if (stio->type == '-') retval = TRUE; else { ! if (stio->ofp && stio->ofp != stio->ifp) /* a socket */ ! fclose(stio->ofp); ! retval = (fclose(stio->ifp) != EOF); } stio->ofp = stio->ifp = Nullfp; } --- 431,442 ---- else if (stio->type == '-') retval = TRUE; else { ! if (stio->ofp && stio->ofp != stio->ifp) { /* a socket */ ! retval = (fclose(stio->ofp) != EOF); ! fclose(stio->ifp); /* clear stdio, fd already closed */ ! } ! else ! retval = (fclose(stio->ifp) != EOF); } stio->ofp = stio->ifp = Nullfp; } *************** *** 552,558 **** --- 578,588 ---- } else { retval = (int)str_gnum(argstr); + #ifdef MSDOS + s = (char*)(long)retval; /* ouch */ + #else s = (char*)retval; /* ouch */ + #endif } #ifndef lint *************** *** 593,599 **** if (tmpstab != defstab) { statstab = tmpstab; str_set(statname,""); ! if (!stab_io(tmpstab) || fstat(fileno(stab_io(tmpstab)->ifp),&statcache) < 0) { max = 0; } --- 623,629 ---- if (tmpstab != defstab) { statstab = tmpstab; str_set(statname,""); ! if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp || fstat(fileno(stab_io(tmpstab)->ifp),&statcache) < 0) { max = 0; } *************** *** 665,671 **** } #if !defined(TRUNCATE) && !defined(CHSIZE) && defined(F_FREESP) ! /* code courtesy of Pim Zandbergen */ #define CHSIZE int chsize(fd, length) --- 695,701 ---- } #if !defined(TRUNCATE) && !defined(CHSIZE) && defined(F_FREESP) ! /* code courtesy of William Kucharski */ #define CHSIZE int chsize(fd, length) *************** *** 836,845 **** } else { tmps = str_get(str); ! if (*tmps == 'S' && tmps[1] == 't' && tmps[2] == 'a' && tmps[3] == 'b' && str->str_cur == sizeof(STBP) && strlen(tmps) < str->str_cur) { ! tmps = stab_name(((STAB*)str)); /* a stab value, be nice */ ! str = ((STAB*)str)->str_magic; putc('*',fp); } if (str->str_cur && (fwrite(tmps,1,str->str_cur,fp) == 0 || ferror(fp))) --- 866,877 ---- } else { tmps = str_get(str); ! if (*tmps == 'S' && tmps[1] == 't' && tmps[2] == 'B' && tmps[3] == '\0' && str->str_cur == sizeof(STBP) && strlen(tmps) < str->str_cur) { ! STR *tmpstr = str_static(&str_undef); ! stab_fullname(tmpstr,((STAB*)str));/* a stab value, be nice */ ! str = tmpstr; ! tmps = str->str_ptr; putc('*',fp); } if (str->str_cur && (fwrite(tmps,1,str->str_cur,fp) == 0 || ferror(fp))) *************** *** 1920,1927 **** --- 1952,1961 ---- #ifdef PWCLASS str_set(str,pwent->pw_class); #else + #ifdef PWCOMMENT str_set(str, pwent->pw_comment); #endif + #endif (void)astore(ary, ++sp, str = str_static(&str_no)); str_set(str, pwent->pw_gecos); (void)astore(ary, ++sp, str = str_static(&str_no)); *************** *** 2288,2290 **** --- 2322,2563 ---- #endif return FALSE; } + + #ifdef SYSVIPC + + int + do_ipcget(optype, arglast) + int optype; + int *arglast; + { + register STR **st = stack->ary_array; + register int sp = arglast[0]; + key_t key; + int n, flags; + + key = (key_t)str_gnum(st[++sp]); + n = (optype == O_MSGGET) ? 0 : (int)str_gnum(st[++sp]); + flags = (int)str_gnum(st[++sp]); + errno = 0; + switch (optype) + { + case O_MSGGET: + return msgget(key, flags); + case O_SEMGET: + return semget(key, n, flags); + case O_SHMGET: + return shmget(key, n, flags); + } + return -1; /* should never happen */ + } + + int + do_ipcctl(optype, arglast) + int optype; + int *arglast; + { + register STR **st = stack->ary_array; + register int sp = arglast[0]; + STR *astr; + char *a; + int id, n, cmd, infosize, getinfo, ret; + + id = (int)str_gnum(st[++sp]); + n = (optype == O_SEMCTL) ? (int)str_gnum(st[++sp]) : 0; + cmd = (int)str_gnum(st[++sp]); + astr = st[++sp]; + + infosize = 0; + getinfo = (cmd == IPC_STAT); + + switch (optype) + { + case O_MSGCTL: + if (cmd == IPC_STAT || cmd == IPC_SET) + infosize = sizeof(struct msqid_ds); + break; + case O_SHMCTL: + if (cmd == IPC_STAT || cmd == IPC_SET) + infosize = sizeof(struct shmid_ds); + break; + case O_SEMCTL: + if (cmd == IPC_STAT || cmd == IPC_SET) + infosize = sizeof(struct semid_ds); + else if (cmd == GETALL || cmd == SETALL) + { + struct semid_ds semds; + if (semctl(id, 0, IPC_STAT, &semds) == -1) + return -1; + getinfo = (cmd == GETALL); + infosize = semds.sem_nsems * sizeof(ushort); + } + break; + } + + if (infosize) + { + if (getinfo) + { + STR_GROW(astr, infosize+1); + a = str_get(astr); + } + else + { + a = str_get(astr); + if (astr->str_cur != infosize) + { + errno = EINVAL; + return -1; + } + } + } + else + { + int i = (int)str_gnum(astr); + a = (char *)i; /* ouch */ + } + errno = 0; + switch (optype) + { + case O_MSGCTL: + ret = msgctl(id, cmd, a); + break; + case O_SEMCTL: + ret = semctl(id, n, cmd, a); + break; + case O_SHMCTL: + ret = shmctl(id, cmd, a); + break; + } + if (getinfo && ret >= 0) { + astr->str_cur = infosize; + astr->str_ptr[infosize] = '\0'; + } + return ret; + } + + int + do_msgsnd(arglast) + int *arglast; + { + register STR **st = stack->ary_array; + register int sp = arglast[0]; + STR *mstr; + char *mbuf; + int id, msize, flags; + + id = (int)str_gnum(st[++sp]); + mstr = st[++sp]; + flags = (int)str_gnum(st[++sp]); + mbuf = str_get(mstr); + if ((msize = mstr->str_cur - sizeof(long)) < 0) { + errno = EINVAL; + return -1; + } + errno = 0; + return msgsnd(id, mbuf, msize, flags); + } + + int + do_msgrcv(arglast) + int *arglast; + { + register STR **st = stack->ary_array; + register int sp = arglast[0]; + STR *mstr; + char *mbuf; + long mtype; + int id, msize, flags, ret; + + id = (int)str_gnum(st[++sp]); + mstr = st[++sp]; + msize = (int)str_gnum(st[++sp]); + mtype = (long)str_gnum(st[++sp]); + flags = (int)str_gnum(st[++sp]); + mbuf = str_get(mstr); + if (mstr->str_cur < sizeof(long)+msize+1) { + STR_GROW(mstr, sizeof(long)+msize+1); + mbuf = str_get(mstr); + } + errno = 0; + ret = msgrcv(id, mbuf, msize, mtype, flags); + if (ret >= 0) { + mstr->str_cur = sizeof(long)+ret; + mstr->str_ptr[sizeof(long)+ret] = '\0'; + } + return ret; + } + + int + do_semop(arglast) + int *arglast; + { + register STR **st = stack->ary_array; + register int sp = arglast[0]; + STR *opstr; + char *opbuf; + int id, opsize; + + id = (int)str_gnum(st[++sp]); + opstr = st[++sp]; + opbuf = str_get(opstr); + opsize = opstr->str_cur; + if (opsize < sizeof(struct sembuf) + || (opsize % sizeof(struct sembuf)) != 0) { + errno = EINVAL; + return -1; + } + errno = 0; + return semop(id, opbuf, opsize/sizeof(struct sembuf)); + } + + int + do_shmio(optype, arglast) + int optype; + int *arglast; + { + register STR **st = stack->ary_array; + register int sp = arglast[0]; + STR *mstr; + char *mbuf, *shm; + int id, mpos, msize; + struct shmid_ds shmds; + extern char *shmat(); + + id = (int)str_gnum(st[++sp]); + mstr = st[++sp]; + mpos = (int)str_gnum(st[++sp]); + msize = (int)str_gnum(st[++sp]); + errno = 0; + if (shmctl(id, IPC_STAT, &shmds) == -1) + return -1; + if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) { + errno = EFAULT; /* can't do as caller requested */ + return -1; + } + shm = shmat(id, (char *)NULL, (optype == O_SHMREAD) ? SHM_RDONLY : 0); + if (shm == (char *)-1) /* I hate System V IPC, I really do */ + return -1; + mbuf = str_get(mstr); + if (optype == O_SHMREAD) { + if (mstr->str_cur < msize) { + STR_GROW(mstr, msize+1); + mbuf = str_get(mstr); + } + bcopy(shm + mpos, mbuf, msize); + mstr->str_cur = msize; + mstr->str_ptr[msize] = '\0'; + } + else { + int n; + + if ((n = mstr->str_cur) > msize) + n = msize; + bcopy(mbuf, shm + mpos, n); + if (n < msize) + bzero(shm + mpos + n, msize - n); + } + return shmdt(shm); + } + + #endif /* SYSVIPC */ Index: dolist.c Prereq: 3.0.1.9 *** dolist.c.old Tue Oct 16 11:49:58 1990 --- dolist.c Tue Oct 16 11:50:08 1990 *************** *** 1,4 **** ! /* $Header: dolist.c,v 3.0.1.9 90/08/13 22:15:35 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: dolist.c,v 3.0.1.10 90/10/15 16:19:48 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,16 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: dolist.c,v $ + * Revision 3.0.1.10 90/10/15 16:19:48 lwall + * patch29: added caller + * patch29: added scalar reverse + * patch29: sort undefined_subroutine @array is now a fatal error + * * Revision 3.0.1.9 90/08/13 22:15:35 lwall * patch28: defined(@array) and defined(%array) didn't work right * *************** *** 1301,1312 **** register STR **down = &st[arglast[2]]; register int i = arglast[2] - arglast[1]; - if (gimme != G_ARRAY) { - str_sset(str,&str_undef); - STABSET(str); - st[arglast[0]+1] = str; - return arglast[0]+1; - } while (i-- > 0) { *up++ = *down; if (i-- > 0) --- 1306,1311 ---- *************** *** 1317,1322 **** --- 1316,1347 ---- return arglast[2] - 1; } + int + do_sreverse(str,gimme,arglast) + STR *str; + int gimme; + int *arglast; + { + STR **st = stack->ary_array; + register char *up; + register char *down; + register int tmp; + + str_sset(str,st[arglast[2]]); + up = str_get(str); + if (str->str_cur > 1) { + down = str->str_ptr + str->str_cur - 1; + while (down > up) { + tmp = *up; + *up++ = *down; + *down-- = tmp; + } + } + STABSET(str); + st[arglast[0]+1] = str; + return arglast[0]+1; + } + static CMD *sortcmd; static STAB *firststab = Nullstab; static STAB *secondstab = Nullstab; *************** *** 1359,1367 **** max = up - &st[sp]; sp--; if (max > 1) { ! if (stab_sub(stab) && (sortcmd = stab_sub(stab)->cmd)) { int oldtmps_base = tmps_base; if (!sortstack) { sortstack = anew(Nullstab); sortstack->ary_flags = 0; --- 1384,1394 ---- max = up - &st[sp]; sp--; if (max > 1) { ! if (stab) { int oldtmps_base = tmps_base; + if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd)) + fatal("Undefined subroutine \"%s\" in sort", stab_name(stab)); if (!sortstack) { sortstack = anew(Nullstab); sortstack->ary_flags = 0; *************** *** 1468,1478 **** --- 1495,1573 ---- } int + do_caller(arg,maxarg,gimme,arglast) + ARG *arg; + int maxarg; + int gimme; + int *arglast; + { + STR **st = stack->ary_array; + register int sp = arglast[0]; + register CSV *csv = curcsv; + STR *str; + int count = 0; + + if (!csv) + fatal("There is no caller"); + if (maxarg) + count = (int) str_gnum(st[sp+1]); + for (;;) { + if (!csv) + return sp; + if (csv->curcsv && csv->curcsv->sub == stab_sub(DBsub)) + count++; + if (!count--) + break; + csv = csv->curcsv; + } + if (gimme != G_ARRAY) { + STR *str = arg->arg_ptr.arg_str; + str_set(str,csv->curcmd->c_stash->tbl_name); + STABSET(str); + st[++sp] = str; + return sp; + } + + #ifndef lint + (void)astore(stack,++sp, + str_2static(str_make(csv->curcmd->c_stash->tbl_name,0)) ); + (void)astore(stack,++sp, + str_2static(str_make(stab_val(csv->curcmd->c_filestab)->str_ptr,0)) ); + (void)astore(stack,++sp, + str_2static(str_nmake((double)csv->curcmd->c_line)) ); + if (!maxarg) + return sp; + str = str_static(&str_undef); + stab_fullname(str, csv->stab); + (void)astore(stack,++sp, str); + (void)astore(stack,++sp, + str_2static(str_nmake((double)csv->hasargs)) ); + (void)astore(stack,++sp, + str_2static(str_nmake((double)csv->wantarray)) ); + if (csv->hasargs) { + ARRAY *ary = csv->argarray; + + if (dbargs->ary_max < ary->ary_fill) + astore(dbargs,ary->ary_fill,Nullstr); + Copy(ary->ary_array, dbargs->ary_array, ary->ary_fill+1, STR*); + dbargs->ary_fill = ary->ary_fill; + } + #else + (void)astore(stack,++sp, + str_2static(str_make("",0))); + #endif + return sp; + } + + int do_tms(str,gimme,arglast) STR *str; int gimme; int *arglast; { + #ifdef MSDOS + return -1; + #else STR **st = stack->ary_array; register int sp = arglast[0]; *************** *** 1502,1507 **** --- 1597,1603 ---- str_2static(str_nmake(0.0))); #endif return sp; + #endif } int Index: dump.c Prereq: 3.0.1.1 *** dump.c.old Tue Oct 16 11:50:19 1990 --- dump.c Tue Oct 16 11:50:21 1990 *************** *** 1,4 **** ! /* $Header: dump.c,v 3.0.1.1 90/03/27 15:49:58 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: dump.c,v 3.0.1.2 90/10/15 16:22:10 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: dump.c,v $ + * Revision 3.0.1.2 90/10/15 16:22:10 lwall + * patch29: *foo now prints as *package'foo + * * Revision 3.0.1.1 90/03/27 15:49:58 lwall * patch16: changed unsigned to unsigned int * *************** *** 25,30 **** --- 28,34 ---- register int i; register STAB *stab; register HENT *entry; + STR *str = str_static(&str_undef); dump_cmd(main_root,Nullcmd); for (i = 0; i <= 127; i++) { *************** *** 31,37 **** for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) { stab = (STAB*)entry->hent_val; if (stab_sub(stab)) { ! dump("\nSUB %s = ", stab_name(stab)); dump_cmd(stab_sub(stab)->cmd,Nullcmd); } } --- 35,42 ---- for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) { stab = (STAB*)entry->hent_val; if (stab_sub(stab)) { ! stab_fullname(str,stab); ! dump("\nSUB %s = ", str->str_ptr); dump_cmd(stab_sub(stab)->cmd,Nullcmd); } } *************** *** 246,258 **** dump_stab(stab) register STAB *stab; { if (!stab) { fprintf(stderr,"{}\n"); return; } dumplvl++; fprintf(stderr,"{\n"); ! dump("STAB_NAME = %s\n",stab_name(stab)); dumplvl--; dump("}\n"); } --- 251,267 ---- dump_stab(stab) register STAB *stab; { + STR *str; + if (!stab) { fprintf(stderr,"{}\n"); return; } + str = str_static(&str_undef); dumplvl++; fprintf(stderr,"{\n"); ! stab_fullname(str,stab); ! dump("STAB_NAME = %s\n", str->str_ptr); dumplvl--; dump("}\n"); } Index: eval.c Prereq: 3.0.1.8 *** eval.c.old Tue Oct 16 11:51:56 1990 --- eval.c Tue Oct 16 11:52:06 1990 *************** *** 1,4 **** ! /* $Header: eval.c,v 3.0.1.8 90/08/13 22:17:14 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: eval.c,v 3.0.1.9 90/10/15 16:46:13 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,25 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: eval.c,v $ + * Revision 3.0.1.9 90/10/15 16:46:13 lwall + * patch29: added caller + * patch29: added scalar + * patch29: added cmp and <=> + * patch29: added sysread and syswrite + * patch29: added -M, -A and -C + * patch29: index and substr now have optional 3rd args + * patch29: you can now read into the middle string + * patch29: ~ now works on vector string + * patch29: non-existent array values no longer cause core dumps + * patch29: eof; core dumped + * patch29: oct and hex now produce unsigned result + * patch29: unshift did not return the documented value + * * Revision 3.0.1.8 90/08/13 22:17:14 lwall * patch28: the NSIG hack didn't work right on Xenix * patch28: defined(@array) and defined(%array) didn't work right *************** *** 90,96 **** static STIO *stio; static struct lstring *lstr; static int old_record_separator; - extern int wantarray; double sin(), cos(), atan2(), pow(); --- 104,109 ---- *************** *** 158,163 **** --- 171,178 ---- case O_ITEM: if (gimme == G_ARRAY) goto array_return; + /* FALL THROUGH */ + case O_SCALAR: STR_SSET(str,st[1]); STABSET(str); break; *************** *** 353,358 **** --- 368,381 ---- value = str_gnum(st[1]); value = (value != str_gnum(st[2])) ? 1.0 : 0.0; goto donumset; + case O_NCMP: + value = str_gnum(st[1]); + value -= str_gnum(st[2]); + if (value > 0.0) + value = 1.0; + else if (value < 0.0) + value = -1.0; + goto donumset; case O_BIT_AND: if (!sawvec || st[1]->str_nok || st[2]->str_nok) { value = str_gnum(st[1]); *************** *** 466,477 **** else { STR_SSET(str,st[1]); tmps = str_get(str); ! for (anum = str->str_cur; anum; anum--) *tmps = ~*tmps; } break; case O_SELECT: ! tmps = stab_name(defoutstab); if (maxarg > 0) { if ((arg[1].arg_type & A_MASK) == A_WORD) defoutstab = arg[1].arg_ptr.arg_stab; --- 489,500 ---- else { STR_SSET(str,st[1]); tmps = str_get(str); ! for (anum = str->str_cur; anum; anum--, tmps++) *tmps = ~*tmps; } break; case O_SELECT: ! stab_fullname(str,defoutstab); if (maxarg > 0) { if ((arg[1].arg_type & A_MASK) == A_WORD) defoutstab = arg[1].arg_ptr.arg_stab; *************** *** 481,487 **** stab_io(defoutstab) = stio_new(); curoutstab = defoutstab; } - str_set(str, tmps); STABSET(str); break; case O_WRITE: --- 504,509 ---- *************** *** 617,624 **** case O_AELEM: anum = ((int)str_gnum(st[2])) - arybase; str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE); - if (!str) - goto say_undef; break; case O_DELETE: tmpstab = arg[1].arg_ptr.arg_stab; --- 639,644 ---- *************** *** 653,665 **** tmpstab = arg[1].arg_ptr.arg_stab; tmps = str_get(st[2]); str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE); - if (!str) - goto say_undef; break; case O_LAELEM: anum = ((int)str_gnum(st[2])) - arybase; str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE); ! if (!str) fatal("Assignment to non-creatable value, subscript %d",anum); break; case O_LHELEM: --- 673,683 ---- tmpstab = arg[1].arg_ptr.arg_stab; tmps = str_get(st[2]); str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE); break; case O_LAELEM: anum = ((int)str_gnum(st[2])) - arybase; str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE); ! if (!str || str == &str_undef) fatal("Assignment to non-creatable value, subscript %d",anum); break; case O_LHELEM: *************** *** 667,673 **** tmps = str_get(st[2]); anum = st[2]->str_cur; str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE); ! if (!str) fatal("Assignment to non-creatable value, subscript \"%s\"",tmps); if (tmpstab == envstab) /* heavy wizardry going on here */ str_magic(str, tmpstab, 'E', tmps, anum); /* str is now magic */ --- 685,691 ---- tmps = str_get(st[2]); anum = st[2]->str_cur; str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE); ! if (!str || str == &str_undef) fatal("Assignment to non-creatable value, subscript \"%s\"",tmps); if (tmpstab == envstab) /* heavy wizardry going on here */ str_magic(str, tmpstab, 'E', tmps, anum); /* str is now magic */ *************** *** 678,683 **** --- 696,703 ---- else if (stab_hash(tmpstab)->tbl_dbm) str_magic(str, tmpstab, 'D', tmps, anum); #endif + else if (perldb && tmpstab == DBline) + str_magic(str, tmpstab, 'L', tmps, anum); break; case O_LSLICE: anum = 2; *************** *** 752,758 **** if (anum < 0 || anum > st[1]->str_cur) str_nset(str,"",0); else { ! optype = (int)str_gnum(st[3]); if (optype < 0) optype = 0; tmps += anum; --- 772,778 ---- if (anum < 0 || anum > st[1]->str_cur) str_nset(str,"",0); else { ! optype = maxarg < 3 ? st[1]->str_cur : (int)str_gnum(st[3]); if (optype < 0) optype = 0; tmps += anum; *************** *** 802,828 **** tmps = str_get(st[1]); value = (double) !str_eq(st[1],st[2]); goto donumset; case O_SUBR: sp = do_subr(arg,gimme,arglast); st = stack->ary_array + arglast[0]; /* maybe realloced */ goto array_return; case O_DBSUBR: ! sp = do_dbsubr(arg,gimme,arglast); st = stack->ary_array + arglast[0]; /* maybe realloced */ goto array_return; case O_SORT: 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) - stab = defoutstab; sp = do_sort(str,stab, gimme,arglast); goto array_return; case O_REVERSE: ! sp = do_reverse(str, ! gimme,arglast); goto array_return; case O_WARN: if (arglast[2] - arglast[1] != 1) { --- 822,858 ---- tmps = str_get(st[1]); value = (double) !str_eq(st[1],st[2]); goto donumset; + case O_SCMP: + tmps = str_get(st[1]); + value = (double) str_cmp(st[1],st[2]); + goto donumset; case O_SUBR: sp = do_subr(arg,gimme,arglast); st = stack->ary_array + arglast[0]; /* maybe realloced */ goto array_return; case O_DBSUBR: ! sp = do_subr(arg,gimme,arglast); st = stack->ary_array + arglast[0]; /* maybe realloced */ goto array_return; + case O_CALLER: + sp = do_caller(arg,maxarg,gimme,arglast); + st = stack->ary_array + arglast[0]; /* maybe realloced */ + goto array_return; case O_SORT: 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_sort(str,stab, gimme,arglast); goto array_return; case O_REVERSE: ! if (gimme == G_ARRAY) ! sp = do_reverse(str, ! gimme,arglast); ! else ! sp = do_sreverse(str, ! gimme,arglast); goto array_return; case O_WARN: if (arglast[2] - arglast[1] != 1) { *************** *** 893,905 **** tmps = str_get(st[1]); if (!tmps || !*tmps) { tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE); ! if (tmpstr) ! tmps = str_get(tmpstr); } if (!tmps || !*tmps) { tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE); ! if (tmpstr) ! tmps = str_get(tmpstr); } #ifdef TAINT taintproper("Insecure dependency in chdir"); --- 923,933 ---- tmps = str_get(st[1]); if (!tmps || !*tmps) { tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE); ! tmps = str_get(tmpstr); } if (!tmps || !*tmps) { tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE); ! tmps = str_get(tmpstr); } #ifdef TAINT taintproper("Insecure dependency in chdir"); *************** *** 918,924 **** tmps = ""; else tmps = str_get(st[1]); ! str_reset(tmps,arg[2].arg_ptr.arg_hash); value = 1.0; goto donumset; case O_LIST: --- 946,952 ---- tmps = ""; else tmps = str_get(st[1]); ! str_reset(tmps,curcmd->c_stash); value = 1.0; goto donumset; case O_LIST: *************** *** 946,953 **** stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); ! if (do_eof(stab)) /* make sure we have fp with something */ ! str_set(str, No); else { #ifdef TAINT tainted = 1; --- 974,983 ---- stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); ! if (!stab) ! stab = argvstab; ! if (!stab || do_eof(stab)) /* make sure we have fp with something */ ! goto say_undef; else { #ifdef TAINT tainted = 1; *************** *** 972,977 **** --- 1002,1008 ---- goto donumset; case O_RECV: case O_READ: + case O_SYSREAD: if ((arg[1].arg_type & A_MASK) == A_WORD) stab = arg[1].arg_ptr.arg_stab; else *************** *** 978,992 **** stab = stabent(str_get(st[1]),TRUE); tmps = str_get(st[2]); anum = (int)str_gnum(st[3]); - STR_GROW(st[2], anum+1), (tmps = str_get(st[2])); /* sneaky */ errno = 0; if (!stab_io(stab) || !stab_io(stab)->ifp) ! goto say_zero; #ifdef SOCKET ! else if (optype == O_RECV) { argtype = sizeof buf; ! optype = (int)str_gnum(st[4]); ! anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, optype, buf, &argtype); if (anum >= 0) { st[2]->str_cur = anum; --- 1009,1028 ---- stab = stabent(str_get(st[1]),TRUE); tmps = str_get(st[2]); anum = (int)str_gnum(st[3]); errno = 0; + maxarg = sp - arglast[0]; + if (maxarg > 4) + warn("Too many args on read"); + if (maxarg == 4) + maxarg = (int)str_gnum(st[4]); + else + maxarg = 0; if (!stab_io(stab) || !stab_io(stab)->ifp) ! goto say_undef; #ifdef SOCKET ! if (optype == O_RECV) { argtype = sizeof buf; ! anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, maxarg, buf, &argtype); if (anum >= 0) { st[2]->str_cur = anum; *************** *** 997,1021 **** str_sset(str,&str_undef); break; } ! else if (stab_io(stab)->type == 's') { argtype = sizeof buf; ! anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, 0, buf, &argtype); } ! #else ! else if (optype == O_RECV) ! goto badsock; #endif else ! anum = fread(tmps, 1, anum, stab_io(stab)->ifp); if (anum < 0) goto say_undef; ! st[2]->str_cur = anum; ! st[2]->str_ptr[anum] = '\0'; value = (double)anum; goto donumset; case O_SEND: - #ifdef SOCKET if ((arg[1].arg_type & A_MASK) == A_WORD) stab = arg[1].arg_ptr.arg_stab; else --- 1033,1064 ---- str_sset(str,&str_undef); break; } ! #else ! if (optype == O_RECV) ! goto badsock; ! #endif ! STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2])); /* sneaky */ ! #ifdef SOCKET ! if (stab_io(stab)->type == 's') { argtype = sizeof buf; ! anum = recvfrom(fileno(stab_io(stab)->ifp), tmps+maxarg, anum, 0, buf, &argtype); } ! else #endif + if (optype == O_SYSREAD) { + anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum); + } else ! anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp); if (anum < 0) goto say_undef; ! st[2]->str_cur = anum+maxarg; ! st[2]->str_ptr[anum+maxarg] = '\0'; value = (double)anum; goto donumset; + case O_SYSWRITE: case O_SEND: if ((arg[1].arg_type & A_MASK) == A_WORD) stab = arg[1].arg_ptr.arg_stab; else *************** *** 1022,1038 **** stab = stabent(str_get(st[1]),TRUE); tmps = str_get(st[2]); anum = (int)str_gnum(st[3]); - optype = sp - arglast[0]; errno = 0; - if (optype > 4) - warn("Too many args on send"); stio = stab_io(stab); if (!stio || !stio->ifp) { anum = -1; ! if (dowarn) ! warn("Send on closed socket"); } ! else if (optype >= 4) { tmps2 = str_get(st[4]); anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum, tmps2, st[4]->str_cur); --- 1065,1095 ---- stab = stabent(str_get(st[1]),TRUE); tmps = str_get(st[2]); anum = (int)str_gnum(st[3]); errno = 0; stio = stab_io(stab); + maxarg = sp - arglast[0]; if (!stio || !stio->ifp) { anum = -1; ! if (dowarn) { ! if (optype == O_SYSWRITE) ! warn("Syswrite on closed filehandle"); ! else ! warn("Send on closed socket"); ! } } ! else if (optype == O_SYSWRITE) { ! if (maxarg > 4) ! warn("Too many args on syswrite"); ! if (maxarg == 4) ! optype = (int)str_gnum(st[4]); ! else ! optype = 0; ! anum = write(fileno(stab_io(stab)->ifp), tmps+optype, anum); ! } ! #ifdef SOCKET ! else if (maxarg >= 4) { ! if (maxarg > 4) ! warn("Too many args on send"); tmps2 = str_get(st[4]); anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum, tmps2, st[4]->str_cur); *************** *** 1039,1051 **** } else anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum); if (anum < 0) goto say_undef; value = (double)anum; goto donumset; - #else - goto badsock; - #endif case O_SEEK: if ((arg[1].arg_type & A_MASK) == A_WORD) stab = arg[1].arg_ptr.arg_stab; --- 1096,1109 ---- } else anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum); + #else + else + goto badsock; + #endif if (anum < 0) goto say_undef; value = (double)anum; goto donumset; case O_SEEK: if ((arg[1].arg_type & A_MASK) == A_WORD) stab = arg[1].arg_ptr.arg_stab; *************** *** 1059,1065 **** case O_RETURN: tmps = "_SUB_"; /* just fake up a "last _SUB_" */ optype = O_LAST; ! if (wantarray == G_ARRAY) { lastretstr = Nullstr; lastspbase = arglast[1]; lastsize = arglast[2] - arglast[1]; --- 1117,1123 ---- case O_RETURN: tmps = "_SUB_"; /* just fake up a "last _SUB_" */ optype = O_LAST; ! if (curcsv->wantarray == G_ARRAY) { lastretstr = Nullstr; lastspbase = arglast[1]; lastsize = arglast[2] - arglast[1]; *************** *** 1118,1125 **** longjmp(top_env, 1); case O_INDEX: tmps = str_get(st[1]); #ifndef lint ! if (!(tmps2 = fbminstr((unsigned char*)tmps, (unsigned char*)tmps + st[1]->str_cur, st[2]))) #else if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr)) --- 1176,1192 ---- longjmp(top_env, 1); case O_INDEX: tmps = str_get(st[1]); + if (maxarg < 3) + anum = 0; + else { + anum = (int) str_gnum(st[3]) - arybase; + if (anum < 0) + anum = 0; + else if (anum > st[1]->str_cur) + anum = st[1]->str_cur; + } #ifndef lint ! if (!(tmps2 = fbminstr((unsigned char*)tmps + anum, (unsigned char*)tmps + st[1]->str_cur, st[2]))) #else if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr)) *************** *** 1131,1138 **** case O_RINDEX: tmps = str_get(st[1]); tmps2 = str_get(st[2]); #ifndef lint ! if (!(tmps2 = rninstr(tmps, tmps + st[1]->str_cur, tmps2, tmps2 + st[2]->str_cur))) #else if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch)) --- 1198,1214 ---- case O_RINDEX: tmps = str_get(st[1]); tmps2 = str_get(st[2]); + if (maxarg < 3) + anum = st[1]->str_cur; + else { + anum = (int) str_gnum(st[3]) - arybase + st[2]->str_cur; + if (anum < 0) + anum = 0; + else if (anum > st[1]->str_cur) + anum = st[1]->str_cur; + } #ifndef lint ! if (!(tmps2 = rninstr(tmps, tmps + anum, tmps2, tmps2 + st[2]->str_cur))) #else if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch)) *************** *** 1370,1377 **** case O_FORK: #ifdef FORK anum = fork(); ! if (!anum && (tmpstab = stabent("$",allstabs))) ! str_numset(STAB_STR(tmpstab),(double)getpid()); value = (double)anum; goto donumset; #else --- 1446,1456 ---- case O_FORK: #ifdef FORK anum = fork(); ! if (!anum) { ! if (tmpstab = stabent("$",allstabs)) ! str_numset(STAB_STR(tmpstab),(double)getpid()); ! hclear(pidstatus); /* no kids, so don't wait for 'em */ ! } value = (double)anum; goto donumset; #else *************** *** 1392,1397 **** --- 1471,1490 ---- fatal("Unsupported function wait"); break; #endif + case O_WAITPID: + #ifdef WAITPID + #ifndef lint + anum = (int)str_gnum(st[1]); + optype = (int)str_gnum(st[2]); + anum = wait4pid(anum, &argflags,optype); + value = (double)anum; + #endif + statusvalue = (unsigned short)argflags; + goto donumset; + #else + fatal("Unsupported function wait"); + break; + #endif case O_SYSTEM: #ifdef FORK #ifdef TAINT *************** *** 1412,1419 **** #ifndef lint ihand = signal(SIGINT, SIG_IGN); qhand = signal(SIGQUIT, SIG_IGN); ! while ((argtype = wait(&argflags)) != anum && argtype >= 0) ! pidgone(argtype,argflags); #else ihand = qhand = 0; #endif --- 1505,1511 ---- #ifndef lint ihand = signal(SIGINT, SIG_IGN); qhand = signal(SIGQUIT, SIG_IGN); ! argtype = wait4pid(anum, &argflags, 0); #else ihand = qhand = 0; #endif *************** *** 1420,1426 **** (void)signal(SIGINT, ihand); (void)signal(SIGQUIT, qhand); statusvalue = (unsigned short)argflags; ! if (argtype == -1) value = -1.0; else { value = (double)((unsigned int)argflags & 0xffff); --- 1512,1518 ---- (void)signal(SIGINT, ihand); (void)signal(SIGQUIT, qhand); statusvalue = (unsigned short)argflags; ! if (argtype < 0) value = -1.0; else { value = (double)((unsigned int)argflags & 0xffff); *************** *** 1446,1452 **** } goto donumset; #endif /* FORK */ ! case O_EXEC: if ((arg[1].arg_type & A_MASK) == A_STAB) value = (double)do_aexec(st[1],arglast); else if (arglast[2] - arglast[1] != 1) --- 1538,1544 ---- } goto donumset; #endif /* FORK */ ! case O_EXEC_OP: if ((arg[1].arg_type & A_MASK) == A_STAB) value = (double)do_aexec(st[1],arglast); else if (arglast[2] - arglast[1] != 1) *************** *** 1463,1469 **** argtype = 3; snarfnum: ! anum = 0; if (maxarg < 1) tmps = str_get(stab_val(defstab)); else --- 1555,1561 ---- argtype = 3; snarfnum: ! tmplong = 0; if (maxarg < 1) tmps = str_get(stab_val(defstab)); else *************** *** 1478,1492 **** /* FALL THROUGH */ case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': ! anum <<= argtype; ! anum += *tmps++ & 15; break; case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': if (argtype != 4) goto out; ! anum <<= 4; ! anum += (*tmps++ & 7) + 9; break; case 'x': argtype = 4; --- 1570,1584 ---- /* FALL THROUGH */ case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': ! tmplong <<= argtype; ! tmplong += *tmps++ & 15; break; case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': if (argtype != 4) goto out; ! tmplong <<= 4; ! tmplong += (*tmps++ & 7) + 9; break; case 'x': argtype = 4; *************** *** 1495,1501 **** } } out: ! value = (double)anum; goto donumset; case O_CHOWN: #ifdef CHOWN --- 1587,1593 ---- } } out: ! value = (double)tmplong; goto donumset; case O_CHOWN: #ifdef CHOWN *************** *** 1535,1540 **** --- 1627,1680 ---- fatal("Unsupported function umask"); break; #endif + #ifdef SYSVIPC + case O_MSGGET: + case O_SHMGET: + case O_SEMGET: + if ((anum = do_ipcget(optype, arglast)) == -1) + goto say_undef; + value = (double)anum; + goto donumset; + case O_MSGCTL: + case O_SHMCTL: + case O_SEMCTL: + anum = do_ipcctl(optype, arglast); + if (anum == -1) + goto say_undef; + if (anum != 0) { + value = (double)anum; + goto donumset; + } + str_set(str,"0 but true"); + STABSET(str); + break; + case O_MSGSND: + value = (double)(do_msgsnd(arglast) >= 0); + goto donumset; + case O_MSGRCV: + value = (double)(do_msgrcv(arglast) >= 0); + goto donumset; + case O_SEMOP: + value = (double)(do_semop(arglast) >= 0); + goto donumset; + case O_SHMREAD: + case O_SHMWRITE: + value = (double)(do_shmio(optype, arglast) >= 0); + goto donumset; + #else /* not SYSVIPC */ + case O_MSGGET: + case O_MSGCTL: + case O_MSGSND: + case O_MSGRCV: + case O_SEMGET: + case O_SEMCTL: + case O_SEMOP: + case O_SHMGET: + case O_SHMCTL: + case O_SHMREAD: + case O_SHMWRITE: + fatal("System V IPC is not implemented on this machine"); + #endif /* not SYSVIPC */ case O_RENAME: tmps = str_get(st[1]); tmps2 = str_get(st[2]); *************** *** 1604,1609 **** --- 1744,1753 ---- #endif if (instr(buf,"cannot make")) errno = EEXIST; + else if (instr(buf,"existing file")) + errno = EEXIST; + else if (instr(buf,"ile exists")) + errno = EEXIST; else if (instr(buf,"non-exist")) errno = ENOENT; else if (instr(buf,"does not exist")) *************** *** 1769,1781 **** 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); } value = (double)(ary->ary_fill + 1); ! break; case O_REQUIRE: case O_DOFILE: --- 1913,1925 ---- if (arglast[2] - arglast[1] != 1) do_unshift(ary,arglast); else { ! STR *tmpstr = Str_new(52,0); /* must copy the STR */ ! str_sset(tmpstr,st[2]); aunshift(ary,1); ! (void)astore(ary,0,tmpstr); } value = (double)(ary->ary_fill + 1); ! goto donumset; case O_REQUIRE: case O_DOFILE: *************** *** 1789,1795 **** tainted |= tmpstr->str_tainted; taintproper("Insecure dependency in eval"); #endif ! sp = do_eval(tmpstr, optype, arg[2].arg_ptr.arg_hash, gimme,arglast); goto array_return; --- 1933,1939 ---- tainted |= tmpstr->str_tainted; taintproper("Insecure dependency in eval"); #endif ! sp = do_eval(tmpstr, optype, curcmd->c_stash, gimme,arglast); goto array_return; *************** *** 1846,1851 **** --- 1990,2011 ---- value = (double)statcache.st_size; goto donumset; + case O_FTMTIME: + if (mystat(arg,st[1]) < 0) + goto say_undef; + value = (double)(basetime - statcache.st_mtime) / 86400.0; + goto donumset; + case O_FTATIME: + if (mystat(arg,st[1]) < 0) + goto say_undef; + value = (double)(basetime - statcache.st_atime) / 86400.0; + goto donumset; + case O_FTCTIME: + if (mystat(arg,st[1]) < 0) + goto say_undef; + value = (double)(basetime - statcache.st_ctime) / 86400.0; + goto donumset; + case O_FTSOCK: #ifdef S_IFSOCK anum = S_IFSOCK; *************** *** 2116,2121 **** --- 2276,2283 ---- stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); + if (!stab) + goto say_undef; sp = do_getsockname(optype,stab,arglast); goto array_return; *************** *** 2250,2255 **** --- 2412,2419 ---- stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); + if (!stab) + goto say_undef; sp = do_dirop(optype,stab,gimme,arglast); goto array_return; case O_SYSCALL: Index: MANIFEST *** MANIFEST.old Tue Oct 16 15:30:56 1990 --- MANIFEST Tue Oct 16 15:30:59 1990 *************** *** 52,57 **** --- 52,61 ---- eg/scan/scan_suid Scan for setuid anomalies eg/scan/scanner An anomaly reporter eg/shmkill A program to remove unused shared memory + eg/sysvipc/README Intro to Sys V IPC examples + eg/sysvipc/ipcmsg Example of SYS V IPC message queues + eg/sysvipc/ipcsem Example of Sys V IPC semaphores + eg/sysvipc/ipcshm Example of Sys V IPC shared memory eg/travesty A program to print travesties of its input text eg/van/empty A program to empty the trashcan eg/van/unvanish A program to undo what vanish does *************** *** 81,86 **** --- 85,91 ---- hash.h Public declarations for the above ioctl.pl Sample ioctl.pl lib/abbrev.pl An abbreviation table builder + lib/cacheout.pl Manages output filehandles when you need too many lib/complete.pl A command completion subroutine lib/ctime.pl A ctime workalike lib/dumpvar.pl A variable dumper *************** *** 89,95 **** lib/getopts.pl Perl library supporting option parsing lib/importenv.pl Perl routine to get environment into variables lib/look.pl A "look" equivalent - lib/nsyslog.pl Newer syslog.pl lib/perldb.pl Perl debugging routines lib/pwd.pl Routines to keep track of PWD environment variable lib/stat.pl Perl library supporting stat function --- 94,99 ---- *************** *** 115,124 **** --- 119,142 ---- msdos/popen.c My_popen and my_pclose for MS-DOS os2/Makefile Makefile for OS/2 os2/README.OS2 Notes for OS/2 + os2/a2p.cs Compiler script for a2p + os2/a2p.def Linker defs for a2p os2/config.h Configuration file for OS/2 + os2/dir.h Directory header + os2/director.c Directory routines os2/eg/os2.pl Sample script for OS/2 os2/eg/syscalls.pl Example of syscall on OS/2 + os2/makefile Make file + os2/mktemp.c Mktemp() using TMP + os2/os2.c Unix compatibility functions + os2/perl.bad names of protect-only API calls for BIND + os2/perl.cs Compiler script for perl + os2/perl.def Linker defs for perl + os2/perlglob.cs Compiler script for perlglob + os2/perlglob.def Linker defs for perlglob + os2/perlsh.cmd Poor man's shell for os2 os2/popen.c Code for opening pipes + os2/selfrun.cmd Example of extproc feature os2/suffix.c Code for creating backup filenames patchlevel.h The current patch level of perl perl.h Global declarations *** End of Patch 31 ***