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 (file)
--- 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 (executable)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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)