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

[HACK] microperl-5.16.1 for win32

Thread Next
From:
Roy Tam
Date:
September 13, 2012 10:28
Subject:
[HACK] microperl-5.16.1 for win32
Message ID:
op.wkjw6vak074as3@2fprep
Hello all,

I hacked perl-5.16.1 source for compiling microperl-5.16.1 under  
Strawberry Perl 5.16.1 (MinGW gcc 4.6.3) and enabled %ENV in microperl.

Patch is inlined:

diff -rU8 perl-5.16.1/Makefile.micro  
perl-5.16.1-microperlw32/Makefile.micro
--- perl-5.16.1/Makefile.micro	2012-04-25 08:18:30.000000000 +0800
+++ perl-5.16.1-microperlw32/Makefile.micro	2012-09-13 09:29:03.952247700  
+0800
@@ -1,33 +1,33 @@
  LD = $(CC)
  CCFLAGS = -c
  DEFINES = -DPERL_CORE -DPERL_MICRO -DSTANDARD_C -DPERL_USE_SAFE_PUTENV \
-	  -DNO_MATHOMS
-OPTIMIZE =
+	  -DNO_MATHOMS -DPERL_STATIC_SYMS
+OPTIMIZE = -Os -mpreferred-stack-boundary=2 -fomit-frame-pointer  
-fno-strict-aliasing -fno-exceptions -fno-asynchronous-unwind-tables  
-fno-unwind-tables -Iwin32 -Iwin32/include -I.
  CFLAGS = $(DEFINES) $(OPTIMIZE)
-LDFLAGS =
-LIBS = -lm
+LDFLAGS = -s
+LIBS = -lm -lcomctl32 -lwsock32 -lws2_32
  _O = .o
  ENV = env
  PERL = perl
  _X =
  RUN =

  all:	microperl

  O = uav$(_O) udeb$(_O) udoio$(_O) udoop$(_O) udump$(_O) \
  	uglobals$(_O) ugv$(_O) uhv$(_O) umro$(_O)\
  	umg$(_O) uperlmain$(_O) uop$(_O) ureentr$(_O) \
  	upad$(_O) uperl$(_O) uperlio$(_O) uperly$(_O) upp$(_O) \
  	upp_ctl$(_O) upp_hot$(_O) upp_sys$(_O) upp_pack$(_O) upp_sort$(_O) \
  	uregcomp$(_O) uregexec$(_O) urun$(_O) \
  	uscope$(_O) usv$(_O) utaint$(_O) utoke$(_O) \
  	unumeric$(_O) ulocale$(_O) umathoms$(_O) \
-	uuniversal$(_O) uutf8$(_O) uutil$(_O) uperlapi$(_O) ukeywords$(_O)
+	uuniversal$(_O) uutf8$(_O) uutil$(_O) uperlapi$(_O) ukeywords$(_O)  
win32$(_O) win32sck$(_O) fcrypt$(_O)

  microperl:	$(O)
  	$(LD) -o $@ $(O) $(LDFLAGS) $(LIBS)

  generated_headers = uuudmap.h ubitcount.h umg_data.h
  H = av.h uconfig.h cop.h cv.h embed.h embedvar.h form.h gv.h handy.h \
  	hv.h intrpvar.h iperlsys.h mg.h op.h opcode.h opnames.h pad.h \
  	patchlevel.h perl.h perlsdio.h perlvars.h perly.h pp.h \
@@ -167,16 +167,25 @@
  	$(CC) $(CCFLAGS) -o $@ $(CFLAGS) mathoms.c

  uuniversal$(_O):	$(HE) universal.c XSUB.h
  	$(CC) $(CCFLAGS) -o $@ $(CFLAGS) universal.c

  uutf8$(_O):	$(HE) utf8.c
  	$(CC) $(CCFLAGS) -o $@ $(CFLAGS) utf8.c

+win32$(_O):	$(HE) win32/win32.c
+	$(CC) $(CCFLAGS) -o $@ $(CFLAGS) win32/win32.c
+
+win32sck$(_O):	$(HE) win32/win32sck.c
+	$(CC) $(CCFLAGS) -o $@ $(CFLAGS) win32/win32sck.c
+
+fcrypt$(_O):	$(HE) win32/fcrypt.c
+	$(CC) $(CCFLAGS) -o $@ $(CFLAGS) win32/fcrypt.c
+
  uutil$(_O):	$(HE) util.c
  	$(CC) $(CCFLAGS) -o $@ $(CFLAGS) util.c

  uperlapi$(_O):	$(HE) perlapi.c perlapi.h
  	$(CC) $(CCFLAGS) -o $@ $(CFLAGS) perlapi.c

  uuudmap.h umg_data.h: ubitcount.h

