Initial implementation of the zForth lang plugin

configure

@@ -1,5 +1,5 @@
 #!/bin/sh
-# This script was automatically generated by ACR v2.0.0
+# This script was automatically generated by ACR v2.1.2
 # @author: pancake <nopcode.org>
 # @url:    http://www.nopcode.org
 # @repo:   git clone https://github.com/radare/acr
@@ -84,6 +84,7 @@ HOST="${BUILD}"
 TARGET="${HOST}"
 ETCDIR="/etc"
 SYSCONFDIR=""
+DESCRIPTION=""
 
 create_environ() {
 : ${EPREFIX:="${PREFIX}"}
@@ -92,6 +93,8 @@ create_environ() {
 : ${SBINDIR:="${PREFIX}/sbin"}
 : ${ETCDIR:="${SPREFIX}/etc"}
 : ${LIBDIR:="${SPREFIX}/lib"}
+: ${PKGCFG_LIBDIR:='${exec_prefix}/lib'}
+: ${PKGCFG_INCDIR:='${prefix}/include'}
 : ${LIBEXECDIR:="${SPREFIX}/libexec"}
 : ${INCLUDEDIR:="${SPREFIX}/include"}
 : ${DATADIR:="${SPREFIX}/share"}
@@ -110,12 +113,12 @@ done
 : ${INSTALL_PROGRAM_STRIP:=${INSTALL} -m 755 -s}
 : ${INSTALL_MAN:=${INSTALL} -m 444}
 : ${INSTALL_LIB:=${INSTALL} -m 755 -c}
- PKGNAME='radare2-rlang' ; VERSION='5.7.0' ; VERSION_MAJOR=5; VERSION_MINOR=7; VERSION_PATCH=0; VERSION_NUMBER=50700; CONTACT_MAIL="[email protected]" ; CONTACT_NAME="pancake" ; CONTACT="pancake <[email protected]>" ;
+ PKGNAME='radare2-rlang' ; VERSION='5.9.0' ; VERSION_MAJOR=5; VERSION_MINOR=9; VERSION_PATCH=0; VERSION_NUMBER=50900; CONTACT_MAIL="[email protected]" ; CONTACT_NAME="pancake" ; CONTACT="pancake <[email protected]>" ;
 }
 
 show_usage() {
 cat <<EOF2
-'configure' configures radare2-rlang-5.7.0 to adapt to many kinds of systems.
+'configure' configures radare2-rlang-5.9.0 to adapt to many kinds of systems.
 
 Usage: ./configure [OPTION]... [VAR=VALUE]...
 
@@ -196,10 +199,10 @@ ocho() {
 
 show_version() {
 if [ "$QUIET" = 1 ]; then
-	echo "5.7.0"
+	echo "5.9.0"
 	exit 0
 fi
-echo "radare2-rlang-5.7.0 configuration script done with acr v2.0.0.
+echo "radare2-rlang-5.9.0 configuration script done with acr v2.1.2.
 The 'Free Software Foundation' message is only for autodetection.
 Originally written by pancake <nopcode.org>."
 exit 0
@@ -227,11 +230,13 @@ case $flag in
 -V|-version|--version)
 	show_version ; ;;
 -r|--r|--report)
-echo "PKGNAME:   radare2-rlang"
-echo "VERSION:   5.7.0"
-echo "LANGS:     c"
-echo "PKG-CONFIG:  r_core"
-echo "FLAGS:     --with-ostype=auto"
+echo "PKGNAME:     radare2-rlang"
+echo "VERSION:     5.9.0"
+echo "AUTHOR:      pancake"
+echo "EMAIL:       [email protected]"
+echo "LANGS:       c"
+echo "PKGCONFIG:   r_core"
+echo "FLAGS:       --with-ostype=auto"
 	exit 0
 	;;
 --cache-file)
@@ -271,10 +276,12 @@ echo "FLAGS:     --with-ostype=auto"
 --localstatedir)
 	LOCALSTATEDIR="$value"; ;;
 --libdir)
-	LIBDIR="$value"; ;;
+	LIBDIR="$value"
+	PKGCFG_LIBDIR="$value"; ;;
 --libpath)
 	LDFLAGS="${LDFLAGS} ${LIBPATH}$value"; ;;
 --includedir)
+	PKGCFG_INCDIR="$value"
 	INCLUDEDIR="$value"; CFLAGS="${CFLAGS} -I$value"; ;;
 --infodir)
 	INFODIR="$value"; ;;
@@ -299,7 +306,7 @@ parse_options "$1"
 shift
 done
 
