Skip to content

GitLab

Commit f89b73e6 authored by ian@well-typed.com's avatar ian@well-typed.com
Browse files

Add more modes to mkDerivedConstants 

We now generate a platformConstants file that we can read at runtime.
parent 86054b4a
Hide whitespace changes
Inline Side-by-side
compiler/ghc.mk
View file @ f89b73e6
......@@ -461,9 +461,16 @@ $(compiler_stage1_depfile_haskell) : compiler/stage1/$(PLATFORM_H)
$(compiler_stage2_depfile_haskell) : compiler/stage2/$(PLATFORM_H)
$(compiler_stage3_depfile_haskell) : compiler/stage3/$(PLATFORM_H)
$(compiler_stage1_depfile_haskell) : $(includes_H_CONFIG) $(includes_H_PLATFORM) $(includes_GHCCONSTANTS) $(includes_DERIVEDCONSTANTS) $(PRIMOP_BITS)
$(compiler_stage2_depfile_haskell) : $(includes_H_CONFIG) $(includes_H_PLATFORM) $(includes_GHCCONSTANTS) $(includes_DERIVEDCONSTANTS) $(PRIMOP_BITS)
$(compiler_stage3_depfile_haskell) : $(includes_H_CONFIG) $(includes_H_PLATFORM) $(includes_GHCCONSTANTS) $(includes_DERIVEDCONSTANTS) $(PRIMOP_BITS)
COMPILER_INCLUDES_DEPS += $(includes_H_CONFIG)
COMPILER_INCLUDES_DEPS += $(includes_H_PLATFORM)
COMPILER_INCLUDES_DEPS += $(includes_GHCCONSTANTS)
COMPILER_INCLUDES_DEPS += $(includes_GHCCONSTANTS_HASKELL_TYPE)
COMPILER_INCLUDES_DEPS += $(includes_DERIVEDCONSTANTS)
COMPILER_INCLUDES_DEPS += $(PRIMOP_BITS)
$(compiler_stage1_depfile_haskell) : $(COMPILER_INCLUDES_DEPS)
$(compiler_stage2_depfile_haskell) : $(COMPILER_INCLUDES_DEPS)
$(compiler_stage3_depfile_haskell) : $(COMPILER_INCLUDES_DEPS)
# Every Constants.o object file depends on includes/GHCConstants.h:
$(eval $(call compiler-hs-dependency,Constants,$(includes_GHCCONSTANTS) includes/HaskellConstants.hs))
......
compiler/main/DynFlags.hs
View file @ f89b73e6
......@@ -20,6 +20,7 @@ module DynFlags (
WarningFlag(..),
ExtensionFlag(..),
Language(..),
PlatformConstants(..),
FatalMessager, LogAction, FlushOut(..), FlushErr(..),
ProfAuto(..),
glasgowExtsFlags,
......@@ -705,8 +706,9 @@ data Settings = Settings {
sOpt_l :: [String],
sOpt_windres :: [String],
sOpt_lo :: [String], -- LLVM: llvm optimiser
sOpt_lc :: [String] -- LLVM: llc static compiler
sOpt_lc :: [String], -- LLVM: llc static compiler
sPlatformConstants :: PlatformConstants
}
targetPlatform :: DynFlags -> Platform
......@@ -3138,3 +3140,5 @@ compilerInfo dflags
("Global Package DB", systemPackageConfig dflags)
]
#include "../includes/dist-derivedconstants/header/GHCConstantsHaskellType.hs"
compiler/main/SysTools.lhs
View file @ f89b73e6
......@@ -172,15 +172,23 @@ initSysTools mbMinusB
-- format, '/' separated
let settingsFile = top_dir </> "settings"
platformConstantsFile = top_dir </> "platformConstants"
installed :: FilePath -> FilePath
installed file = top_dir </> file
settingsStr <- readFile settingsFile
platformConstantsStr <- readFile platformConstantsFile
mySettings <- case maybeReadFuzzy settingsStr of
Just s ->
return s
Nothing ->
pgmError ("Can't parse " ++ show settingsFile)
platformConstants <- case maybeReadFuzzy platformConstantsStr of
Just s ->
return s
Nothing ->
pgmError ("Can't parse " ++
show platformConstantsFile)
let getSetting key = case lookup key mySettings of
Just xs ->
return $ case stripPrefix "$topdir" xs of
......@@ -326,7 +334,8 @@ initSysTools mbMinusB
sOpt_l = [],
sOpt_windres = [],
sOpt_lo = [],
sOpt_lc = []
sOpt_lc = [],
sPlatformConstants = platformConstants
}
\end{code}
......
ghc/ghc.mk
View file @ f89b73e6
......@@ -127,12 +127,19 @@ all_ghc_stage3 : $(GHC_STAGE3)
$(INPLACE_LIB)/settings : settings
"$(CP)" $< $@
$(INPLACE_LIB)/platformConstants: $(includes_GHCCONSTANTS_HASKELL_VALUE)
"$(CP)" $< $@
# The GHC programs need to depend on all the helper programs they might call,
# and the settings files they use
$(GHC_STAGE1) : | $(UNLIT) $(INPLACE_LIB)/settings
$(GHC_STAGE2) : | $(UNLIT) $(INPLACE_LIB)/settings
$(GHC_STAGE3) : | $(UNLIT) $(INPLACE_LIB)/settings
GHC_DEPENDENCIES += $(UNLIT)
GHC_DEPENDENCIES += $(INPLACE_LIB)/settings
GHC_DEPENDENCIES += $(INPLACE_LIB)/platformConstants
$(GHC_STAGE1) : | $(GHC_DEPENDENCIES)
$(GHC_STAGE2) : | $(GHC_DEPENDENCIES)
$(GHC_STAGE3) : | $(GHC_DEPENDENCIES)
ifeq "$(GhcUnregisterised)" "NO"
$(GHC_STAGE1) : | $(SPLIT)
......
includes/ghc.mk
View file @ f89b73e6
......@@ -132,6 +132,8 @@ endif
includes_DERIVEDCONSTANTS = includes/dist-derivedconstants/header/DerivedConstants.h
includes_GHCCONSTANTS = includes/dist-derivedconstants/header/GHCConstants.h
includes_GHCCONSTANTS_HASKELL_TYPE = includes/dist-derivedconstants/header/GHCConstantsHaskellType.hs
includes_GHCCONSTANTS_HASKELL_VALUE = includes/dist-derivedconstants/header/platformConstants
ifeq "$(PORTING_HOST)-$(AlienScript)" "YES-"
......@@ -170,7 +172,21 @@ $(includes_GHCCONSTANTS) : $(INPLACE_BIN)/mkDerivedConstants$(exeext) | $$(dir $
ifeq "$(AlienScript)" ""
./$< --gen-haskell >$@
else
$(AlienScript) run ./$< >$@
$(AlienScript) run ./$< --gen-haskell >$@
endif
$(includes_GHCCONSTANTS_HASKELL_TYPE) : $(INPLACE_BIN)/mkDerivedConstants$(exeext) | $$(dir $$@)/.
ifeq "$(AlienScript)" ""
./$< --gen-haskell-type >$@
else
$(AlienScript) run ./$< --gen-haskell-type >$@
endif
$(includes_GHCCONSTANTS_HASKELL_VALUE) : $(INPLACE_BIN)/mkDerivedConstants$(exeext) | $$(dir $$@)/.
ifeq "$(AlienScript)" ""
./$< --gen-haskell-value >$@
else
$(AlienScript) run ./$< --gen-haskell-value >$@
endif
endif
......@@ -181,11 +197,11 @@ endif
$(eval $(call clean-target,includes,,\
$(includes_H_CONFIG) $(includes_H_PLATFORM) \
$(includes_GHCCONSTANTS) $(includes_DERIVEDCONSTANTS)))
$(includes_GHCCONSTANTS) $(includes_GHCCONSTANTS_HASKELL_TYPE) $(includes_GHCCONSTANTS_HASKELL_VALUE) $(includes_DERIVEDCONSTANTS)))
$(eval $(call all-target,includes,,\
$(includes_H_CONFIG) $(includes_H_PLATFORM) \
$(includes_GHCCONSTANTS) $(includes_DERIVEDCONSTANTS)))
$(includes_GHCCONSTANTS) $(includes_GHCCONSTANTS_HASKELL_TYPE) $(includes_GHCCONSTANTS_HASKELL_VALUE) $(includes_DERIVEDCONSTANTS)))
install: install_includes
......
includes/mkDerivedConstants.c
View file @ f89b73e6
......@@ -29,7 +29,7 @@
#include <stdio.h>
#include <string.h>
enum Mode { Gen_Haskell, Gen_Header } mode;
enum Mode { Gen_Haskell, Gen_Haskell_Type, Gen_Haskell_Value, Gen_Header } mode;
#define str(a,b) #a "_" #b
......@@ -45,6 +45,12 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
printf("oFFSET_" str " :: Int\n"); \
printf("oFFSET_" str " = %" FMT_SizeT "\n", (size_t)offset); \
break; \
case Gen_Haskell_Type: \
printf(" , pc_OFFSET_" str " :: Int\n"); \
break; \
case Gen_Haskell_Value: \
printf(" , pc_OFFSET_" str " = %" FMT_SizeT "\n", (size_t)offset); \
break; \
case Gen_Header: \
printf("#define OFFSET_" str " %" FMT_SizeT "\n", (size_t)offset); \
break; \
......@@ -53,6 +59,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
#define ctype(type) \
switch (mode) { \
case Gen_Haskell: \
case Gen_Haskell_Type: \
case Gen_Haskell_Value: \
break; \
case Gen_Header: \
printf("#define SIZEOF_" #type " %" FMT_SizeT "\n", \
......@@ -69,6 +77,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
#define field_type_(str, s_type, field) \
switch (mode) { \
case Gen_Haskell: \
case Gen_Haskell_Type: \
case Gen_Haskell_Value: \
break; \
case Gen_Header: \
printf("#define REP_" str " b"); \
......@@ -79,6 +89,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
#define field_type_gcptr_(str, s_type, field) \
switch (mode) { \
case Gen_Haskell: \
case Gen_Haskell_Type: \
case Gen_Haskell_Value: \
break; \
case Gen_Header: \
printf("#define REP_" str " gcptr\n"); \
......@@ -98,6 +110,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
#define struct_field_macro(str) \
switch (mode) { \
case Gen_Haskell: \
case Gen_Haskell_Type: \
case Gen_Haskell_Value: \
break; \
case Gen_Header: \
printf("#define " str "(__ptr__) REP_" str "[__ptr__+OFFSET_" str "]\n"); \
......@@ -121,6 +135,12 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
printf("sIZEOF_" str " :: Int\n"); \
printf("sIZEOF_" str " = %" FMT_SizeT "\n", (size_t)size); \
break; \
case Gen_Haskell_Type: \
printf(" , pc_SIZEOF_" str " :: Int\n"); \
break; \
case Gen_Haskell_Value: \
printf(" , pc_SIZEOF_" str " = %" FMT_SizeT "\n", (size_t)size); \
break; \
case Gen_Header: \
printf("#define SIZEOF_" str " %" FMT_SizeT "\n", (size_t)size); \
break; \
......@@ -129,6 +149,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
#define def_closure_size(str, size) \
switch (mode) { \
case Gen_Haskell: \
case Gen_Haskell_Type: \
case Gen_Haskell_Value: \
break; \
case Gen_Header: \
printf("#define SIZEOF_" str " (SIZEOF_StgHeader+%" FMT_SizeT ")\n", (size_t)size); \
......@@ -154,6 +176,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
#define closure_field_macro(str) \
switch (mode) { \
case Gen_Haskell: \
case Gen_Haskell_Type: \
case Gen_Haskell_Value: \
break; \
case Gen_Header: \
printf("#define " str "(__ptr__) REP_" str "[__ptr__+SIZEOF_StgHeader+OFFSET_" str "]\n"); \
......@@ -169,6 +193,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
#define closure_payload_macro(str) \
switch (mode) { \
case Gen_Haskell: \
case Gen_Haskell_Type: \
case Gen_Haskell_Value: \
break; \
case Gen_Header: \
printf("#define " str "(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_" str " + WDS(__ix__)]\n"); \
......@@ -205,6 +231,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
#define tso_field_offset_macro(str) \
switch (mode) { \
case Gen_Haskell: \
case Gen_Haskell_Type: \
case Gen_Haskell_Value: \
break; \
case Gen_Header: \
printf("#define TSO_OFFSET_" str " (SIZEOF_StgHeader+SIZEOF_OPT_StgTSOProfInfo+OFFSET_" str ")\n"); \
......@@ -218,6 +246,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
#define tso_field_macro(str) \
switch (mode) { \
case Gen_Haskell: \
case Gen_Haskell_Type: \
case Gen_Haskell_Value: \
break; \
case Gen_Header: \
printf("#define " str "(__ptr__) REP_" str "[__ptr__+TSO_OFFSET_" str "]\n") \
......@@ -232,6 +262,8 @@ enum Mode { Gen_Haskell, Gen_Header } mode;
#define opt_struct_size(s_type, option) \
switch (mode) { \
case Gen_Haskell: \
case Gen_Haskell_Type: \
case Gen_Haskell_Value: \
break; \
case Gen_Header: \
printf("#ifdef " #option "\n"); \
......@@ -255,6 +287,12 @@ main(int argc, char *argv[])
if (0 == strcmp("--gen-haskell", argv[1])) {
mode = Gen_Haskell;
}
else if (0 == strcmp("--gen-haskell-type", argv[1])) {
mode = Gen_Haskell_Type;
}
else if (0 == strcmp("--gen-haskell-value", argv[1])) {
mode = Gen_Haskell_Value;
}
else {
printf("Bad args\n");
exit(1);
......@@ -268,6 +306,16 @@ main(int argc, char *argv[])
switch (mode) {
case Gen_Haskell:
break;
case Gen_Haskell_Type:
printf("data PlatformConstants = PlatformConstants {\n");
/* Now a kludge that allows the real entries to all start with a
comma, which makes life a little easier */
printf(" pc_platformConstants :: ()\n");
break;
case Gen_Haskell_Value:
printf("PlatformConstants {\n");
printf(" pc_platformConstants = ()\n");
break;
case Gen_Header:
printf("/* This file is created automatically. Do not edit by hand.*/\n\n");
......@@ -528,5 +576,18 @@ main(int argc, char *argv[])
struct_field(StgAsyncIOResult, errCode);
#endif
switch (mode) {
case Gen_Haskell:
break;
case Gen_Haskell_Type:
printf(" } deriving (Read, Show)\n");
break;
case Gen_Haskell_Value:
printf(" }\n");
break;
case Gen_Header:
break;
}
return 0;
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment