diff kernel.rhope @ 63:04baa003de5a

Merged latest changes with better C branch
author Mike Pavone <pavone@retrodev.com>
date Wed, 05 May 2010 22:12:23 -0400
parents 079200bc3e75
children d0ce696786cc
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/kernel.rhope	Wed May 05 22:12:23 2010 -0400
@@ -0,0 +1,295 @@
+
+Val[in:out]
+{
+	out <- in
+}
+
+Blueprint Boolean
+{
+	Val(Int32,Naked)
+}
+
+/*
+Blueprint Blueprint
+{
+	Val(Blueprint,Naked)
+}*/
+
+Blueprint Int64
+{
+	Num(Int64,Naked)
+}
+
+If@Int64[num:yes,no]
+{
+	yes,no <- If[[num]!=[0i64]]
+}
+
+Blueprint Int32
+{
+	Num(Int32,Naked)
+}
+
+If@Int32[num:yes,no]
+{
+	yes,no <- If[[num]!=[0i32]]
+}
+
+Foreign C:libc
+{
+	write[filedes(Int32,Naked),buf(Array,Raw Pointer),nbyte(Int64,Naked):written(Int32,Naked)]
+}
+
+_Print Int32[n,buf:out]
+{
+	If[[n] < [10i32]]
+	{
+		byte <- [[n]Trunc Int8] + [48i8]
+		out <- [buf]Append[byte]
+	}{
+		next <- [n]/[10i32]
+		
+		byte <- [[[n]-[[next]*[10i32]]]Trunc Int8] + [48i8]
+		out <- [_Print Int32[next, buf]]Append[byte]
+	}
+}
+
+Print@Int32[n:out]
+{
+	If[[n] < [0i32]]
+	{
+		val <- [0i32]-[n]
+		buf <- [Array[1]]Append[45i8]
+	}{
+		val <- Val[n]
+		buf <- Array[1]
+	}
+	fbuf <- [_Print Int32[val, buf]]Append[10i8]
+	out <- write[1i32, fbuf, Int64[[fbuf]Length >>]]
+}
+
+Blueprint Int16
+{
+	Num(Int16,Naked)
+}
+
+If@Int16[num:yes,no]
+{
+	yes,no <- If[[num]!=[0i16]]
+}
+
+Blueprint Int8
+{
+	Num(Int8,Naked)
+}
+
+If@Int8[num:yes,no]
+{
+	yes,no <- If[[num]!=[0i8]]
+}
+
+Blueprint UInt64
+{
+	Num(UInt64,Naked)
+}
+
+If@UInt64[num:yes,no]
+{
+	yes,no <- If[[num]!=[0u64]]
+}
+
+Blueprint UInt32
+{
+	Num(UInt32,Naked)
+}
+
+If@UInt32[num:yes,no]
+{
+	yes,no <- If[[num]!=[0u32]]
+}
+
+Blueprint UInt16
+{
+	Num(UInt16,Naked)
+}
+
+If@UInt16[num:yes,no]
+{
+	yes,no <- If[[num]!=[0u16]]
+}
+
+Blueprint UInt8
+{
+	Num(UInt8,Naked)
+}
+
+If@UInt8[num:yes,no]
+{
+	yes,no <- If[[num]!=[0u8]]
+}
+
+
+Blueprint Array
+{
+	Eltype(Blueprint)
+	Length(Int32,Naked)
+	Storage(Int32,Naked)
+}
+
+Foreign C:runtime
+{
+	_internal_array_copyout[array(Array), index(Int32,Naked), dest(Any Type,Boxed,Mutable):dest]
+	_internal_array_copyin[array(Array,Boxed,Mutable), index(Int32,Naked), val:array]
+	_internal_array_getboxed[array(Array), index(Int32,Naked):out]
+	_internal_array_setboxed[array(Array,Boxed,Mutable), index(Int32,Naked), val:array]
+	_internal_array_allocboxed[size(Int32,Naked):out(Array)]
+	_internal_array_allocnaked[size(Int32,Naked),type(Blueprint):out(Array)]
+	_internal_blueprint_eq[left(Blueprint),right(Blueprint):out(Int32,Naked)]
+}
+
+=@Blueprint[left,right:out]
+{
+	out <- [_internal_blueprint_eq[left,right]]!=[0]
+}
+
+Array[n:out(Array)]
+{
+	out <- [[_internal_array_allocboxed[0]
+	]Length <<[0]
+	]Storage <<[0]
+}
+
+First@Array[array:out(Int32),empty]
+{
+	,empty <- If[[array]Length >>]
+	{ out <- 0 }
+}
+
+Next@Array[array,current:out(Int32),empty]
+{
+	next <- [current]+[1]
+	,empty <- If[[next] < [[array]Length >>]]
+	{
+		out <- Val[next]
+	}
+}
+
+Last@Array[array:out(Int32),empty]
+{
+	,empty <- If[[array]Length >>]
+	{ out <-  [[array]Length >>] - [1] }
+}
+
+Append@Array[array,newval:out(Array)]
+{
+	out <- [array]Set[[array]Length >>, newval]
+}
+
+Index@Array[array,index(Int32):out,notfound]
+{
+	,notfound <- If[[index] >= [0]]
+	{
+		,notfound <- If[[index] < [[array]Length >>]]
+		{
+			eltype <- [array]Eltype >>
+			If[[eltype] = [Any Type()]]
+			{
+				out <- _internal_array_getboxed[array, index]
+			}{
+				out <- _internal_array_copyout[array, index, Build[eltype]]
+			}
+		}
+	}	
+}
+
+_Copy to Boxed[source,dest,current:out]
+{
+	ndest <- _internal_array_setboxed[dest, current, [source]Index[current]]
+	
+	[source]Next[current]
+	{
+		out <- _Copy to Boxed[source, ndest, ~]
+	}{
+		out <- Val[ndest]
+	}
+}
+
+_Copy Naked[source,dest,current:out]
+{
+	ndest <- _internal_array_copyin[dest, current, [source]Index[current]]
+	
+	[source]Next[current]
+	{
+		out <- _Copy Naked[source, ndest, ~]
+	}{
+		out <- Val[ndest]
+	}
+}
+
+Set@Array[array,index(Int32),val:out(Array)]
+{
+	If[[index] < [[array]Storage >>]]
+	{
+		If[[index] > [[array]Length >>]]
+		{
+			farray <- [[array]Set[[index]-[1], val]]Length <<[ [index]+[1] ]
+		}{
+			If[[index] = [[array]Length >>]]
+			{
+				farray <- [array]Length <<[ [index]+[1] ]
+			}{
+				farray <- Val[array]
+			}
+		}
+		eltype <- [array]Eltype >>
+		If[[eltype] = [Any Type()]]
+		{
+			out <- _internal_array_setboxed[farray, index, val]
+		}{
+			If[[Blueprint Of[val]] = [eltype]]
+			{
+				out <- _internal_array_copyin[farray, index, val]
+			}{
+				boxed <- _internal_array_allocboxed[[farray]Storage >>]
+				[array]First
+				{
+					copied <- _Copy to Boxed[farray, boxed, ~]
+				}{
+					//I don't think this case should happen normally
+					copied <- Val[boxed]
+				}
+				out <- _internal_array_setboxed[copied, index, val]
+			}
+		}
+	}{
+		If[[array]Length >>]
+		{
+			If[[index] < [4]]
+			{
+				new storage <- [index]+[index]
+			}{
+				new storage <- [index]+[[index]RShift[1]]
+			}
+			 
+			do boxed <- If[[[array]Eltype >>] = [Any Type()]]
+			{
+				copied <- _Copy to Boxed[array, _internal_array_allocboxed[new storage], 0]
+			}{	
+				bp <- Blueprint Of[val]
+				If[[[array]Eltype >>] = [bp]]
+				{
+					copied <- _Copy Naked[array, _internal_array_allocnaked[new storage, bp], 0]
+				}{
+					copied <- _Copy to Boxed[array, _internal_array_allocboxed[new storage], 0]
+				}
+			}
+			out <- [[copied]Length <<[[array]Length >>]]Set[index,val]
+		}{
+			len <- [index]+[1]
+			out <- [_internal_array_allocnaked[len, Blueprint Of[val]]
+			]Set[index,val]
+		}
+	}
+}
+
+