/* 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.
*/
#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
#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;
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)
#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
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
*/
-#define pthread_getspecific(k) (*_threadstore())
-#define pthread_setspecific(k,v) (*_threadstore()=v,0)
+#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 pthread_key_create(keyp,flag) (*keyp=_gettid(),0)
-#define sched_yield() DosSleep(0)
+#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
+#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 { \
# 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(),
#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 *);
? (--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
#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)
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 {
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
#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);
PQTOPLEVEL get_sysinfo(ULONG pid, ULONG flags);
-#endif /* _OS2EMX_H */
+#endif /* _OS2_H */