X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=dce271d4af8d1decb1aa58b5cc116c07a99779d0;hb=a60c0954410db87be540ee8439afcd54350bbb8e;hp=271de285fa992599f115810947b0a2173ea133c6;hpb=3fe9a6f19eb206c685bd7389e54e2838fdfd04b7;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doio.c b/doio.c
index 271de28..dce271d 100644
--- a/doio.c
+++ b/doio.c
@@ -34,7 +34,7 @@
 #endif
 
 #ifdef I_UTIME
-#  ifdef WIN32
+#  ifdef _MSC_VER
 #    include <sys/utime.h>
 #  else
 #    include <utime.h>
@@ -66,14 +66,17 @@
 # endif
 #endif
 
+/* Put this after #includes because <unistd.h> defines _XOPEN_*. */
+#ifndef Sock_size_t
+#  if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) || defined(__GLIBC__)
+#    define Sock_size_t Size_t
+#  else
+#    define Sock_size_t int
+#  endif
+#endif
+
 bool
-do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp)
-GV *gv;
-register char *name;
-I32 len;
-int as_raw;
-int rawmode, rawperm;
-PerlIO *supplied_fp;
+do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawperm, FILE *supplied_fp)
 {
     register IO *io = GvIOn(gv);
     PerlIO *saveifp = Nullfp;
@@ -274,6 +277,7 @@ PerlIO *supplied_fp;
     }
     if (IoTYPE(io) &&
       IoTYPE(io) != '|' && IoTYPE(io) != '-') {
+	dTHR;
 	if (Fstat(PerlIO_fileno(fp),&statbuf) < 0) {
 	    (void)PerlIO_close(fp);
 	    goto say_false;
@@ -288,9 +292,11 @@ PerlIO *supplied_fp;
 	    !statbuf.st_mode
 #endif
 	) {
-	    int buflen = sizeof tokenbuf;
-	    if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tokenbuf, &buflen) >= 0
-		|| errno != ENOTSOCK)
+	    char tmpbuf[256];
+	    Sock_size_t buflen = sizeof tmpbuf;
+	    if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tmpbuf,
+			    &buflen) >= 0
+		  || errno != ENOTSOCK)
 		IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */
 				/* but some return 0 for streams too, sigh */
 	}