diff -rU8 perl-5.16.1/mg.c perl-5.16.1-microperlw32/mg.c
--- perl-5.16.1/mg.c	2012-08-04 01:35:26.000000000 +0800
+++ perl-5.16.1-microperlw32/mg.c	2012-09-13 09:22:44.237034400 +0800
@@ -1426,62 +1426,16 @@
  #if defined HAS_SIGPROCMASK
  static void
  unblock_sigmask(pTHX_ void* newset)
  {
      sigprocmask(SIG_UNBLOCK, (sigset_t*)newset, NULL);
  }
  #endif

-void
-Perl_despatch_signals(pTHX)
-{
-    dVAR;
-    int sig;
-    PL_sig_pending = 0;
-    for (sig = 1; sig < SIG_SIZE; sig++) {
-	if (PL_psig_pend[sig]) {
-	    dSAVE_ERRNO;
-#ifdef HAS_SIGPROCMASK
-	    /* From sigaction(2) (FreeBSD man page):
-	     * | Signal routines normally execute with the signal that
-	     * | caused their invocation blocked, but other signals may
-	     * | yet occur.
-	     * Emulation of this behavior (from within Perl) is enabled
-	     * using sigprocmask
-	     */
-	    int was_blocked;
-	    sigset_t newset, oldset;
-
-	    sigemptyset(&newset);
-	    sigaddset(&newset, sig);
-	    sigprocmask(SIG_BLOCK, &newset, &oldset);
-	    was_blocked = sigismember(&oldset, sig);
-	    if (!was_blocked) {
-		SV* save_sv = newSVpvn((char *)(&newset), sizeof(sigset_t));
-		ENTER;
-		SAVEFREESV(save_sv);
-		SAVEDESTRUCTOR_X(unblock_sigmask, SvPV_nolen(save_sv));
-	    }
-#endif
- 	    PL_psig_pend[sig] = 0;
-#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
-	    (*PL_sighandlerp)(sig, NULL, NULL);
-#else
-	    (*PL_sighandlerp)(sig);
-#endif
-#ifdef HAS_SIGPROCMASK
-	    if (!was_blocked)
-		LEAVE;
-#endif
-	    RESTORE_ERRNO;
-	}
-    }
-}
-
  /* sv of NULL signifies that we're acting as magic_clearsig.  */
  int
  Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
  {
      dVAR;
      I32 i;
      SV** svp = NULL;
      /* Need to be careful with SvREFCNT_dec(), because that can have side
@@ -1628,16 +1582,62 @@
      if(i)
  	LEAVE;
  #endif
      SvREFCNT_dec(to_dec);
      return 0;
  }
  #endif /* !PERL_MICRO */

+void
+Perl_despatch_signals(pTHX)
+{
+    dVAR;
+    int sig;
+    PL_sig_pending = 0;
+    for (sig = 1; sig < SIG_SIZE; sig++) {
+	if (PL_psig_pend[sig]) {
+	    dSAVE_ERRNO;
+#ifdef HAS_SIGPROCMASK
+	    /* From sigaction(2) (FreeBSD man page):
+	     * | Signal routines normally execute with the signal that
+	     * | caused their invocation blocked, but other signals may
+	     * | yet occur.
+	     * Emulation of this behavior (from within Perl) is enabled
+	     * using sigprocmask
+	     */
+	    int was_blocked;
+	    sigset_t newset, oldset;
+
+	    sigemptyset(&newset);
+	    sigaddset(&newset, sig);
+	    sigprocmask(SIG_BLOCK, &newset, &oldset);
+	    was_blocked = sigismember(&oldset, sig);
+	    if (!was_blocked) {
+		SV* save_sv = newSVpvn((char *)(&newset), sizeof(sigset_t));
+		ENTER;
+		SAVEFREESV(save_sv);
+		SAVEDESTRUCTOR_X(unblock_sigmask, SvPV_nolen(save_sv));
+	    }
+#endif
+ 	    PL_psig_pend[sig] = 0;
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+	    (*PL_sighandlerp)(sig, NULL, NULL);
+#else
+	    (*PL_sighandlerp)(sig);
+#endif
+#ifdef HAS_SIGPROCMASK
+	    if (!was_blocked)
+		LEAVE;
+#endif
+	    RESTORE_ERRNO;
+	}
+    }
+}
+
  int
  Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
  {
      dVAR;
      PERL_ARGS_ASSERT_MAGIC_SETISA;
      PERL_UNUSED_ARG(sv);

      /* Skip _isaelem because _isa will handle it shortly */
diff -rU8 perl-5.16.1/perl.c perl-5.16.1-microperlw32/perl.c
--- perl-5.16.1/perl.c	2012-08-04 01:35:26.000000000 +0800
+++ perl-5.16.1-microperlw32/perl.c	2012-09-13 09:26:51.499122700 +0800
@@ -320,21 +320,21 @@
      HvSHAREKEYS_off(PL_strtab);			/* mandatory */
      hv_ksplit(PL_strtab, 512);

  #if defined(__DYNAMIC__) && (defined(NeXT) || defined(__NeXT__))
      _dyld_lookup_and_bind
  	("__environ", (unsigned long *) &environ_pointer, NULL);
  #endif /* environ */

-#ifndef PERL_MICRO
+//#ifndef PERL_MICRO
  #   ifdef  USE_ENVIRON_ARRAY
      PL_origenviron = environ;
  #   endif
-#endif
+//#endif

      /* Use sysconf(_SC_CLK_TCK) if available, if not
       * available or if the sysconf() fails, use the HZ.
       * BeOS has those, but returns the wrong value.
       * The HZ if not originally defined has been by now
       * been defined as CLK_TCK, if available. */
  #if defined(HAS_SYSCONF) && defined(_SC_CLK_TCK) && !defined(__BEOS__)
      PL_clocktick = sysconf(_SC_CLK_TCK);
@@ -791,17 +791,17 @@
      PL_exitlistlen = 0;

      SvREFCNT_dec(PL_registered_mros);

      /* jettison our possibly duplicated environment */
      /* if PERL_USE_SAFE_PUTENV is defined environ will not have been  
copied
       * so we certainly shouldn't free it here
       */
-#ifndef PERL_MICRO
+//#ifndef PERL_MICRO
  #if defined(USE_ENVIRON_ARRAY) && !defined(PERL_USE_SAFE_PUTENV)
      if (environ != PL_origenviron && !PL_use_safe_putenv
  #ifdef USE_ITHREADS
  	/* only main thread can free environ[0] contents */
  	&& PL_curinterp == aTHX
  #endif
  	)
      {
@@ -811,17 +811,17 @@
  	    safesysfree(environ[i]);

  	/* Must use safesysfree() when working with environ. */
  	safesysfree(environ);		

  	environ = PL_origenviron;
      }
  #endif
-#endif /* !PERL_MICRO */
+//#endif /* !PERL_MICRO */

      if (destruct_level == 0) {

  	DEBUG_P(debprofdump());

  #if defined(PERLIO_LAYERS)
  	/* No more IO - including error messages ! */
  	PerlIO_cleanup(aTHX);
@@ -4162,17 +4162,17 @@
  	sv_setpv(GvSV(tmpgv),PL_origfilename);
      }
      if ((PL_envgv = gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV))) {
  	HV *hv;
  	bool env_is_not_environ;
  	GvMULTI_on(PL_envgv);
  	hv = GvHVn(PL_envgv);
  	hv_magic(hv, NULL, PERL_MAGIC_env);
-#ifndef PERL_MICRO
+//#ifndef PERL_MICRO
  #ifdef USE_ENVIRON_ARRAY
  	/* Note that if the supplied env parameter is actually a copy
  	   of the global environ then it may now point to free'd memory
  	   if the environment has been modified since. To avoid this
  	   problem we treat env==NULL as meaning 'use the default'
  	*/
  	if (!env)
  	    env = environ;
@@ -4201,17 +4201,17 @@
  #endif
  	    sv = newSVpv(s+1, 0);
  	    (void)hv_store(hv, old_var, s - old_var, sv, 0);
  	    if (env_is_not_environ)
  	        mg_set(sv);
  	  }
        }
  #endif /* USE_ENVIRON_ARRAY */