-ENVWORDS="MANDIR INFODIR LIBDIR INCLUDEDIR LOCALSTATEDIR ETCDIR SYSCONFDIR DATADIR DOCDIR LIBEXECDIR SBINDIR BINDIR EPREFIX PREFIX SPREFIX TARGET HOST BUILD INSTALL INSTALL_LIB INSTALL_MAN INSTALL_PROGRAM INSTALL_PROGRAM_STRIP INSTALL_DIR INSTALL_SCRIPT INSTALL_DATA HOST_OS HOST_CPU BUILD_OS BUILD_CPU TARGET_OS TARGET_CPU VERSION VERSION_MAJOR VERSION_MINOR VERSION_PATCH VERSION_NUMBER PKGNAME VPATH CONTACT CONTACT_NAME CONTACT_MAIL CC CFLAGS CPPFLAGS LDFLAGS HAVE_LANG_C PKGCONFIG R2_CFLAGS R2_LDFLAGS HAVE_PKGCFG_R_CORE USEROSTYPE"
+ENVWORDS="MANDIR DESCRIPTION INFODIR LIBDIR INCLUDEDIR LOCALSTATEDIR ETCDIR SYSCONFDIR DATADIR DOCDIR LIBEXECDIR SBINDIR BINDIR EPREFIX PREFIX SPREFIX TARGET HOST BUILD INSTALL INSTALL_LIB INSTALL_MAN INSTALL_PROGRAM INSTALL_PROGRAM_STRIP INSTALL_DIR INSTALL_SCRIPT INSTALL_DATA HOST_OS HOST_CPU BUILD_OS BUILD_CPU TARGET_OS TARGET_CPU VERSION VERSION_MAJOR VERSION_MINOR VERSION_PATCH VERSION_NUMBER PKGCFG_LIBDIR PKGCFG_INCDIR PKGNAME VPATH CONTACT CONTACT_NAME CONTACT_MAIL CC CFLAGS CPPFLAGS LDFLAGS HAVE_LANG_C PKGCONFIG R2_CFLAGS R2_LDFLAGS HAVE_PKGCFG_R_CORE USEROSTYPE"
 
 create_environ
 
@@ -322,7 +329,7 @@ if [ "${CROSSBUILD}" = 1 ]; then
  if [ $? = 0 ]; then CC="${HOST}-${CC}"; fi
 fi
 echo "int main(int argc, char **argv){return 0;}" > test.c
- (exec ${CC} ${CFLAGS} ${CPPFLAGS} ${LDFLAGS} test.c >/dev/null 2>&1)
+ (exec ${CC} -o a.out ${CFLAGS} ${CPPFLAGS} ${LDFLAGS} test.c >/dev/null 2>&1)
 if [ $? = 0 ]; then echo ${CC}; else
  echo no ; HAVE_LANG_C=0
 do_remove

configure.acr

@@ -1,5 +1,5 @@
 PKGNAME radare2-rlang
-VERSION 5.7.0
+VERSION 5.9.0
 CONTACT pancake ; [email protected]
 
 REPORT PREFIX ;

zforth/Makefile

@@ -0,0 +1,16 @@
+include ../config.mk
+
+CFLAGS += -I zForth/src/linux
+CFLAGS += -I zForth/src/zforth
+CFLAGS += -fPIC -shared
+LDFLAGS +=-lr_util
+R2_LIBEXT:=$(shell r2 -H R2_LIBEXT)
+R2_USER_PLUGINS=$(shell r2 -H R2_USER_PLUGINS)
+
+all: zForth
+	$(CC) -o lang_zforth.$(R2_LIBEXT) $(CFLAGS) $(LDFLAGS) zforth.c zForth/src/zforth/zforth.c
+	mkdir -p $(R2_USER_PLUGINS)
+	cp -f lang_zforth.$(R2_LIBEXT) $(R2_USER_PLUGINS)
+
+zForth:
+	git clone https://github.com/zevv/zForth

zforth/zforth.c

