Work towards garbage collection and explicitly managed stack frames.

git-svn-id: http://svn.drobilla.net/resp/tuplr@126 ad02d1e2-f140-0410-9f75-f8b11f17cedd

6 files changed, 154 insertions, 30 deletions

diff --git a/Makefile b/Makefile
index d2fa881..53770bc 100644
--- a/Makefile
+++ b/Makefile
@@ -4,12 +4,20 @@ LLVM_LDFLAGS=`llvm-config --ldflags --libs core jit native`
 CXXFLAGS=-O0 -g -Wall -Wextra -Wno-unused-parameter $(LLVM_CXXFLAGS)
 LDFLAGS=$(LLVM_LDFLAGS) -lm 
 
-build/tuplr: build/tuplr.o build/typing.o build/llvm.o build/write.o build/gc.o
+all: builddir build/tuplr
+	mkdir -p build
+
+builddir:
+	mkdir -p build
+
+build/tuplr: build/tuplr.o build/typing.o build/llvm.o build/gclib.so build/write.o build/gc.o
 	g++ -o $@ $^ $(LDFLAGS)
 
 build/%.o: %.cpp tuplr.hpp
-	mkdir -p build
 	g++ $(CXXFLAGS) -o $@ -c $<
 
+build/%.so: %.cpp tuplr.hpp
+	g++ -fPIC -dPIC -shared $(CXXFLAGS) -o $@ $<
+
 clean:
 	rm -rf build
diff --git a/gc.cpp b/gc.cpp
index 6221e7f..a321d35 100644
--- a/gc.cpp
+++ b/gc.cpp
@@ -38,10 +38,8 @@ mark(CEnv& cenv, const Object* obj)
 	obj->used = true;
 	const ATuple* tup = dynamic_cast<const ATuple*>(obj);
 	if (tup) {
-		FOREACH(ATuple::const_iterator, i, *tup) {
+		FOREACH(ATuple::const_iterator, i, *tup)
 			mark(cenv, *i);
-			mark(cenv, cenv.type(*i));
-		}
 	}
 }
 