-#endif /* !PERL_MICRO */
+//#endif /* !PERL_MICRO */
      }
      TAINT_NOT;

      /* touch @F array to prevent spurious warnings 20020415 MJD */
      if (PL_minus_a) {
        (void) get_av("main::F", GV_ADD | GV_ADDMULTI);
      }
  }
diff -rU8 perl-5.16.1/perl.h perl-5.16.1-microperlw32/perl.h
--- perl-5.16.1/perl.h	2012-08-04 01:35:26.000000000 +0800
+++ perl-5.16.1-microperlw32/perl.h	2012-09-13 09:03:01.514273900 +0800
@@ -3614,17 +3614,17 @@
  #define CLUMP_2UV(iv)	((iv) < 0 ? 0 : (UV)(iv))
  #define CLUMP_2IV(uv)	((uv) > (UV)IV_MAX ? IV_MAX : (IV)(uv))

  #ifndef MAXSYSFD
  #   define MAXSYSFD 2
  #endif

  #ifndef __cplusplus
-#if !(defined(UNDER_CE) || defined(SYMBIAN))
+#if !(defined(UNDER_CE) || defined(SYMBIAN)) && !defined(PERL_MICRO)
  Uid_t getuid (void);
  Uid_t geteuid (void);
  Gid_t getgid (void);
  Gid_t getegid (void);
  #endif
  #endif

  #ifndef Perl_debug_log
