Merge pull request #165 from jayrm/array-descriptor

fbc-int: add array descriptor API

- new header in ./inc/fbc-int/array.bi
- tests in ./tests/fbc-int/array.bas
- new run time function fb_ArrayGetDesc() to return FBARRAY ptr

Author: jayrm

changelog.txt

@@ -35,6 +35,7 @@ Version 1.07.0
 - '-edebug' command line option to enable __FB_DEBUG__
 - '-edebuginfo' command line option to enable debug symbols
 - '-elocation' command line option to enable reporting error location
+- ./inc/fbc-int/array.bi - fbc internal API for array descriptor
 
 [fixed]
 - sf.net #881: C backend: support for varadic function parameters in gcc using __builtin_va_list type and related macros

inc/fbc-int/array.bi

@@ -0,0 +1,41 @@
+#ifndef __FBC_INT_ARRAY_BI__ 
+#define __FBC_INT_ARRAY_BI__
+
+# if __FB_LANG__ = "fb"
+namespace FBC
+# endif
+
+	'' declarations must follow ./src/rtlib/fb_array.h
+
+	const FB_MAXDIMENSIONS as integer = 8
+
+	type FBARRAYDIM
+		dim as uinteger elements     '' number of elements
+		dim as integer lbound        '' dimension lower bound
+		dim as integer ubound        '' dimension upper bound
+	end type
+
+	type FBARRAY
+		dim as any ptr index_ptr     '' @array(0, 0, 0, ... )
+		dim as any ptr base_ptr      '' start of memory at array lowest bounds
+		dim as uinteger size         '' byte size of allocated contents
+		dim as uinteger element_len  '' byte size of single element
+		dim as uinteger dimensions   '' number of dimensions
+		
+		'' take care with number of dimensions; fbc may allocate
+		'' a smaller descriptor with fewer than FB_MAXDIMENSIONS
+		'' in dimTb() if it is known at compile time that they
+		'' are never needed.  Always respsect number of 
+		'' dimensions when accessing dimTb()
+
+		dim as FBARRAYDIM dimTb(0 to FB_MAXDIMENSIONS-1)
+	end type
+
+# if __FB_LANG__ = "fb"
+end namespace
+# endif
+
+declare function fb_ArrayGetDesc alias "fb_ArrayGetDesc" _
+	  ( array() as any ) as FBC.FBARRAY ptr
+
+#endif

src/rtlib/array_getdesc.c

@@ -0,0 +1,8 @@
+/* fbc-int API: array descriptor internals */
+
+#include "fb.h"
+
+FBCALL FBARRAY *fb_ArrayGetDesc( FBARRAY *array )
+{
+	return array;
+}

src/rtlib/fb_array.h

@@ -51,6 +51,7 @@ FBCALL int        fb_ArrayClear        ( FBARRAY *array, int isvarlen );
 FBCALL int        fb_ArrayClearObj     ( FBARRAY *array, FB_DEFCTOR ctor, FB_DEFCTOR dtor, int dofill );
 FBCALL int        fb_ArrayErase        ( FBARRAY *array, int isvarlen );
 FBCALL int        fb_ArrayEraseObj     ( FBARRAY *array, FB_DEFCTOR dtor );
+FBCALL FBARRAY   *fb_ArrayGetDesc      ( FBARRAY *array );
 FBCALL void       fb_ArrayStrErase     ( FBARRAY *array );
        int        fb_ArrayRedim        ( FBARRAY *array, size_t element_len, int preserve, size_t dimensions, ... );
        int        fb_ArrayRedimEx      ( FBARRAY *array, size_t element_len, int doclear, int isvarlen, size_t dimensions, ... );

tests/dirlist.mk

@@ -17,6 +17,7 @@ data \
 datetime \
 dim \
 expressions \
+fbc-int \
 file \
 functions \
 gfx \

tests/fbc-int/array.bas