diff --git a/gclib.cpp b/gclib.cpp
new file mode 100644
index 0000000..3181dcd
--- /dev/null
+++ b/gclib.cpp
@@ -0,0 +1,45 @@
+/* Tuplr: A programming language
+ * Copyright (C) 2008-2009 David Robillard <dave@drobilla.net>
+ *
+ * Tuplr is free software: you can redistribute it and/or modify it under
+ * the terms of the GNU Affero General Public License as published by the
+ * Free Software Foundation, either version 3 of the License, or (at your
+ * option) any later version.
+ *
+ * Tuplr 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 Affero General
+ * Public License for more details.
+ *
+ * You should have received a copy of the GNU Affero General Public License
+ * along with Tuplr.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include "tuplr.hpp"
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+extern "C" {
+
+void
+tuplr_gc_initialize(unsigned heapSize)
+{
+	//printf("LLVM GC INIT %u\n", heapSize);
+}
+
+void*
+tuplr_gc_allocate(unsigned size)
+{
+	//printf("LLVM GC ALLOC %u\n", size);
+	return malloc(size);
+}
+
+void
+tuplr_gc_collect()
+{
+	//printf("LLVM GC COLLECT\n");
+}
+
+}
+
diff --git a/llvm.cpp b/llvm.cpp
index c5161a0..b07624d 100644
--- a/llvm.cpp
+++ b/llvm.cpp
@@ -124,6 +124,8 @@ CEnv::compile(AST* obj)
 void
 CEnv::optimise(CFunction f)
 {
+	if (args.find("-g") != args.end())
+		return;
 	verifyFunction(*static_cast<Function*>(f));
 	_pimpl->opt.run(*static_cast<Function*>(f));
 }
@@ -194,20 +196,26 @@ ASymbol::compile(CEnv& cenv)
 void
 AClosure::lift(CEnv& cenv)
 {
+	cenv.push();
+	for (const_iterator p = prot()->begin(); p != prot()->end(); ++p)
+		cenv.def((*p)->as<ASymbol*>(), *p, NULL, NULL);
+
+	// Lift body
+	for (size_t i = 2; i < size(); ++i)
+		at(i)->lift(cenv);
+
+	cenv.pop();
+
 	AType* type = cenv.type(this);
 	if (funcs.find(type) || !type->concrete())
 		return;
 
-	ATuple* protT = type->at(1)->as<ATuple*>();
-	vector<AType*> argsT;
-	for (size_t i = 0; i < protT->size(); ++i)
-		argsT.push_back(protT->at(i)->as<AType*>());
-
-	liftCall(cenv, argsT);
+	AType* protT = type->at(1)->as<AType*>();
+	liftCall(cenv, *protT);
 }
 
 void
-AClosure::liftCall(CEnv& cenv, const vector<AType*>& argsT)
+AClosure::liftCall(CEnv& cenv, const AType& argsT)
 {
 	TEnv::GenericTypes::const_iterator gt = cenv.tenv.genericTypes.find(this);
 	assert(gt != cenv.tenv.genericTypes.end());
@@ -233,21 +241,67 @@ AClosure::liftCall(CEnv& cenv, const vector<AType*>& argsT)
 	ATuple* protT = thisType->at(1)->as<ATuple*>();
 
 	// Write function declaration
-	string name = this->name == "" ? cenv.gensym("_fn") : this->name;
+	const string name = (this->name == "") ? cenv.gensym("_fn") : this->name;
 	Function* f = compileFunction(cenv, name,
 			lltype(thisType->at(thisType->size()-1)->to<AType*>()),
 			*protT, loc);
 
+	llvm::IRBuilder<>& builder = llengine(cenv)->builder;
+
 	cenv.push();
 	Subst oldSubst = cenv.tsubst;
 	cenv.tsubst = Subst::compose(cenv.tsubst, Subst::compose(argsSubst, subst));
 
+//#define EXPLICIT_STACK_FRAME 1
+
+#ifdef EXPLICIT_STACK_FRAMES
+	vector<const Type*> types;
+	types.push_back(PointerType::get(Type::VoidTy, 0));
+	size_t s = 0;
+#endif
+
 	// Bind argument values in CEnv
 	vector<Value*> args;
 	const_iterator p = prot()->begin();
 	size_t i = 0;
-	for (Function::arg_iterator a = f->arg_begin(); a != f->arg_end(); ++a, ++p)
-		cenv.def((*p)->as<ASymbol*>(), *p, protT->at(i++)->as<AType*>(), &*a);
+	for (Function::arg_iterator a = f->arg_begin(); a != f->arg_end(); ++a, ++p, ++i) {
+		AType* t = protT->at(i)->as<AType*>();
+		const Type* lt = lltype(t);
+		THROW_IF(!lt, loc, "untyped parameter\n");
+		cenv.def((*p)->as<ASymbol*>(), *p, t, &*a);
+#ifdef EXPLICIT_STACK_FRAMES
+		types.push_back(lt);
+		s += std::max(lt->getPrimitiveSizeInBits(), unsigned(8));
+#endif
+	}
+
+
+#ifdef EXPLICIT_STACK_FRAMES
+	// Scan out definitions
+	for (size_t i = 0; i < size(); ++i) {
+		ADefinition* def = at(i)->to<ADefinition*>();
+		if (def) {
+			const Type* lt = lltype(cenv.type(def->at(2)));
+			THROW_IF(!lt, loc, "untyped definition\n");
+			types.push_back(lt);
+			s += std::max(lt->getPrimitiveSizeInBits(), unsigned(8));
+		}
+	}
+
+	// Create stack frame
+	StructType* sT = StructType::get(types, false);
+	PointerType* pT = PointerType::get(sT, 0);
+	Value* frameSize = ConstantInt::get(Type::Int32Ty, (s + pT->getPrimitiveSizeInBits()) / 8);
+	Value* mem = builder.CreateCall(LLVal(cenv.alloc), frameSize, "mem");
+	Value* frame = builder.CreateBitCast(mem, pT, "frame");
+
+	// Bind parameter values in stack frame
+	i = 1;
+	for (Function::arg_iterator a = f->arg_begin(); a != f->arg_end(); ++a, ++i) {
+		Value* v = builder.CreateStructGEP(frame, i);
+		builder.CreateStore(&*a, v);
+	}
+#endif
 
 	// Write function body
 	try {
@@ -257,7 +311,7 @@ AClosure::liftCall(CEnv& cenv, const vector<AType*>& argsT)
 		CValue retVal = NULL;
 		for (size_t i = 2; i < size(); ++i)
 			retVal = cenv.compile(at(i));
-		llengine(cenv)->builder.CreateRet(LLVal(retVal)); // Finish function
+		builder.CreateRet(LLVal(retVal)); // Finish function
 		cenv.optimise(LLFunc(f));
 	} catch (Error& e) {
 		f->eraseFromParent(); // Error reading body, remove function
@@ -277,8 +331,8 @@ AClosure::compile(CEnv& cenv)
 void
 ACall::lift(CEnv& cenv)
 {
-	AClosure*      c = cenv.tenv.resolve(at(0))->to<AClosure*>();
-	vector<AType*> argsT;
+	AClosure* c = cenv.tenv.resolve(at(0))->to<AClosure*>();
+	AType     argsT(loc, NULL);
 
 	// Lift arguments
 	for (size_t i = 1; i < size(); ++i) {
@@ -304,18 +358,21 @@ ACall::compile(CEnv& cenv)
 	if (!c) return NULL; // Primitive
 
 	AType protT(loc, NULL);
-	for (size_t i = 1; i < size(); ++i)
+	vector<const Type*> types;
+	for (size_t i = 1; i < size(); ++i) {
 		protT.push_back(cenv.type(at(i)));
+		types.push_back(lltype(cenv.type(at(i))));
+	}
 
 	TEnv::GenericTypes::const_iterator gt = cenv.tenv.genericTypes.find(c);
 	assert(gt != cenv.tenv.genericTypes.end());
 	AType fnT(loc, cenv.penv.sym("Fn"), &protT, cenv.type(this), 0);
 	Function* f = (Function*)c->funcs.find(&fnT);
-	THROW_IF(!f, loc, (format("callee failed to compile for type %1%") % fnT.str()).str())
+	THROW_IF(!f, loc, (format("callee failed to compile for type %1%") % fnT.str()).str());
 
 	vector<Value*> params(size() - 1);
-	for (size_t i = 1; i < size(); ++i)
-		params[i-1] = LLVal(cenv.compile(at(i)));
+	for (size_t i = 0; i < types.size(); ++i)
+		params[i] = LLVal(cenv.compile(at(i+1)));
 
 	return llengine(cenv)->builder.CreateCall(f, params.begin(), params.end());
 }
@@ -582,6 +639,9 @@ eval(CEnv& cenv, const string& name, istream& is)
 
 		Object::pool.collect(cenv, Object::pool.roots());
 
+		if (cenv.args.find("-d") != cenv.args.end())
+			cenv.write(cenv.out);
+
 	} catch (Error& e) {
 		cenv.err << e.what() << endl;
 		return 1;
@@ -638,6 +698,8 @@ repl(CEnv& cenv)
 			Object::pool.collect(cenv, Object::pool.roots());
 
 			cenv.tsubst = oldSubst;
+			if (cenv.args.find("-d") != cenv.args.end())
+				cenv.write(cenv.out);
 
 		} catch (Error& e) {
 			cenv.err << e.what() << endl;
@@ -655,7 +717,8 @@ newCenv(PEnv& penv, TEnv& tenv)
 	// Host provided allocation primitive prototypes
 	std::vector<const Type*> argsT(1, Type::Int32Ty);
 	FunctionType* funcT = FunctionType::get(PointerType::get(Type::Int8Ty, 0), argsT, false);
-	cenv->alloc = Function::Create(funcT, Function::ExternalLinkage, "malloc", engine->module);
+	cenv->alloc = Function::Create(funcT, Function::ExternalLinkage,
+			"tuplr_gc_allocate", engine->module);
 
 	return cenv;
 }
@@ -663,7 +726,7 @@ newCenv(PEnv& penv, TEnv& tenv)
 void
 freeCenv(CEnv* cenv)
 {
-	Object::pool.collect(*cenv, GC::Roots());
+	Object::pool.collect(*cenv, ::GC::Roots());
 	delete (LLVMEngine*)cenv->engine();
 	delete cenv;
 }
diff --git a/tuplr.cpp b/tuplr.cpp
index c945c34..f3d0c66 100644
--- a/tuplr.cpp
+++ b/tuplr.cpp
@@ -139,7 +139,8 @@ macDef(PEnv& penv, const SExp& exp)
 		SExp fnExp(exp.at(2).loc);
 		fnExp.push_back(SExp(exp.at(2).loc, "fn"));
 		fnExp.push_back(argsExp);
-		fnExp.push_back(exp.at(2));
+		for (size_t i = 2; i < exp.size(); ++i)
+			fnExp.push_back(exp.at(i));
 		SExp ret(exp.loc);
 		ret.push_back(exp.at(0));
 		ret.push_back(exp.at(1).at(0));
@@ -244,6 +245,8 @@ print_usage(char* name, bool error)
 	os << "  -h               Display this help and exit"        << endl;
 	os << "  -r               Enter REPL after evaluating files" << endl;
 	os << "  -p               Pretty-print input only"           << endl;
+	os << "  -g               Debug (disable optimisation)"      << endl;
+	os << "  -d               Dump assembly output"              << endl;
 	os << "  -e EXPRESSION    Evaluate EXPRESSION"               << endl;
 	os << "  -o FILE          Write output to FILE"              << endl;
 	return error ? 1 : 0;
@@ -267,9 +270,10 @@ main(int argc, char** argv)
 			return print_usage(argv[0], false);
 		} else if (argv[i][0] != '-') {
 			files.push_back(argv[i]);
-		} else if (!strncmp(argv[i], "-r", 3)) {
-			args.insert(make_pair(argv[i], ""));
-		} else if (!strncmp(argv[i], "-p", 3)) {
+		} else if (!strncmp(argv[i], "-r", 3)
+				|| !strncmp(argv[i], "-p", 3)
+				|| !strncmp(argv[i], "-g", 3)
+				|| !strncmp(argv[i], "-d", 3)) {
 			args.insert(make_pair(argv[i], ""));
 		} else if (i == argc-1 || argv[i+1][0] == '-') {
 			return print_usage(argv[0], true);
@@ -279,6 +283,8 @@ main(int argc, char** argv)
 		}
 	}
 
+	cenv->args = args;
+
 	int ret = 0;
 
 	string output;
diff --git a/tuplr.hpp b/tuplr.hpp
index 8910136..97a5988 100644
--- a/tuplr.hpp
+++ b/tuplr.hpp
@@ -165,6 +165,7 @@ struct Object {
 	static GC pool;
 };
 
+
 /***************************************************************************
  * Abstract Syntax Tree                                                    *
  ***************************************************************************/
@@ -264,7 +265,8 @@ struct AType : public ATuple {
 	AType(Cursor c, AST* ast, ...) : ATuple(c), kind(EXPR), id(0) {
 		if (!ast) return;
 		va_list args; va_start(args, ast);
-		push_back(ast);
+		if (ast)
+			push_back(ast);
 		for (AST* a = va_arg(args, AST*); a; a = va_arg(args, AST*))
 			push_back(a);
 		va_end(args);
@@ -361,7 +363,7 @@ struct AClosure : public ATuple {
 	bool    operator==(const AST& rhs) const { return this == &rhs; }
 	void    constrain(TEnv& tenv, Constraints& c) const;
 	void    lift(CEnv& cenv);
-	void    liftCall(CEnv& cenv, const vector<AType*>& argsT);
+	void    liftCall(CEnv& cenv, const AType& argsT);
 	CValue  compile(CEnv& cenv);
 	ATuple* prot() const { return at(1)->to<ATuple*>(); }
 	Funcs         funcs;
@@ -607,6 +609,8 @@ struct CEnv {
 	CFunction alloc;
 	Subst     tsubst;
 
+	map<string,string> args;
+
 private:
 	struct PImpl; ///< Private Implementation
 	PImpl* _pimpl;