# undef I_SYS_UN
#endif
-#ifdef USE_5005THREADS
-
-#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;
-
-#define MUTEX_INIT(m) \
- STMT_START { \
- int rc; \
- if ((rc = _rmutex_create(m,0))) \
- 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))) \
- Perl_croak_nocontext("panic: MUTEX_LOCK: rc=%i", rc); \
- } STMT_END
-#define MUTEX_UNLOCK(m) \
- STMT_START { \
- int rc; \
- if ((rc = _rmutex_release(m))) \
- Perl_croak_nocontext("panic: MUTEX_UNLOCK: rc=%i", rc); \
- } STMT_END
-#define MUTEX_DESTROY(m) \
- STMT_START { \
- int rc; \
- if ((rc = _rmutex_close(m))) \
- 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))) \
- 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)\
- 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)\
- Perl_croak_nocontext("panic: COND_BROADCAST, rc=%i", rc); \
- } STMT_END
-/* #define COND_WAIT(c, m) \
- STMT_START { \
- if (WaitForSingleObject(*(c),INFINITE) == WAIT_FAILED) \
- Perl_croak_nocontext("panic: COND_WAIT"); \
- } STMT_END
-*/
-#define COND_WAIT(c, m) os2_cond_wait(c,m)
-
-#define COND_WAIT_win32(c, m) \
- STMT_START { \
- int rc; \
- if ((rc = SignalObjectAndWait(*(m),*(c),INFINITE,FALSE))) \
- Perl_croak_nocontext("panic: COND_WAIT"); \
- else \
- MUTEX_LOCK(m); \
- } STMT_END
-#define COND_DESTROY(c) \
- STMT_START { \
- int rc; \
- if ((rc = DosCloseEventSem(*(c)))) \
- Perl_croak_nocontext("panic: COND_DESTROY, rc=%i", rc); \
- } STMT_END
-/*#define THR ((struct thread *) TlsGetValue(PL_thr_key))
-*/
-
-#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 /* 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) \
- ? Perl_croak_nocontext("LocalMemory"),1 \
- : 0 \
- )
-#endif /* USE_SLOW_THREAD_SPECIFIC */
-#define pthread_key_delete(keyp)
-#define pthread_self() _gettid()
-#define YIELD DosSleep(0)
-
-#ifdef PTHREADS_INCLUDED /* For ./x2p stuff. */
-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 /* PTHREAD_INCLUDED */
-
-#define THREADS_ELSEWHERE
-
-#else /* USE_5005THREADS */
-
#define do_spawn(a) os2_do_spawn(a)
#define do_aspawn(a,b,c) os2_do_aspawn((a),(b),(c))
-
-#endif /* USE_5005THREADS */
void Perl_OS2_init(char **);
void Perl_OS2_init3(char **envp, void **excH, int flags);
struct passwd *my_getpwent (void);
void my_setpwent (void);
void my_endpwent (void);
+char *gcvt_os2(double value, int digits, char *buffer);
struct group *getgrent (void);
void setgrent (void);
#include <stdlib.h> /* before the following definitions */
#include <unistd.h> /* before the following definitions */
+#include <fcntl.h>
+#include <sys/stat.h>
#define chdir _chdir2
#define getcwd _getcwd2
? (--FILE_ptr(fp), ++FILE_cnt(fp), (int)c) : ungetc(c,fp))
#endif
+#define PERLIO_IS_BINMODE_FD(fd) _PERLIO_IS_BINMODE_FD(fd)
+
+#ifdef __GNUG__
+# define HAS_BOOL
+#endif
+#ifndef HAS_BOOL
+# define bool char
+# define HAS_BOOL 1
+#endif
+
+#include <emx/io.h> /* for _fd_flags() prototype */
+
+static inline bool
+_PERLIO_IS_BINMODE_FD(int fd)
+{
+ int *pflags = _fd_flags(fd);
+
+ return pflags && (*pflags) & O_BINARY;
+}
+
/* ctermid is missing from emx0.9d */
char *ctermid(char *s);
/* 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))
+
+/* This form propagates the return value, setting $^E if needed */
+#define SaveWinError(expr) ((expr) ? : (FillWinError, 0))
+
+/* This form propagates the return value, dieing with $^E if needed */
+#define SaveCroakWinError(expr,die,name1,name2) \
+ ((expr) ? : (CroakWinError(die,name1 name2), 0))
+
#define FillOSError(rc) (os2_setsyserrno(rc), \
Perl_severity = SEVERITY_ERROR)
+#define WinError_2_Perl_rc \
+ ( init_PMWIN_entries(), \
+ Perl_rc=(*PMWIN_entries.GetLastError)(perl_hab_GET()) )
+
+/* Calling WinGetLastError() resets the error code of the current thread.
+ Since for some Win* API return value 0 is normal, one needs to call
+ this before calling them to distinguish normal and anomalous returns. */
+/*#define ResetWinError() WinError_2_Perl_rc */
+
/* 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()),\
+#define FillWinError ( WinError_2_Perl_rc, \
Perl_severity = ERRORIDSEV(Perl_rc), \
Perl_rc = ERRORIDERROR(Perl_rc), \
os2_setsyserrno(Perl_rc))
ORD_WinWindowFromId,
ORD_WinWindowFromPoint,
ORD_WinPostMsg,
+ ORD_WinEnableWindow,
+ ORD_WinEnableWindowUpdate,
+ ORD_WinIsWindowEnabled,
+ ORD_WinIsWindowShowing,
+ ORD_WinIsWindowVisible,
+ ORD_WinQueryWindowPtr,
+ ORD_WinQueryWindowULong,
+ ORD_WinQueryWindowUShort,
+ ORD_WinSetWindowBits,
+ ORD_WinSetWindowPtr,
+ ORD_WinSetWindowULong,
+ ORD_WinSetWindowUShort,
+ ORD_WinQueryDesktopWindow,
+ ORD_WinSetActiveWindow,
+ ORD_DosQueryModFromEIP,
ORD_NENTRIES
};
#define AssignFuncPByORD(p,o) (*(Perl_PFN*)&(p) = (loadByOrdinal(o, 1)))
+/* This flavor caches the procedure pointer (named as p__Win#name) locally */
+#define DeclWinFuncByORD_CACHE(ret,name,o,at,args) \
+ DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,0,1)
+
+/* This flavor may reset the last error before the call (if ret=0 may be OK) */
+#define DeclWinFuncByORD_CACHE_resetError(ret,name,o,at,args) \
+ DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,1,1)
+
+/* Two flavors below do the same as above, but do not auto-croak */
+/* This flavor caches the procedure pointer (named as p__Win#name) locally */
+#define DeclWinFuncByORD_CACHE_survive(ret,name,o,at,args) \
+ DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,0,0)
+
+/* This flavor may reset the last error before the call (if ret=0 may be OK) */
+#define DeclWinFuncByORD_CACHE_resetError_survive(ret,name,o,at,args) \
+ DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,1,0)
+
+#define DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,r,die) \
+ static ret (*CAT2(p__Win,name)) at; \
+ static ret name at { \
+ if (!CAT2(p__Win,name)) \
+ AssignFuncPByORD(CAT2(p__Win,name), o); \
+ if (r) ResetWinError(); \
+ return SaveCroakWinError(CAT2(p__Win,name) args, die, "[Win]", STRINGIFY(name)); }
+
+/* These flavors additionally assume ORD is name with prepended ORD_Win */
+#define DeclWinFunc_CACHE(ret,name,at,args) \
+ DeclWinFuncByORD_CACHE(ret,name,CAT2(ORD_Win,name),at,args)
+#define DeclWinFunc_CACHE_resetError(ret,name,at,args) \
+ DeclWinFuncByORD_CACHE_resetError(ret,name,CAT2(ORD_Win,name),at,args)
+#define DeclWinFunc_CACHE_survive(ret,name,at,args) \
+ DeclWinFuncByORD_CACHE_survive(ret,name,CAT2(ORD_Win,name),at,args)
+#define DeclWinFunc_CACHE_resetError_survive(ret,name,at,args) \
+ DeclWinFuncByORD_CACHE_resetError_survive(ret,name,CAT2(ORD_Win,name),at,args)
+
+void ResetWinError(void);
+void CroakWinError(int die, char *name);
+
#define PERLLIB_MANGLE(s, n) perllib_mangle((s), (n))
char *perllib_mangle(char *, unsigned int);