Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Replace run-time on-demand initialisation of PL_bitcount with a const…

…ant 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.
  • Loading branch information...
commit efa50c51e3301a2ca8be765fedfdae78eff1615b 1 parent 869053c
Nicholas Clark authored
View
8 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
View
1  embed.pl
@@ -696,6 +696,7 @@ END
END
for $sym (sort keys %intrp) {
+ next if $sym eq 'bitcount';
print $em multon($sym,'I','vTHX->');
}
View
1  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)
View
24 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;
}
View
8 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. */
View
6 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;
View
19 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
View
14 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)];
View
2  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);
View
8 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);*
View
9 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)
View
9 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)
Please sign in to comment.
Something went wrong with that request. Please try again.