@@ -0,0 +1,96 @@
+#include "fbcunit.bi"
+#include "fbc-int/array.bi"
+
+using FBC
+
+'' tests for array descriptor internals
+
+SUITE( fbc_tests.fbc_int.array )
+
+	#macro check_array( ap, b, s, e, d )
+		if( ap ) then
+			CU_ASSERT( ap->base_ptr = b )
+			CU_ASSERT( ap->size = s )
+			CU_ASSERT( ap->element_len = e )
+			CU_ASSERT( ap->dimensions = d )
+		else
+			CU_FAIL()
+		end if
+	#endmacro
+
+	#macro check_dim( ap, d, e, l, u )
+		if( ap ) then
+			CU_ASSERT( ap->dimTb(d).elements = e )
+			CU_ASSERT( ap->dimTb(d).lbound = l )
+			CU_ASSERT( ap->dimTb(d).ubound = u )
+		else
+			CU_FAIL()
+		end if
+	#endmacro
+	
+	TEST( static_fixed )
+		'' static array will have descriptor because it is passed
+		'' a procedure, in this case, fb_ArrayGetDesc() 
+	
+		static a1(2 to 11) as integer
+		dim ap1 as FBARRAY ptr = fb_ArrayGetDesc( a1() )
+		check_array( ap1, @a1(2), sizeof(integer) * 10, sizeof(integer), 1 )
+		check_dim( ap1, 0, 10, 2, 11 )
+		
+		static a2(2 to 6, 3 to 12) as integer
+		dim ap2 as FBARRAY ptr = fb_ArrayGetDesc( a2() )
+		check_array( ap2, @a2(2,3), sizeof(integer) * 5 * 10, sizeof(integer), 2 )
+		check_dim( ap2, 0, 5, 2, 6 )
+		check_dim( ap2, 1, 10, 3, 12 )
+	END_TEST
+
+   	TEST( static_empty )
+   		'' static array will have descriptor because it is dynamic
+
+		static a0() as integer
+		dim ap0 as FBARRAY ptr = fb_ArrayGetDesc( a0() )
+		check_array( ap0, 0, 0, sizeof(integer), 0 )
+	
+		static a1(any) as integer
+		dim ap1 as FBARRAY ptr = fb_ArrayGetDesc( a1() )
+		check_array( ap1, 0, 0, sizeof(integer), 1 )
+		check_dim( ap1, 0, 0, 0, 0 )
+
+		static a2(any,any) as integer
+		dim ap2 as FBARRAY ptr = fb_ArrayGetDesc( a2() )
+		check_array( ap2, 0, 0, sizeof(integer), 2 )
+		check_dim( ap2, 0, 0, 0, 0 )
+		check_dim( ap2, 1, 0, 0, 0 )
+	END_TEST
+
+	TEST( local_fixed )
+		dim a1(2 to 11) as integer
+		dim ap1 as FBARRAY ptr = fb_ArrayGetDesc( a1() )
+		check_array( ap1, @a1(2), sizeof(integer) * 10, sizeof(integer), 1 )
+		check_dim( ap1, 0, 10, 2, 11 )
+
+		dim a2(2 to 6, 3 to 12) as integer
+		dim ap2 as FBARRAY ptr = fb_ArrayGetDesc( a2() )
+		check_array( ap2, @a2(2,3), sizeof(integer) * 5 * 10, sizeof(integer), 2 )
+		check_dim( ap2, 0, 5, 2, 6 )
+		check_dim( ap2, 1, 10, 3, 12 )
+	END_TEST
+
+	TEST( local_empty )
+		dim a0() as integer
+		dim ap0 as FBARRAY ptr = fb_ArrayGetDesc( a0() )
+		check_array( ap0, 0, 0, sizeof(integer), 0 )
+	
+		dim a1(any) as integer
+		dim ap1 as FBARRAY ptr = fb_ArrayGetDesc( a1() )
+		check_array( ap1, 0, 0, sizeof(integer), 1 )
+		check_dim( ap1, 0, 0, 0, 0 )
+
+		dim a2(any,any) as integer
+		dim ap2 as FBARRAY ptr = fb_ArrayGetDesc( a2() )
+		check_array( ap2, 0, 0, sizeof(integer), 2 )
+		check_dim( ap2, 0, 0, 0, 0 )
+		check_dim( ap2, 1, 0, 0, 0 )
+	END_TEST
+
+END_SUITE