diff cbackend.rhope @ 49:3e20ed8959c4

Added initial FFI implementation, Array type and 64-bit integers
author Mike Pavone <pavone@retrodev.com>
date Thu, 08 Apr 2010 01:02:18 -0400
parents a24eb366195c
children 689fb73e7612
line wrap: on
line diff
--- a/cbackend.rhope	Tue Mar 02 00:18:49 2010 -0500
+++ b/cbackend.rhope	Thu Apr 08 01:02:18 2010 -0400
@@ -137,7 +137,9 @@
 		If[[[type]Name >>] = ["Array"]]
 		{
 			[("Naked","Raw Pointer")]Find[variant]
-			{
+			{
+				/*
+				//Below code assumes that paramaterized types are implemented
 				pre param <- [[type]Params >>]Index[0] {}
 				{ pre param <- Type Instance["Any Type"] }
 				[[type]Params >>]Index[1]
@@ -151,7 +153,9 @@
 				}{
 					out <- [child type]Append[" *"]
 					array <- ""
-				}
+				} */
+				out <- "void *"
+				array <- ""
 			}{
 				typename <- "Array"
 			}
@@ -159,13 +163,13 @@
 		}{
 			,regulartype <- [("Naked","Raw Pointer")]Find[variant]
 			{
-				[("Int32","Int16","Int8")]Find[[type]Name >>]
+				[("Int64","Int32","Int16","Int8")]Find[[type]Name >>]
 				{
 					primitive <- Yes
 					[[type]Name >>]Slice[3] {}
 					{ typename <- [["int"]Append[~]]Append["_t"] }
 				}{
-					,regulartype <- [("UInt32","UInt16","UInt8")]Find[[type]Name >>]
+					,regulartype <- [("UInt64","UInt32","UInt16","UInt8")]Find[[type]Name >>]
 					{
 						primitive <- Yes
 						[[type]Name >>]Slice[4] {}
@@ -234,8 +238,17 @@
 	If[[[[ctype]Fields >>]Length] = [1]]
 	{
 		out <- [[[_Type Def C Type["typedef struct {\n\tobject _SP_header;\n\t", [[ctype]Fields >>]Index[0]]]Append["\n} t_"]]Append[[ctype]Name >>]]Append[";"]
-	}{
-		out <- [Fold["_Type Def C Type", "OBegin", [ctype]Fields >>]]Append[ [["\nObject("]Append[Escape Rhope Name[[ctype]Name >>]]]Append[")"] ]
+	}{
+		//HACK!!!
+		If[[[ctype]Name >>]=["Blueprint"]]
+		{
+			out <- ""	
+		}{
+			If[[[ctype]Name >>]=["Array"]]
+			{ oend <- "\nMObject(" }
+			{ oend <- "\nObject(" } 
+			out <- [Fold["_Type Def C Type", "OBegin", [ctype]Fields >>]]Append[ [[oend]Append[Escape Rhope Name[[ctype]Name >>]]]Append[")"] ]
+		}
 	}
 }
 
@@ -252,15 +265,37 @@
 }
 
 Type Init@C Type[ctype,id,method reg,field reg:out]
-{
+{
+	If[[[ctype]Name >>]=["Array"]]
+	{ size <- "-1" }
+	{ 
+		[("Int64","Int32","Int16","Int8")]Find[[ctype]Name >>]
+		{
+			[[ctype]Name >>]Slice[3] {}
+			{ typename <- [["int"]Append[~]]Append["_t"] }
+		}{
+			[("UInt64","UInt32","UInt16","UInt8")]Find[[ctype]Name >>]
+			{
+				[[ctype]Name >>]Slice[4] {}
+				{ typename <- [["uint"]Append[~]]Append["_t"] }
+			}{
+				If[[[ctype]Name >>]=["Blueprint"]]
+				{ typename <- "blueprint *" }
+				{ 
+					If[[[ctype]Name >>]=["Boolean"]]
+					{ typename <- "int32_t" }
+					{ typename <- ["nt_"]Append[Escape Rhope Name[[ctype]Name >>]] }
+				}
+			}
+		}
+		size <- [["sizeof("]Append[typename]]Append[")"] 
+	}
 	start <- [["\tbp = register_type_byid("
 		]Append[id]
-		]Append[ 
-			[[", sizeof("
+		]Append[
+			[[", "]Append[size]
 			]Append[
-				["t_"]Append[Escape Rhope Name[ [ctype]Name >> ]]]
-			]Append[
-				["), (special_func)"]Append[
+				[", (special_func)"]Append[
 					[ 
 						[[[[Escape Rhope Name NU[[ctype]Init >>]
 						]Append[", (special_func)"]
@@ -281,7 +316,7 @@
 C Type Registry[:out]
 {
 	out <- [[[Build["C Type Registry"]]Lookup << [
-			[[[[[[[[[[[[[[[[Dictionary[]
+			[[[[[[[[[[[[[[[[[Dictionary[]
 			]Set["UInt8", "TYPE_UINT8"]
 			]Set["UInt16", "TYPE_UINT16"]
 			]Set["UInt32", "TYPE_UINT32"]
@@ -293,7 +328,8 @@
 			]Set["Boolean", "TYPE_BOOLEAN"]
 			]Set["Float32", "TYPE_FLOAT32"]
 			]Set["Float64", "TYPE_FLOAT64"]
-			]Set["Real Number", "TYPE_FLOAT64"]
+			]Set["Real Number", "TYPE_FLOAT64"]
+			]Set["Blueprint", "TYPE_BLUEPRINT"]
 			]Set["Array", "TYPE_ARRAY"]
 			]Set["Method Missing Exception", "TYPE_METHODMISSINGEXCEPTION"]
 			]Set["Field Missing Exception", "TYPE_FIELDMISSINGEXCEPTION"]
@@ -319,7 +355,8 @@
 
 Type Inits@C Type Registry[reg,method reg,field reg:out]
 {
-	out <- Fold[[[["_Type Inits C"]Set Input[0, reg]]Set Input[1, method reg]]Set Input[2, field reg], "", [reg]Definitions >>]
+	out <- Fold[[[["_Type Inits C"]Set Input[0, reg]]Set Input[1, method reg]]Set Input[2, field reg], "", [reg]Definitions >>]
+	{ Print["Type inits got output"] }
 }
 
 Register Type@C Type Registry[reg,def:out]
@@ -343,7 +380,11 @@
 
 Type ID@C Type Registry[reg,name:out,notfound]
 {
-	out,notfound <- [[reg]Lookup >>]Index[name]
+	out <- [[reg]Lookup >>]Index[name] {}
+	{
+		,notfound <- If[[name]=["Any Type"]]
+		{ out <- "0" }
+	}
 }
 
 Simple Type?@C Type Registry[reg,name:yep,nope,notfound]
@@ -509,18 +550,19 @@
 {
     source <- [psource]Make Op[func] 
     dest <- [pdest]Make Op[func]
-    out <- [func]Add Statement[[[[dest]Append[" = add_ref("]]Append[source]]Append[")"]]
+    out <- [func]Add Statement[[[[dest]Append[" = add_ref((object *)"]]Append[source]]Append[")"]]
 }
 
 AddRef No Dest@C Function[func,psource:out]
 {
     source <- [psource]Make Op[func] 
-    out <- [func]Add Statement[[["add_ref("]Append[source]]Append[")"]]
+    out <- [func]Add Statement[[["add_ref((object *)"]Append[source]]Append[")"]]
 }
 
 Release@C Function[func,psource:out]
 {
-	source <- [psource]Make Op[func]
+	source <- [psource]Make Op[func]
+	Print[["Release: "]Append[source]]
 	out <- [func]Add Statement[[["release_ref("]Append[source]]Append[")"]]
 }
 
@@ -624,7 +666,21 @@
 		]Append[", &"]
 		]Append[dest]
 		]Append[")"] ]
-}
+}
+
+Get Raw Pointer@C Function[func,psource,pdest:out]
+{
+	dest <- [pdest]Make Op[func]
+	source <- [psource]Make Op[func]
+	out <- [func]Add Statement[ [[[dest]Append[" = &("]]Append[source]]Append["->payload)"] ]
+}
+
+Array Raw Pointer@C Function[func,psource,pdest:out]
+{
+	dest <- [pdest]Make Op[func]
+	source <- [psource]Make Op[func]
+	out <- [func]Add Statement[ [[[dest]Append[" = ((char *)"]]Append[source]]Append[")+ sizeof(t_Array)"] ]
+}
 
 _Function Arg C[func,val,inputnum:out]
 {
@@ -647,10 +703,29 @@
 }
 
 Func Base@C Function[func,tocall,args,type:out]
-{
+{
+	Pretty Print[args, ""]
+	{
 	rargs <- Map[args, ["Make Op"]Set Input[1, func]]
 	out <- [Fold["_Function Arg C", func, rargs]
-	]Add Raw Line[[[[[ [type]Append["("] ]Append[tocall]]Append[", "]]Append[ [rargs]Length ]]Append[")"]]
+	]Add Raw Line[[[[[ [type]Append["("] ]Append[tocall]]Append[", "]]Append[ [rargs]Length ]]Append[")"]]
+	}
+}
+
+Call Foreign@C Function[func,name,language,args,store result:out]
+{
+	rargs <- Map[args, ["Make Op"]Set Input[1, func]]
+	//Assume language = "C" for now
+	base <- [[[name]Append["("]]Append[ Join[rargs, ", "] ]]Append[")"]
+	,do store <- If[[Type Of[store result]]=["String"]]
+	{ 
+		,do store <- If[[store result]=[""]]
+		{ stmt <- Val[base] }
+	}
+	
+	Val[do store]
+	{ stmt <- [[Make Op[store result, func]]Append[" = "]]Append[base] }
+	out <- [func]Add Statement[stmt]
 }
 
 Field Base@C Function[func,field,args,type:out]
@@ -693,6 +768,16 @@
 	}{
 		out <- Escape Rhope Name[op]
 	}
+}
+
+Resolve Output@C Function[func,name:out]
+{
+	If[[[func]Convention >>] = ["rhope"]]
+	{
+		out <- ["locals->"]Append[Escape Rhope Name[name]]
+	}{
+		out <- Escape Rhope Name[name]
+	} 
 }
 
 Instruction Stream@C Function[func:out]
@@ -721,13 +806,16 @@
 }
 
 If Null Else@C Function[func,left,right:out]
-{
+{
+	check <- [[Make Condition[left]]Strip Addref]Make Op[func]
+	l <- [left]Make Op[func]
+	r <- [right]Make Op[func]
 	out <- [[[[[["("
-		]Append[left]
+		]Append[check]
 		]Append[" ? "]
-		]Append[left]
+		]Append[l]
 		]Append[" : "]
-		]Append[right]
+		]Append[r]
 		]Append[")"]
 }
 
@@ -761,7 +849,9 @@
 
 
 Definitions@C Function[func:out]
-{
+{
+	Print[["Definitions@C Function: "]Append[[func]Name >>]]
+	{
 	If[ [[[func]Convention >>] = ["rhope"]] And [[ [[[func]Variables >>]Length]+[[[func]Outputs >>]Length] ] > [0]] ]
 	{
 		localtype <- [[[Fold[["_Output Defs C"]Set Input[3, func], Fold["_Var Defs C","typedef struct {\n", [func]Variables >>], [func]Outputs >>]]Append["} l_"]]Append[Escape Rhope Name[[func]Name >>]]]Append[";\n"]
@@ -785,7 +875,8 @@
 	}{
 		proto <- [[func]Naked Proto]Append[";\n"]
 	}
-	out <- [localtype]Append[proto]
+	out <- [localtype]Append[proto]
+	}
 }
 
 _Proto Input[list,input,index,types:out]
@@ -837,7 +928,8 @@
 }
 
 Text@C Function[func:out]
-{	
+{	
+	Print[["Text@C Function: "]Append[[func]Name >>]]
 	If[ [[func]Convention >>] = ["rhope"] ]
 	{
 		cname <- Escape Rhope Name[[func]Name >>]
@@ -881,12 +973,25 @@
 	Functions
 	Method Registry
 	Field Registry
-	Type Registry
+	Type Registry
+	Libraries
 }
 
 C Program[:out]
 {
-	out <- [[[[Build["C Program"]]Functions <<[Dictionary[]]]Method Registry <<[C Method Registry[]]]Type Registry <<[C Type Registry[]]]Field Registry <<[C Field Registry[]]
+	out <- [[[[[Build["C Program"]]Functions <<[Dictionary[]]]Method Registry <<[C Method Registry[]]]Type Registry <<[C Type Registry[]]]Field Registry <<[C Field Registry[]]]Libraries <<[Dictionary[]]
+}
+
+Link@C Program[program,language,library:out]
+{
+	If[[library] = ["runtime"]]
+	{
+		out <- program
+	}{
+		langlibs <- [[program]Libraries >>]Index[language] {}
+		{ langlibs <- Dictionary[] }
+		out <- [program]Libraries <<[ [[program]Libraries >>]Set[language, [langlibs]Set[library, Yes]] ]
+	}
 }
 
 Register Type@C Program[program,def:out]
@@ -943,26 +1048,32 @@
 }
 
 _Set Consts C Program[text,value,name,type reg:out]
-{
+{
+	Print[["_Set Consts: "]Append[valtype]]
+	Pretty Print[value, "_Set Consts: "]
 	//TODO: Support more constant types
 	valtype <- Type Of[value]
 	[("Int32","Whole Number")]Find[valtype]
 	{
-		out <- [text]Append[[[[["\t_const_"]Append[Escape Rhope Name[name]]]Append[" = make_Int32("]]Append[value]]Append[");\n"]]
+		out <- [text]Append[[[[["\t_const_"]Append[Escape Rhope Name[name]]]Append[" = make_Int32("]]Append[value]]Append[");\n"]]
+		{ Print["_Set Consts got output integer"] }
 	}{
 		If[[valtype] = ["Type Instance"]]
 		{
 			//TODO: Support parametric types
 			typeid <- [type reg]Type ID[[value]Name >>]
-			out <- [text]Append[[[[["\t_const_"]Append[Escape Rhope Name[name]]]Append[" = make_Blueprint("]]Append[typeid]]Append[");\n"]]
+			out <- [text]Append[[[[["\t_const_"]Append[Escape Rhope Name[name]]]Append[" = make_Blueprint("]]Append[typeid]]Append[");\n"]]
+			{ Print["_Set Consts got output blueprint"] }
 		}{
 			If[[valtype] = ["Yes No"]]
 			{
 				If[value]
 				{
-					out <- [text]Append[[["\t_const_"]Append[Escape Rhope Name[name]]]Append[" = (object *)val_yes;\n"]]
+					out <- [text]Append[[["\t_const_"]Append[Escape Rhope Name[name]]]Append[" = (object *)val_yes;\n"]]
+					{ Print["_Set Consts got output yes"] }
 				}{
-					out <- [text]Append[[["\t_const_"]Append[Escape Rhope Name[name]]]Append[" = (object *)val_no;\n"]]
+					out <- [text]Append[[["\t_const_"]Append[Escape Rhope Name[name]]]Append[" = (object *)val_no;\n"]]
+					{ Print["_Set Consts got output no"] }
 				}
 			}
 		}
@@ -979,7 +1090,8 @@
 #include \"context.h\"
 #include \"func.h\"
 #include \"integer.h\"
-#include \"blueprint.h\"
+#include \"blueprint.h\"
+#include \"array.h\"
 #include \"bool.h\"\n\n"
 	out <- [[[[[[headers
 		]Append[[[program]Type Registry >>]Type Defs]
@@ -988,7 +1100,7 @@
 					Fold["_Defs C Program", "", [program]Functions >>], 
 					constants
 				], [program]Functions >>]]
-		]Append["#include \"builtin.c\"\n\nint main(int argc, char **argv)
+		]Append["#include \"builtin.c\"\n#include \"array.c\"\n\nint main(int argc, char **argv)
 {
 	returntype ret;
 	calldata *cdata;