diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index bdc2e8e..f0e4e29 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1886,7 +1886,19 @@ linkBinary dflags o_files dep_packages = do rc_objs <- maybeCreateManifest dflags output_fn - SysTools.runLink dflags ( + -- On iOS, instead of an executable we create a static library. + -- We can't use any dynamic libraries when doing this, so here we strip the + -- ones that would otherwise get added. + let link opts + | platformOS (targetPlatform dflags) == OSiOS + = SysTools.runLibtool dflags $ [ o | o <- opts, + case o of + SysTools.FileOption _ _ -> True + SysTools.Option opt -> + opt `notElem` ["-ldl", "-liconv", "-lm", "-lpthread"] ] + | otherwise = SysTools.runLink dflags opts + + link ( map SysTools.Option verbFlags ++ [ SysTools.Option "-o" , SysTools.FileOption "" output_fn @@ -1950,11 +1962,13 @@ linkBinary dflags o_files dep_packages = do exeFileName :: DynFlags -> FilePath exeFileName dflags | Just s <- outputFile dflags = - if platformOS (targetPlatform dflags) == OSMinGW32 - then if null (takeExtension s) - then s <.> "exe" - else s - else s + case platformOS (targetPlatform dflags) of + OSMinGW32 -> if null (takeExtension s) + then s <.> "exe" + else s + OSiOS -> let (path, file) = splitFileName s -- On iOS we link a static + in combine path (file++".a") -- lib into Xcode + _ -> s | otherwise = if platformOS (targetPlatform dflags) == OSMinGW32 then "main.exe" diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 54d9d1b..7a1a38a 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -45,6 +45,7 @@ import Util import Panic import Outputable import Maybes +import Platform ( Platform(..), OS(..) ) import System.Environment ( getEnv ) import Distribution.InstalledPackageInfo @@ -876,7 +877,13 @@ collectLinkOpts :: DynFlags -> [PackageConfig] -> [String] collectLinkOpts dflags ps = concat (map all_opts ps) where libs p = packageHsLibs dflags p ++ extraLibraries p - all_opts p = map ("-l" ++) (libs p) ++ ldOptions p + -- On iOS, instead of creating an executable, we create a static library that + -- we then link into an Xcode project. The iOS libtool doesn't accept most + -- link options, so we just discard any that are specified in packages. + -- Generally they need to be added by hand to the Xcode project instead. + all_opts p = case platformOS (targetPlatform dflags) of + OSiOS -> map ("-l" ++) (libs p) + _ -> map ("-l" ++) (libs p) ++ ldOptions p packageHsLibs :: DynFlags -> PackageConfig -> [String] packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p) diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index bacd53e..f34ac16 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -15,7 +15,7 @@ module SysTools ( runUnlit, runCpp, runCc, -- [Option] -> IO () runPp, -- [Option] -> IO () runSplit, -- [Option] -> IO () - runAs, runLink, -- [Option] -> IO () + runAs, runLink, runLibtool, -- [Option] -> IO () runMkDLL, runWindres, runLlvmOpt, @@ -595,6 +595,13 @@ runLink dflags args = do mb_env <- getGccEnv args1 runSomethingFiltered dflags id "Linker" p args1 mb_env +runLibtool :: DynFlags -> [Option] -> IO () +runLibtool dflags args = do + let (p,args0) = ("libtool", [Option "-static"]) + args1 = args0 ++ args + mb_env <- getGccEnv args1 + runSomethingFiltered dflags id "Linker" p args1 mb_env + runMkDLL :: DynFlags -> [Option] -> IO () runMkDLL dflags args = do let (p,args0) = pgm_dll dflags @@ -1182,6 +1189,7 @@ linkDynLib dflags o_files dep_packages ++ pkg_lib_path_opts ++ pkg_link_opts )) + OSiOS -> throwGhcExceptionIO (ProgramError "dynamic libraries are not supported on iOS target") _ -> do ------------------------------------------------------------------- -- Making a DSO diff --git a/ghc.mk b/ghc.mk index 5843d81..7eafc63 100644 --- a/ghc.mk +++ b/ghc.mk @@ -640,10 +640,12 @@ ifeq "$(CrossCompiling)-$(phase)" "YES-final" MAYBE_GHCTAGS= MAYBE_HPC= MAYBE_RUNGHC= +MAYBE_GHCPWD= else MAYBE_GHCTAGS=utils/ghctags MAYBE_HPC=utils/hpc MAYBE_RUNGHC=utils/runghc +MAYBE_GHCPWD=utils/ghc-pwd endif BUILD_DIRS += utils/haddock @@ -654,7 +656,7 @@ BUILD_DIRS += utils/ghc-pkg BUILD_DIRS += utils/deriveConstants BUILD_DIRS += utils/testremove BUILD_DIRS += $(MAYBE_GHCTAGS) -BUILD_DIRS += utils/ghc-pwd +BUILD_DIRS += $(MAYBE_GHCPWD) BUILD_DIRS += utils/ghc-cabal BUILD_DIRS += $(MAYBE_HPC) BUILD_DIRS += $(MAYBE_RUNGHC) diff --git a/includes/rts/storage/GC.h b/includes/rts/storage/GC.h index 80f11d3..85cfde8 100644 --- a/includes/rts/storage/GC.h +++ b/includes/rts/storage/GC.h @@ -154,8 +154,18 @@ StgPtr allocate ( Capability *cap, W_ n ); StgPtr allocatePinned ( Capability *cap, W_ n ); /* memory allocator for executable memory */ -void * allocateExec(W_ len, void **exec_addr); -void freeExec (void *p); +#if defined(USE_LIBFFI_FOR_ADJUSTORS) +typedef struct { void* ptr; } AdjustorWritable; +typedef struct { void* ptr; } AdjustorExecutable; +#else +typedef void* AdjustorWritable; +typedef void* AdjustorExecutable; +#endif + +/* Return writeable handle, and executable through exec_addr. */ +AdjustorWritable allocateExec(W_ len, AdjustorExecutable *exec_addr); +AdjustorWritable execToWritable(AdjustorExecutable); +void freeExec(AdjustorWritable p); // Used by GC checks in external .cmm code: extern W_ large_alloc_lim; diff --git a/libraries/Cabal b/libraries/Cabal index 14c5a3f..723f165 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 14c5a3f78c00772cf54c2fd5c920a64d53e6f594 +Subproject commit 723f165b97cb2eaec2a4e987bd3eea5490eee272 diff --git a/libraries/primitive b/libraries/primitive --- a/libraries/primitive +++ b/libraries/primitive @@ -1 +1 @@ -Subproject commit 75c3379b6d76e914cc3c7ffd290b6b1cad7ea3e6 +Subproject commit 75c3379b6d76e914cc3c7ffd290b6b1cad7ea3e6-dirty diff --git a/libraries/terminfo b/libraries/terminfo --- a/libraries/terminfo +++ b/libraries/terminfo @@ -1 +1 @@ -Subproject commit 116d3ee6840d52bab69c880d775ae290a20d64bc +Subproject commit 116d3ee6840d52bab69c880d775ae290a20d64bc-dirty diff --git a/libraries/time b/libraries/time --- a/libraries/time +++ b/libraries/time @@ -1 +1 @@ -Subproject commit 12ba4321d34d646cf9040ad12810c4257d26ade9 +Subproject commit 12ba4321d34d646cf9040ad12810c4257d26ade9-dirty diff --git a/libraries/transformers b/libraries/transformers --- a/libraries/transformers +++ b/libraries/transformers @@ -1 +1 @@ -Subproject commit a59fb93860f84ccd44178dcbbb82cfea7e02cd07 +Subproject commit a59fb93860f84ccd44178dcbbb82cfea7e02cd07-dirty diff --git a/libraries/vector b/libraries/vector --- a/libraries/vector +++ b/libraries/vector @@ -1 +1 @@ -Subproject commit f27156970d9480806a5defcfea5367187c2a6997 +Subproject commit f27156970d9480806a5defcfea5367187c2a6997-dirty diff --git a/mk/config.mk.in b/mk/config.mk.in index 275c21a..5594d8d 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -567,6 +567,9 @@ ifeq "$(CrossCompiling)" "YES" SRC_HSC2HS_OPTS_STAGE1 += --cross-compile SRC_HSC2HS_OPTS_STAGE2 += --cross-compile endif +SRC_HSC2HS_OPTS_STAGE0 += --cflag=-D$(HostArch_CPP)_HOST_ARCH=1 --cflag=-D$(HostOS_CPP)_HOST_OS=1 +SRC_HSC2HS_OPTS_STAGE1 += --cflag=-D$(TargetArch_CPP)_HOST_ARCH=1 --cflag=-D$(TargetOS_CPP)_HOST_OS=1 +SRC_HSC2HS_OPTS_STAGE2 += --cflag=-D$(TargetArch_CPP)_HOST_ARCH=1 --cflag=-D$(TargetOS_CPP)_HOST_OS=1 ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32" WINDRES = $(INPLACE_MINGW)/bin/windres diff --git a/rts/Adjustor.c b/rts/Adjustor.c index 1a0bc28..a6da5ff 100644 --- a/rts/Adjustor.c +++ b/rts/Adjustor.c @@ -60,13 +60,17 @@ extern void *adjustorCode; void freeHaskellFunctionPtr(void* ptr) { + AdjustorExecutable exec; + AdjustorWritable writ; ffi_closure *cl; - - cl = (ffi_closure*)ptr; + + exec.ptr = ptr; + writ = execToWritable(exec); + cl = writ.ptr; freeStablePtr(cl->user_data); stgFree(cl->cif->arg_types); stgFree(cl->cif); - freeExec(cl); + freeExec(writ); } static ffi_type * char_to_ffi_type(char c) @@ -98,9 +102,9 @@ createAdjustor (int cconv, ffi_type **arg_types; nat n_args, i; ffi_type *result_type; - ffi_closure *cl; + AdjustorWritable writ; + AdjustorExecutable code; int r, abi; - void *code; n_args = strlen(typeString) - 1; cif = stgMallocBytes(sizeof(ffi_cif), "createAdjustor"); @@ -126,15 +130,15 @@ createAdjustor (int cconv, r = ffi_prep_cif(cif, abi, n_args, result_type, arg_types); if (r != FFI_OK) barf("ffi_prep_cif failed: %d", r); - cl = allocateExec(sizeof(ffi_closure), &code); - if (cl == NULL) { + writ = allocateExec(sizeof(ffi_closure), &code); + if (writ.ptr == NULL) { barf("createAdjustor: failed to allocate memory"); } - r = ffi_prep_closure(cl, cif, (void*)wptr, hptr/*userdata*/); + r = ffi_prep_closure_loc(writ.ptr, cif, (void*)wptr, hptr/*userdata*/, code.ptr); if (r != FFI_OK) barf("ffi_prep_closure failed: %d", r); - return (void*)code; + return code.ptr; } #else // To end of file... diff --git a/rts/posix/Itimer.c b/rts/posix/Itimer.c index b99ff89..4bcc3a1 100644 --- a/rts/posix/Itimer.c +++ b/rts/posix/Itimer.c @@ -45,6 +45,20 @@ #include /* + * timer_create doesn't exist and setitimer doesn't fire on iOS, so we're using + * a pthreads-based implementation. It may be to do with interference with the + * signals of the debugger. Revisit. See #7723. + */ +#if defined(ios_HOST_OS) +#define USE_PTHREAD_FOR_ITIMER +#endif + +#if defined(USE_PTHREAD_FOR_ITIMER) +#include +#include +#endif + +/* * We use a realtime timer by default. I found this much more * reliable than a CPU timer: * @@ -107,6 +121,7 @@ static timer_t timer; static Time itimer_interval = DEFAULT_TICK_INTERVAL; +#if !defined(USE_PTHREAD_FOR_ITIMER) static void install_vtalrm_handler(TickProc handle_tick) { struct sigaction action; @@ -132,13 +147,33 @@ static void install_vtalrm_handler(TickProc handle_tick) stg_exit(EXIT_FAILURE); } } +#endif + +#if defined(USE_PTHREAD_FOR_ITIMER) +static volatile int itimer_enabled; +static void *itimer_thread_func(void *_handle_tick) +{ + TickProc handle_tick = _handle_tick; + while (1) { + usleep(TimeToUS(itimer_interval)); + switch (itimer_enabled) { + case 1: handle_tick(0); break; + case 2: itimer_enabled = 0; + } + } + return NULL; +} +#endif void initTicker (Time interval, TickProc handle_tick) { itimer_interval = interval; -#if defined(USE_TIMER_CREATE) +#if defined(USE_PTHREAD_FOR_ITIMER) + pthread_t tid; + pthread_create(&tid, NULL, itimer_thread_func, (void*)handle_tick); +#elif defined(USE_TIMER_CREATE) { struct sigevent ev; @@ -153,15 +188,18 @@ initTicker (Time interval, TickProc handle_tick) stg_exit(EXIT_FAILURE); } } -#endif - install_vtalrm_handler(handle_tick); +#else + install_vtalrm_handler(handle_tick); +#endif } void startTicker(void) { -#if defined(USE_TIMER_CREATE) +#if defined(USE_PTHREAD_FOR_ITIMER) + itimer_enabled = 1; +#elif defined(USE_TIMER_CREATE) { struct itimerspec it; @@ -193,7 +231,14 @@ startTicker(void) void stopTicker(void) { -#if defined(USE_TIMER_CREATE) +#if defined(USE_PTHREAD_FOR_ITIMER) + if (itimer_enabled == 1) { + itimer_enabled = 2; + /* Wait for the thread to confirm it won't generate another tick. */ + while (itimer_enabled != 0) + sched_yield(); + } +#elif defined(USE_TIMER_CREATE) struct itimerspec it; it.it_value.tv_sec = 0; diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index f14b3b0..f6de61c 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -29,6 +29,9 @@ #include "Trace.h" #include "GC.h" #include "Evac.h" +#if defined(ios_HOST_OS) +#include "Hash.h" +#endif #include @@ -1094,7 +1097,7 @@ calcNeeded (rtsBool force_major, memcount *blocks_needed) // because it knows how to work around the restrictions put in place // by SELinux. -void *allocateExec (W_ bytes, void **exec_ret) +AdjustorWritable allocateExec(W_ bytes, AdjustorExecutable *exec_ret) { void **ret, **exec; ACQUIRE_SM_LOCK; @@ -1106,8 +1109,13 @@ void *allocateExec (W_ bytes, void **exec_ret) return (ret + 1); } -// freeExec gets passed the executable address, not the writable address. -void freeExec (void *addr) +AdjustorWritable execToWritable(AdjustorExecutable exec) +{ + /* They're identical, so convert the type. */ + return exec; +} + +void freeExec(AdjustorWritable addr) { void *writable; writable = *((void**)addr - 1); @@ -1116,9 +1124,57 @@ void freeExec (void *addr) RELEASE_SM_LOCK } +#elif defined(ios_HOST_OS) + +static HashTable* allocatedExecs; + +AdjustorWritable allocateExec(W_ bytes, AdjustorExecutable *exec_ret) +{ + AdjustorWritable writ; + ffi_closure* cl; + if (bytes != sizeof(ffi_closure)) + barf("allocateExec: may only be used for ffi_closure"); + ACQUIRE_SM_LOCK; + cl = writ.ptr = ffi_closure_alloc((size_t)bytes + sizeof(AdjustorExecutable), &exec_ret->ptr); + if (cl != NULL) { + /* Record the executable address after the ffi_closure so we can retrieve + it when we free it. */ + AdjustorExecutable* exec = (AdjustorExecutable*)(cl + 1); + *exec = *exec_ret; + if (allocatedExecs == NULL) + allocatedExecs = allocHashTable(); + insertHashTable(allocatedExecs, (StgWord)exec_ret->ptr, writ.ptr); + } + RELEASE_SM_LOCK; + return writ; +} + +AdjustorWritable execToWritable(AdjustorExecutable exec) +{ + AdjustorWritable writ; + ACQUIRE_SM_LOCK; + if (allocatedExecs == NULL || + (writ.ptr = lookupHashTable(allocatedExecs, (StgWord)exec.ptr)) == NULL) { + RELEASE_SM_LOCK; + barf("execToWritable: not found"); + } + RELEASE_SM_LOCK; + return writ; +} + +void freeExec(AdjustorWritable writ) +{ + ffi_closure* cl = writ.ptr; + AdjustorExecutable exec = *((AdjustorExecutable*)(cl + 1)); + ACQUIRE_SM_LOCK; + removeHashTable(allocatedExecs, (StgWord)exec.ptr, writ.ptr); + ffi_closure_free(cl); + RELEASE_SM_LOCK +} + #else -void *allocateExec (W_ bytes, void **exec_ret) +AdjustorWritable allocateExec(W_ bytes, AdjustorExecutable *exec_ret) { void *ret; W_ n; @@ -1158,7 +1214,13 @@ void *allocateExec (W_ bytes, void **exec_ret) return ret; } -void freeExec (void *addr) +AdjustorWritable execToWritable(AdjustorExecutable exec) +{ + /* They're identical, so just change types. */ + return exec; +} + +void freeExec(AdjustorExecutable addr) { StgPtr p = (StgPtr)addr - 1; bdescr *bd = Bdescr((StgPtr)p); diff --git a/rules/distdir-opts.mk b/rules/distdir-opts.mk index fd415b6..d9056ba 100644 --- a/rules/distdir-opts.mk +++ b/rules/distdir-opts.mk @@ -85,8 +85,6 @@ $1_$2_ALL_HSC2HS_OPTS = \ $$(SRC_HSC2HS_OPTS) \ $$(SRC_HSC2HS_OPTS_STAGE$3) \ --cflag=-D__GLASGOW_HASKELL__=$$(if $$(filter 0,$3),$$(GhcCanonVersion),$$(ProjectVersionInt)) \ - --cflag=-D$$(HostArch_CPP)_HOST_ARCH=1 \ - --cflag=-D$$(HostOS_CPP)_HOST_OS=1 \ $$($1_$2_HSC2HS_CC_OPTS) \ $$($1_$2_HSC2HS_LD_OPTS) \ --cflag=-I$1/$2/build/autogen \