@@ -330,6 +336,7 @@ PerlIO *supplied_fp;
 #endif
     IoIFP(io) = fp;
     if (writing) {
+	dTHR;
 	if (IoTYPE(io) == 's'
 	  || (IoTYPE(io) == '>' && S_ISCHR(statbuf.st_mode)) ) {
 	    if (!(IoOFP(io) = PerlIO_fdopen(PerlIO_fileno(fp),"w"))) {
@@ -351,8 +358,7 @@ say_false:
 }
 
 PerlIO *
-nextargv(gv)
-register GV *gv;
+nextargv(register GV *gv)
 {
     register SV *sv;
 #ifndef FLEXFILENAMES
@@ -374,6 +380,7 @@ register GV *gv;
     }
     filemode = 0;
     while (av_len(GvAV(gv)) >= 0) {
+	dTHR;
 	STRLEN len;
 	sv = av_shift(GvAV(gv));
 	SAVEFREESV(sv);
@@ -409,8 +416,12 @@ register GV *gv;
 #ifndef FLEXFILENAMES
 		    if (Stat(SvPVX(sv),&statbuf) >= 0
 		      && statbuf.st_dev == filedev
-		      && statbuf.st_ino == fileino ) {
-			warn("Can't do inplace edit: %s > 14 characters",
+		      && statbuf.st_ino == fileino
+#ifdef DJGPP
+                      || (_djstat_fail_bits & _STFAIL_TRUENAME)!=0
+#endif
+                      ) {
+			warn("Can't do inplace edit: %s would not be uniq",
 			  SvPVX(sv) );
 			do_close(gv,FALSE);
 			continue;
@@ -471,7 +482,10 @@ register GV *gv;
 #ifdef HAS_FCHMOD
 		(void)fchmod(lastfd,filemode);
 #else
+#  if !(defined(WIN32) && defined(__BORLANDC__))
+		/* Borland runtime creates a readonly file! */
 		(void)chmod(oldname,filemode);
+#  endif
 #endif
 		if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) {
 #ifdef HAS_FCHOWN
@@ -486,7 +500,8 @@ register GV *gv;
 	    return IoIFP(GvIOp(gv));
 	}
 	else
-	    PerlIO_printf(PerlIO_stderr(), "Can't open %s: %s\n",SvPV(sv, na), Strerror(errno));
+	    PerlIO_printf(PerlIO_stderr(), "Can't open %s: %s\n",
+	      SvPV(sv, na), Strerror(errno));
     }
     if (inplace) {
 	(void)do_close(argvoutgv,FALSE);
@@ -497,10 +512,7 @@ register GV *gv;
 
 #ifdef HAS_PIPE
 void
-do_pipe(sv, rgv, wgv)
-SV *sv;
-GV *rgv;
-GV *wgv;
+do_pipe(SV *sv, GV *rgv, GV *wgv)
 {
     register IO *rstio;
     register IO *wstio;
@@ -579,8 +591,7 @@ do_close(GV *gv, bool not_implicit)
 }
 
 bool
-io_close(io)
-IO* io;
+io_close(IO *io)
 {
     bool retval = FALSE;
     int status;
@@ -608,9 +619,9 @@ IO* io;
 }
 
 bool
-do_eof(gv)
-GV *gv;
+do_eof(GV *gv)
 {
+    dTHR;
     register IO *io;
     int ch;
 
@@ -646,26 +657,18 @@ GV *gv;
 }
 
 long
-do_tell(gv)
-GV *gv;
+do_tell(GV *gv)
 {
     register IO *io;
+    register PerlIO *fp;
 
-    if (!gv)
-	goto phooey;
-
-    io = GvIO(gv);
-    if (!io || !IoIFP(io))
-	goto phooey;
-
+    if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) {
 #ifdef ULTRIX_STDIO_BOTCH
-    if (PerlIO_eof(IoIFP(io)))
-	(void)PerlIO_seek (IoIFP(io), 0L, 2);		/* ultrix 1.2 workaround */
+	if (PerlIO_eof(fp))
+	    (void)PerlIO_seek(fp, 0L, 2);	/* ultrix 1.2 workaround */
 #endif
-
-    return PerlIO_tell(IoIFP(io));
-
-phooey:
+	return PerlIO_tell(fp);
+    }
     if (dowarn)
 	warn("tell() on unopened file");
     SETERRNO(EBADF,RMS$_IFI);
@@ -673,34 +676,38 @@ phooey:
 }
 
 bool
-do_seek(gv, pos, whence)
-GV *gv;
-long pos;
-int whence;
+do_seek(GV *gv, long int pos, int whence)
 {
     register IO *io;
+    register PerlIO *fp;
 
-    if (!gv)
-	goto nuts;
-
-    io = GvIO(gv);
-    if (!io || !IoIFP(io))
-	goto nuts;
-
+    if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) {
 #ifdef ULTRIX_STDIO_BOTCH
-    if (PerlIO_eof(IoIFP(io)))
-	(void)PerlIO_seek (IoIFP(io), 0L, 2);		/* ultrix 1.2 workaround */
+	if (PerlIO_eof(fp))
+	    (void)PerlIO_seek(fp, 0L, 2);	/* ultrix 1.2 workaround */
 #endif
-
-    return PerlIO_seek(IoIFP(io), pos, whence) >= 0;
-
-nuts:
+	return PerlIO_seek(fp, pos, whence) >= 0;
+    }
     if (dowarn)
 	warn("seek() on unopened file");
     SETERRNO(EBADF,RMS$_IFI);
     return FALSE;
 }
 
+long
+do_sysseek(GV *gv, long int pos, int whence)
+{
+    register IO *io;
+    register PerlIO *fp;
+
+    if (gv && (io = GvIO(gv)) && (fp = IoIFP(io)))
+	return lseek(PerlIO_fileno(fp), pos, whence);
+    if (dowarn)
+	warn("sysseek() on unopened file");
+    SETERRNO(EBADF,RMS$_IFI);
+    return -1L;
+}
+
 #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
 	/* code courtesy of William Kucharski */
 #define HAS_CHSIZE
@@ -709,7 +716,6 @@ I32 my_chsize(fd, length)
 I32 fd;			/* file descriptor */
 Off_t length;		/* length to set file to */
 {
-    extern long lseek();
     struct flock fl;
     struct stat filebuf;
 
@@ -754,9 +760,7 @@ Off_t length;		/* length to set file to */
 #endif /* F_FREESP */
 
 bool
-do_print(sv,fp)
-register SV *sv;
-PerlIO *fp;
+do_print(register SV *sv, FILE *fp)
 {
     register char *tmps;
     STRLEN len;
@@ -800,10 +804,9 @@ PerlIO *fp;
 }
 
 I32
-my_stat(ARGS)
-dARGS
+my_stat(ARGSproto)
 {
-    dSP;
+    djSP;
     IO *io;
     GV* tmpgv;
 
@@ -852,10 +855,9 @@ dARGS
 }
 
 I32
-my_lstat(ARGS)
-dARGS
+my_lstat(ARGSproto)
 {
-    dSP;
+    djSP;
     SV *sv;
     if (op->op_flags & OPf_REF) {
 	EXTEND(sp,1);
@@ -883,15 +885,13 @@ dARGS
 }
 
 bool
-do_aexec(really,mark,sp)
-SV *really;
-register SV **mark;
-register SV **sp;
+do_aexec(SV *really, register SV **mark, register SV **sp)
 {
     register char **a;
     char *tmps;
 
     if (sp > mark) {
+	dTHR;
 	New(401,Argv, sp - mark + 1, char*);
 	a = Argv;
 	while (++mark <= sp) {
@@ -915,7 +915,7 @@ register SV **sp;
 }
 
 void
-do_execfree()
+do_execfree(void)
 {
     if (Argv) {
 	Safefree(Argv);
@@ -927,11 +927,10 @@ do_execfree()
     }
 }
 
-#ifndef OS2
+#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP)
 
 bool
-do_exec(cmd)
-char *cmd;
+do_exec(char *cmd)
 {
     register char **a;
     register char *s;
@@ -1018,14 +1017,12 @@ char *cmd;
     return FALSE;
 }
 
-#endif /* OS2 */
+#endif /* OS2 || WIN32 */
 
 I32
-apply(type,mark,sp)
-I32 type;
-register SV **mark;
-register SV **sp;
+apply(I32 type, register SV **mark, register SV **sp)
 {
+    dTHR;
     register I32 val;
     register I32 val2;
     register I32 tot = 0;
@@ -1193,10 +1190,7 @@ register SV **sp;
 /* Do the permissions allow some operation?  Assumes statcache already set. */
 #ifndef VMS /* VMS' cando is in vms.c */
 I32
-cando(bit, effective, statbufp)
-I32 bit;
-I32 effective;
-register struct stat *statbufp;
+cando(I32 bit, I32 effective, register struct stat *statbufp)
 {
 #ifdef DOSISH
     /* [Comments and code from Len Reed]
@@ -1248,9 +1242,7 @@ register struct stat *statbufp;
 #endif /* ! VMS */
 
 I32
-ingroup(testgid,effective)
-I32 testgid;
-I32 effective;
+ingroup(I32 testgid, I32 effective)
 {
     if (testgid == (effective ? egid : gid))
 	return TRUE;
@@ -1274,11 +1266,9 @@ I32 effective;
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
 
 I32
-do_ipcget(optype, mark, sp)
-I32 optype;
-SV **mark;
-SV **sp;
+do_ipcget(I32 optype, SV **mark, SV **sp)
 {
+    dTHR;
     key_t key;
     I32 n, flags;
 
@@ -1309,15 +1299,16 @@ SV **sp;
 }
 
 I32
-do_ipcctl(optype, mark, sp)
-I32 optype;
-SV **mark;
-SV **sp;
+do_ipcctl(I32 optype, SV **mark, SV **sp)
 {
+    dTHR;
     SV *astr;
     char *a;
     I32 id, n, cmd, infosize, getinfo;
     I32 ret = -1;
+#ifdef __linux__	/* XXX Need metaconfig test */
+    union semun unsemds;
+#endif
 
     id = SvIVx(*++mark);
     n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
@@ -1347,7 +1338,21 @@ SV **sp;
 	else if (cmd == GETALL || cmd == SETALL)
 	{
 	    struct semid_ds semds;
+#ifdef __linux__	/* XXX Need metaconfig test */
+/* linux (and Solaris2?) uses :
+   int semctl (int semid, int semnum, int cmd, union semun arg)
+       union semun {
+            int val;
+            struct semid_ds *buf;
+            ushort *array;
+       };
+*/
+            union semun semun;
+            semun.buf = &semds;
+	    if (semctl(id, 0, IPC_STAT, semun) == -1)
+#else
 	    if (semctl(id, 0, IPC_STAT, &semds) == -1)
+#endif
 		return -1;
 	    getinfo = (cmd == GETALL);
 	    infosize = semds.sem_nsems * sizeof(short);
@@ -1393,7 +1398,12 @@ SV **sp;
 #endif
 #ifdef HAS_SEM
     case OP_SEMCTL:
+#ifdef __linux__	/* XXX Need metaconfig test */
+        unsemds.buf = (struct semid_ds *)a;
+	ret = semctl(id, n, cmd, unsemds);
+#else
 	ret = semctl(id, n, cmd, (struct semid_ds *)a);
+#endif
 	break;
 #endif
 #ifdef HAS_SHM
@@ -1411,11 +1421,10 @@ SV **sp;
 }
 
 I32
-do_msgsnd(mark, sp)
-SV **mark;
-SV **sp;
+do_msgsnd(SV **mark, SV **sp)
 {
 #ifdef HAS_MSG
+    dTHR;
     SV *mstr;
     char *mbuf;
     I32 id, msize, flags;
@@ -1435,11 +1444,10 @@ SV **sp;
 }
 
 I32
-do_msgrcv(mark, sp)
-SV **mark;
-SV **sp;
+do_msgrcv(SV **mark, SV **sp)
 {
 #ifdef HAS_MSG
+    dTHR;
     SV *mstr;
     char *mbuf;
     long mtype;
@@ -1473,11 +1481,10 @@ SV **sp;
 }
 
 I32
-do_semop(mark, sp)
-SV **mark;
-SV **sp;
+do_semop(SV **mark, SV **sp)
 {
 #ifdef HAS_SEM
+    dTHR;
     SV *opstr;
     char *opbuf;
     I32 id;
@@ -1499,12 +1506,10 @@ SV **sp;
 }
 
 I32
-do_shmio(optype, mark, sp)
-I32 optype;
-SV **mark;
-SV **sp;
+do_shmio(I32 optype, SV **mark, SV **sp)
 {
 #ifdef HAS_SHM
+    dTHR;
     SV *mstr;
     char *mbuf, *shm;
     I32 id, mpos, msize;
@@ -1522,7 +1527,7 @@ SV **sp;
 	SETERRNO(EFAULT,SS$_ACCVIO);		/* can't do as caller requested */
 	return -1;
     }
-    shm = (Shmat_t)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
+    shm = (char *)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
     if (shm == (char *)-1)	/* I hate System V IPC, I really do */
 	return -1;
     if (optype == OP_SHMREAD) {
@@ -1551,3 +1556,4 @@ SV **sp;
 }
 
 #endif /* SYSV IPC */
+