@@ -5306,16 +5306,17 @@
  #define SET_NUMERIC_LOCAL()     	/**/
  #define IS_NUMERIC_RADIX(a, b)		(0)
  #define STORE_NUMERIC_LOCAL_SET_STANDARD()	/**/
  #define STORE_NUMERIC_STANDARD_SET_LOCAL()	/**/
  #define RESTORE_NUMERIC_LOCAL()		/**/
  #define RESTORE_NUMERIC_STANDARD()	/**/
  #define Atof				my_atof
  #define IN_LOCALE_RUNTIME		0
+#define IN_LOCALE_COMPILETIME		0

  #endif /* !USE_LOCALE_NUMERIC */

  #if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) &&  
QUADKIND == QUAD_IS_LONG_LONG
  #    ifdef __hpux
  #        define strtoll __strtoll	/* secret handshake */
  #    endif
  #    ifdef WIN64
diff -rU8 perl-5.16.1/pp_sys.c perl-5.16.1-microperlw32/pp_sys.c
--- perl-5.16.1/pp_sys.c	2012-08-04 01:35:26.000000000 +0800
+++ perl-5.16.1-microperlw32/pp_sys.c	2012-09-13 09:21:28.082246600 +0800
@@ -4146,17 +4146,17 @@
  	    (void)SvPV_nolen_const(*MARK);      /* stringify for taint check */
  	    if (PL_tainted)
  		break;
  	}
  	MARK = ORIGMARK;
  	TAINT_PROPER("system");
      }
      PERL_FLUSHALL_FOR_CHILD;
