Skip to content

Commit

Permalink
wip
Browse files Browse the repository at this point in the history
  • Loading branch information
@ollef
ollef committed Feb 10, 2024
1 parent 1586515 commit f25850b
Show file tree
Hide file tree
Showing 6 changed files with 144 additions and 517 deletions.
43 changes: 13 additions & 30 deletions rts/Sixten.Builtin.ll
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,57 +7,40 @@ declare void @exit(i32)
@Sixten.Builtin.EmptyRepresentation = unnamed_addr constant i64 0
@Sixten.Builtin.WordRepresentation = unnamed_addr constant i64 8

define external fastcc { ptr, ptr } @Sixten.Builtin.unknown(ptr %shadow_stack, ptr %heap_pointer, ptr %heap_limit, ptr %destination, i64 %a) {
define external fastcc void @Sixten.Builtin.unknown(ptr %destination, i64 %a) {
call void @exit(i32 7411)
unreachable
}

define external fastcc { i64, ptr, ptr } @Sixten.Builtin.addRepresentation(ptr %shadow_stack, ptr %heap_pointer, ptr %heap_limit, i64 %a, i64 %b) {
define external fastcc i64 @Sixten.Builtin.addRepresentation(i64 %a, i64 %b) {
%result = add i64 %a, %b
%result_with_heap_pointer_and_limit1 = insertvalue { i64, ptr, ptr } undef, i64 %result, 0
%result_with_heap_pointer_and_limit2 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit1, ptr %heap_pointer, 1
%result_with_heap_pointer_and_limit3 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit2, ptr %heap_limit, 2
ret { i64, ptr, ptr } %result_with_heap_pointer_and_limit3
ret i64 %result
}

define external fastcc { i64, ptr, ptr } @Sixten.Builtin.maxRepresentation(ptr %shadow_stack, ptr %heap_pointer, ptr %heap_limit, i64 %a, i64 %b) {
define external fastcc i64 @Sixten.Builtin.maxRepresentation(i64 %a, i64 %b) {
%a_lt_b = icmp ult i64 %a, %b
%result = select i1 %a_lt_b, i64 %b, i64 %a
%result_with_heap_pointer_and_limit1 = insertvalue { i64, ptr, ptr } undef, i64 %result, 0
%result_with_heap_pointer_and_limit2 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit1, ptr %heap_pointer, 1
%result_with_heap_pointer_and_limit3 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit2, ptr %heap_limit, 2
ret { i64, ptr, ptr } %result_with_heap_pointer_and_limit3
ret i64 %result
}

define external fastcc { ptr, ptr } @Sixten.Builtin.printInt(ptr %shadow_stack, ptr %heap_pointer, ptr %heap_limit, i64 %tagged_i) {
define external fastcc void @Sixten.Builtin.printInt(i64 %tagged_i) {
%i = ashr i64 %tagged_i, 1
call void @print_int(i64 %i)
%result_with_heap_pointer_and_limit1 = insertvalue { ptr, ptr } undef, ptr %heap_pointer, 0
%result_with_heap_pointer_and_limit2 = insertvalue { ptr, ptr } %result_with_heap_pointer_and_limit1, ptr %heap_limit, 1
ret { ptr, ptr } %result_with_heap_pointer_and_limit2
ret void
}

define external fastcc { i64, ptr, ptr } @Sixten.Builtin.addInt(ptr %shadow_stack, ptr %heap_pointer, ptr %heap_limit, i64 %a, i64 %b) {
define external fastcc i64 @Sixten.Builtin.addInt(i64 %a, i64 %b) {
%result = add i64 %a, %b
%result_with_heap_pointer_and_limit1 = insertvalue { i64, ptr, ptr } undef, i64 %result, 0
%result_with_heap_pointer_and_limit2 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit1, ptr %heap_pointer, 1
%result_with_heap_pointer_and_limit3 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit2, ptr %heap_limit, 2
ret { i64, ptr, ptr } %result_with_heap_pointer_and_limit3
ret i64 %result
}

define external fastcc { i64, ptr, ptr } @Sixten.Builtin.mulInt(ptr %shadow_stack, ptr %heap_pointer, ptr %heap_limit, i64 %a, i64 %b) {
define external fastcc i64 @Sixten.Builtin.mulInt(i64 %a, i64 %b) {
%doubled_result = mul i64 %a, %b
%result = ashr i64 %doubled_result, 1
%result_with_heap_pointer_and_limit1 = insertvalue { i64, ptr, ptr } undef, i64 %result, 0
%result_with_heap_pointer_and_limit2 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit1, ptr %heap_pointer, 1
%result_with_heap_pointer_and_limit3 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit2, ptr %heap_limit, 2
ret { i64, ptr, ptr } %result_with_heap_pointer_and_limit3
ret i64 %result
}

define external fastcc { i64, ptr, ptr } @Sixten.Builtin.subInt(ptr %shadow_stack, ptr %heap_pointer, ptr %heap_limit, i64 %a, i64 %b) {
define external fastcc i64 @Sixten.Builtin.subInt(i64 %a, i64 %b) {
%result = sub i64 %a, %b
%result_with_heap_pointer_and_limit1 = insertvalue { i64, ptr, ptr } undef, i64 %result, 0
%result_with_heap_pointer_and_limit2 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit1, ptr %heap_pointer, 1
%result_with_heap_pointer_and_limit3 = insertvalue { i64, ptr, ptr } %result_with_heap_pointer_and_limit2, ptr %heap_limit, 2
ret { i64, ptr, ptr } %result_with_heap_pointer_and_limit3
ret i64 %result
}
47 changes: 22 additions & 25 deletions src/Assembly.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -55,9 +55,6 @@ data Instruction
| RestoreStack !Operand
| HeapAllocate
{ destination :: !Local
, shadowStack :: !Operand
, heapPointer :: !Operand
, heapLimit :: !Operand
, constructorTag :: !Word8
, size :: !Operand
}
Expand Down Expand Up @@ -153,8 +150,8 @@ instance Pretty Instruction where
returningInstr dst "savestack" ([] :: [Operand])
RestoreStack o ->
voidInstr "restorestack" [o]
HeapAllocate dst a b c d e ->
returningInstr dst "gcmalloc" [a, b, c, Lit $ Literal.Integer $ fromIntegral d, e]
HeapAllocate dst a b ->
returningInstr dst "heap_alloc" [Lit $ Literal.Integer $ fromIntegral a, b]
ExtractHeapPointer dst a ->
returningInstr dst "extract heap pointer" [a]
ExtractHeapPointerConstructorTag dst a ->
Expand All @@ -167,21 +164,21 @@ instance Pretty Instruction where
Return local -> pretty local <+> "= "
<> "switch"
<+> pretty scrutinee
<> line
<> indent
2
( vsep
[ pretty i
<+> "->"
<> line
<> indent
2
( vsep
[ pretty i
<+> "->"
<> line
<> indent 2 (pretty basicBlock)
| (i, basicBlock) <- branches
]
<> line
<> indent 2 (pretty basicBlock)
| (i, basicBlock) <- branches
]
<> line
<> "_ -> "
<> line
<> indent 2 (pretty default_)
)
<> "_ -> "
<> line
<> indent 2 (pretty default_)
)
where
voidInstr name args =
name <+> hsep (pretty <$> args)
Expand All @@ -197,23 +194,23 @@ instance Pretty Definition where
<+> pretty type_
<+> "constant"
<+> "="
<> line
<> indent 2 (pretty knownConstant)
<> line
<> indent 2 (pretty knownConstant)
ConstantDefinition type_ returnType constantParameters basicBlock ->
pretty type_
<+> "constant"
<+> pretty returnType
<+> tupled (pretty <$> constantParameters)
<+> "="
<> line
<> indent 2 (pretty basicBlock)
<> line
<> indent 2 (pretty basicBlock)
FunctionDefinition returnType args basicBlock ->
"function"
<+> pretty returnType
<+> tupled (pretty <$> args)
<+> "="
<> line
<> indent 2 (pretty basicBlock)
<> line
<> indent 2 (pretty basicBlock)

instance Pretty BasicBlock where
pretty (BasicBlock instrs result) =
Expand Down
22 changes: 6 additions & 16 deletions src/AssemblyToLLVM.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -424,32 +424,22 @@ assembleInstruction instruction =
argument' <- assembleOperandAndCastTo Assembly.WordPointer argument
declare "llvm.stackrestore" $ "declare ccc void @llvm.stackrestore" <> parens [pointer]
emitInstruction $ "call ccc void @llvm.stackrestore" <> parens [typedOperand argument']
Assembly.HeapAllocate {destination, shadowStack, heapPointer, heapLimit, constructorTag, size} -> do
destination' <- activateLocal (Assembly.Struct [Assembly.Word, Assembly.WordPointer, Assembly.WordPointer]) destination
shadowStack' <- assembleOperandAndCastTo Assembly.WordPointer shadowStack
heapPointer' <- assembleOperandAndCastTo Assembly.WordPointer heapPointer
heapLimit' <- assembleOperandAndCastTo Assembly.WordPointer heapLimit
Assembly.HeapAllocate {destination, constructorTag, size} -> do
destination' <- activateLocal Assembly.Word destination
size' <- assembleOperandAndCastTo Assembly.Word size
declare
"__regcall3__heap_alloc"
$ "declare x86_regcallcc "
<> braces [wordSizedInt, pointer, pointer]
<> wordSizedInt
<> " @__regcall3__heap_alloc"
<> parens [pointer, pointer, pointer, "i8", wordSizedInt]
<> parens ["i8", wordSizedInt]
emitInstruction $
localName destination'
<> " = call x86_regcallcc "
<> braces
[ wordSizedInt
, pointer
, pointer
]
<> wordSizedInt
<> "@__regcall3__heap_alloc"
<> parens
[ typedOperand shadowStack'
, typedOperand heapPointer'
, typedOperand heapLimit'
, "i8 " <> Builder.word8Dec constructorTag
[ "i8 " <> Builder.word8Dec constructorTag
, typedOperand size'
]
Assembly.ExtractHeapPointer destination pointer_ -> do
Expand Down
39 changes: 19 additions & 20 deletions src/ClosureConverted/Representation.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -60,10 +60,10 @@ signature def =
returnRepresentation <- typeRepresentation env' type_
pure $ Representation.FunctionSignature parameterRepresentations returnRepresentation
Syntax.DataDefinition {} ->
pure $ Representation.ConstantSignature $ Representation.Direct Representation.Doesn'tContainHeapPointers
pure $ Representation.ConstantSignature Representation.Direct
Syntax.ParameterisedDataDefinition _boxity tele ->
telescopeSignature context tele mempty \_ _ parameterRepresentations -> do
pure $ Representation.FunctionSignature parameterRepresentations $ Representation.Direct Representation.Doesn'tContainHeapPointers
telescopeSignature context tele mempty \_ _ parameterRepresentations ->
pure $ Representation.FunctionSignature parameterRepresentations Representation.Direct
where
context =
Context.empty
Expand Down Expand Up @@ -95,38 +95,38 @@ typeRepresentation :: Environment v -> Domain.Type -> M Representation
typeRepresentation env type_ =
case type_ of
Domain.Neutral (Domain.Var _) _ ->
pure $ Representation.Indirect Representation.MightContainHeapPointers
pure Representation.Indirect
-- TODO: Handle these special cases in a nicer way
Domain.Neutral (Domain.Global (Name.Lifted Builtin.TypeName 0)) Tsil.Empty ->
pure $ Representation.Direct Representation.Doesn'tContainHeapPointers
pure Representation.Direct
Domain.Neutral (Domain.Global (Name.Lifted Builtin.IntName 0)) Tsil.Empty ->
pure $ Representation.Direct Representation.Doesn'tContainHeapPointers
pure Representation.Direct
Domain.Neutral (Domain.Global global) (Domain.groupSpine -> [Domain.GroupedApps args]) -> do
globalCase global args
Domain.Neutral (Domain.Global global) (Domain.groupSpine -> []) -> do
globalCase global []
Domain.Neutral {} ->
pure $ Representation.Indirect Representation.MightContainHeapPointers
pure Representation.Indirect
Domain.Con {} ->
pure $ Representation.Indirect Representation.MightContainHeapPointers
pure Representation.Indirect
Domain.Lit {} ->
pure $ Representation.Indirect Representation.MightContainHeapPointers
pure Representation.Indirect
Domain.Glued _ _ type' ->
typeRepresentation env type'
Domain.Lazy lazyType -> do
type' <- force lazyType
typeRepresentation env type'
Domain.Pi {} ->
pure $ Representation.Direct Representation.MightContainHeapPointers
pure Representation.Direct
Domain.Function {} ->
pure $ Representation.Direct Representation.Doesn'tContainHeapPointers
pure Representation.Direct
where
globalCase global@(Name.Lifted qualifiedName liftedNameNumber) args = do
-- TODO caching
definition <- fetch $ Query.ClosureConverted global
case definition of
Syntax.TypeDeclaration _ ->
pure $ Representation.Indirect Representation.MightContainHeapPointers
pure Representation.Indirect
Syntax.ConstantDefinition term -> do
value <- Evaluation.evaluate Environment.empty term
type' <- Evaluation.apply env value args
Expand All @@ -135,20 +135,20 @@ typeRepresentation env type_ =
maybeType' <- Evaluation.applyFunction env (Telescope.fromVoid tele) args
case maybeType' of
Nothing ->
pure $ Representation.Direct Representation.MightContainHeapPointers -- a closure
pure Representation.Direct -- a closure
Just type' ->
typeRepresentation env type'
Syntax.DataDefinition Boxed _ ->
pure $ Representation.Direct Representation.MightContainHeapPointers
pure Representation.Direct
Syntax.DataDefinition Unboxed constructors -> do
unless (liftedNameNumber == 0) $ panic "ClosureConverted.Representation. Data with name number /= 0"
unboxedDataRepresentation qualifiedName Environment.empty constructors
Syntax.ParameterisedDataDefinition Boxed _ ->
pure $ Representation.Direct Representation.MightContainHeapPointers
pure Representation.Direct
Syntax.ParameterisedDataDefinition Unboxed tele -> do
unless (liftedNameNumber == 0) $ panic "ClosureConverted.Representation. Data with name number /= 0"
maybeResult <- Evaluation.applyTelescope env (Telescope.fromVoid tele) args $ unboxedDataRepresentation qualifiedName
pure $ fromMaybe (Representation.Indirect Representation.MightContainHeapPointers) maybeResult
pure $ fromMaybe Representation.Indirect maybeResult

unboxedDataRepresentation :: Name.Qualified -> Environment v -> Syntax.ConstructorDefinitions v -> M Representation
unboxedDataRepresentation dataTypeName env (Syntax.ConstructorDefinitions constructors) = do
Expand All @@ -164,8 +164,7 @@ unboxedDataRepresentation dataTypeName env (Syntax.ConstructorDefinitions constr
Nothing -> fieldRepresentation
Just _ -> constructorTagRepresentation <> fieldRepresentation
where
constructorTagRepresentation =
Representation.Direct Representation.Doesn'tContainHeapPointers
constructorTagRepresentation = Representation.Direct

constructorFieldRepresentation :: Environment v -> Domain.Type -> Representation -> M Representation
constructorFieldRepresentation env type_ accumulatedRepresentation = do
Expand All @@ -174,8 +173,8 @@ constructorFieldRepresentation env type_ accumulatedRepresentation = do
Domain.Pi _ fieldType closure -> do
fieldRepresentation <- typeRepresentation env fieldType
case accumulatedRepresentation <> fieldRepresentation of
representation@(Representation.Indirect Representation.MightContainHeapPointers) ->
pure representation
Representation.Indirect ->
pure Representation.Indirect
accumulatedRepresentation' -> do
(context', var) <- Environment.extend env
type'' <- Evaluation.evaluateClosure closure $ Domain.var var
Expand Down
Loading

0 comments on commit f25850b

Please sign in to comment.