*/
#define HAS_UTIME /**/
+/* BIG_TIME:
+ * This symbol is defined if Time_t is an unsigned type on this system.
+ */
+#define BIG_TIME
+
#define HAS_KILL
#define HAS_WAIT
#define HAS_DLERROR
*/
#undef USEMYBINMODE
+#define SOCKET_OPEN_MODE "b"
+
/* Stat_t:
* This symbol holds the type used to declare buffers for information
* returned by stat(). It's usually just struct stat. It may be necessary
# undef I_SYS_UN
#endif
-#ifdef USE_5005THREADS
+#ifdef USE_ITHREADS
#define do_spawn(a) os2_do_spawn(aTHX_ (a))
#define do_aspawn(a,b,c) os2_do_aspawn(aTHX_ (a),(b),(c))
# define pthread_getspecific(k) (*(k))
# define pthread_setspecific(k,v) (*(k)=(v),0)
# define pthread_key_create(keyp,flag) \
- ( DosAllocThreadLocalMemory(1,(U32*)keyp) \
+ ( DosAllocThreadLocalMemory(1,(unsigned long**)keyp) \
? Perl_croak_nocontext("LocalMemory"),1 \
: 0 \
)
#define THREADS_ELSEWHERE
-#else /* USE_5005THREADS */
+#else /* USE_ITHREADS */
#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);
# define PERL_SYS_INIT3(argcp, argvp, envp) \
{ void *xreg[2]; \
+ MALLOC_CHECK_TAINT(*argcp, *argvp, *envp) \
_response(argcp, argvp); \
_wildcard(argcp, argvp); \
Perl_OS2_init3(*envp, xreg, 0)
#endif
#define TMPPATH1 "plXXXXXX"
-extern char *tmppath;
+extern const char *tmppath;
PerlIO *my_syspopen(pTHX_ char *cmd, char *mode);
/* Cannot prototype with I32 at this point. */
int my_syspclose(PerlIO *f);
void my_endpwent (void);
char *gcvt_os2(double value, int digits, char *buffer);
+#define MAX_SLEEP (((1<30) / (1000/4))-1) /* 1<32 msec */
+
+static __inline__ unsigned
+my_sleep(unsigned sec)
+{
+ int remain;
+ while (sec > MAX_SLEEP) {
+ sec -= MAX_SLEEP;
+ remain = sleep(MAX_SLEEP);
+ if (remain)
+ return remain + sec;
+ }
+ return sleep(sec);
+}
+
+#define sleep my_sleep
+
+#ifndef INCL_DOS
+unsigned long DosSleep(unsigned long);
+unsigned long DosAllocThreadLocalMemory (unsigned long cb, unsigned long **p);
+#endif
+
struct group *getgrent (void);
void setgrent (void);
void endgrent (void);
#define strtoll _strtoll
#define strtoull _strtoull
+#define usleep(usec) ((void)_sleep2(((usec)+500)/1000))
+
+
/*
* fwrite1() should be a routine with the same calling sequence as fwrite(),
* but which outputs all of the bytes requested as a single stream (unlike
#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);
#if OS2_STAT_HACK
#define Stat(fname,bufptr) os2_stat((fname),(bufptr))
-#define Fstat(fd,bufptr) fstat((fd),(bufptr))
+#define Fstat(fd,bufptr) os2_fstat((fd),(bufptr))
#define Fflush(fp) fflush(fp)
#define Mkdir(path,mode) mkdir((path),(mode))
+#define chmod(path,mode) os2_chmod((path),(mode))
#undef S_IFBLK
#undef S_ISBLK
-#define S_IFBLK 0120000
+#define S_IFBLK 0120000 /* Hacks to make things compile... */
#define S_ISBLK(mode) (((mode) & S_IFMT) == S_IFBLK)
+int os2_chmod(const char *name, int pmode);
+int os2_fstat(int handle, struct stat *st);
+
#else
#define Stat(fname,bufptr) stat((fname),(bufptr))
unsigned long phmq_refcnt;
unsigned long phmq_servers;
unsigned long initial_mode; /* VIO etc. mode we were started in */
+ unsigned long morph_refcnt;
} OS2_Perl_data_t;
extern OS2_Perl_data_t OS2_Perl_data;
#define Perl_hmq_refcnt (OS2_Perl_data.phmq_refcnt)
#define Perl_hmq_servers (OS2_Perl_data.phmq_servers)
#define Perl_os2_initial_mode (OS2_Perl_data.initial_mode)
+#define Perl_morph_refcnt (OS2_Perl_data.morph_refcnt)
unsigned long Perl_hab_GET();
unsigned long Perl_Register_MQ(int serve);
/* The expressions below return true on error. */
/* INCL_DOSERRORS needed. rc should be declared outside. */
-#define CheckOSError(expr) (!(rc = (expr)) ? 0 : (FillOSError(rc), 1))
+#define CheckOSError(expr) ((rc = (expr)) ? (FillOSError(rc), rc) : 0)
/* 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_Dos32QueryHeaderInfo,
+ ORD_DosTmrQueryFreq,
+ ORD_DosTmrQueryTime,
+ ORD_WinQueryActiveDesktopPathname,
+ ORD_WinInvalidateRect,
+ ORD_WinCreateFrameControls,
+ ORD_WinQueryClipbrdFmtInfo,
+ ORD_WinQueryClipbrdOwner,
+ ORD_WinQueryClipbrdViewer,
+ ORD_WinQueryClipbrdData,
+ ORD_WinOpenClipbrd,
+ ORD_WinCloseClipbrd,
+ ORD_WinSetClipbrdData,
+ ORD_WinSetClipbrdOwner,
+ ORD_WinSetClipbrdViewer,
+ ORD_WinEnumClipbrdFmts,
+ ORD_WinEmptyClipbrd,
+ ORD_WinAddAtom,
+ ORD_WinFindAtom,
+ ORD_WinDeleteAtom,
+ ORD_WinQueryAtomUsage,
+ ORD_WinQueryAtomName,
+ ORD_WinQueryAtomLength,
+ ORD_WinQuerySystemAtomTable,
+ ORD_WinCreateAtomTable,
+ ORD_WinDestroyAtomTable,
+ ORD_WinOpenWindowDC,
+ ORD_DevOpenDC,
+ ORD_DevQueryCaps,
+ ORD_DevCloseDC,
+ ORD_WinMessageBox,
+ ORD_WinMessageBox2,
+ ORD_WinQuerySysValue,
+ ORD_WinSetSysValue,
+ ORD_WinAlarm,
+ ORD_WinFlashWindow,
+ ORD_WinLoadPointer,
+ ORD_WinQuerySysPointer,
+ ORD_DosReplaceModule,
+ ORD_DosPerfSysCall,
+ ORD_RexxRegisterSubcomExe,
ORD_NENTRIES
};
#define DeclVoidFuncByORD(name,o,at,args) \
void name at { CallORD(void,o,at,args); }
-/* These functions return false on error, and save the error info in $^E */
+/* This function returns error code on error, and saves the error info in $^E and Perl_rc */
+#define DeclOSFuncByORD_native(ret,name,o,at,args) \
+ ret name at { unsigned long rc; return CheckOSError(CallORD(ret,o,at,args)); }
+
+/* These functions return false on error, and save the error info in $^E and Perl_rc */
#define DeclOSFuncByORD(ret,name,o,at,args) \
ret name at { unsigned long rc; return !CheckOSError(CallORD(ret,o,at,args)); }
#define DeclWinFuncByORD(ret,name,o,at,args) \
#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);
+#define fork fork_with_resources
+
+#ifdef EINTR /* x2p do not include perl.h!!! */
+static __inline__ int
+my_select(int nfds, fd_set *readfds, fd_set *writefds, fd_set *exceptfds, struct timeval *timeout)
+{
+ if (nfds == 0 && timeout && (_emx_env & 0x200)) {
+ if (DosSleep(1000 * timeout->tv_sec + (timeout->tv_usec + 500)/1000) == 0)
+ return 0;
+ errno = EINTR;
+ return -1;
+ }
+ return select(nfds, readfds, writefds, exceptfds, timeout);
+}
+
+#define select my_select
+#endif
+
+
typedef int (*Perl_PFN)();
Perl_PFN loadByOrdinal(enum entries_ordinals ord, int fail);
extern const Perl_PFN * const pExtFCN;
char *os2error(int rc);
int os2_stat(const char *name, struct stat *st);
+int fork_with_resources();
int setpriority(int which, int pid, int val);
int getpriority(int which /* ignored */, int pid);
+void croak_with_os2error(char *s) __attribute__((noreturn));
+
#ifdef PERL_CORE
int os2_do_spawn(pTHX_ char *cmd);
-int os2_do_aspawn(pTHX_ SV *really, void **vmark, void **vsp);
+int os2_do_aspawn(pTHX_ SV *really, SV **vmark, SV **vsp);
#endif
#ifndef LOG_DAEMON
https://perl5.git.perl.org / perl5.git / blobdiff