From: Nicholas Clark <nick@ccl4.org>
Date: Wed, 20 May 2009 06:30:48 +0000 (+0200)
Subject: Replace run-time on-demand initialisation of PL_bitcount with a constant table.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=efa50c51e3301a2ca8be765fedfdae78eff1615b;p=p5sagit%2Fp5-mst-13.2.git

Replace run-time on-demand initialisation of PL_bitcount with a constant table.
(The table is 256 bytes; the run-time initialisation code is larger than this!)
Adapt generate_uudmap.c to generate the initalisation block for PL_bitcount,
writing the code to bitcount.h, using the same approach as uudmap.h.

To preserve binary compatibility:
for MULTIPLICITY:
  keep Ibitcount in the interpreter structure, but remove all the macros that
  access it. PL_bitcount is a new symbol in the object file, which won't clash
  with anything as that name wasn't used before.
otherwise:
  keep PL_bitcount as a char *, but initialise it at compile time to a new
  constant array PL_bitcount array. Remove the code that attempts to Safefree()
  it at interpreter destruction time.
---

diff --git a/Makefile.SH b/Makefile.SH
index 94c1238..fff2e98 100644
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -572,10 +572,10 @@ perlmini.c: perl.c
 perlmini\$(OBJ_EXT): perlmini.c
 	\$(CCCMD) \$(PLDLFLAGS) $DPERL_IS_MINIPERL perlmini.c
 
-globals\$(OBJ_EXT): uudmap.h
+globals\$(OBJ_EXT): uudmap.h bitcount.h
 
-uudmap.h: generate_uudmap\$(HOST_EXE_EXT)
-	\$(RUN) ./generate_uudmap\$(HOST_EXE_EXT) uudmap.h
+uudmap.h bitcount.h: generate_uudmap\$(HOST_EXE_EXT)
+	\$(RUN) ./generate_uudmap\$(HOST_EXE_EXT) uudmap.h bitcount.h
 
 generate_uudmap\$(HOST_EXE_EXT): generate_uudmap\$(OBJ_EXT)
 	\$(CC) -o generate_uudmap\$(EXE_EXT) \$(LDFLAGS) generate_uudmap\$(OBJ_EXT) \$(libs)
@@ -1181,7 +1181,7 @@ veryclean:	cleanup_unpacked_files _verycleaner _mopup _clobber
 
 # Do not 'make _mopup' directly.
 _mopup:
-	rm -f *$(OBJ_EXT) *$(LIB_EXT) all perlmain.c opmini.c perlmini.c uudmap.h generate_uudmap$(EXE_EXT)
+	rm -f *$(OBJ_EXT) *$(LIB_EXT) all perlmain.c opmini.c perlmini.c uudmap.h generate_uudmap$(EXE_EXT) bitcount.h
 	-rmdir .depending
 	-@test -f extra.pods && rm -f `cat extra.pods`
 	-@test -f vms/README_vms.pod && rm -f vms/README_vms.pod
diff --git a/embed.pl b/embed.pl
index 50da232..0287c85 100755
--- a/embed.pl
+++ b/embed.pl
@@ -696,6 +696,7 @@ print $em do_not_edit ("embedvar.h"), <<'END';
 END
 
 for $sym (sort keys %intrp) {
+    next if $sym eq 'bitcount';
     print $em multon($sym,'I','vTHX->');
 }
 
diff --git a/embedvar.h b/embedvar.h
index 636e39a..7b20505 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -71,7 +71,6 @@
 #define PL_basetime		(vTHX->Ibasetime)
 #define PL_beginav		(vTHX->Ibeginav)
 #define PL_beginav_save		(vTHX->Ibeginav_save)
-#define PL_bitcount		(vTHX->Ibitcount)
 #define PL_body_arenas		(vTHX->Ibody_arenas)
 #define PL_body_roots		(vTHX->Ibody_roots)
 #define PL_bodytarget		(vTHX->Ibodytarget)
diff --git a/generate_uudmap.c b/generate_uudmap.c
index 27b142a..2c3e24a 100644
--- a/generate_uudmap.c
+++ b/generate_uudmap.c
@@ -1,3 +1,8 @@
+/* Originally this program just generated uudmap.h
+   However, when we later wanted to generate bitcount.h, it was easier to
+   refactor it and keep the same name, than either alternative - rename it,
+   or duplicate all of the Makefile logic for a second program.  */
+
 #include <stdio.h>
 #include <stdlib.h>
 /* If it turns out that we need to make this conditional on config.sh derived
@@ -45,12 +50,14 @@ typedef unsigned char U8;
 
 /* This will ensure it is all zeros.  */
 static char PL_uudmap[256];
