See patch #20.
--- /dev/null
+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";
--- /dev/null
+#!./perl
+
+#
+# based on t/op/dbm.t modified for gdbm and atariST stat() semantics
+#
+print "1..12\n";
+
+unlink <Op.dbm>;
+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';
--- /dev/null
+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
-/* $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
*
* 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
#ifdef HAS_SOCKET
#include <sys/socket.h>
#include <netdb.h>
+#ifndef ENOTSOCK
+#include <net/errno.h>
+#endif
#endif
#ifdef HAS_SELECT
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;
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]))
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 */
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) {
!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 */
}
}
}
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);
}
#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) );
#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) );
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) {
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);
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;
}
else {
retval = (int)str_gnum(argstr);
-#ifdef MSDOS
+#ifdef DOSISH
s = (char*)(long)retval; /* ouch */
#else
s = (char*)retval; /* ouch */
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
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) {
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);
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);
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;
}
}
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 *
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;
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;
}
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);
return &str_yes;
}
+static char **Argv = Null(char **);
+static char *Cmd = Nullch;
+
bool
do_aexec(really,arglast)
STR *really;
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);
}
*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()
{
register int sp = arglast[1];
register STIO *stio;
int fd;
- int lvl;
- int optname;
+ unsigned int lvl;
+ unsigned int optname;
if (!stab)
goto nuts;
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:
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;
}
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]);
#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));
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]);
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));
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]);
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));
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]);
}
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));
for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
s[(k % masksize) + offset] = fd_sets[i][j+offset];
}
+ Safefree(fd_sets[i]);
}
}
#endif
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]);
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);
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]);
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);
register int sp = arglast[1];
register STIO *stio;
long along;
-#ifndef telldir
- long telldir();
-#endif
#ifndef apollo
struct DIRENT *readdir();
#endif
#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;
errno = EBADF;
return sp;
-#else
- fatal("Unimplemented directory operation");
#endif
+phooey:
+ fatal("Unimplemented directory operation");
}
+int
apply(type,arglast)
int type;
int *arglast;
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
* 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 */
{
#ifdef HAS_MSG
case O_MSGCTL:
- ret = msgctl(id, cmd, a);
+ ret = msgctl(id, cmd, (struct msqid_ds *)a);
break;
#endif
#ifdef HAS_SEM
#endif
#ifdef HAS_SHM
case O_SHMCTL:
- ret = shmctl(id, cmd, a);
+ ret = shmctl(id, cmd, (struct shmid_ds *)a);
break;
#endif
}
return -1;
}
errno = 0;
- return msgsnd(id, mbuf, msize, flags);
+ return msgsnd(id, (struct msgbuf *)mbuf, msize, flags);
#else
fatal("msgsnd not implemented");
#endif
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';
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';
}
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
-/* $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
*
* 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
/* Forms stuff */
+static int countlines();
+
void
form_parseargs(fcmd)
register FCMD *fcmd;
curlen = orec->o_len - 2; \
}
+void
format(orec,fcmd,sp)
register struct outrec *orec;
register FCMD *fcmd;
*d++ = ' ';
}
size = s - t;
- (void)bcopy(t,d,size);
+ Copy(t,d,size,char);
d += size;
*s = tmpchar;
if (fcmd->f_flags & FC_CHOP)
*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')
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';
*d++ = '\0';
}
+static int
countlines(s,size)
register char *s;
register int size;
return count;
}
+void
do_write(orec,stab,sp)
struct outrec *orec;
STAB *stab;
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);
: 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 <<!GROK!THIS!
#!$bin/perl
'di';
-/* $RCSfile: handy.h,v $$Revision: 4.0.1.3 $$Date: 91/11/05 22:54:26 $
+/* $RCSfile: handy.h,v $$Revision: 4.0.1.4 $$Date: 92/06/08 13:23:17 $
*
* Copyright (c) 1991, Larry Wall
*
* License or the Artistic License, as specified in the README file.
*
* $Log: handy.h,v $
+ * Revision 4.0.1.4 92/06/08 13:23:17 lwall
+ * patch20: isascii() may now be supplied by a library routine
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ *
* Revision 4.0.1.3 91/11/05 22:54:26 lwall
* patch11: erratum
*
#define strnNE(s1,s2,l) (strncmp(s1,s2,l))
#define strnEQ(s1,s2,l) (!strncmp(s1,s2,l))
-#if defined(CTYPE256) || !defined(isascii)
+#if defined(CTYPE256) || (!defined(isascii) && !defined(HAS_ISASCII))
#define isALNUM(c) (isalpha(c) || isdigit(c) || c == '_')
#define isALPHA(c) isalpha(c)
#define isSPACE(c) isspace(c)
#define isLOWER(c) (isascii(c) && islower(c))
#endif
-#define MEM_SIZE unsigned int
-
/* Line numbers are unsigned, 16 bits. */
typedef unsigned short line_t;
#ifdef lint
#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)))), \
- bzero((char*)(v), (n) * sizeof(t))
+ memzero((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))))
#else
#define New(x,v,n,t) (v = (t*)safemalloc(((unsigned long)(n) * sizeof(t))))
#define Newc(x,v,n,t,c) (v = (c*)safemalloc(((unsigned long)(n) * sizeof(t))))
#define Newz(x,v,n,t) (v = (t*)safemalloc(((unsigned long)(n) * sizeof(t)))), \
- bzero((char*)(v), (n) * sizeof(t))
+ memzero((char*)(v), (n) * sizeof(t))
#define Renew(v,n,t) (v = (t*)saferealloc((char*)(v),((unsigned long)(n)*sizeof(t))))
#define Renewc(v,n,t,c) (v = (c*)saferealloc((char*)(v),((unsigned long)(n)*sizeof(t))))
#endif /* MSDOS */
#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))
+ memzero((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)
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))
+#define Move(s,d,n,t) (void)memmove((char*)(d),(char*)(s), (n) * sizeof(t))
+#define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
+#define Zero(d,n,t) (void)memzero((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 *))
#define Newz(x,v,n,s) (v = Null(s *))
#define Renew(v,n,s) (v = Null(s *))
+#define Move(s,d,n,t)
#define Copy(s,d,n,t)
#define Zero(d,n,t)
#define Safefree(d) d = d
#endif /* lint */
+
+#ifdef STRUCTCOPY
+#define StructCopy(s,d,t) *((t*)(d)) = *((t*)(s))
+#else
+#define StructCopy(s,d,t) Copy(s,d,1,t)
+#endif
-/* $RCSfile: hash.c,v $$Revision: 4.0.1.2 $$Date: 91/11/05 17:24:13 $
+/* $RCSfile: hash.c,v $$Revision: 4.0.1.3 $$Date: 92/06/08 13:26:29 $
*
* Copyright (c) 1991, Larry Wall
*
* License or the Artistic License, as specified in the README file.
*
* $Log: hash.c,v $
+ * Revision 4.0.1.3 92/06/08 13:26:29 lwall
+ * patch20: removed implicit int declarations on functions
+ * patch20: delete could cause %array to give too low a count of buckets filled
+ * patch20: hash tables now split only if the memory is available to do so
+ *
* Revision 4.0.1.2 91/11/05 17:24:13 lwall
* patch11: saberized perl
*
#include "EXTERN.h"
#include "perl.h"
+static void hsplit();
+
static char coeff[] = {
61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
if (bcmp(entry->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) {
#endif
}
+static void
hsplit(tb)
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;
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
}
--- /dev/null
+libswanted='ndbm m'
+ccflags="$ccflags -DJMPCLOBBER"
+optimize='+O1'
+d_mymalloc=define
+alignbytes=8
libswanted=`echo $libswanted | sed -e 's/malloc //' -e 's/BSD //`
-optimize='+O1'
+eval_cflags='optimize=+O1'
+teval_cflags=$eval_cflags
*3.1*) d_syscall=$undef ;;
*2.1*) libswanted=`echo $libswanted | sed 's/ malloc / /'` ;;
esac
+d_index=define
-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"'
--- /dev/null
+# defaults for the masscomp (concurrent) 6000 series running RTU 5.0
+cppstdin=/lib/cpp
+cmd_cflags='optimize=""'
+tcmd_cflags='optimize=""'
+d_mymalloc=define
#!./perl
+$mainperldir = "/usr/bin";
+
while (@ARGV) {
$nonono = 1 if $ARGV[0] eq '-n';
$versiononly = 1 if $ARGV[0] eq '-v';
@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";
}
$accum .= $_;
}
+close CONFIG;
+
+open(PERL_C, "perl.c");
+while (<PERL_C>) {
+ 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.
# First we install the version-numbered executables.
-$ver = sprintf("%5.3f", $]);
-
&unlink("$installbin/perl$ver");
&cmd("cp perl $installbin/perl$ver");
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.
$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 (<MI>) {
print MO;
*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
esac
echo "Extracting makedir (with variable substitutions)"
+rm -f makedir
$spitshell >makedir <<!GROK!THIS!
$startsh
-# $Header: makedir.SH,v 4.0 91/03/20 01:27:13 lwall Locked $
+# $RCSfile: makedir.SH,v $$Revision: 4.0.1.1 $$Date: 92/06/08 14:24:55 $
#
# $Log: makedir.SH,v $
+# Revision 4.0.1.1 92/06/08 14:24:55 lwall
+# patch20: SH files didn't work well with symbolic links
+#
# Revision 4.0 91/03/20 01:27:13 lwall
# 4.0 baseline.
#
/*
* Globbing for OS/2. Relies on the expansion done by the library
- * startup code. (dds)
+ * startup code.
*/
-#include <stdio.h>
-#include <string.h>
+#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;
}
-#define PATCHLEVEL 25
+#define PATCHLEVEL 26
#!./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";
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";}
projects / p5sagit/p5-mst-13.2.git / commitdiff