FEAT: improved support for dealing with HANDLE types in extensions

Originally, HANDLE was just pointer, but I enhanced it recently to also being able define its type, so one can on native side test, type of provided handle and not just blindly throw some pointers as an arguments. In this commit it is reflected also when dealing with native extensions.

Author: Oldes

src/boot/types-ext.r

@@ -17,7 +17,7 @@ REBOL [
 end			0	0
 unset		*	null
 none		*	null
-handle		*	ptr
+handle		*	handle
 
 logic 		4	32
 integer		*	64
@@ -57,6 +57,6 @@ image		*	image
 
 gob			47	ser
 
-object		48	ptr
-module		*	ptr
+object		48	object
+module		*	object
 

src/core/f-extension.c

@@ -37,13 +37,14 @@
 // Extension evaluation categories:
 enum {
     RXE_NULL,	// unset
-	RXE_PTR,	// any pointer
+	RXE_HANDLE,	// handle
     RXE_32,		// logic
     RXE_64,		// integer, decimal, etc.
     RXE_SYM,	// word
     RXE_SER,	// string
 	RXE_IMAGE,	// image
 	RXE_DATE,	// from upper section
+	RXE_OBJECT, // any object
 	RXE_MAX
 };
 
@@ -88,8 +89,12 @@ x*/	RXIARG Value_To_RXI(REBVAL *val)
 		arg.series = VAL_SERIES(val);
 		arg.index = VAL_INDEX(val);
 		break;
-	case RXE_PTR:
+	case RXE_OBJECT:
+		arg.addr = VAL_OBJ_FRAME(val);
+		break;
+	case RXE_HANDLE:
 		arg.addr = VAL_HANDLE(val);
+		arg.handle.type = VAL_HANDLE_TYPE(val);
 		break;
 	case RXE_32:
 		arg.int32a = VAL_I32(val);
@@ -105,7 +110,7 @@ x*/	RXIARG Value_To_RXI(REBVAL *val)
 		break;
 	case RXE_IMAGE:
 		arg.series = VAL_SERIES(val);
-		arg.width = VAL_IMAGE_WIDE(val);
+		arg.width  = VAL_IMAGE_WIDE(val);
 		arg.height = VAL_IMAGE_HIGH(val);
 		break;
 	case RXE_NULL:
@@ -131,8 +136,12 @@ x*/	void RXI_To_Value(REBVAL *val, RXIARG arg, REBCNT type)
 		VAL_SERIES(val) = arg.series;
 		VAL_INDEX(val) = arg.index;
 		break;
-	case RXE_PTR:
+	case RXE_OBJECT:
+		VAL_OBJ_FRAME(val) = arg.addr;
+		break;
+	case RXE_HANDLE:
 		VAL_HANDLE(val) = arg.addr;
+		VAL_HANDLE_TYPE(val) = arg.handle.type;
 		break;
 	case RXE_32:
 		VAL_I32(val) = arg.int32a;
@@ -324,6 +333,7 @@ x*/	int Do_Callback(REBSER *obj, u32 name, RXIARG *args, RXIARG *result)
 
 		// Try to load the DLL file:
 		if (!(dll = OS_OPEN_LIBRARY(name, &error))) {
+			printf("error: %i\n", error);
 			Trap1(RE_NO_EXTENSION, val);
 		}
 
@@ -476,6 +486,19 @@ x*/	int Do_Callback(REBSER *obj, u32 name, RXIARG *args, RXIARG *result)
 		SET_FALSE(val);
 		break;
 	case RXR_ERROR:
+		{
+			const char* errmsg = frm.args[1].series;
+			if(errmsg != NULL) {
+				int len = strlen(errmsg);
+				VAL_SET(val, REB_STRING);		
+				VAL_SERIES(val) = Make_Binary(len);
+				VAL_INDEX(val) = 0;
+				VAL_TAIL(val) = len;
+				memcpy(VAL_BIN_HEAD(val), errmsg, len);
+			}
+			Trap1(RE_COMMAND_FAIL, val);
+		}
+		break;
 	default:
 		SET_UNSET(val);
 	}

src/include/reb-defs.h

@@ -32,8 +32,21 @@
 #define REB_DEFS_H
 
 #ifndef REB_DEF
-typedef void *REBSER;
+typedef void(*ANYFUNC)(void *);
+typedef struct RL_Reb_Series {
+	void *data;
+	u32 tail;
+} REBSER;
 typedef void *REBOBJ;
+typedef struct Reb_Handle {
+	REBCNT	sym;    // Index of the word's symbol. Used as a handle's type!
+	REBFLG  flags;  // Handle_Flags
+	union {
+		ANYFUNC	code;
+		REBSER *data;
+		REBINT  index;
+	};
+} REBHAN;
 #endif
 
 /* These used for access-os native function */
