first cut of C extensions

16 files changed, 207 insertions, 15 deletions

diff --git a/src/bytecode.c b/src/bytecode.c
index eb46bc57..869c26e2 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -36,6 +36,8 @@
 
 typedef struct colm_struct Struct;
 
+Tree **host_call( Program *prg, long code, Tree **sp );
+
 #define TRUE_VAL  1
 #define FALSE_VAL 0
 
@@ -3198,6 +3200,15 @@ again:
 			break;
 		}
 
+		case IN_HOST: {
+			Half funcId;
+			read_half( funcId );
+
+			debug( prg, REALM_BYTECODE, "IN_HOST %hd\n", funcId );
+
+			sp = host_call( prg, funcId, sp );
+			break;
+		}
 		case IN_CALL_WV: {
 			Half funcId;
 			read_half( funcId );
diff --git a/src/bytecode.h b/src/bytecode.h
index 90b5afca..a035f699 100644
--- a/src/bytecode.h
+++ b/src/bytecode.h
@@ -74,7 +74,6 @@ typedef unsigned long colm_value_t;
 
 #define IN_TST_NZ_TREE           0xd1
 
-// 0xea
 // 0xeb
 // 0xec
 // 0xd4
@@ -229,6 +228,8 @@ typedef unsigned long colm_value_t;
 #define IN_PRINT_XML             0x89
 #define IN_PRINT_STREAM          0x8a
 
+#define IN_HOST                  0xea
+
 #define IN_CALL_WC               0x8c
 #define IN_CALL_WV               0x8d
 #define IN_RET                   0x8e
@@ -520,7 +521,6 @@ enum LEL_ID {
 #define vm_pushn(n) \
 	( ( (sp-(n)) < prg->sb_beg ? (sp = vm_bs_add(prg, sp, n)) : 0 ), (sp -= (n)) )
 
-
 #define vm_pop_type(type) \
 	({ SW r = *sp; (sp+1) >= prg->sb_end ? (sp = vm_bs_pop(prg, sp, 1)) : (sp += 1); (type)r; })
 
@@ -631,7 +631,6 @@ static inline void vm_set_local( struct colm_execution *exec, int o, Tree* v )
 
 long stringLength( Head *str );
 const char *stringData( Head *str );
-Head *stringAllocFull( struct colm_program *prg, const char *data, long length );
 Head *initStrSpace( long length );
 Head *stringCopy( struct colm_program *prg, Head *head );
 void stringFree( struct colm_program *prg, Head *head );
@@ -649,8 +648,6 @@ Head *stringSprintf( Program *prg, Str *format, long integer );
 Head *makeLiteral( struct colm_program *prg, long litoffset );
 Head *intToStr( struct colm_program *prg, Word i );
 
-Tree *constructString( struct colm_program *prg, Head *s );
-
 void colm_execute( struct colm_program *prg, Execution *exec, Code *code );
 void reductionExecution( Execution *exec, Tree **sp );
 void generationExecution( Execution *exec, Tree **sp );
diff --git a/src/colm.lm b/src/colm.lm
index 9aa62387..6e273946 100644
--- a/src/colm.lm
+++ b/src/colm.lm
@@ -214,6 +214,7 @@ def root_item
 |	[struct_def] :Struct commit
 |	[namespace_def] :Namespace commit
 |	[function_def] :Function commit
+|	[in_host_def] :InHost commit
 |	[iter_def] :Iter commit
 |	[statement] :Statement commit
 |	[global_def] :Global commit
@@ -265,6 +266,7 @@ def struct_item
 |	[region_def] :Region commit
 |	[struct_def] :Struct commit
 |	[function_def] :Function commit
+|	[in_host_def] :InHost commit
 |	[iter_def] :Iter commit
 |	[export_def] :Export commit
 |	[pre_eof_def] :PreEof commit
@@ -303,6 +305,11 @@ def function_def
 			POPEN ParamVarDefList: param_var_def_list PCLOSE
 			COPEN lang_stmt_list CCLOSE]
 
+def in_host_def
+	[opt_export type_ref id 
+			POPEN ParamVarDefList: param_var_def_list PCLOSE
+			EQUALS HostFunc: id]
+
 def struct_var_def
 	[var_def]
 
@@ -344,6 +351,7 @@ def namespace_item
 |	[struct_def] :Struct commit
 |	[namespace_def] :Namespace commit
 |	[function_def] :Function commit
+|	[in_host_def] :InHost commit
 |	[iter_def] :Iter commit
 |	[pre_eof_def] :PreEof commit
 |	[precedence_def] :Precedence commit
diff --git a/src/compiler.cc b/src/compiler.cc
index 300d84db..0d2d48d6 100644
--- a/src/compiler.cc
+++ b/src/compiler.cc
@@ -395,6 +395,7 @@ Compiler::Compiler( )
 	nextPatConsId(0),
 	nextGenericId(1),
 	nextFuncId(0),
+	nextHostId(0),
 	nextObjectId(1),     /* 0 is  reserved for no object. */
 	nextFrameId(0),
 	nextParserId(0),
@@ -1093,6 +1094,53 @@ void Compiler::generateOutput( long activeRealm )
 	if ( !gblLibrary ) 
 		fsmGen->writeMain( activeRealm );
 
+	if ( !gblLibrary )  {
+		for ( FunctionList::Iter hc = inHostList; hc.lte(); hc++ ) {
+			*outStream <<
+				"Value " << hc->hostCall << "( Program *prg";
+			for ( ParameterList::Iter p = *hc->paramList; p.lte(); p++ ) {
+				*outStream <<
+					", Value";
+			}
+			*outStream << " );\n";
+		}
+
+		*outStream <<
+			"Tree **host_call( Program *prg, long code, Tree **sp )\n"
+			"{\n"
+			"	Value rtn = 0;\n"
+			"	switch ( code ) {\n";
+		
+		for ( FunctionList::Iter hc = inHostList; hc.lte(); hc++ ) {
+			*outStream <<
+				"		case " << hc->funcId << ": {\n";
+
+			int pos = 0;
+			for ( ParameterList::Iter p = *hc->paramList; p.lte(); p++, pos++ ) {
+				*outStream <<
+					"			Value p" << pos << " = vm_pop_value();\n";
+			}
+			
+			*outStream <<
+				"			rtn = " << hc->hostCall << "( prg";
+
+			pos = 0;
+			for ( ParameterList::Iter p = *hc->paramList; p.lte(); p++, pos++ ) {
+				*outStream <<
+					", p" << pos;
+			}
+			*outStream << " );\n"
+				"			break;\n"
+				"		}\n";
+		}
+			
+		*outStream <<
+			"	}\n"
+			"	vm_push_value( rtn );\n"
+			"	return sp;\n"
+			"}\n";
+	}
+
 	outStream->flush();
 }
 
diff --git a/src/compiler.h b/src/compiler.h
index fd2fb14d..178ed5a8 100644
--- a/src/compiler.h
+++ b/src/compiler.h
@@ -793,6 +793,7 @@ struct Compiler
 	void resolveMapElementOf( ObjectDef *container, ObjectDef *obj, ElementOf *elof );
 	void resolveElementOf( ObjectDef *obj );
 	void makeFuncVisible( Function *func, bool isUserIter );
+	void makeInHostVisible( Function *func );
 
 	void declareFunction( Function *func );
 	void declareReductionCode( Production *prod );
@@ -802,6 +803,7 @@ struct Compiler
 	void declareByteCode();
 
 	void resolveFunction( Function *func );
+	void resolveInHost( Function *func );
 	void resolvePreEof( TokenRegion *region );
 	void resolveRootBlock();
 	void resolveTranslateBlock( LangEl *langEl );
@@ -952,7 +954,9 @@ struct Compiler
 	int nextGenericId;
 
 	FunctionList functionList;
+	FunctionList inHostList;
 	int nextFuncId;
+	int nextHostId;
 
 	enum CompileContext {
 		CompileTranslation,
diff --git a/src/ctinput.cc b/src/ctinput.cc
index 24427dab..2e00bf55 100644
--- a/src/ctinput.cc
+++ b/src/ctinput.cc
@@ -497,3 +497,8 @@ extern "C" void internalPopBinding( PdaRun *pdaRun, ParseTree *parseTree )
 	if ( lastBound == parseTree )
 		pdaRun->bindings->pop();
 }
