develooper Front page | perl.perl5.porters | Postings from September 2003

[PATCH 5.8.1 @21211] OS/2 APIs again

From:
Ilya Zakharevich
Date:
September 16, 2003 23:49
Subject:
[PATCH 5.8.1 @21211] OS/2 APIs again
Message ID:
20030917064941.GA20444@math.berkeley.edu
a) The C macros for idiomatic access to OS/2 API were not ideal:

   a1) CheckOSError() was not propagating the exact error code (only 0 and 1);

   a2) DeclOSFuncByORD() was negating the exit code of the API, and
       while it preserved the return value in a safe location, it was
       not documented good enough; the patch documents things, and
       adds a new flavor without the loss of info;

b) To reliably load DLLs from virtual file systems (e.g., from ZIP
   files), an access to special API is needed ("we are going to erase
   the DLL, so please stop memory mapping its pages to the file system").
   Obviously, this cannot be delegated to a dynamically loadable module...

   So a new entry point OS2::replaceModule() is introduced.

Yours,
Ilya

--- ./os2/os2ish.h-pre	Sun Aug  3 13:28:02 2003
+++ ./os2/os2ish.h	Tue Sep 16 23:35:28 2003
@@ -532,7 +532,7 @@ void init_PMWIN_entries(void);
 
 /* 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 CheckWinError(expr) ((expr) ? 0: (FillWinError, 1))
 
@@ -681,6 +681,7 @@ enum entries_ordinals {
     ORD_WinFlashWindow,
     ORD_WinLoadPointer,
     ORD_WinQuerySysPointer,
+    ORD_DosReplaceModule,
     ORD_NENTRIES
 };
 
@@ -691,7 +692,11 @@ enum entries_ordinals {
 #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)	\
--- ./os2/os2.c-pre	Sat Sep 13 14:26:24 2003
+++ ./os2/os2.c	Tue Sep 16 23:36:46 2003
@@ -619,6 +619,7 @@ static const struct {
   {&pmwin_handle, NULL, 745},		/* WinFlashWindow */
   {&pmwin_handle, NULL, 780},		/* WinLoadPointer */
   {&pmwin_handle, NULL, 828},		/* WinQuerySysPointer */
+  {&doscalls_handle, NULL, 417},	/* DosReplaceModule */
 };
 
 HMODULE
@@ -1828,6 +1829,29 @@ XS(XS_File__Copy_syscopy)
     XSRETURN(1);
 }
 
+/* APIRET APIENTRY DosReplaceModule (PCSZ pszOld, PCSZ pszNew, PCSZ pszBackup); */
+
+DeclOSFuncByORD(ULONG,replaceModule,ORD_DosReplaceModule,
+		(char *old, char *new, char *backup), (old, new, backup))
+
+XS(XS_OS2_replaceModule); /* prototype to pass -Wmissing-prototypes */
+XS(XS_OS2_replaceModule)
+{
+    dXSARGS;
+    if (items < 1 || items > 3)
+	Perl_croak(aTHX_ "Usage: OS2::replaceModule(target [, source [, backup]])");
+    {
+	char *	target = (char *)SvPV_nolen(ST(0));
+	char *	source = (items < 2) ? Nullch : (char *)SvPV_nolen(ST(1));
+	char *	backup = (items < 3) ? Nullch : (char *)SvPV_nolen(ST(2));
+
+	if (!replaceModule(target, source, backup))
+	    croak_with_os2error("replaceModule() error");
+    }
+    XSRETURN_EMPTY;
+}
+
+
 #define PERL_PATCHLEVEL_H_IMPLICIT	/* Do not init local_patches. */
 #include "patchlevel.h"
 #undef PERL_PATCHLEVEL_H_IMPLICIT
@@ -3478,6 +3502,7 @@ Xs_OS2_init(pTHX)
         newXS("Cwd::sys_is_relative", XS_Cwd_sys_is_relative, file);
         newXS("Cwd::sys_cwd", XS_Cwd_sys_cwd, file);
         newXS("Cwd::sys_abspath", XS_Cwd_sys_abspath, file);
+        newXS("OS2::replaceModule", XS_OS2_replaceModule, file);
         newXSproto("OS2::_control87", XS_OS2__control87, file, "$$");
         newXSproto("OS2::get_control87", XS_OS2_get_control87, file, "");
         newXSproto("OS2::set_control87", XS_OS2_set_control87, file, ";$$");



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About