@@ -0,0 +1,202 @@
+/* radare - LGPL - Copyright 2024 pancake<nopcode.org> */
+/* zForth extension for radare2 */
+
+#include "r_lib.h"
+#include "r_lang.h"
+#include "zforth.h"
+
+// XXX
+//#define RUBYAPI  LIBDIR"/ruby1.8/radare.rb"
+#define RUBYAPI  "/usr/lib/radare2/"R2_VERSION"/radare.rb"
+
+#include "r_core.h"
+
+static RCore *Gcore = NULL;
+
+zf_result do_eval(const char *src, int line, const char *buf) {
+	const char *msg = NULL;
+	zf_result rv = zf_eval (buf);
+
+	switch (rv) {
+		case ZF_OK: break;
+		case ZF_ABORT_INTERNAL_ERROR: msg = "internal error"; break;
+		case ZF_ABORT_OUTSIDE_MEM: msg = "outside memory"; break;
+		case ZF_ABORT_DSTACK_OVERRUN: msg = "dstack overrun"; break;
+		case ZF_ABORT_DSTACK_UNDERRUN: msg = "dstack underrun"; break;
+		case ZF_ABORT_RSTACK_OVERRUN: msg = "rstack overrun"; break;
+		case ZF_ABORT_RSTACK_UNDERRUN: msg = "rstack underrun"; break;
+		case ZF_ABORT_NOT_A_WORD: msg = "not a word"; break;
+		case ZF_ABORT_COMPILE_ONLY_WORD: msg = "compile-only word"; break;
+		case ZF_ABORT_INVALID_SIZE: msg = "invalid size"; break;
+		case ZF_ABORT_DIVISION_BY_ZERO: msg = "division by zero"; break;
+		default: msg = "unknown error";
+	}
+
+	if (msg) {
+		fprintf(stderr, "\033[31m");
+		if(src) fprintf(stderr, "%s:%d: ", src, line);
+		fprintf(stderr, "%s\033[0m\n", msg);
+	}
+
+	return rv;
+}
+static void save(const char *fname)
+{
+	size_t len;
+	void *p = zf_dump(&len);
+	FILE *f = fopen(fname, "wb");
+	if(f) {
+		fwrite(p, 1, len, f);
+		fclose(f);
+	}
+}
+
+void include(const char *fname) {
+	char buf[256];
+
+	FILE *f = fopen(fname, "rb");
+	int line = 1;
+	if(f) {
+		while(fgets(buf, sizeof(buf), f)) {
+			do_eval(fname, line++, buf);
+		}
+		fclose(f);
+	} else {
+		fprintf(stderr, "error opening file '%s': %s\n", fname, strerror(errno));
+	}
+}
+
+  // TODO: use rlog
+void zf_host_trace(const char *fmt, va_list va) {
+	fprintf(stderr, "\033[1;30m");
+	vfprintf(stderr, fmt, va);
+	fprintf(stderr, "\033[0m");
+}
+
+  // TODO use rnum
+zf_cell zf_host_parse_num(const char *buf) {
+	zf_cell v;
+	int n = 0;
+	int r = sscanf(buf, ZF_SCAN_FMT"%n", &v, &n);
+	if(r != 1 || buf[n] != '\0') {
+		zf_abort(ZF_ABORT_NOT_A_WORD);
+	}
+	return v;
+}
+
+zf_input_state zf_host_sys(zf_syscall_id id, const char *input) {
+	switch ((int)id) {
+	/* The core system callbacks */
+	case ZF_SYSCALL_EMIT:
+		putchar ((char)zf_pop());
+		fflush (stdout);
+		break;
+	case ZF_SYSCALL_PRINT:
+		printf(ZF_CELL_FMT " ", zf_pop());
+		break;
+
+	case ZF_SYSCALL_TELL: {
+		zf_cell len = zf_pop();
+		zf_cell addr = zf_pop();
+		if(addr >= ZF_DICT_SIZE - len) {
+			zf_abort(ZF_ABORT_OUTSIDE_MEM);
+		}
+		void *buf = (uint8_t *)zf_dump(NULL) + (int)addr;
+		(void)fwrite(buf, 1, len, stdout);
+		fflush(stdout); }
+		break;
+
+
+	/* Application specific callbacks */
+
+	case ZF_SYSCALL_USER + 0:
+		printf("\n");
+		exit(0);
+		break;
+
+	case ZF_SYSCALL_USER + 1:
+		zf_push(sin(zf_pop()));
+		break;
+
+	case ZF_SYSCALL_USER + 2:
+		if(input == NULL) {
+			return ZF_INPUT_PASS_WORD;
+		}
+		include(input);
+		break;
+
+	case ZF_SYSCALL_USER + 3:
+		save("zforth.save");
+		break;
+
+	default:
+		printf("unhandled syscall %d\n", id);
+		break;
+	}
+
+	return ZF_INPUT_INTERPRET;
+}
+
+#if 0
+static VALUE radare_ruby_cmd(VALUE self, VALUE string) {
+	const char *retstr;
+	Check_Type (string, T_STRING);
+	retstr = r_core_cmd_str (core, RSTRING(string)->ptr);
+	if (retstr == NULL || retstr[0]=='\0')
+		return rb_str_new2 ("");
+	return rb_str_new2 (retstr);
+}
+#endif
+
+static bool run(RLangSession *user, const char *code, int len) {
+	// zf_result err = zf_eval (code);
+	zf_result err = do_eval ("-", 0, code);
+	if (err != ZF_OK) {
+		fprintf (stderr, "error %d handled\n", err);
+		return false;
+	}
+	return true;
+}
+
+static bool run_file(RLangSession *user, const char *file) {
+	if (r_file_exists (file)) {
+		char *contents = r_file_slurp (file, NULL);
+		zf_eval (contents);
+		return true;
+	}
+	R_LOG_ERROR ("lang_zforth: Cannot open '%s'\n", file);
+	return false;
+}
+
+static bool init(RLangSession *user) {
+	int trace = 0;
+	zf_init (trace);
+	zf_bootstrap ();
+	include("zForth/forth/core.zf");
+	return true;
+}
+
+static const char *help =
+	"zForth plugin usage:\n"
+	" 1 2 + .\n";
+
+static RLangPlugin r_lang_plugin_ruby = {
+	.meta = {
+		.name = "zforth",
+		.desc = "zForth language extension",
+	},
+	.ext = "zf",
+	.init = &init,
+	.help = &help,
+	.run = &run,
+	.run_file = &run_file,
+	.set_argv = NULL,
+};
+
+#ifndef CORELIB
+RLibStruct radare_plugin = {
+	.type = R_LIB_TYPE_LANG,
+	.version = R2_VERSION,
+	.data = &r_lang_plugin_ruby,
+};
+#endif