+
+extern "C" void host_call( long, Tree ** )
+{
+
+}
diff --git a/src/declare.cc b/src/declare.cc
index 6ecf6335..676631d3 100644
--- a/src/declare.cc
+++ b/src/declare.cc
@@ -1379,6 +1379,30 @@ void Compiler::makeFuncVisible( Function *func, bool isUserIter )
 	func->objMethod = objMethod;
 }
 
+void Compiler::makeInHostVisible( Function *func )
+{
+	/* Set up the parameters. */
+	for ( ParameterList::Iter param = *func->paramList; param.lte(); param++ ) {
+		if ( func->localFrame->rootScope->findField( param->name ) != 0 )
+			error(param->loc) << "parameter " << param->name << " redeclared" << endp;
+
+		func->localFrame->rootScope->insertField( param->name, param );
+	}
+
+	/* Insert the function into the global function map. */
+	ObjectMethod *objMethod = new ObjectMethod( func->typeRef, func->name, 
+			IN_HOST, IN_HOST, 
+			func->paramList->length(), 0, func->paramList, false );
+	objMethod->funcId = func->funcId;
+	objMethod->useFuncId = true;
+	objMethod->useCallObj = false;
+	objMethod->func = func;
+
+	globalObjectDef->methodMap->insert( func->name, objMethod );
+
+	func->objMethod = objMethod;
+}
+
 /*
  * Type Declaration Root.
  */
@@ -1391,6 +1415,9 @@ void Compiler::declarePass()
 	for ( FunctionList::Iter f = functionList; f.lte(); f++ )
 		makeFuncVisible( f, f->isUserIter );
 
+	for ( FunctionList::Iter f = inHostList; f.lte(); f++ )
+		makeInHostVisible( f );
+
 	rootNamespace->declare( this );
 
 	/* Will fill in zero lels that were not declared. */
diff --git a/src/loadcolm.cc b/src/loadcolm.cc
index 97388eca..42243919 100644
--- a/src/loadcolm.cc
+++ b/src/loadcolm.cc
@@ -2235,6 +2235,18 @@ struct LoadColm
 		blockClose();
 	}
 
+	void walkInHostDef( in_host_def InHostDef )
+	{
+		ObjectDef *localFrame = blockOpen();
+
+		TypeRef *typeRef = walkTypeRef( InHostDef.type_ref() );
+		String id = InHostDef.id().data();
+		ParameterList *paramList = walkParamVarDefList( InHostDef.ParamVarDefList() );
+		inHostDef( InHostDef.HostFunc().data(), localFrame, paramList, typeRef, id, false );
+
+		blockClose();
+	}
+
 	void walkIterDef( iter_def IterDef )
 	{
 		ObjectDef *localFrame = blockOpen();
@@ -2280,6 +2292,9 @@ struct LoadColm
 		case struct_item::Function:
 			walkFunctionDef( structItem.function_def() );
 			break;
+		case struct_item::InHost:
+			walkInHostDef( structItem.in_host_def() );
+			break;
 		case struct_item::Iter:
 			walkIterDef( structItem.iter_def() );
 			break;
@@ -2369,6 +2384,9 @@ struct LoadColm
 		case root_item::Function:
 			walkFunctionDef( rootItem.function_def() );
 			break;
+		case struct_item::InHost:
+			walkInHostDef( rootItem.in_host_def() );
+			break;
 		case root_item::Iter:
 			walkIterDef( rootItem.iter_def() );
 			break;
@@ -2433,6 +2451,9 @@ struct LoadColm
 		case namespace_item::Function:
 			walkFunctionDef( item.function_def() );
 			break;
+		case struct_item::InHost:
+			walkInHostDef( item.in_host_def() );
+			break;
 		case namespace_item::Iter:
 			walkIterDef( item.iter_def() );
 			break;
diff --git a/src/loadinit.cc b/src/loadinit.cc
index 9d1e1764..c684c1e1 100644
--- a/src/loadinit.cc
+++ b/src/loadinit.cc
@@ -383,7 +383,7 @@ void LoadInit::go( long activeRealm )
 	argv[2] = 0;
 
 	colm_program *program = colm_new_program( &colm_object );
-	colm_set_debug( program, 0x1 );
+	colm_set_debug( program, 0x0 );
 	colm_run_program( program, 2, argv );
 
 	/* Extract the parse tree. */
diff --git a/src/main.cc b/src/main.cc
index 1758579c..61914bfa 100644
--- a/src/main.cc
+++ b/src/main.cc
@@ -94,6 +94,7 @@ bool gblLibrary = false;
 long gblActiveRealm = 0;
 
 ArgsVector includePaths;
+ArgsVector additionalCodeFiles;;
 
 /* Print version information. */
 void version();
@@ -181,6 +182,7 @@ void usage()
 "   -c                   compile only (don't produce binary)\n"
 "   -e <file>            write C++ export header to <file>\n"
 "   -x <file>            write C++ export code to <file>\n"
+"	-a <file>            additional code file to include in output program\n"
 	;	
 }
 
@@ -394,8 +396,14 @@ void compileOutputInstalled( const char *argv0 )
 		last -= 1;
 	}
 
+
 	int length = 1024 + strlen(intermedFn) + strlen(binaryFn);
-	char command[length];
+
+	for ( ArgsVector::Iter af = additionalCodeFiles; af.lte(); af++ )
+		length += strlen( *af ) + 2;
+
+	char *command = new char[length];
+
 	sprintf( command, 
 		"gcc -Wall -Wwrite-strings"
 		" -I" PREFIX "/include"
@@ -405,8 +413,15 @@ void compileOutputInstalled( const char *argv0 )
 		" -L" PREFIX "/lib"
 		" -lcolmd",
 		binaryFn, intermedFn );
+	
+	for ( ArgsVector::Iter af = additionalCodeFiles; af.lte(); af++ ) {
+		strcat( command, " " );
+		strcat( command, *af );
+	}
 
 	compileOutputCommand( command );
+
+	delete[] command;
 }
 
 void compileOutputInSource( const char *argv0 )
@@ -418,7 +433,11 @@ void compileOutputInSource( const char *argv0 )
 	last[0] = 0;
 
 	int length = 1024 + 3 * strlen(location) + strlen(intermedFn) + strlen(binaryFn);
-	char command[length];
+
+	for ( ArgsVector::Iter af = additionalCodeFiles; af.lte(); af++ )
+		length += strlen( *af ) + 2;
+
+	char *command = new char[length];
 	sprintf( command, 
 		"gcc -Wall -Wwrite-strings"
 		" -I%s/../aapl"
@@ -430,8 +449,15 @@ void compileOutputInSource( const char *argv0 )
 		" -lcolmd",
 		location, location,
 		binaryFn, intermedFn, location );
+
+	for ( ArgsVector::Iter af = additionalCodeFiles; af.lte(); af++ ) {
+		strcat( command, " " );
+		strcat( command, *af );
+	}
 	
 	compileOutputCommand( command );
+
+	delete[] command;
 }
 
 bool inSourceTree( const char *argv0 )
