WARNING! Access to this system is limited to authorised users only.
Unauthorised users may be subject to prosecution.
Unauthorised access to this system is a criminal offence under Australian law (Federal Crimes Act 1914 Part VIA)
It is a criminal offence to:
(1) Obtain access to data without authority. -Penalty 2 years imprisonment.
(2) Damage, delete, alter or insert data without authority. -Penalty 10 years imprisonment.
User activity is monitored and recorded. Anyone using this system expressly consents to such monitoring and recording.

To protect your data, the CISO officer has suggested users to enable 2FA as soon as possible.
Currently 2.3% of users enabled 2FA.

Commit 85ea89d7 authored by Pavel Zakopaylo's avatar Pavel Zakopaylo
Browse files

Fixed type-related bug in primordial function generation

parent d06055ae
......@@ -256,7 +256,7 @@ data MuState = MuState
, _definitions :: Seq Definition
, _topLevels :: Seq TopLevel
, _topBinds :: M.Map GHC.Id GlobalCellName
, _mainFunc :: Maybe (VarName, VarName)
, _mainFunc :: Maybe (VarName, VarName, TypedefName)
}
uniqueID :: Lens' MuState Int
......@@ -274,7 +274,7 @@ topLevels k m = fmap (\new -> m { _topLevels = new }) (k (_topLevels m))
topBinds :: Lens' MuState (M.Map GHC.Id GlobalCellName)
topBinds k m = fmap (\new -> m { _topBinds = new }) (k (_topBinds m))
mainFunc :: Lens' MuState (Maybe (VarName, VarName))
mainFunc :: Lens' MuState (Maybe (VarName, VarName, TypedefName))
mainFunc k m = fmap (\new -> m { _mainFunc = new }) (k (_mainFunc m))
-------------------------------------------------- * Block building monad
......@@ -443,11 +443,11 @@ bundleMu modName codegen = runMu initialState $ do
-- | Generates main function that evaluates selected closure
-- NOTE: Will fail (VM panic) if called (with Just) multiple times
haskellMain :: Maybe (VarName, VarName) -> Mu (Maybe FunctionName)
haskellMain :: Maybe (VarName, VarName, TypedefName) -> Mu (Maybe FunctionName)
haskellMain m = case m of
Nothing -> return Nothing
Just (entry, closure) -> do
Just (entry, closure, closMuRefType) -> do
typedef "@pi8" $ UPtr i8
typedef "@ppi8" $ UPtr "@pi8"
funcsig "@_haskell_main_sig" [i64, "@ppi8"] []
......@@ -456,7 +456,12 @@ haskellMain m = case m of
basicBlock "@_haskell_main.entry"
[("@_haskell_main.entry.argc", i64),
("@_haskell_main.entry.argv", "@ppi8")] $ do
return $ TailCall muClosureFunctionSig entry [closure]
emit' $ ["@_haskell_main.entry.target"] :=
ConvertOperation REFCAST closMuRefType
muClosureIref closure
return $ TailCall muClosureFunctionSig entry
["@_haskell_main.entry.target"]
return $ Just "@_haskell_main"
......@@ -504,9 +509,14 @@ closure name table payload = do
-- a different payload.
definitions %= (|> TypeDefinition closMuType (Struct $
muClosure : map unboxedType payload))
definitions %= (|> TypeDefinition closMuRefType (IRef closMuType))
where
name' = closureNameOf name
closMuType = closureTypeNameOf name
closMuRefType = closureRefTypeNameOf name
-- | Emit a string. The string itself will be allocated during build time.
......@@ -574,6 +584,9 @@ closureNameOf' n = VarName $ Name $ stringify n <> "_closure"
closureTypeNameOf :: (Uniquable a, NamedThing a) => a -> TypedefName
closureTypeNameOf n = TypedefName $ Name $ stringify n <> "_clostype"
closureRefTypeNameOf :: (Uniquable a, NamedThing a) => a -> TypedefName
closureRefTypeNameOf n = TypedefName $ Name $ stringify n <> "_refclostype"
entryNameOf :: GHC.Id -> FunctionName
entryNameOf n = FunctionName $ Name $ stringify n <> "_entry"
......
......@@ -212,7 +212,8 @@ codegenTop' name rhs = do
mod <- gets _moduleName
when (tail (stringify name) == ("zdmainzd" <> mod <> "zdmain")) $ do
traceM "Found main method!"
modify (\v -> v { _mainFunc = Just (entry, closureNameOf' name) })
modify (\v -> v { _mainFunc = Just (entry, closureNameOf' name,
closureRefTypeNameOf name) })
topBinds %= (M.insert name $ closureNameOf name)
case rhs of
......
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