X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=os2%2Fos2ish.h;h=30e67ca071dab722a7c9bf04d5542a0488d604b8;hb=5d0f390387801a9d64f5847c6ea27f18454bd071;hp=cfd13c83355911fbe34cb54c2398b1f71f94c97f;hpb=90866323e988eded2d449f93e3ad86d3d1542814;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/os2/os2ish.h b/os2/os2ish.h
index cfd13c8..30e67ca 100644
--- a/os2/os2ish.h
+++ b/os2/os2ish.h
@@ -19,7 +19,7 @@
 
 /* USEMYBINMODE
  *	This symbol, if defined, indicates that the program should
- *	use the routine my_binmode(FILE *fp, char iotype) to insure
+ *	use the routine my_binmode(FILE *fp, char iotype, int mode) to insure
  *	that a file is in "binary" mode -- that is, that no translation
  *	of bytes occurs on read or write operations.
  */
@@ -64,10 +64,17 @@
 #ifndef SIGILL
 #    define SIGILL 6         /* blech */
 #endif
-#define ABORT() kill(getpid(),SIGABRT);
+#define ABORT() kill(PerlProc_getpid(),SIGABRT);
 
 #define BIT_BUCKET "/dev/nul"  /* Will this work? */
 
+/* Apparently TCPIPV4 defines may be included even with only IAK present */
+
+#if !defined(NO_TCPIPV4) && !defined(TCPIPV4)
+#  define TCPIPV4
+#  define TCPIPV4_FORCED		/* Just in case */
+#endif
+
 #if defined(I_SYS_UN) && !defined(TCPIPV4)
 /* It is not working without TCPIPV4 defined. */
 # undef I_SYS_UN
@@ -75,6 +82,9 @@
 
 #ifdef USE_THREADS
 
+#define do_spawn(a)      os2_do_spawn(aTHX_ (a))
+#define do_aspawn(a,b,c) os2_do_aspawn(aTHX_ (a),(b),(c))
+
 #define OS2_ERROR_ALREADY_POSTED 299	/* Avoid os2.h */
 
 extern int rc;
@@ -83,49 +93,49 @@ extern int rc;
     STMT_START {						\
 	int rc;							\
 	if ((rc = _rmutex_create(m,0)))				\
-	    croak("panic: MUTEX_INIT: rc=%i", rc);		\
+	    Perl_croak_nocontext("panic: MUTEX_INIT: rc=%i", rc);	\
     } STMT_END
 #define MUTEX_LOCK(m) \
     STMT_START {						\
 	int rc;							\
 	if ((rc = _rmutex_request(m,_FMR_IGNINT)))		\
-	    croak("panic: MUTEX_LOCK: rc=%i", rc);		\
+	    Perl_croak_nocontext("panic: MUTEX_LOCK: rc=%i", rc);	\
     } STMT_END
 #define MUTEX_UNLOCK(m) \
     STMT_START {						\
 	int rc;							\
 	if ((rc = _rmutex_release(m)))				\
-	    croak("panic: MUTEX_UNLOCK: rc=%i", rc);		\
+	    Perl_croak_nocontext("panic: MUTEX_UNLOCK: rc=%i", rc);	\
     } STMT_END
 #define MUTEX_DESTROY(m) \
     STMT_START {						\
 	int rc;							\
 	if ((rc = _rmutex_close(m)))				\
-	    croak("panic: MUTEX_DESTROY: rc=%i", rc);		\
+	    Perl_croak_nocontext("panic: MUTEX_DESTROY: rc=%i", rc);	\
     } STMT_END
 
 #define COND_INIT(c) \
     STMT_START {						\
 	int rc;							\
 	if ((rc = DosCreateEventSem(NULL,c,0,0)))		\
-	    croak("panic: COND_INIT: rc=%i", rc);		\
+	    Perl_croak_nocontext("panic: COND_INIT: rc=%i", rc);	\
     } STMT_END
 #define COND_SIGNAL(c) \
     STMT_START {						\
 	int rc;							\
-	if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)		\
-	    croak("panic: COND_SIGNAL, rc=%ld", rc);		\
+	if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)\
+	    Perl_croak_nocontext("panic: COND_SIGNAL, rc=%ld", rc);	\
     } STMT_END
 #define COND_BROADCAST(c) \
     STMT_START {						\
 	int rc;							\
 	if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)\
