/* 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? */
#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
*/
#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)
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 **);
# define PerlIO FILE
#endif
+/* 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
int Perl_Serve_Messages(int force);
/* Cannot prototype with I32 at this point. */
int Perl_Process_Messages(int force, long *cntp);
-char *os2_execname(void);
+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 OS2_XS_init() (*OS2_Perl_data.xs_init)()
+#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, \
#define CheckWinError(expr) ((expr) ? 0: (FillWinError, 1))
#define FillOSError(rc) (os2_setsyserrno(rc), \
Perl_severity = SEVERITY_ERROR)
-#define FillWinError (Perl_severity = ERRORIDSEV(Perl_rc), \
- Perl_rc = ERRORIDERROR(Perl_rc)), \
- os2_setsyserrno(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()),\
+ Perl_severity = ERRORIDSEV(Perl_rc), \
+ Perl_rc = ERRORIDERROR(Perl_rc), \
+ os2_setsyserrno(Perl_rc))
#define STATIC_FILE_LENGTH 127