+static char PL_bitcount[256];
 
 int main(int argc, char **argv) {
   size_t i;
+  int bits;
 
-  if (argc < 2 || argv[1][0] == '\0') {
-    fprintf(stderr, "Usage: %s uudemap.h\n", argv[0]);
+  if (argc < 3 || argv[1][0] == '\0' || argv[2][0] == '\0') {
+    fprintf(stderr, "Usage: %s uudemap.h bitcount.h\n", argv[0]);
     return 1;
   }
 
@@ -64,6 +71,19 @@ int main(int argc, char **argv) {
 
   output_block_to_file(argv[0], argv[1], PL_uudmap, sizeof(PL_uudmap));
 
+  for (bits = 1; bits < 256; bits++) {
+    if (bits & 1)	PL_bitcount[bits]++;
+    if (bits & 2)	PL_bitcount[bits]++;
+    if (bits & 4)	PL_bitcount[bits]++;
+    if (bits & 8)	PL_bitcount[bits]++;
+    if (bits & 16)	PL_bitcount[bits]++;
+    if (bits & 32)	PL_bitcount[bits]++;
+    if (bits & 64)	PL_bitcount[bits]++;
+    if (bits & 128)	PL_bitcount[bits]++;
+  }
+
+  output_block_to_file(argv[0], argv[2], PL_bitcount, sizeof(PL_bitcount));
+
   return 0;
 }
 
diff --git a/intrpvar.h b/intrpvar.h
index 504a056..487576a 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -533,7 +533,15 @@ PERLVARI(Iglob_index,	int,	0)
 
 PERLVAR(Iparser,	yy_parser *)	/* current parser state */
 
+#ifdef MULTIPLICITY
+/* For binary compatibility, keep the interpreter structure the same.
+   However, we no longer use this entry.  */
 PERLVAR(Ibitcount,	char *)
+#else
+/* For binary compatibility, need to retain an extern char *PL_bitcount.
+   So make it point to the compile time generated array.  */
+PERLVARI(Ibitcount,	char *, (char *)PL_bitcount_array)
+#endif
 
 /* Array of signal handlers, indexed by signal number, through which the C
    signal handler dispatches.  */
diff --git a/perl.c b/perl.c
index 567ca75..2c7a4c1 100644
--- a/perl.c
+++ b/perl.c
@@ -1232,8 +1232,10 @@ perl_destruct(pTHXx)
     PL_psig_ptr = (SV**)NULL;
     Safefree(PL_psig_name);
     PL_psig_name = (SV**)NULL;
-    Safefree(PL_bitcount);
-    PL_bitcount = NULL;
+#ifdef MULTIPLICITY
+    Safefree(my_perl->Ibitcount);
+    my_perl->Ibitcount = NULL;
+#endif
     Safefree(PL_psig_pend);
     PL_psig_pend = (int*)NULL;
     PL_formfeed = NULL;
diff --git a/perl.h b/perl.h
index 0e52ebc..66459b4 100644
--- a/perl.h
+++ b/perl.h
@@ -4240,10 +4240,29 @@ EXTCONST char PL_uuemap[65]
 EXTCONST char PL_uudmap[256] =
 #include "uudmap.h"
 ;
+#  ifdef MULTIPLICITY
+/* There's no binary compatibility issue with adding a new global PL_bitcount,
+   because before this change, under MULTIPLICITY the pre-processor would have
+   been replacing the token PL_bitcount with an expression to access the
+   interpreter struct.  */
+EXTCONST char PL_bitcount[256] =
+#  else
+/* For binary compatibility, we can't replace the existing pointer PL_bitcount
+   with an array PL_bitcount.  So keep the existing variable, but make it point
+   to our compile-time generated array instead.  */
+EXTCONST char PL_bitcount_array[256] =
+#  endif
+#  include "bitcount.h"
+;
 EXTCONST char* const PL_sig_name[] = { SIG_NAME };
 EXTCONST int         PL_sig_num[]  = { SIG_NUM };
 #else
 EXTCONST char PL_uudmap[256];
+#  ifdef MULTIPLICITY
+EXTCONST char PL_bitcount[256];
+#  else
+EXTCONST char PL_bitcount_array[256];
+#  endif
 EXTCONST char* const PL_sig_name[];
 EXTCONST int         PL_sig_num[];
 #endif
diff --git a/pp_pack.c b/pp_pack.c
index 0895c9b..31cc8eb 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -1477,20 +1477,6 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 	    if (howlen == e_star || len > (strend - s) * 8)
 		len = (strend - s) * 8;
 	    if (checksum) {
-		if (!PL_bitcount) {
-		    int bits;
-		    Newxz(PL_bitcount, 256, char);
-		    for (bits = 1; bits < 256; bits++) {
-			if (bits & 1)	PL_bitcount[bits]++;
-			if (bits & 2)	PL_bitcount[bits]++;
-			if (bits & 4)	PL_bitcount[bits]++;
-			if (bits & 8)	PL_bitcount[bits]++;
-			if (bits & 16)	PL_bitcount[bits]++;
-			if (bits & 32)	PL_bitcount[bits]++;
-			if (bits & 64)	PL_bitcount[bits]++;
-			if (bits & 128)	PL_bitcount[bits]++;
-		    }
-		}
 		if (utf8)
 		    while (len >= 8 && s < strend) {
 			cuv += PL_bitcount[uni_to_byte(aTHX_ &s, strend, datumtype)];
diff --git a/sv.c b/sv.c
index 6e7fbd4..5ba9ba2 100644
--- a/sv.c
+++ b/sv.c
@@ -12176,7 +12176,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_glob_index	= proto_perl->Iglob_index;
     PL_srand_called	= proto_perl->Isrand_called;
-    PL_bitcount		= NULL;	/* reinits on demand */
+    my_perl->Ibitcount	= NULL;	/* no longer used */
 
     if (proto_perl->Ipsig_pend) {
 	Newxz(PL_psig_pend, SIG_SIZE, int);
diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template
index 6a0668a..f507457 100644
--- a/vms/descrip_mms.template
+++ b/vms/descrip_mms.template
@@ -502,8 +502,8 @@ perlmini.c : perl.c
 perlmini$(O) : perlmini.c
 	$(CC) $(CORECFLAGS) $(MMS$SOURCE)
 
-uudmap.h : generate_uudmap$(E)
-	MCR SYS$DISK:[]generate_uudmap$(E) uudmap.h
+uudmap.h bitcount.h : generate_uudmap$(E)
+	MCR SYS$DISK:[]generate_uudmap$(E) uudmap.h bitcount.h
 
 generate_uudmap$(E) : generate_uudmap$(O) $(CRTL)
 	Link $(LINKFLAGS)/NoDebug/Trace/NoMap/NoFull/NoCross/Exe=$(MMS$TARGET) generate_uudmap$(O) $(CRTLOPTS)
@@ -1692,7 +1692,7 @@ doop$(O) : doop.c $(h)
 	$(CC) $(CORECFLAGS) $(MMS$SOURCE)
 dump$(O) : dump.c $(h)
 	$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-globals$(O) : globals.c uudmap.h $(h)
+globals$(O) : globals.c uudmap.h bitcount.h $(h)
         $(CC) $(CORECFLAGS) $(MMS$SOURCE)
 gv$(O) : gv.c $(h)
 	$(CC) $(CORECFLAGS) $(MMS$SOURCE)
@@ -1824,6 +1824,7 @@ tidy : cleanlis
 	- If F$Search("vms.c;-1")   .nes."" Then Purge/NoConfirm/Log vms.c
 	- If F$Search("perlmain.c;-1")   .nes."" Then Purge/NoConfirm/Log perlmain.c
 	- If F$Search("uudmap.h;-1")   .nes."" Then Purge/NoConfirm/Log uudmap.h
+	- If F$Search("bitcount.h;-1")   .nes."" Then Purge/NoConfirm/Log bitcount.h
 	- If F$Search("Perlshr_Gbl*.Mar;-1")   .nes."" Then Purge/NoConfirm/Log Perlshr_Gbl*.Mar
 	- If F$Search("[.ext.DynaLoader]dl_vms$(O);-1").nes."" Then Purge/NoConfirm/Log [.ext.DynaLoader]dl_vms$(O)
 	- If F$Search("[.ext.DynaLoader]dl_vms.c;-1").nes."" Then Purge/NoConfirm/Log [.ext.DynaLoader]dl_vms.c
@@ -1859,6 +1860,7 @@ clean : tidy cleantest cleanup_unpacked_files
 	- If F$Search("perlmain.c")   .nes."" Then Delete/NoConfirm/Log perlmain.c;*
 	- If F$Search("perlmini.c")   .nes."" Then Delete/NoConfirm/Log perlmini.c;*
 	- If F$Search("uudmap.h")   .nes."" Then Delete/NoConfirm/Log uudmap.h;*
+	- If F$Search("bitcount.h")   .nes."" Then Delete/NoConfirm/Log bitcount.h;*
 	- If F$Search("Perlshr_Gbl*.Mar")   .nes."" Then Delete/NoConfirm/Log Perlshr_Gbl*.Mar;*
 	- If F$Search("*.TS").nes."" Then Delete/NoConfirm/Log *.TS;*
 	- If F$Search("[.ext.DynaLoader]dl_vms$(O)").nes."" Then Delete/NoConfirm/Log [.ext.DynaLoader]dl_vms$(O);*
diff --git a/win32/Makefile b/win32/Makefile
index 9eed883..5ae31e3 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -765,6 +765,7 @@ CORE_NOCFG_H	=		\
 CORE_H		= $(CORE_NOCFG_H) .\config.h ..\git_version.h
 
 UUDMAP_H	= ..\uudmap.h
+BITCOUNT_H	= ..\bitcount.h
 
 MICROCORE_OBJ	= $(MICROCORE_SRC:.c=.obj)
 CORE_OBJ	= $(MICROCORE_OBJ) $(EXTRACORE_SRC:.c=.obj)
@@ -997,10 +998,10 @@ $(X2P) : $(MINIPERL) $(X2P_OBJ)
 <<
 	$(EMBED_EXE_MANI)
 
-$(MINIDIR)\globals$(o) : $(UUDMAP_H)
+$(MINIDIR)\globals$(o) : $(UUDMAP_H) $(BITCOUNT_H)
 
-$(UUDMAP_H) : $(GENUUDMAP)
-	$(GENUUDMAP) $(UUDMAP_H)
+$(UUDMAP_H) $(BITCOUNT_H) : $(GENUUDMAP)
+	$(GENUUDMAP) $(UUDMAP_H) $(BITCOUNT_H)
 
 $(GENUUDMAP) : $(GENUUDMAP_OBJ)
 	$(LINK32) -subsystem:console -out:$@ @<<
@@ -1323,7 +1324,7 @@ _clean :
 	-@$(DEL) $(PERLSTATICLIB)
 	-@$(DEL) $(PERLDLL)
 	-@$(DEL) $(CORE_OBJ)
-	-@$(DEL) $(GENUUDMAP) $(GENUUDMAP_OBJ) $(UUDMAP_H)
+	-@$(DEL) $(GENUUDMAP) $(GENUUDMAP_OBJ) $(UUDMAP_H) $(BITCOUNT_H)
 	-if exist $(MINIDIR) rmdir /s /q $(MINIDIR)
 	-if exist $(UNIDATADIR1) rmdir /s /q $(UNIDATADIR1)
 	-if exist $(UNIDATADIR2) rmdir /s /q $(UNIDATADIR2)
diff --git a/win32/makefile.mk b/win32/makefile.mk
index c5abb46..2991a11 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -923,6 +923,7 @@ CORE_NOCFG_H	=		\
 CORE_H		= $(CORE_NOCFG_H) .\config.h ..\git_version.h
 
 UUDMAP_H	= ..\uudmap.h
+BITCOUNT_H	= ..\bitcount.h
 
 MICROCORE_OBJ	= $(MICROCORE_SRC:db:+$(o))
 CORE_OBJ	= $(MICROCORE_OBJ) $(EXTRACORE_SRC:db:+$(o))
@@ -1298,10 +1299,10 @@ $(X2P) : $(MINIPERL) $(X2P_OBJ)
 	$(EMBED_EXE_MANI)
 .ENDIF
 
-$(MINIDIR)\globals$(o) : $(UUDMAP_H)
+$(MINIDIR)\globals$(o) : $(UUDMAP_H) $(BITCOUNT_H)
 
-$(UUDMAP_H) : $(GENUUDMAP)
-	$(GENUUDMAP) $(UUDMAP_H)
+$(UUDMAP_H) $(BITCOUNT_H) : $(GENUUDMAP)
+	$(GENUUDMAP) $(UUDMAP_H) $(BITCOUNT_H)
 
 $(GENUUDMAP) : $(GENUUDMAP_OBJ)
 .IF "$(CCTYPE)" == "BORLAND"
@@ -1649,7 +1650,7 @@ _clean :
 	-@erase $(PERLSTATICLIB)
 	-@erase $(PERLDLL)
 	-@erase $(CORE_OBJ)
-	-@erase $(GENUUDMAP) $(GENUUDMAP_OBJ) $(UUDMAP_H)
+	-@erase $(GENUUDMAP) $(GENUUDMAP_OBJ) $(UUDMAP_H) $(BITCOUNT_H)
 	-if exist $(MINIDIR) rmdir /s /q $(MINIDIR)
 	-if exist $(UNIDATADIR1) rmdir /s /q $(UNIDATADIR1)
 	-if exist $(UNIDATADIR2) rmdir /s /q $(UNIDATADIR2)