-	    croak("panic: COND_BROADCAST, rc=%i", rc);		\
+	    Perl_croak_nocontext("panic: COND_BROADCAST, rc=%i", rc);	\
     } STMT_END
 /* #define COND_WAIT(c, m) \
     STMT_START {						\
 	if (WaitForSingleObject(*(c),INFINITE) == WAIT_FAILED)	\
-	    croak("panic: COND_WAIT");				\
+	    Perl_croak_nocontext("panic: COND_WAIT");		\
     } STMT_END
 */
 #define COND_WAIT(c, m) os2_cond_wait(c,m)
@@ -133,8 +143,8 @@ extern int rc;
 #define COND_WAIT_win32(c, m) \
     STMT_START {						\
 	int rc;							\
-	if ((rc = SignalObjectAndWait(*(m),*(c),INFINITE,FALSE)))\
-	    croak("panic: COND_WAIT");				\
+	if ((rc = SignalObjectAndWait(*(m),*(c),INFINITE,FALSE)))	\
+	    Perl_croak_nocontext("panic: COND_WAIT");			\
 	else							\
 	    MUTEX_LOCK(m);					\
     } STMT_END
@@ -142,21 +152,24 @@ extern int rc;
     STMT_START {						\
 	int rc;							\
 	if ((rc = DosCloseEventSem(*(c))))			\
-	    croak("panic: COND_DESTROY, rc=%i", rc);		\
+	    Perl_croak_nocontext("panic: COND_DESTROY, rc=%i", rc);	\
     } STMT_END
 /*#define THR ((struct thread *) TlsGetValue(PL_thr_key))
-#define dTHR struct thread *thr = THR
 */
 
 #ifdef USE_SLOW_THREAD_SPECIFIC
 #  define pthread_getspecific(k)	(*_threadstore())
 #  define pthread_setspecific(k,v)	(*_threadstore()=v,0)
 #  define pthread_key_create(keyp,flag)	(*keyp=_gettid(),0)
-#else
+#else /* USE_SLOW_THREAD_SPECIFIC */
 #  define pthread_getspecific(k)	(*(k))
 #  define pthread_setspecific(k,v)	(*(k)=(v),0)
-#  define pthread_key_create(keyp,flag)	(DosAllocThreadLocalMemory(1,(U32*)keyp) ? croak("LocalMemory"),1 : 0)
-#endif
+#  define pthread_key_create(keyp,flag)			\
+	( DosAllocThreadLocalMemory(1,(U32*)keyp)	\
+	  ? Perl_croak_nocontext("LocalMemory"),1	\
+	  : 0						\
+	)
+#endif /* USE_SLOW_THREAD_SPECIFIC */
 #define pthread_key_delete(keyp)
 #define pthread_self()			_gettid()
 #define YIELD				DosSleep(0)
@@ -166,26 +179,41 @@ int pthread_join(pthread_t tid, void **status);
 int pthread_detach(pthread_t tid);
 int pthread_create(pthread_t *tid, const pthread_attr_t *attr,
 		   void *(*start_routine)(void*), void *arg);
-#endif 
+#endif /* PTHREAD_INCLUDED */
 
 #define THREADS_ELSEWHERE
 
-#endif 
+#else /* USE_THREADS */
+
+#define do_spawn(a)      os2_do_spawn(a)
+#define do_aspawn(a,b,c) os2_do_aspawn((a),(b),(c))
+
+#endif /* USE_THREADS */
  
 void Perl_OS2_init(char **);
 
 /* XXX This code hideously puts env inside: */
 