@@ -456,7 +482,7 @@ bool inSourceTree( const char *argv0 )
 
 void processArgs( int argc, const char **argv )
 {
-	ParamCheck pc( "cD:e:x:I:vdlio:S:M:vHh?-:sV", argc, argv );
+	ParamCheck pc( "cD:e:x:I:vdlio:S:M:vHh?-:sVa:", argc, argv );
 
 	while ( pc.check() ) {
 		switch ( pc.state ) {
@@ -522,6 +548,10 @@ void processArgs( int argc, const char **argv )
 			case 'x':
 				exportCodeFn = pc.parameterArg;
 				break;
+			case 'a':
+				additionalCodeFiles.append( pc.parameterArg );
+				break;
+
 			case 'D':
 #if DEBUG
 				if ( strcmp( pc.parameterArg, "BYTECODE" ) == 0 )
diff --git a/src/parser.cc b/src/parser.cc
index 5ce080c2..7e901f6b 100644
--- a/src/parser.cc
+++ b/src/parser.cc
@@ -452,6 +452,18 @@ void BaseParser::functionDef( StmtList *stmtList, ObjectDef *localFrame,
 	newFunction->inContext = curStruct();
 }
 
+void BaseParser::inHostDef( const String &hostCall, ObjectDef *localFrame,
+	ParameterList *paramList, TypeRef *typeRef, const String &name, bool exprt )
+{
+	Function *newFunction = Function::cons( typeRef, name, 
+			paramList, 0, pd->nextHostId++, false, exprt );
+	newFunction->hostCall = hostCall;
+	newFunction->localFrame = localFrame;
+	newFunction->inHost = true;
+	pd->inHostList.append( newFunction );
+	newFunction->inContext = curStruct();
+}
+
 void BaseParser::iterDef( StmtList *stmtList, ObjectDef *localFrame,
 	ParameterList *paramList, const String &name )
 {
diff --git a/src/parser.h b/src/parser.h
index b38e9e5b..5909d55f 100644
--- a/src/parser.h
+++ b/src/parser.h
@@ -86,9 +86,14 @@ struct BaseParser
 
 	ObjectDef *blockOpen();
 	void blockClose();
+
+	void inHostDef( const String &hostCall, ObjectDef *localFrame,
+			ParameterList *paramList, TypeRef *typeRef,
+			const String &name, bool exprt );
 	void functionDef( StmtList *stmtList, ObjectDef *localFrame,
 			ParameterList *paramList, TypeRef *typeRef,
 			const String &name, bool exprt );
+
 	void iterDef( StmtList *stmtList, ObjectDef *localFrame,
 			ParameterList *paramList, const String &name );
 	LangStmt *globalDef( ObjectField *objField, LangExpr *expr,
diff --git a/src/parsetree.h b/src/parsetree.h
index 8afb63c5..10b2143c 100644
--- a/src/parsetree.h
+++ b/src/parsetree.h
@@ -3338,7 +3338,8 @@ struct Function
 		paramListSize(0),
 		paramUTs(0),
 		inContext(0),
-		objMethod(0)
+		objMethod(0),
+		inHost(false)
 	{}
 
 	static Function *cons( TypeRef *typeRef, const String &name, 
@@ -3361,6 +3362,7 @@ struct Function
 	TransBlock *transBlock;
 	TypeRef *typeRef;
 	String name;
+	String hostCall;
 	ParameterList *paramList;
 	CodeBlock *codeBlock;
 	ObjectDef *localFrame;
@@ -3371,6 +3373,7 @@ struct Function
 	StructDef *inContext;
 	bool exprt;
 	ObjectMethod *objMethod;
+	bool inHost;
 
 	Function *prev, *next;
 };
diff --git a/src/resolve.cc b/src/resolve.cc
index 5f8bfaa4..90a35b60 100644
--- a/src/resolve.cc
+++ b/src/resolve.cc
@@ -780,6 +780,16 @@ void Compiler::resolveFunction( Function *func )
 	block->resolve( this );
 }
 
+void Compiler::resolveInHost( Function *func )
+{
+	if ( func->typeRef != 0 ) 
+		func->typeRef->resolveType( this );
+
+	for ( ParameterList::Iter param = *func->paramList; param.lte(); param++ )
+		param->typeRef->resolveType( this );
+}
+
+
 void Compiler::resolvePreEof( TokenRegion *region )
 {
 	CodeBlock *block = region->preEofBlock;
@@ -810,6 +820,9 @@ void Compiler::resolveParseTree()
 	for ( FunctionList::Iter f = functionList; f.lte(); f++ )
 		resolveFunction( f );
 
+	for ( FunctionList::Iter f = inHostList; f.lte(); f++ )
+		resolveInHost( f );
+
 	/* Compile the reduction code. */
 	for ( DefList::Iter prod = prodList; prod.lte(); prod++ ) {
 		if ( prod->redBlock != 0 )
diff --git a/src/synthesis.cc b/src/synthesis.cc
index 474a1154..9e63bfaa 100644
--- a/src/synthesis.cc
+++ b/src/synthesis.cc
@@ -909,7 +909,7 @@ ObjectField **LangVarRef::evaluateArgs( Compiler *pd, CodeVect &code,
 
 			size += 1;
 
-			if ( lookup.objMethod->func ) {
+			if ( lookup.objMethod->func && !lookup.objMethod->func->inHost ) {
 				code.append( IN_STASH_ARG );
 				code.appendHalf( pos );
 				code.appendHalf( 1 );
@@ -1081,14 +1081,14 @@ UniqueType *LangVarRef::evaluateCall( Compiler *pd, CodeVect &code, CallArgVect
 
 	/* Prepare the contiguous call args space. */
 	int asLoc;
-	if ( func != 0 ) {
+	if ( func != 0 && !func->inHost ) {
 		code.append( IN_PREP_ARGS );
 		asLoc = code.length();
 		code.appendHalf( 0 );
 	}
 
 	bool resetContiguous = false;
-	if ( func != 0 ) {
+	if ( func != 0 && !func->inHost ) {
 		long stretch = func->paramListSize + 5 + func->localFrame->size();
 		resetContiguous = pd->beginContiguous( code, stretch );
 	}
@@ -1107,13 +1107,13 @@ UniqueType *LangVarRef::evaluateCall( Compiler *pd, CodeVect &code, CallArgVect
 	pd->endContiguous( code, resetContiguous );
 	pd->clearContiguous( code, resetContiguous );
 
-	if ( func != 0 ) {
+	if ( func != 0 && !func->inHost ) {
 		code.append( IN_CLEAR_ARGS );
 		code.appendHalf( func->paramListSize );
 		code.setHalf( asLoc, func->paramListSize );
 	}
 
-	if ( func != 0 )
+	if ( func != 0 && !func->inHost )
 		code.append( IN_LOAD_RETVAL );
 
 	/* Return the type to the expression. */
@@ -3008,6 +3008,9 @@ void Compiler::placeAllFrameObjects()
 	for ( FunctionList::Iter f = functionList; f.lte(); f++ )
 		placeFrameFields( f->localFrame );
 
+	for ( FunctionList::Iter f = inHostList; f.lte(); f++ )
+		placeFrameFields( f->localFrame );
+
 	/* Reduction code. */
 	for ( DefList::Iter prod = prodList; prod.lte(); prod++ ) {
 		if ( prod->redBlock != 0 )
@@ -3080,6 +3083,9 @@ void Compiler::placeAllFunctions()
 {
 	for ( FunctionList::Iter f = functionList; f.lte(); f++ )
 		placeUserFunction( f, f->isUserIter );
+
+	for ( FunctionList::Iter f = inHostList; f.lte(); f++ )
+		placeUserFunction( f, false );
 }
 
 
diff --git a/src/tree.h b/src/tree.h
index cd31b35c..3cea7e82 100644
--- a/src/tree.h
+++ b/src/tree.h
@@ -356,6 +356,8 @@ Value colm_viter_deref_cur( struct colm_program *prg, GenericIter *iter );
 
 Str *string_prefix( Program *prg, Str *str, long len );
 Str *string_suffix( Program *prg, Str *str, long pos );
+Head *stringAllocFull( struct colm_program *prg, const char *data, long length );
+Tree *constructString( struct colm_program *prg, Head *s );
 
 #if defined(__cplusplus)
 }