/* -*- mode: objc; coding: utf-8 -*- */
/* Toilet Lisp, a Common Lisp subset for the Étoilé runtime.
* Copyright (C) 2008 Matthias Andreas Benkard.
*
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation, either version 3 of the License, or (at
* your option) any later version.
*
* This program is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see .
*/
#import "MLKLLVMCompiler.h"
#import "globals.h"
#import
#import
#import
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
using namespace llvm;
static ExecutionEngine *execution_engine;
static llvm::Module *module;
static IRBuilder builder;
static FunctionPassManager *fpm;
static PointerType *PointerTy;
static ModuleProvider *module_provider;
static Constant
*createGlobalStringPtr (const char *string)
{
Constant *(indices[2]);
indices[0] = indices[1] = ConstantInt::get (Type::Int32Ty, 0);
Constant *str = ConstantArray::get (string);
Constant *str2 = new GlobalVariable (str->getType(),
true,
GlobalValue::InternalLinkage,
str,
"",
module);
Constant *ptr = ConstantExpr::getGetElementPtr (str2, indices, 2);
return ptr;
}
@implementation MLKLLVMCompiler
+(void) initialize
{
module = new llvm::Module ("MLKLLVMModule");
execution_engine = ExecutionEngine::create (module);
PointerTy = PointerType::get(Type::Int8Ty, 0);
module_provider = new ExistingModuleProvider (module);
fpm = new FunctionPassManager (module_provider);
fpm->add (new TargetData (*execution_engine->getTargetData()));
fpm->add (createInstructionCombiningPass());
fpm->add (createReassociatePass());
fpm->add (createGVNPass());
// fpm->add (createVerifierPass());
// fpm->add (createLowerSetJmpPass());
// fpm->add (createRaiseAllocationsPass());
// fpm->add (createCFGSimplificationPass());
// fpm->add (createPromoteMemoryToRegisterPass());
// fpm->add (createGlobalOptimizerPass());
// fpm->add (createGlobalDCEPass());
// fpm->add (createFunctionInliningPass());
// Utilities.
// fpm->add (createUnifyFunctionExitNodesPass());
}
+(id) compile:(id)object
inContext:(MLKLexicalContext *)context
{
Value *v = NULL;
BasicBlock *block;
std::vector noargs (0, Type::VoidTy);
FunctionType *function_type = FunctionType::get (PointerTy,
noargs,
false);
Function *function = Function::Create (function_type,
Function::ExternalLinkage,
"",
module);
id lambdaForm;
id (*fn)();
block = BasicBlock::Create ("entry", function);
builder.SetInsertPoint (block);
v = [self processForm:[MLKForm formWithObject:object
inContext:context
forCompiler:self]];
[self insertTrace:@"Bla.\n"];
builder.CreateRet (v);
verifyFunction (*function);
fpm->run (*function);
// JIT-compile.
fn = (id (*)()) execution_engine->getPointerToFunction (function);
module->dump();
NSLog (@"%p", fn);
// Execute.
lambdaForm = fn();
NSLog (@"Closure built.");
return lambdaForm;
}
+(void) processTopLevelForm:(id)object
{
[self processTopLevelForm:object
inMode:not_compile_time_mode];
}
+(void) processTopLevelForm:(id)object
inMode:(enum MLKProcessingMode)mode
{
//FIXME
// If PROGN, do this... If EVAL-WHEN, do that...
}
+(Value *) processForm:(MLKForm *)form
{
return [form processForLLVM];
}
+(Value *) insertSelectorLookup:(NSString *)name
{
Constant *function =
module->getOrInsertFunction (
#ifdef __NEXT_RUNTIME__
"sel_getUid",
#else
"sel_get_uid",
#endif
PointerTy,
PointerTy,
NULL);
Constant *nameptr = createGlobalStringPtr ([name UTF8String]);
return builder.CreateCall (function, nameptr, "selector");
}
+(Value *) insertMethodCall:(NSString *)messageName
onObject:(Value *)object
withArgumentVector:(std::vector *)argv
{
return [self insertMethodCall:messageName
onObject:object
withArgumentVector:argv
name:@""];
}
+(Value *) insertMethodCall:(NSString *)messageName
onObject:(Value *)object
withArgumentVector:(std::vector *)argv
name:(NSString *)name;
{
std::vector argtypes (2, PointerTy);
FunctionType *ftype = FunctionType::get (PointerTy, argtypes, true);
Value *sel = [self insertSelectorLookup:messageName];
#ifdef __NEXT_RUNTIME__
Constant *function =
module->getOrInsertFunction ("objc_msgSend",
ftype);
#else
std::vector lookup_argtypes (2, PointerTy);
FunctionType *lookup_ftype = FunctionType::get (PointerType::get (ftype, 0),
lookup_argtypes,
false);
Constant *lookup_function =
module->getOrInsertFunction ("objc_msg_lookup",
lookup_ftype);
Value *function =
builder.CreateCall2 (lookup_function, object, sel, "method_impl");
#endif
// XXX The following doesn't work. Why?
// std::deque argd (*argv);
// argd.push_front (sel);
// argd.push_front (object);
std::vector argd;
argd.push_back (object);
argd.push_back (sel);
std::vector::iterator e;
for (e = argv->begin(); e != argv->end(); e++)
argd.push_back (*e);
return builder.CreateCall (function, argd.begin(), argd.end());
}
+(Value *) insertMethodCall:(NSString *)messageName
onObject:(Value *)object
withName:(NSString *)name
{
std::vector argv;
return [self insertMethodCall:messageName
onObject:object
withArgumentVector:&argv
name:name];
}
+(Value *) insertMethodCall:(NSString *)messageName
onObject:(Value *)object
{
return [self insertMethodCall:messageName
onObject:object
withName:@""];
}
+(Value *) insertClassLookup:(NSString *)className
{
Constant *function =
module->getOrInsertFunction (
#ifdef __NEXT_RUNTIME__
"objc_getClass",
#else
"objc_get_class",
#endif
PointerTy,
PointerTy,
NULL);
const char *cname = [className UTF8String];
// Value *nameptr = builder.CreateGlobalStringPtr (cname, "");
Constant *nameptr = createGlobalStringPtr (cname);
return builder.CreateCall (function, nameptr, cname);
}
+(void) insertTrace:(NSString *)message
{
Constant *function =
module->getOrInsertFunction ("puts",
Type::Int32Ty,
PointerTy,
NULL);
builder.CreateCall (function, createGlobalStringPtr ([message UTF8String]));
Constant *function2 =
module->getOrInsertFunction ("fflush",
Type::Int32Ty,
PointerTy,
NULL);
}
@end
@implementation MLKForm (MLKLLVMCompilation)
-(Value *) processForLLVM
{
NSLog (@"WARNING: Unrecognised form type: %@", self);
return NULL;
}
@end
@implementation MLKProgNForm (MLKLLVMCompilation)
-(Value *) processForLLVM
{
NSEnumerator *e = [_bodyForms objectEnumerator];
MLKForm *form;
Value *value = NULL;
if ([_bodyForms count] == 0)
value = ConstantPointerNull::get (PointerTy);
while ((form = [e nextObject]))
{
value = [form processForLLVM];
}
return value;
}
@end
@implementation MLKSimpleLoopForm (MLKLLVMCompilation)
-(Value *) processForLLVM
{
NSEnumerator *e = [_bodyForms objectEnumerator];
MLKForm *form;
Function *function = builder.GetInsertBlock()->getParent();
BasicBlock *loopBlock = BasicBlock::Create ("loop", function);
BasicBlock *joinBlock = BasicBlock::Create ("after_loop");
builder.CreateBr (loopBlock);
builder.SetInsertPoint (loopBlock);
while ((form = [e nextObject]))
{
[form processForLLVM];
}
builder.CreateBr (loopBlock);
builder.SetInsertPoint (joinBlock);
function->getBasicBlockList().push_back (joinBlock);
builder.CreateUnreachable ();
return NULL;
}
@end
@implementation MLKSymbolForm (MLKLLVMCompilation)
-(Value *) processForLLVM
{
Value *value;
if ([_context variableHeapAllocationForSymbol:_form])
{
Value *binding = builder.CreateLoad ([_context bindingForSymbol:_form]);
value = [_compiler insertMethodCall:@"value" onObject:binding];
}
else
{
value = builder.CreateLoad ([_context valueForSymbol:_form],
[MLKPrintToString(_form) UTF8String]);
}
return value;
}
@end
@implementation MLKFunctionCallForm (MLKLLVMCompilation)
-(Value *) processForLLVM
{
if (![_context symbolNamesFunction:_head])
{
NSLog (@"Compiler: Don't know function %@", MLKPrintToString(_head));
// XXX Issue a style warning.
}
Value *functionCell = builder.CreateLoad ([_context functionCellForSymbol:_head]);
Value *functionPtr = builder.CreateLoad (functionCell);
Value *closureDataCell = builder.CreateLoad ([_context closureDataPointerForSymbol:_head]);
Value *closureDataPtr = builder.CreateLoad (closureDataCell);
NSEnumerator *e = [_argumentForms objectEnumerator];
MLKForm *form;
std::vector args;
args.push_back (closureDataPtr);
while ((form = [e nextObject]))
{
args.push_back ([form processForLLVM]);
}
Value *endmarker = builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
(uint64_t)MLKEndOfArgumentsMarker,
false),
PointerTy);
args.push_back (endmarker);
CallInst *call = builder.CreateCall (functionPtr,
args.begin(),
args.end(),
[MLKPrintToString(_head) UTF8String]);
return call;
}
@end
@implementation MLKSimpleLambdaForm (MLKLLVMCompilation)
-(Value *) processForLLVM
{
std::vector argtypes (1, PointerTy);
FunctionType *ftype = FunctionType::get (PointerTy, argtypes, true);
Function *function = Function::Create (ftype,
Function::InternalLinkage,
"",
module);
Function::arg_iterator args = function->arg_begin();
Value *closure_data_arg = args++;
closure_data_arg->setName ("closure_data");
BasicBlock *outerBlock = builder.GetInsertBlock ();
BasicBlock *initBlock = BasicBlock::Create ("init_function", function);
BasicBlock *loopBlock = BasicBlock::Create ("load_args");
BasicBlock *loopInitBlock = BasicBlock::Create ("load_args_prelude");
BasicBlock *joinBlock = BasicBlock::Create ("function_body");
builder.SetInsertPoint (initBlock);
[_compiler insertTrace:@"In function."];
Value *endmarker = builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
(uint64_t)MLKEndOfArgumentsMarker,
false),
PointerType::get(Type::Int8Ty, 0));
Value *ap = builder.CreateAlloca (Type::Int8Ty, NULL, "ap");
builder.CreateCall (module->getOrInsertFunction ("llvm.va_start",
Type::VoidTy,
PointerTy,
NULL),
ap);
[_compiler insertTrace:@"After va_start."];
Value *nsmutablearray = [_compiler insertClassLookup:@"NSMutableArray"];
Value *mlkcons = [_compiler insertClassLookup:@"MLKCons"];
// FIXME: Heap-allocate if appropriate.
Value *lambdaList = builder.CreateAlloca (PointerTy, NULL, "lambda_list");
builder.CreateStore ([_compiler insertMethodCall:@"array"
onObject:nsmutablearray],
lambdaList);
builder.CreateBr (loopInitBlock);
builder.SetInsertPoint (loopInitBlock);
function->getBasicBlockList().push_back (loopInitBlock);
[_compiler insertTrace:@"In loop."];
Value *arg = builder.CreateVAArg (ap, PointerTy, "arg");
Value *cond = builder.CreateICmpEQ (arg, endmarker);
builder.CreateCondBr (cond, joinBlock, loopBlock);
builder.SetInsertPoint (loopBlock);
function->getBasicBlockList().push_back (loopBlock);
[_compiler insertTrace:@"Adding argument."];
std::vector argv (1, arg);
builder.CreateStore ([_compiler insertMethodCall:@"addObject:"
onObject:builder.CreateLoad(lambdaList)
withArgumentVector:&argv],
lambdaList);
builder.CreateBr (loopInitBlock);
builder.SetInsertPoint (joinBlock);
function->getBasicBlockList().push_back (joinBlock);
[_compiler insertTrace:@"After loop."];
builder.CreateCall (module->getOrInsertFunction ("llvm.va_end",
Type::VoidTy,
PointerTy,
NULL),
ap);
argv[0] = builder.CreateLoad(lambdaList);
builder.CreateStore ([_compiler insertMethodCall:@"listWithArray:"
onObject:mlkcons
withArgumentVector:&argv],
lambdaList);
NSEnumerator *e = [_bodyForms objectEnumerator];
MLKForm *form;
Value *value = NULL;
if ([_bodyForms count] == 0)
{
//NSLog (@"%LAMBDA: No body.");
value = ConstantPointerNull::get (PointerTy);
}
while ((form = [e nextObject]))
{
//NSLog (@"%LAMBDA: Processing subform.");
[form->_context setValue:lambdaList forSymbol:_lambdaListName];
value = [form processForLLVM];
}
[_compiler insertTrace:@"Returning."];
builder.CreateRet (value);
function->dump();
NSLog (@"Verify...");
verifyFunction (*function);
NSLog (@"Optimise...");
fpm->run (*function);
//NSLog (@"Assemble...");
//id (*function_code)(...) = (id (*)(...)) execution_engine->getPointerToFunction (function);
NSLog (@"Done.");
//function_code (0, MLKEndOfArgumentsMarker);
function->dump();
NSLog (@"Function built.");
builder.SetInsertPoint (outerBlock);
Value *closure_data = ConstantPointerNull::get (PointerTy);
argv[0] = function;
// argv[0] = (builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
// (uint64_t)function_code,
// false),
// PointerTy));
argv.push_back (closure_data);
argv.push_back (builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
0,
false),
PointerTy));
Value *mlkcompiledclosure = [_compiler
insertClassLookup:@"MLKCompiledClosure"];
Value *closure =
[_compiler insertMethodCall:@"closureWithCode:data:length:"
onObject:mlkcompiledclosure
withArgumentVector:&argv];
return closure;
}
@end