-#ifdef __EMX__
+#ifdef PERL_CORE
+#  define PERL_SYS_INIT3(argcp, argvp, envp) STMT_START {	\
+    _response(argcp, argvp);			\
+    _wildcard(argcp, argvp);			\
+    Perl_OS2_init(*envp);	} STMT_END
 #  define PERL_SYS_INIT(argcp, argvp) STMT_START {	\
     _response(argcp, argvp);			\
     _wildcard(argcp, argvp);			\
-    Perl_OS2_init(env);	} STMT_END
-#else  /* Compiling embedded Perl with non-EMX compiler */
+    Perl_OS2_init(NULL);	} STMT_END
+#else  /* Compiling embedded Perl or Perl extension */
+#  define PERL_SYS_INIT3(argcp, argvp, envp) STMT_START {	\
+    Perl_OS2_init(*envp);	} STMT_END
 #  define PERL_SYS_INIT(argcp, argvp) STMT_START {	\
-    Perl_OS2_init(env);	} STMT_END
+    Perl_OS2_init(NULL);	} STMT_END
+#endif
+
+#ifndef __EMX__
 #  define PERL_CALLCONV _System
 #endif
+
 #define PERL_SYS_TERM()		MALLOC_TERM
 
 /* #define PERL_SYS_TERM() STMT_START {	\
@@ -214,20 +242,38 @@ void *sys_alloc(int size);
 #  define PerlIO FILE
 #endif 
 
-#define TMPPATH tmppath
+/* os2ish is used from a2p/a2p.h without pTHX/pTHX_ first being
+ * defined.  Hack around this to get us to compile.
+*/
+#ifdef PTHX_UNUSED
+# ifndef pTHX
+#  define pTHX
+# endif
+# ifndef pTHX_
+#  define pTHX_
+# endif
+#endif
+
 #define TMPPATH1 "plXXXXXX"
 extern char *tmppath;
-PerlIO *my_syspopen(char *cmd, char *mode);
+PerlIO *my_syspopen(pTHX_ char *cmd, char *mode);
 /* Cannot prototype with I32 at this point. */
 int my_syspclose(PerlIO *f);
 FILE *my_tmpfile (void);
 char *my_tmpnam (char *);
+int my_mkdir (__const__ char *, long);
+int my_rmdir (__const__ char *);
+
+#undef L_tmpnam
+#define L_tmpnam MAXPATHLEN
 
 #define tmpfile	my_tmpfile
 #define tmpnam	my_tmpnam
 #define isatty	_isterm
 #define rand	random
 #define srand	srandom
+#define strtoll	_strtoll
+#define strtoull	_strtoull
 
 /*
  * fwrite1() should be a routine with the same calling sequence as fwrite(),
@@ -239,6 +285,8 @@ char *my_tmpnam (char *);
 
 #define my_getenv(var) getenv(var)
 #define flock	my_flock
+#define rmdir	my_rmdir
+#define mkdir	my_mkdir
 
 void *emx_calloc (size_t, size_t);
 void emx_free (void *);
@@ -262,6 +310,9 @@ void *emx_realloc (void *, size_t);
 	 ? (--FILE_ptr(fp), ++FILE_cnt(fp), (int)c) : ungetc(c,fp))
 #endif
 
+/* ctermid is missing from emx0.9d */
+char *ctermid(char *s);
+
 #define OP_BINARY O_BINARY
 
 #define OS2_STAT_HACK 1
@@ -311,6 +362,7 @@ extern OS2_Perl_data_t OS2_Perl_data;
 #define Perl_rc			(OS2_Perl_data.rc)
 #define Perl_severity		(OS2_Perl_data.severity)
 #define errno_isOS2		12345678
+#define errno_isOS2_set		12345679
 #define OS2_Perl_flags	(OS2_Perl_data.flags)
 #define Perl_HAB_set_f	1
 #define Perl_HAB_set	(OS2_Perl_flags & Perl_HAB_set_f)