@@ -82,6 +95,27 @@ typedef struct rebol_met {
 typedef int	cmp_t(const void *, const void *);
 void reb_qsort(void *a, size_t n, size_t es, cmp_t *cmp);
 
+// Encoding_opts was originally in sys-core.h, but I moved it here so it can
+// be used also while makking external extensions. (oldes)
+
+// Encoding options:
+enum encoding_opts {
+	ENC_OPT_BIG,		// big endian (not little)
+	ENC_OPT_UTF8,		// UTF-8
+	ENC_OPT_UTF16,		// UTF-16
+	ENC_OPT_UTF32,		// UTF-32
+	ENC_OPT_BOM,		// byte order marker
+	ENC_OPT_CRLF,		// CR line termination
+	ENC_OPT_NO_COPY,	// do not copy if ASCII
+};
+
+#define ENCF_NO_COPY (1<<ENC_OPT_NO_COPY)
+#if OS_CRLF
+#define ENCF_OS_CRLF (1<<ENC_OPT_CRLF)
+#else
+#define ENCF_OS_CRLF 0
+#endif
+
 #pragma pack()
 
 #endif

src/include/reb-ext.h

@@ -40,7 +40,6 @@
 
 */
 
-
 // Value structure (for passing args to and from):
 #pragma pack(4)
 typedef union rxi_arg_val {
@@ -66,6 +65,10 @@ typedef union rxi_arg_val {
 		int width:16;
 		int height:16;
 	};
+	struct {
+		void  *ptr;
+		REBCNT type;
+	} handle;
 } RXIARG;
 
 // For direct access to arg array:
@@ -107,7 +110,8 @@ typedef int (*RXICAL)(int cmd, RXIFRM *args, REBCEC *ctx);
 #define RXA_INDEX(f,n)	(RXA_ARG(f,n).index)
 #define RXA_OBJECT(f,n)	(RXA_ARG(f,n).addr)
 #define RXA_MODULE(f,n)	(RXA_ARG(f,n).addr)
-#define RXA_HANDLE(f,n)	(RXA_ARG(f,n).addr)
+#define RXA_HANDLE(f,n)	(RXA_ARG(f,n).handle.ptr)
+#define RXA_HANDLE_TYPE(f,n)  (RXA_ARG(f,n).handle.type)
 #define RXA_IMAGE(f,n)	(RXA_ARG(f,n).image)
 #define RXA_IMAGE_BITS(f,n)	  ((REBYTE *)RL_SERIES((RXA_ARG(f,n).image), RXI_SER_DATA))
 #define RXA_IMAGE_WIDTH(f,n)  (RXA_ARG(f,n).width)

src/include/sys-core.h

@@ -268,24 +268,6 @@ enum {
 	POL_EXEC,
 };
 
-// Encoding options:
-enum encoding_opts {
-	ENC_OPT_BIG,		// big endian (not little)
-	ENC_OPT_UTF8,		// UTF-8
-	ENC_OPT_UTF16,		// UTF-16
-	ENC_OPT_UTF32,		// UTF-32
-	ENC_OPT_BOM,		// byte order marker
-	ENC_OPT_CRLF,		// CR line termination
-	ENC_OPT_NO_COPY,	// do not copy if ASCII
-};
-
-#define ENCF_NO_COPY (1<<ENC_OPT_NO_COPY)
-#if OS_CRLF
-#define ENCF_OS_CRLF (1<<ENC_OPT_CRLF)
-#else
-#define ENCF_OS_CRLF 0
-#endif
-
 /***********************************************************************
 **
 **	Macros

src/os/host-ext-test.c

@@ -68,10 +68,15 @@ char *RX_Spec =
 	"img0:   command [{return 10x20 image}]\n"
 	"cec0:   command [{test command context struct} blk [block!]]\n"
 	"cec1:   command [{returns cec.index value or -1 if no cec}]\n"
+	"hndl1:  command [{creates a handle}]\n"
+	"hndl2:  command [{return handle's internal value as integer} hnd [handle!]]\n"
+	"hndl3:  command [{null handle's internal value} hnd [handle!]]\n"
 
-	"a: b: c: none\n"
+	"a: b: c: h: none\n"
 	"xtest: does [\n"
 		"foreach blk [\n"
+			"[h: hndl1]\n"
+			"[hndl2 h]\n"
 			"[xarg0]\n"
 			"[xarg1 111]\n"
 			"[xarg1 1.1]\n"
@@ -83,6 +88,7 @@ char *RX_Spec =
 			"[xword1 {system}]\n"
 			"[xobj1 system 'version]\n"
 
+
 			// We just use this context as example. Normally, it would be
 			// your own object that has your special functions within it.
 			"[calls lib 'negate]\n"
@@ -97,7 +103,7 @@ char *RX_Spec =
 			//"replace {x} {x} {y}\n"
 			"probe do blk\n"
 		"]\n"
-		"prin {^/^[[7mAsync call result should be printed:^[[0m }"
+	"prin {^/^[[7mAsync call result (should be printed 1234):^[[0m }"
 		"wait 0.1 ; let async events happen\n"
 		"exit\n"
 	"]\n"
@@ -228,7 +234,22 @@ RXIEXT int RX_Call(int cmd, RXIFRM *frm, void *ctx) {
 			RXA_INT64(frm, 1) = (i64)(cec ? cec->index : -1);
 			RXA_TYPE(frm, 1) = RXT_INTEGER;
 		}
-		
+		break;
+
+	case 11: //command [{creates a handle}]"
+		{
+			RXA_HANDLE(frm, 1) = (void*)42;
+			RXA_HANDLE_TYPE(frm, 1) = RL_MAP_WORD("xtest");
+			RXA_TYPE(frm, 1) = RXT_HANDLE;
+		}
+		break;
+
+	case 12: //command [{return handle's internal value as integer} hnd [handle!]]"
+		{
+			i64 i = (i64)RXA_HANDLE(frm, 1);
+			RXA_INT64(frm, 1) = i;
+			RXA_TYPE(frm, 1) = RXT_INTEGER;
+		}
 		break;
 
 	default: