Skip to content

Commit

Permalink
flambda-backend: Provide a no-naked-pointers runtime and use it for t…
Browse files Browse the repository at this point in the history
…he compiler (#1224)
  • Loading branch information
mshinwell authored Mar 17, 2023
1 parent ba77581 commit 95f7e80
Show file tree
Hide file tree
Showing 3 changed files with 38 additions and 2 deletions.
12 changes: 11 additions & 1 deletion runtime/Makefile
Original file line number Diff line number Diff line change
Expand Up @@ -76,6 +76,7 @@ ifeq "$(SUPPORTS_SHARED_LIBRARIES)" "true"
BYTECODE_STATIC_LIBRARIES += libcamlrun_pic.$(A)
BYTECODE_SHARED_LIBRARIES += libcamlrun_shared.$(SO)
NATIVE_STATIC_LIBRARIES += libasmrun_pic.$(A)
NATIVE_STATIC_LIBRARIES += libasmrunnnp.$(A)
NATIVE_SHARED_LIBRARIES += libasmrun_shared.$(SO)
endif
endif
Expand Down Expand Up @@ -106,6 +107,8 @@ libasmruni_OBJECTS := $(NATIVE_C_SOURCES:.c=.ni.$(O)) $(ASM_OBJECTS)
libasmrunpic_OBJECTS := $(NATIVE_C_SOURCES:.c=.npic.$(O)) \
$(ASM_OBJECTS:.$(O)=_libasmrunpic.$(O))

libasmrunnnp_OBJECTS := $(NATIVE_C_SOURCES:.c=.nnp.$(O)) $(ASM_OBJECTS)

# General (non target-specific) assembler and compiler flags

ifneq "$(CCOMPTYPE)" "msvc"
Expand Down Expand Up @@ -310,6 +313,9 @@ libasmruni.$(A): $(libasmruni_OBJECTS)
libasmrun_pic.$(A): $(libasmrunpic_OBJECTS)
$(call MKLIB,$@, $^)

libasmrunnnp.$(A): $(libasmrunnnp_OBJECTS)
$(call MKLIB,$@, $^)

libasmrun_shared.$(SO): $(libasmrunpic_OBJECTS)
$(MKDLL) -o $@ $^ $(NATIVECCLIBS)

Expand All @@ -336,6 +342,9 @@ libasmrun_shared.$(SO): $(libasmrunpic_OBJECTS)
%.npic.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS)
%.npic.$(D): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS)

%.nnp.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) -DNO_NAKED_POINTERS
%.nnp.$(D): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) -DNO_NAKED_POINTERS

# The major GC performs better with this flag on Intel processors
# This is a workaround for an Intel CPU bug:
# https://www.intel.co.uk/content/www/uk/en/support/articles/000055650/processors.html
Expand Down Expand Up @@ -369,7 +378,7 @@ endef

object_types := % %.b %.bd %.bi %.bpic
ifneq "$(NATIVE_COMPILER)" "false"
object_types += %.n %.nd %.ni %.np %.npic
object_types += %.n %.nnp %.nd %.ni %.np %.npic
endif

$(foreach object_type, $(object_types), \
Expand Down Expand Up @@ -414,6 +423,7 @@ i386nt.obj: i386nt.asm domain_state32.inc
DEP_FILES := $(addsuffix .b, $(basename $(BYTECODE_C_SOURCES) instrtrace))
ifneq "$(NATIVE_COMPILER)" "false"
DEP_FILES += $(addsuffix .n, $(basename $(NATIVE_C_SOURCES)))
DEP_FILES += $(addsuffix .nnp, $(basename $(NATIVE_C_SOURCES)))
endif
DEP_FILES += $(addsuffix d, $(DEP_FILES)) \
$(addsuffix i, $(DEP_FILES)) \
Expand Down
3 changes: 2 additions & 1 deletion runtime/dune
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@
(action (with-stdout-to %{targets} (run %{dep:gen_primitives.sh}))))

(rule
(targets libasmrun.a libasmrund.a libasmruni.a libasmrun_pic.a
(targets libasmrun.a libasmrund.a libasmruni.a libasmrun_pic.a libasmrunnnp.a
libasmrun_shared.so libcamlrun.a libcamlrund.a libcamlruni.a libcamlrun_pic.a
libcamlrun_shared.so ocamlrun ocamlrund ocamlruni ld.conf
sak)
Expand Down Expand Up @@ -77,6 +77,7 @@
libasmrund.a
libasmruni.a
libasmrun_pic.a
libasmrunnnp.a
libasmrun_shared.so
)
(section lib)
Expand Down
25 changes: 25 additions & 0 deletions runtime/memory.c
Original file line number Diff line number Diff line change
Expand Up @@ -90,6 +90,30 @@ static struct page_table caml_page_table;

int caml_page_table_lookup(void * addr)
{
#ifdef NO_NAKED_POINTERS
/* This case should only be hit if C stubs compiled without
NO_NAKED_POINTERS are linked into an executable using
"-runtime-variant nnp". The return value here should cause the
macros in address_class.h to give the same results as when they
are compiled with NO_NAKED_POINTERS defined. */

caml_local_arenas* local_arenas = Caml_state->local_arenas;

if (Is_young(addr))
return In_heap | In_young;

if (local_arenas != NULL) {
int arena;
for (arena = 0; arena < local_arenas->count; arena++) {
char* start = local_arenas->arenas[arena].base;
char* end = start + local_arenas->arenas[arena].length;
if ((char*) addr >= start && (char*) addr < end)
return In_heap | In_local;
}
}

return In_heap;
#else
uintnat h, e;

h = Hash(Page(addr));
Expand All @@ -102,6 +126,7 @@ int caml_page_table_lookup(void * addr)
e = caml_page_table.entries[h];
if (Page_entry_matches(e, (uintnat)addr)) return e & 0xFF;
}
#endif
}

int caml_page_table_initialize(mlsize_t bytesize)
Expand Down

0 comments on commit 95f7e80

Please sign in to comment.