@@ -332,6 +384,7 @@ void	Perl_Deregister_MQ(int serve);
 int	Perl_Serve_Messages(int force);
 /* Cannot prototype with I32 at this point. */
 int	Perl_Process_Messages(int force, long *cntp);
+char	*os2_execname(pTHX);
 
 struct _QMSG;
 struct PMWIN_entries_t {
@@ -345,27 +398,40 @@ struct PMWIN_entries_t {
 		  unsigned long hwndFilter, unsigned long msgFilterFirst,
 		  unsigned long msgFilterLast);
     void * (*DispatchMsg)(unsigned long hab, struct _QMSG *pqmsg);
+    unsigned long (*GetLastError)(unsigned long hab);
+    unsigned long (*CancelShutdown)(unsigned long hmq, unsigned long fCancelAlways);
 };
 extern struct PMWIN_entries_t PMWIN_entries;
 void init_PMWIN_entries(void);
 
-#define perl_hmq_GET(serve)	Perl_Register_MQ(serve);
-#define perl_hmq_UNSET(serve)	Perl_Deregister_MQ(serve);
+#define perl_hmq_GET(serve)	Perl_Register_MQ(serve)
+#define perl_hmq_UNSET(serve)	Perl_Deregister_MQ(serve)
+
+#define OS2_XS_init() (*OS2_Perl_data.xs_init)(aTHX)
+
+#if _EMX_CRT_REV_ >= 60
+# define os2_setsyserrno(rc)	(Perl_rc = rc, errno = errno_isOS2_set, \
+				_setsyserrno(rc))
+#else
+# define os2_setsyserrno(rc)	(Perl_rc = rc, errno = errno_isOS2)
+#endif
 
-#define OS2_XS_init() (*OS2_Perl_data.xs_init)()
 /* The expressions below return true on error. */
 /* INCL_DOSERRORS needed. rc should be declared outside. */
 #define CheckOSError(expr) (!(rc = (expr)) ? 0 : (FillOSError(rc), 1))
 /* INCL_WINERRORS needed. */
 #define SaveWinError(expr) ((expr) ? : (FillWinError, 0))
 #define CheckWinError(expr) ((expr) ? 0: (FillWinError, 1))
-#define FillOSError(rc) (Perl_rc = rc,					\
-			errno = errno_isOS2,				\
+#define FillOSError(rc) (os2_setsyserrno(rc),				\
 			Perl_severity = SEVERITY_ERROR) 
-#define FillWinError (Perl_rc = WinGetLastError(Perl_hab),		\
-			errno = errno_isOS2,				\
+
+/* At this moment init_PMWIN_entries() should be a nop (WinInitialize should
+   be called already, right?), so we do not risk stepping over our own error */
+#define FillWinError (	init_PMWIN_entries(),				\
+			Perl_rc=(*PMWIN_entries.GetLastError)(perl_hab_GET()),\
 			Perl_severity = ERRORIDSEV(Perl_rc),		\
-			Perl_rc = ERRORIDERROR(Perl_rc)) 
+			Perl_rc = ERRORIDERROR(Perl_rc),		\
+			os2_setsyserrno(Perl_rc))
 
 #define STATIC_FILE_LENGTH 127
 
@@ -385,7 +451,7 @@ char *os2error(int rc);
 #define QSS_FILE	8		/* Buggy until fixpack18 */
 #define QSS_SHARED	16
 
-#ifdef _OS2EMX_H
+#ifdef _OS2_H
 
 APIRET APIENTRY Dos32QuerySysState(ULONG func,ULONG arg1,ULONG pid,
 			ULONG _res_,PVOID buf,ULONG bufsz);
@@ -543,5 +609,5 @@ typedef struct {
 
 PQTOPLEVEL get_sysinfo(ULONG pid, ULONG flags);
 
-#endif /* _OS2EMX_H */
+#endif /* _OS2_H */