Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
f89b73e6
Commit
f89b73e6
authored
Sep 13, 2012
by
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
Changes
6
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
;
}
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment