From: Larry Wall Date: Mon, 8 Jun 1992 04:52:08 +0000 (+0000) Subject: perl 4.0 patch 26: patch #20, continued X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bee1dbe28446f1b188ddf14e24e7f65771825d8f;p=p5sagit%2Fp5-mst-13.2.git perl 4.0 patch 26: patch #20, continued See patch #20. --- diff --git a/atarist/test/gdbm b/atarist/test/gdbm new file mode 100644 index 0000000..207eea3 --- /dev/null +++ b/atarist/test/gdbm @@ -0,0 +1,28 @@ +die "cant create dbmtest" unless dbmopen(%keys, "dbmtest", 0666); + +print "Writing...\n"; + +foreach (0..100) { + $keys{"$_"} = $_; +} + +print "Done\n"; + +dbmclose (%keys); + +die "cant read dbmtest" unless dbmopen(%rkeys, "dbmtest", undef); + +$i = 0; +print "Reading...\n"; +while (($key, $val) = each %rkeys) +{ + if ($keys{$key} != $val) + { + print 'Incorrect val ', $key, ' = ', $val, ' expecting ', $keys{$key}, "\n"; + $i = $i + 1; + } +} +print "Done\n"; +dbmclose (%keys); +print $i, " Error(s)\n"; +unlink "dbmtest"; diff --git a/atarist/test/gdbm.t b/atarist/test/gdbm.t new file mode 100644 index 0000000..8e4a3a1 --- /dev/null +++ b/atarist/test/gdbm.t @@ -0,0 +1,101 @@ +#!./perl + +# +# based on t/op/dbm.t modified for gdbm and atariST stat() semantics +# +print "1..12\n"; + +unlink ; +umask(0); +print (dbmopen(h,'Op.dbm',0640) ? "ok 1\n" : "not ok 1\n"); +($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat('Op.dbm'); +print (($mode & 0770) == 0640 ? "ok 2\n" : "not ok 2\n"); +while (($key,$value) = each(h)) { + $i++; +} +print (!$i ? "ok 3\n" : "not ok 3\n"); + +$h{'goner1'} = 'snork'; + +$h{'abc'} = 'ABC'; +$h{'def'} = 'DEF'; +$h{'jkl','mno'} = "JKL\034MNO"; +$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5); +$h{'a'} = 'A'; +$h{'b'} = 'B'; +$h{'c'} = 'C'; +$h{'d'} = 'D'; +$h{'e'} = 'E'; +$h{'f'} = 'F'; +$h{'g'} = 'G'; +$h{'h'} = 'H'; +$h{'i'} = 'I'; + +$h{'goner2'} = 'snork'; +delete $h{'goner2'}; + +dbmclose(h); +print (dbmopen(h,'Op.dbm',0640) ? "ok 4\n" : "not ok 4\n"); + +$h{'j'} = 'J'; +$h{'k'} = 'K'; +$h{'l'} = 'L'; +$h{'m'} = 'M'; +$h{'n'} = 'N'; +$h{'o'} = 'O'; +$h{'p'} = 'P'; +$h{'q'} = 'Q'; +$h{'r'} = 'R'; +$h{'s'} = 'S'; +$h{'t'} = 'T'; +$h{'u'} = 'U'; +$h{'v'} = 'V'; +$h{'w'} = 'W'; +$h{'x'} = 'X'; +$h{'y'} = 'Y'; +$h{'z'} = 'Z'; + +$h{'goner3'} = 'snork'; + +delete $h{'goner1'}; +delete $h{'goner3'}; + +@keys = keys(%h); +@values = values(%h); + +if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";} + +while (($key,$value) = each(h)) { + if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) { + $key =~ y/a-z/A-Z/; + $i++ if $key eq $value; + } +} + +if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";} + +@keys = ('blurfl', keys(h), 'dyick'); +if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";} + +$h{'foo'} = ''; +$h{''} = 'bar'; + +# check cache overflow and numeric keys and contents +$ok = 1; +for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; } +for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; } +print ($ok ? "ok 8\n" : "not ok 8\n"); + +($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat('Op.dbm'); +print ($size > 0 ? "ok 9\n" : "not ok 9\n"); + +@h{0..200} = 200..400; +@foo = @h{0..200}; +print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n"; + +print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n"); +print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n"); + +unlink 'Op.dbm'; diff --git a/atarist/usub/makefile.st b/atarist/usub/makefile.st new file mode 100644 index 0000000..ede484f --- /dev/null +++ b/atarist/usub/makefile.st @@ -0,0 +1,17 @@ +CC = cgcc +SRC = .. +GLOBINCS = +LOCINCS = +LIBS = -lcurses -lgdbm -lpml -lgnu + +cperl.ttp: $(SRC)/uperl.a usersub.o curses.o + $(CC) $(SRC)/uperl.a usersub.o curses.o $(LIBS) -o cperl.ttp + +usersub.o: usersub.c + $(CC) -c -I$(SRC) $(GLOBINCS) -O usersub.c + +curses.o: curses.c + $(CC) -c -I$(SRC) $(GLOBINCS) -O curses.c + +curses.c: acurses.mus + perl mus acurses.mus >curses.c diff --git a/doio.c b/doio.c index 0c5a1c9..aa85abe 100644 --- a/doio.c +++ b/doio.c @@ -1,4 +1,4 @@ -/* $RCSfile: doio.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 16:51:43 $ +/* $RCSfile: doio.c,v $$Revision: 4.0.1.5 $$Date: 92/06/08 13:00:21 $ * * Copyright (c) 1991, Larry Wall * @@ -6,6 +6,16 @@ * License or the Artistic License, as specified in the README file. * * $Log: doio.c,v $ + * Revision 4.0.1.5 92/06/08 13:00:21 lwall + * patch20: some machines don't define ENOTSOCK in errno.h + * patch20: new warnings for failed use of stat operators on filenames with \n + * patch20: wait failed when STDOUT or STDERR reopened to a pipe + * patch20: end of file latch not reset on reopen of STDIN + * patch20: seek(HANDLE, 0, 1) went to eof because of ancient Ultrix workaround + * patch20: fixed memory leak on system() for vfork() machines + * patch20: get*by* routines now return something useful in a scalar context + * patch20: h_errno now accessible via $? + * * Revision 4.0.1.4 91/11/05 16:51:43 lwall * patch11: prepared for ctype implementations that don't define isascii() * patch11: perl mistook some streams for sockets because they return mode 0 too @@ -41,6 +51,9 @@ #ifdef HAS_SOCKET #include #include +#ifndef ENOTSOCK +#include +#endif #endif #ifdef HAS_SELECT @@ -83,6 +96,8 @@ int laststatval = -1; int laststype = O_STAT; +static char* warn_nl = "Unsuccessful %s on filename containing newline"; + bool do_open(stab,name,len) STAB *stab; @@ -100,6 +115,7 @@ int len; FILE *saveofp = Nullfp; char savetype = ' '; + mode[0] = mode[1] = mode[2] = '\0'; name = myname; forkprocess = 1; /* assume true if no fork */ while (len && isSPACE(name[len-1])) @@ -130,7 +146,7 @@ int len; result = fclose(stio->ifp); if (result == EOF && fd > maxsysfd) fprintf(stderr,"Warning: unable to close filehandle %s properly.\n", - stab_name(stab)); + stab_ename(stab)); stio->ofp = stio->ifp = Nullfp; } if (*name == '+' && len > 1 && name[len-1] != '|') { /* scary */ @@ -244,9 +260,13 @@ int len; fp = fopen(name,"r"); } } - Safefree(myname); - if (!fp) + if (!fp) { + if (dowarn && stio->type == '<' && index(name, '\n')) + warn(warn_nl, "open"); + Safefree(myname); goto say_false; + } + Safefree(myname); if (stio->type && stio->type != '|' && stio->type != '-') { if (fstat(fileno(fp),&statbuf) < 0) { @@ -263,7 +283,9 @@ int len; !statbuf.st_mode #endif ) { - if (getsockname(fileno(fp), tokenbuf, 0) >= 0 || errno != ENOTSOCK) + int buflen = sizeof tokenbuf; + if (getsockname(fileno(fp), tokenbuf, &buflen) >= 0 + || errno != ENOTSOCK) stio->type = 's'; /* some OS's return 0 on fstat()ed socket */ /* but some return 0 for streams too, sigh */ } @@ -280,10 +302,20 @@ int len; } } if (fd != fileno(fp)) { + int pid; + STR *str; + dup2(fileno(fp), fd); + str = afetch(fdpid,fileno(fp),TRUE); + pid = str->str_u.str_useful; + str->str_u.str_useful = 0; + str = afetch(fdpid,fd,TRUE); + str->str_u.str_useful = pid; fclose(fp); + } fp = saveifp; + clearerr(fp); } #if defined(HAS_FCNTL) && defined(F_SETFD) fd = fileno(fp); @@ -384,7 +416,7 @@ register STAB *stab; } #endif #ifdef HAS_RENAME -#ifndef MSDOS +#ifndef DOSISH if (rename(oldname,str->str_ptr) < 0) { warn("Can't rename %s to %s: %s, skipping file", oldname, str->str_ptr, strerror(errno) ); @@ -411,7 +443,7 @@ register STAB *stab; #endif } else { -#ifndef MSDOS +#ifndef DOSISH if (UNLINK(oldname) < 0) { warn("Can't rename %s to %s: %s, skipping file", oldname, str->str_ptr, strerror(errno) ); @@ -536,7 +568,7 @@ bool explicit; stio = stab_io(stab); if (!stio) { /* never opened */ if (dowarn && explicit) - warn("Close on unopened file <%s>",stab_name(stab)); + warn("Close on unopened file <%s>",stab_ename(stab)); return FALSE; } if (stio->ifp) { @@ -621,8 +653,10 @@ STAB *stab; if (!stio || !stio->ifp) goto phooey; +#ifdef ULTRIX_STDIO_BOTCH if (feof(stio->ifp)) (void)fseek (stio->ifp, 0L, 2); /* ultrix 1.2 workaround */ +#endif return ftell(stio->ifp); @@ -648,8 +682,10 @@ int whence; if (!stio || !stio->ifp) goto nuts; +#ifdef ULTRIX_STDIO_BOTCH if (feof(stio->ifp)) (void)fseek (stio->ifp, 0L, 2); /* ultrix 1.2 workaround */ +#endif return fseek(stio->ifp, pos, whence) >= 0; @@ -700,7 +736,7 @@ STR *argstr; } else { retval = (int)str_gnum(argstr); -#ifdef MSDOS +#ifdef DOSISH s = (char*)(long)retval; /* ouch */ #else s = (char*)retval; /* ouch */ @@ -711,7 +747,7 @@ STR *argstr; if (optype == O_IOCTL) retval = ioctl(fileno(stio->ifp), func, s); else -#ifdef MSDOS +#ifdef DOSISH fatal("fcntl is not implemented"); #else #ifdef HAS_FCNTL @@ -768,8 +804,11 @@ int *arglast; else #endif laststatval = stat(str_get(statname),&statcache); - if (laststatval < 0) + if (laststatval < 0) { + if (dowarn && index(str_get(statname), '\n')) + warn(warn_nl, "stat"); max = 0; + } } if (gimme != G_ARRAY) { @@ -1000,7 +1039,7 @@ FILE *fp; 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_mortal(&str_undef); - stab_fullname(tmpstr,((STAB*)str));/* a stab value, be nice */ + stab_efullname(tmpstr,((STAB*)str));/* a stab value, be nice */ str = tmpstr; tmps = str->str_ptr; putc('*',fp); @@ -1072,7 +1111,7 @@ STR *str; return laststatval; if (dowarn) warn("Stat on unopened file <%s>", - stab_name(arg[1].arg_ptr.arg_stab)); + stab_ename(arg[1].arg_ptr.arg_stab)); statstab = Nullstab; str_set(statname,""); return (laststatval = -1); @@ -1082,7 +1121,10 @@ STR *str; statstab = Nullstab; str_set(statname,str_get(str)); laststype = O_STAT; - return (laststatval = stat(str_get(str),&statcache)); + laststatval = stat(str_get(str),&statcache); + if (laststatval < 0 && dowarn && index(str_get(str), '\n')) + warn(warn_nl, "stat"); + return laststatval; } } @@ -1104,10 +1146,13 @@ STR *str; statstab = Nullstab; str_set(statname,str_get(str)); #ifdef HAS_LSTAT - return (laststatval = lstat(str_get(str),&statcache)); + laststatval = lstat(str_get(str),&statcache); #else - return (laststatval = stat(str_get(str),&statcache)); + laststatval = stat(str_get(str),&statcache); #endif + if (laststatval < 0 && dowarn && index(str_get(str), '\n')) + warn(warn_nl, "lstat"); + return laststatval; } STR * @@ -1137,7 +1182,7 @@ STR *str; stio = stab_io(statstab); } if (stio && stio->ifp) { -#ifdef STDSTDIO +#if defined(STDSTDIO) || defined(atarist) /* this will work with atariST */ fstat(fileno(stio->ifp),&statcache); if (S_ISDIR(statcache.st_mode)) /* handle NFS glitch */ return arg->arg_type == O_FTTEXT ? &str_no : &str_yes; @@ -1157,7 +1202,7 @@ STR *str; else { if (dowarn) warn("Test on unopened file <%s>", - stab_name(arg[1].arg_ptr.arg_stab)); + stab_ename(arg[1].arg_ptr.arg_stab)); errno = EBADF; return &str_undef; } @@ -1167,8 +1212,11 @@ STR *str; str_set(statname,str_get(str)); really_filename: i = open(str_get(str),0); - if (i < 0) + if (i < 0) { + if (dowarn && index(str_get(str), '\n')) + warn(warn_nl, "open"); return &str_undef; + } fstat(i,&statcache); len = read(i,tbuf,512); (void)close(i); @@ -1201,6 +1249,9 @@ STR *str; return &str_yes; } +static char **Argv = Null(char **); +static char *Cmd = Nullch; + bool do_aexec(really,arglast) STR *really; @@ -1210,12 +1261,11 @@ int *arglast; register int sp = arglast[1]; register int items = arglast[2] - sp; register char **a; - char **argv; char *tmps; if (items) { - New(401,argv, items+1, char*); - a = argv; + New(401,Argv, items+1, char*); + a = Argv; for (st += ++sp; items > 0; items--,st++) { if (*st) *a++ = str_get(*st); @@ -1224,21 +1274,18 @@ int *arglast; } *a = Nullch; #ifdef TAINT - if (*argv[0] != '/') /* will execvp use PATH? */ + if (*Argv[0] != '/') /* will execvp use PATH? */ taintenv(); /* testing IFS here is overkill, probably */ #endif if (really && *(tmps = str_get(really))) - execvp(tmps,argv); + execvp(tmps,Argv); else - execvp(argv[0],argv); - Safefree(argv); + execvp(Argv[0],Argv); } + do_execfree(); return FALSE; } -static char **Argv = Null(char **); -static char *Cmd = Nullch; - void do_execfree() { @@ -1551,8 +1598,8 @@ int *arglast; register int sp = arglast[1]; register STIO *stio; int fd; - int lvl; - int optname; + unsigned int lvl; + unsigned int optname; if (!stab) goto nuts; @@ -1562,14 +1609,15 @@ int *arglast; goto nuts; fd = fileno(stio->ifp); - lvl = (int)str_gnum(st[sp+1]); - optname = (int)str_gnum(st[sp+2]); + lvl = (unsigned int)str_gnum(st[sp+1]); + optname = (unsigned int)str_gnum(st[sp+2]); switch (optype) { case O_GSOCKOPT: st[sp] = str_2mortal(Str_new(22,257)); st[sp]->str_cur = 256; st[sp]->str_pok = 1; - if (getsockopt(fd, lvl, optname, st[sp]->str_ptr, &st[sp]->str_cur) < 0) + if (getsockopt(fd, lvl, optname, st[sp]->str_ptr, + (int*)&st[sp]->str_cur) < 0) goto nuts; break; case O_SSOCKOPT: @@ -1615,11 +1663,11 @@ int *arglast; fd = fileno(stio->ifp); switch (optype) { case O_GETSOCKNAME: - if (getsockname(fd, st[sp]->str_ptr, &st[sp]->str_cur) < 0) + if (getsockname(fd, st[sp]->str_ptr, (int*)&st[sp]->str_cur) < 0) goto nuts2; break; case O_GETPEERNAME: - if (getpeername(fd, st[sp]->str_ptr, &st[sp]->str_cur) < 0) + if (getpeername(fd, st[sp]->str_ptr, (int*)&st[sp]->str_cur) < 0) goto nuts2; break; } @@ -1654,11 +1702,6 @@ int *arglast; struct hostent *hent; unsigned long len; - if (gimme != G_ARRAY) { - astore(ary, ++sp, str_mortal(&str_undef)); - return sp; - } - if (which == O_GHBYNAME) { char *name = str_get(ary->ary_array[sp+1]); @@ -1677,6 +1720,28 @@ int *arglast; #else fatal("gethostent not implemented"); #endif + +#ifdef HOST_NOT_FOUND + if (!hent) + statusvalue = (unsigned short)h_errno & 0xffff; +#endif + + if (gimme != G_ARRAY) { + astore(ary, ++sp, str = str_mortal(&str_undef)); + if (hent) { + if (which == O_GHBYNAME) { +#ifdef h_addr + str_nset(str, *hent->h_addr, hent->h_length); +#else + str_nset(str, hent->h_addr, hent->h_length); +#endif + } + else + str_set(str, hent->h_name); + } + return sp; + } + if (hent) { #ifndef lint (void)astore(ary, ++sp, str = str_mortal(&str_no)); @@ -1726,11 +1791,6 @@ int *arglast; struct netent *getnetent(); struct netent *nent; - if (gimme != G_ARRAY) { - astore(ary, ++sp, str_mortal(&str_undef)); - return sp; - } - if (which == O_GNBYNAME) { char *name = str_get(ary->ary_array[sp+1]); @@ -1745,6 +1805,17 @@ int *arglast; else nent = getnetent(); + if (gimme != G_ARRAY) { + astore(ary, ++sp, str = str_mortal(&str_undef)); + if (nent) { + if (which == O_GNBYNAME) + str_numset(str, (double)nent->n_net); + else + str_set(str, nent->n_name); + } + return sp; + } + if (nent) { #ifndef lint (void)astore(ary, ++sp, str = str_mortal(&str_no)); @@ -1784,11 +1855,6 @@ int *arglast; struct protoent *getprotoent(); struct protoent *pent; - if (gimme != G_ARRAY) { - astore(ary, ++sp, str_mortal(&str_undef)); - return sp; - } - if (which == O_GPBYNAME) { char *name = str_get(ary->ary_array[sp+1]); @@ -1802,6 +1868,17 @@ int *arglast; else pent = getprotoent(); + if (gimme != G_ARRAY) { + astore(ary, ++sp, str = str_mortal(&str_undef)); + if (pent) { + if (which == O_GPBYNAME) + str_numset(str, (double)pent->p_proto); + else + str_set(str, pent->p_name); + } + return sp; + } + if (pent) { #ifndef lint (void)astore(ary, ++sp, str = str_mortal(&str_no)); @@ -1839,11 +1916,6 @@ int *arglast; struct servent *getservent(); struct servent *sent; - if (gimme != G_ARRAY) { - astore(ary, ++sp, str_mortal(&str_undef)); - return sp; - } - if (which == O_GSBYNAME) { char *name = str_get(ary->ary_array[sp+1]); char *proto = str_get(ary->ary_array[sp+2]); @@ -1861,6 +1933,23 @@ int *arglast; } else sent = getservent(); + + if (gimme != G_ARRAY) { + astore(ary, ++sp, str = str_mortal(&str_undef)); + if (sent) { + if (which == O_GSBYNAME) { +#ifdef HAS_NTOHS + str_numset(str, (double)ntohs(sent->s_port)); +#else + str_numset(str, (double)(sent->s_port)); +#endif + } + else + str_set(str, sent->s_name); + } + return sp; + } + if (sent) { #ifndef lint (void)astore(ary, ++sp, str = str_mortal(&str_no)); @@ -2007,6 +2096,7 @@ int *arglast; for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4)) s[(k % masksize) + offset] = fd_sets[i][j+offset]; } + Safefree(fd_sets[i]); } } #endif @@ -2098,11 +2188,6 @@ int *arglast; struct passwd *getpwent(); struct passwd *pwent; - if (gimme != G_ARRAY) { - astore(ary, ++sp, str_mortal(&str_undef)); - return sp; - } - if (which == O_GPWNAM) { char *name = str_get(ary->ary_array[sp+1]); @@ -2116,6 +2201,17 @@ int *arglast; else pwent = getpwent(); + if (gimme != G_ARRAY) { + astore(ary, ++sp, str = str_mortal(&str_undef)); + if (pwent) { + if (which == O_GPWNAM) + str_numset(str, (double)pwent->pw_uid); + else + str_set(str, pwent->pw_name); + } + return sp; + } + if (pwent) { (void)astore(ary, ++sp, str = str_mortal(&str_no)); str_set(str, pwent->pw_name); @@ -2179,11 +2275,6 @@ int *arglast; struct group *getgrent(); struct group *grent; - if (gimme != G_ARRAY) { - astore(ary, ++sp, str_mortal(&str_undef)); - return sp; - } - if (which == O_GGRNAM) { char *name = str_get(ary->ary_array[sp+1]); @@ -2197,6 +2288,17 @@ int *arglast; else grent = getgrent(); + if (gimme != G_ARRAY) { + astore(ary, ++sp, str = str_mortal(&str_undef)); + if (grent) { + if (which == O_GGRNAM) + str_numset(str, (double)grent->gr_gid); + else + str_set(str, grent->gr_name); + } + return sp; + } + if (grent) { (void)astore(ary, ++sp, str = str_mortal(&str_no)); str_set(str, grent->gr_name); @@ -2231,9 +2333,6 @@ int *arglast; register int sp = arglast[1]; register STIO *stio; long along; -#ifndef telldir - long telldir(); -#endif #ifndef apollo struct DIRENT *readdir(); #endif @@ -2278,30 +2377,36 @@ int *arglast; #endif } break; -#if MACH - case O_TELLDIR: - case O_SEEKDIR: - goto nope; -#else - case O_TELLDIR: - st[sp] = str_mortal(&str_undef); - str_numset(st[sp], (double)telldir(stio->dirp)); - break; +#if defined(HAS_TELLDIR) || defined(telldir) + case O_TELLDIR: { +#ifndef telldir + long telldir(); +#endif + st[sp] = str_mortal(&str_undef); + str_numset(st[sp], (double)telldir(stio->dirp)); + break; + } +#endif +#if defined(HAS_SEEKDIR) || defined(seekdir) case O_SEEKDIR: st[sp] = str_mortal(&str_undef); along = (long)str_gnum(st[sp+1]); (void)seekdir(stio->dirp,along); break; #endif +#if defined(HAS_REWINDDIR) || defined(rewinddir) case O_REWINDDIR: st[sp] = str_mortal(&str_undef); (void)rewinddir(stio->dirp); break; +#endif case O_CLOSEDIR: st[sp] = str_mortal(&str_undef); (void)closedir(stio->dirp); stio->dirp = 0; break; + default: + goto phooey; } return sp; @@ -2311,11 +2416,12 @@ nope: errno = EBADF; return sp; -#else - fatal("Unimplemented directory operation"); #endif +phooey: + fatal("Unimplemented directory operation"); } +int apply(type,arglast) int type; int *arglast; @@ -2469,7 +2575,7 @@ int bit; int effective; register struct stat *statbufp; { -#ifdef MSDOS +#ifdef DOSISH /* [Comments and code from Len Reed] * MS-DOS "user" is similar to UNIX's "superuser," but can't write * to write-protected files. The execute permission bit is set @@ -2488,6 +2594,9 @@ register struct stat *statbufp; * Sun's PC-NFS.] */ + /* Atari stat() does pretty much the same thing. we set x_bit_set_in_stat + * too so it will actually look into the files for magic numbers + */ return (bit & statbufp->st_mode) ? TRUE : FALSE; #else /* ! MSDOS */ @@ -2658,7 +2767,7 @@ int *arglast; { #ifdef HAS_MSG case O_MSGCTL: - ret = msgctl(id, cmd, a); + ret = msgctl(id, cmd, (struct msqid_ds *)a); break; #endif #ifdef HAS_SEM @@ -2668,7 +2777,7 @@ int *arglast; #endif #ifdef HAS_SHM case O_SHMCTL: - ret = shmctl(id, cmd, a); + ret = shmctl(id, cmd, (struct shmid_ds *)a); break; #endif } @@ -2699,7 +2808,7 @@ int *arglast; return -1; } errno = 0; - return msgsnd(id, mbuf, msize, flags); + return msgsnd(id, (struct msgbuf *)mbuf, msize, flags); #else fatal("msgsnd not implemented"); #endif @@ -2728,7 +2837,7 @@ int *arglast; mbuf = str_get(mstr); } errno = 0; - ret = msgrcv(id, mbuf, msize, mtype, flags); + ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags); if (ret >= 0) { mstr->str_cur = sizeof(long)+ret; mstr->str_ptr[sizeof(long)+ret] = '\0'; @@ -2802,7 +2911,7 @@ int *arglast; STR_GROW(mstr, msize+1); mbuf = str_get(mstr); } - bcopy(shm + mpos, mbuf, msize); + Copy(shm + mpos, mbuf, msize, char); mstr->str_cur = msize; mstr->str_ptr[msize] = '\0'; } @@ -2811,9 +2920,9 @@ int *arglast; if ((n = mstr->str_cur) > msize) n = msize; - bcopy(mbuf, shm + mpos, n); + Copy(mbuf, shm + mpos, n, char); if (n < msize) - bzero(shm + mpos + n, msize - n); + memzero(shm + mpos + n, msize - n); } return shmdt(shm); #else diff --git a/form.c b/form.c index 701aa05..0eb0976 100644 --- a/form.c +++ b/form.c @@ -1,4 +1,4 @@ -/* $RCSfile: form.c,v $$Revision: 4.0.1.2 $$Date: 91/11/05 17:18:43 $ +/* $RCSfile: form.c,v $$Revision: 4.0.1.3 $$Date: 92/06/08 13:21:42 $ * * Copyright (c) 1991, Larry Wall * @@ -6,6 +6,11 @@ * License or the Artistic License, as specified in the README file. * * $Log: form.c,v $ + * Revision 4.0.1.3 92/06/08 13:21:42 lwall + * patch20: removed implicit int declarations on funcions + * patch20: form feed for formats is now specifiable via $^L + * patch20: Perl now distinguishes overlapped copies from non-overlapped + * * Revision 4.0.1.2 91/11/05 17:18:43 lwall * patch11: formats didn't fill their fields as well as they could * patch11: ^ fields chopped hyphens on line break @@ -25,6 +30,8 @@ /* Forms stuff */ +static int countlines(); + void form_parseargs(fcmd) register FCMD *fcmd; @@ -80,6 +87,7 @@ if (newsize >= curlen) { \ curlen = orec->o_len - 2; \ } +void format(orec,fcmd,sp) register struct outrec *orec; register FCMD *fcmd; @@ -219,7 +227,7 @@ int sp; *d++ = ' '; } size = s - t; - (void)bcopy(t,d,size); + Copy(t,d,size,char); d += size; *s = tmpchar; if (fcmd->f_flags & FC_CHOP) @@ -264,7 +272,7 @@ int sp; *d++ = ' '; } size = s - t; - (void)bcopy(t,d,size); + Copy(t,d,size,char); d += size; *s = tmpchar; if (fcmd->f_next && fcmd->f_next->f_pre[0] == '\n') @@ -286,7 +294,7 @@ int sp; size = str_len(str); CHKLEN(size+1); orec->o_lines += countlines(s,size) - 1; - (void)bcopy(s,d,size); + Copy(s,d,size,char); d += size; if (size && s[size-1] != '\n') { *d++ = '\n'; @@ -325,6 +333,7 @@ int sp; *d++ = '\0'; } +static int countlines(s,size) register char *s; register int size; @@ -338,6 +347,7 @@ register int size; return count; } +void do_write(orec,stab,sp) struct outrec *orec; STAB *stab; @@ -374,7 +384,7 @@ int sp; stio->top_stab = topstab; } if (stio->lines_left >= 0 && stio->page > 0) - (void)putc('\f',ofp); + fwrite(formfeed->str_ptr, formfeed->str_cur, 1, ofp); stio->lines_left = stio->page_len; stio->page++; format(&toprec,stab_form(stio->top_stab),sp); diff --git a/h2ph.SH b/h2ph.SH index 90fd41f..f6925db 100644 --- a/h2ph.SH +++ b/h2ph.SH @@ -19,6 +19,7 @@ echo "Extracting h2ph (with variable substitutions)" : Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. : Protect any dollar signs and backticks that you do not want interpreted : by putting a backslash in front. You may delete these comments. +rm -f h2ph $spitshell >h2ph <hent_key,key,klen)) /* is this it? */ continue; *oentry = entry->hent_next; + if (i && !*oentry) + tb->tbl_fill--; str = str_mortal(entry->hent_val); hentfree(entry); - if (i) - tb->tbl_fill--; #ifdef SOME_DBM do_dbm_delete: if (tb->tbl_dbm) { @@ -273,6 +280,7 @@ unsigned int klen; #endif } +static void hsplit(tb) HASH *tb; { @@ -285,7 +293,13 @@ HASH *tb; register HENT **oentry; a = tb->tbl_array; + nomemok = TRUE; Renew(a, newsize, HENT*); + nomemok = FALSE; + if (!a) { + tb->tbl_dosplit = tb->tbl_max + 1; /* never split again */ + return; + } Zero(&a[oldsize], oldsize, HENT*); /* zero 2nd half*/ tb->tbl_max = --newsize; tb->tbl_dosplit = tb->tbl_max * FILLPCT / 100; @@ -369,7 +383,7 @@ int dodbm; tb->tbl_fill = 0; #ifndef lint if (tb->tbl_array) - (void)bzero((char*)tb->tbl_array, (tb->tbl_max + 1) * sizeof(HENT*)); + (void)memzero((char*)tb->tbl_array, (tb->tbl_max + 1) * sizeof(HENT*)); #endif } diff --git a/hints/hp9000_700.sh b/hints/hp9000_700.sh new file mode 100644 index 0000000..5b15a89 --- /dev/null +++ b/hints/hp9000_700.sh @@ -0,0 +1,5 @@ +libswanted='ndbm m' +ccflags="$ccflags -DJMPCLOBBER" +optimize='+O1' +d_mymalloc=define +alignbytes=8 diff --git a/hints/hp9000_800.sh b/hints/hp9000_800.sh index b5f22ff..e1ab9d7 100644 --- a/hints/hp9000_800.sh +++ b/hints/hp9000_800.sh @@ -1,2 +1,3 @@ libswanted=`echo $libswanted | sed -e 's/malloc //' -e 's/BSD //` -optimize='+O1' +eval_cflags='optimize=+O1' +teval_cflags=$eval_cflags diff --git a/hints/hpux.sh b/hints/hpux.sh index cab5871..904f9de 100644 --- a/hints/hpux.sh +++ b/hints/hpux.sh @@ -5,3 +5,4 @@ case `(uname -r) 2>/dev/null` in *3.1*) d_syscall=$undef ;; *2.1*) libswanted=`echo $libswanted | sed 's/ malloc / /'` ;; esac +d_index=define diff --git a/hints/isc_3_2_2.sh b/hints/isc_3_2_2.sh index 1582595..ff59108 100644 --- a/hints/isc_3_2_2.sh +++ b/hints/isc_3_2_2.sh @@ -1,4 +1,4 @@ -set `echo $libswanted | sed -e 's/ x / /' -e 's/ PW / /' -e s/ malloc / /` +set `echo $libswanted | sed -e 's/ x / /' -e 's/ PW / /' -e 's/ malloc / /'` libswanted="inet malloc $*" doio_cflags='ccflags="$ccflags -DENOTSOCK=103"' tdoio_cflags='ccflags="$ccflags -DENOTSOCK=103"' diff --git a/hints/mc6000.sh b/hints/mc6000.sh new file mode 100644 index 0000000..78c87c8 --- /dev/null +++ b/hints/mc6000.sh @@ -0,0 +1,5 @@ +# defaults for the masscomp (concurrent) 6000 series running RTU 5.0 +cppstdin=/lib/cpp +cmd_cflags='optimize=""' +tcmd_cflags='optimize=""' +d_mymalloc=define diff --git a/installperl b/installperl index 643317a..7f9d36e 100644 --- a/installperl +++ b/installperl @@ -1,5 +1,7 @@ #!./perl +$mainperldir = "/usr/bin"; + while (@ARGV) { $nonono = 1 if $ARGV[0] eq '-n'; $versiononly = 1 if $ARGV[0] eq '-v'; @@ -11,10 +13,6 @@ umask 022; @scripts = ('cppstdin', 'h2ph', 'c2ph', 'pstruct', 'x2p/s2p', 'x2p/find2perl'); @manpages = ('perl.man', 'h2ph.man', 'x2p/a2p.man', 'x2p/s2p.man'); -$version = sprintf("%5.3f", $]); -$release = substr($version,0,3); -$patchlevel = substr($version,3,2); - # Read in the config file. open(CONFIG, "config.sh") || die "You haven't run Configure yet!\n"; @@ -26,6 +24,19 @@ while () { } $accum .= $_; } +close CONFIG; + +open(PERL_C, "perl.c"); +while () { + last if /Revision:/; +} +close PERL_C; +s/.*Revision: //; +$major = $_ + 0; + +$ver = sprintf("%5.3f", $major + $PATCHLEVEL / 1000); +$release = substr($ver,0,3); +$patchlevel = substr($ver,3,2); # Do some quick sanity checks. @@ -45,8 +56,6 @@ if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; } # First we install the version-numbered executables. -$ver = sprintf("%5.3f", $]); - &unlink("$installbin/perl$ver"); &cmd("cp perl $installbin/perl$ver"); @@ -80,17 +89,18 @@ if ($bdev != $ddev || $bino != $dino) { if ($bdev != $ddev || $bino != $dino) { &unlink("$installbin/a2p"); &cmd("cp x2p/a2p $installbin/a2p"); + &chmod(0755, "$installbin/a2p"); } # Make some enemies in the name of standardization. :-) -($udev,$uino) = stat("/usr/bin"); +($udev,$uino) = stat($mainperldir); -if (-w _ && ($udev != $ddev || $uino != $dino) && !$nonono) { - &unlink("/usr/bin/perl"); - eval 'symlink("$installbin/perl", "/usr/bin/perl")' || - eval 'link("$installbin/perl", "/usr/bin/perl")' || - &cmd("cp $installbin/perl /usr/bin"); +if (-w _ && ($udev != $bdev || $uino != $bino) && !$nonono) { + &unlink("$mainperldir/perl"); + eval 'link("$installbin/perl", "$mainperldir/perl")' || + eval 'symlink("$installbin/perl", "$mainperldir/perl")' || + &cmd("cp $installbin/perl $mainperldir"); } # Install scripts. @@ -114,8 +124,8 @@ if ($mansrc ne '') { $new =~ s#.*/##; print STDERR " Installing $mansrc/$new\n"; next if $nonono; - open(MI,$_); - open(MO,">$mansrc/$new"); + open(MI,$_) || warn "Can't open $_: $!\n"; + open(MO,">$mansrc/$new") || warn "Can't install $mansrc/$new: $!\n"; print MO ".ds RP Release $release Patchlevel $patchlevel\n"; while () { print MO; diff --git a/makedir.SH b/makedir.SH index 63214ef..e55d2b7 100644 --- a/makedir.SH +++ b/makedir.SH @@ -13,11 +13,15 @@ case "$0" in */*) cd `expr X$0 : 'X\(.*\)/'` ;; esac echo "Extracting makedir (with variable substitutions)" +rm -f makedir $spitshell >makedir < -#include +#define PERLGLOB +#include "director.c" -main(int argc, char *argv[]) +int main(int argc, char **argv) { - register i; + SHORT i; + USHORT r; + CHAR *f; for (i = 1; i < argc; i++) { - fputs(IsFileSystemFAT(argv[i]) ? strlwr(argv[i]) : argv[i], stdout); - putchar(0); + f = IsFileSystemFAT(argv[i]) ? strlwr(argv[i]) : argv[i]; + DosWrite(1, f, strlen(f) + 1, &r); } + return argc - 1; } diff --git a/patchlevel.h b/patchlevel.h index 10c8c21..9705476 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1 +1 @@ -#define PATCHLEVEL 25 +#define PATCHLEVEL 26 diff --git a/t/op/goto.t b/t/op/goto.t index b76d44d..29bf797 100644 --- a/t/op/goto.t +++ b/t/op/goto.t @@ -1,6 +1,6 @@ #!./perl -# $Header: goto.t,v 4.0 91/03/20 01:52:52 lwall Locked $ +# $RCSfile: goto.t,v $$Revision: 4.0.1.1 $$Date: 92/06/08 15:43:25 $ print "1..3\n"; @@ -30,5 +30,4 @@ print "#2\t:$foo: == 4\n"; if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";} $x = `./perl -e 'goto foo;' 2>&1`; -print "#3\t/label/ in :$x"; if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}