-#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) &&  
!defined(OS2) || defined(PERL_MICRO)
+#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) &&  
!defined(OS2) //|| defined(PERL_MICRO)
      {
  	Pid_t childpid;
  	int pp[2];
  	I32 did_pipes = 0;
  #if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
  	sigset_t newset, oldset;
  #endif

diff -rU8 perl-5.16.1/uconfig.h perl-5.16.1-microperlw32/uconfig.h
--- perl-5.16.1/uconfig.h	2012-08-04 01:35:26.000000000 +0800
+++ perl-5.16.1-microperlw32/uconfig.h	2012-09-13 00:26:44.030500000 +0800
@@ -102,17 +102,17 @@
   *	occurred from a call to dlopen(), dlclose() or dlsym().
   */
  /*#define HAS_DLERROR	/ **/

  /* HAS_DUP2:
   *	This symbol, if defined, indicates that the dup2 routine is
   *	available to duplicate file descriptors.
   */
-/*#define HAS_DUP2	/ **/
+#define HAS_DUP2	1

  /* HAS_FCHMOD:
   *	This symbol, if defined, indicates that the fchmod routine is available
   *	to change mode of opened files.  If unavailable, use chmod().
   */
  /*#define HAS_FCHMOD		/ **/

  /* HAS_FCHOWN:
@@ -138,17 +138,17 @@
   *	available to do file locking.
   */
  /*#define HAS_FLOCK		/ **/

  /* HAS_FORK:
   *	This symbol, if defined, indicates that the fork routine is
   *	available.
   */
-#define HAS_FORK		/**/
+/*#define HAS_FORK		/**/

  /* HAS_FSETPOS:
   *	This symbol, if defined, indicates that the fsetpos routine is
   *	available to set the file position indicator, similar to fseek().
   */
  /*#define HAS_FSETPOS	/ **/

  /* HAS_GETTIMEOFDAY:
@@ -2711,17 +2711,17 @@
   */
  /* Direntry_t:
   *	This symbol is set to 'struct direct' or 'struct dirent' depending on
   *	whether dirent is available or not. You should use this pseudo type to
   *	portably declare your directory entries.
   */
  #define I_DIRENT		/**/
  /*#define DIRNAMLEN	/ **/
-#define Direntry_t struct dirent
+#define Direntry_t struct direct

  /* I_GRP:
   *	This symbol, if defined, indicates to the C program that it should
   *	include <grp.h>.
   */
  /* GRPASSWD:
   *	This symbol, if defined, indicates to the C program that struct group
   *	in <grp.h> contains gr_passwd.
@@ -4699,17 +4699,17 @@
  /*#define	USE_MORE_BITS		/ **/
  #endif

  /* MULTIPLICITY:
   *	This symbol, if defined, indicates that Perl should
   *	be built to use multiplicity.
   */
  #ifndef MULTIPLICITY
-/*#define	MULTIPLICITY		/ **/
+#define	MULTIPLICITY		1
  #endif

  /* USE_NSGETEXECUTABLEPATH:
   *	This symbol, if defined, indicates that we can use _NSGetExecutablePath
   *	and realpath to get a full path for the executable, and hence convert
   *	$^X to an absolute path.
   */
  /*#define USE_NSGETEXECUTABLEPATH	/ **/
diff -rU8 perl-5.16.1/win32/win32.h perl-5.16.1-microperlw32/win32/win32.h
--- perl-5.16.1/win32/win32.h	2012-08-04 01:35:26.000000000 +0800
+++ perl-5.16.1-microperlw32/win32/win32.h	2012-09-13 09:19:46.993190700  
+0800
@@ -41,17 +41,17 @@


  /* Define DllExport akin to perl's EXT,
   * If we are in the DLL then Export the symbol,
   * otherwise import it.
   */

  /* now even GCC supports __declspec() */
-
+#if !defined(PERL_MICRO)
  #if defined(PERLDLL)
  #define DllExport
  /*#define DllExport __declspec(dllexport)*/	/* noises with VC5+sp3 */
  #else
  #define DllExport __declspec(dllimport)
  #endif

  /* The Perl APIs can only be called directly inside the perl5xx.dll.
@@ -65,16 +65,20 @@
   */
  #if !defined(PERLDLL) && !defined(PERL_EXT_RE_BUILD)
  #  ifdef __cplusplus
  #    define PERL_CALLCONV extern "C" __declspec(dllimport)
  #  else
  #    define PERL_CALLCONV __declspec(dllimport)
  #  endif
  #endif
+#else /*!PERL_MICRO*/
+#	define DllExport
+#	define PERL_CALLCONV
+#endif /*!PERL_MICRO*/

  #define  WIN32_LEAN_AND_MEAN
  #include <windows.h>

  /*
   * Bug in winbase.h in mingw-w64 4.4.0-1 at least... they
   * do #define GetEnvironmentStringsA GetEnvironmentStrings and fail
   * to declare GetEnvironmentStringsA.
@@ -94,21 +98,27 @@
  #ifdef   WIN32_LEAN_AND_MEAN		/* C file is NOT a Perl5 original. */
  #define  CONTEXT	PERL_CONTEXT	/* Avoid conflict of CONTEXT defs. */
  #endif /*WIN32_LEAN_AND_MEAN */

  #ifndef TLS_OUT_OF_INDEXES
  #define TLS_OUT_OF_INDEXES (DWORD)0xFFFFFFFF
  #endif

+#ifdef DIR
+#undef DIR
+#endif
+
+#define Strtol _strtoi64
+
  #include <dirent.h>
  #include <io.h>
  #include <process.h>
  #include <stdio.h>
-#include <direct.h>
+//#include <direct.h>
  #include <stdlib.h>
  #include <stddef.h>
  #include <fcntl.h>
  #ifndef EXT
  #include "EXTERN.h"
  #endif

  struct tms {
diff -rU8 perl-5.16.1/win32/win32sck.c  
perl-5.16.1-microperlw32/win32/win32sck.c
--- perl-5.16.1/win32/win32sck.c	2012-04-25 08:18:36.000000000 +0800
+++ perl-5.16.1-microperlw32/win32/win32sck.c	2012-09-13  
09:10:21.938967600 +0800
@@ -23,16 +23,18 @@

  #include "Win32iop.h"
  #include <sys/socket.h>
  #include <fcntl.h>
  #include <sys/stat.h>
  #include <assert.h>
  #include <io.h>

+static PerlInterpreter *my_perl;
+
  /* thanks to Beverly Brown	(beverly@datacube.com) */
  #ifdef USE_SOCKETS_AS_HANDLES
  #	define OPEN_SOCKET(x)	win32_open_osfhandle(x,O_RDWR|O_BINARY)
  #	define TO_SOCKET(x)	_get_osfhandle(x)
  #else
  #	define OPEN_SOCKET(x)	(x)
  #	define TO_SOCKET(x)	(x)
  #endif	/* USE_SOCKETS_AS_HANDLES */

Thread Next


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