ARGC + ARGV words for pforth scripting

custom/01-be-gone/cf_demo1.c

@@ -0,0 +1,99 @@
+#include "pf_all.h"      /* lots of stuff */
+#include "cf_helpers.h"  /* panic, safeAlloc, to_C_string, <stdio.h->{fprintf, stderr, ...}  */
+#include <errno.h>       /* errno         */
+
+/* 
+ * put forward declarations here if necessary
+*/
+
+
+/****************************************************************
+** Step 1: Put your own special glue routines here
+**     or link them in from another file or library.
+****************************************************************/
+
+/* exported functions */
+
+static cell_t f4711( cell_t Val )
+{/* a quick way to check that custom worlds are available
+ */
+    return 11 + 47*Val;
+}
+
+static cell_t be_gone( cell_t fileName, cell_t fnLen )
+{/* Demonstrates passing strings from PForth to C.
+    Interprets the passed strings as file name and tries to delete the file.
+	Returns 0 or errno 
+ */
+    int res;
+    char* buf = to_C_string( fileName, fnLen );
+    res = remove(buf);  /* delete file in file system */
+    if( res!=0 && errno!=0 )
+        res = errno;
+    free(buf);
+    return res;
+}
+
+
+/****************************************************************
+** Step 2: Create CustomFunctionTable.
+**     Do not change the name of CustomFunctionTable!
+**     It is used by the pForth kernel.
+****************************************************************/
+
+#ifdef PF_NO_GLOBAL_INIT
+/******************
+** If your loader does not support global initialization, then you
+** must define PF_NO_GLOBAL_INIT and provide a function to fill
+** the table. Some embedded system loaders require this!
+** Do not change the name of LoadCustomFunctionTable()!
+** It is called by the pForth kernel.
+*/
+#define NUM_CUSTOM_FUNCTIONS  (2)
+CFunc0 CustomFunctionTable[NUM_CUSTOM_FUNCTIONS];
+
+Err LoadCustomFunctionTable( void )
+{
+    CustomFunctionTable[0] = f4711;
+    CustomFunctionTable[1] = be_gone;
+    return 0;
+}
+
+#else
+/******************
+** If your loader supports global initialization (most do.) then just
+** create the table like this.
+*/
+CFunc0 CustomFunctionTable[] =
+{
+    (CFunc0) f4711,
+    (CFunc0) be_gone
+};
+#endif
+
+
+/****************************************************************
+** Step 3: Add custom functions to the dictionary.
+**     Do not change the name of CompileCustomFunctions!
+**     It is called by the pForth kernel.
+****************************************************************/
+
+#if (!defined(PF_NO_INIT)) && (!defined(PF_NO_SHELL))
+Err CompileCustomFunctions( void )
+{
+    Err err;
+    int i = 0;
+/* Compile Forth words that call your custom functions.
+** Make sure order of functions matches that in LoadCustomFunctionTable().
+** Parameters are: Name in UPPER CASE, Function, Index, Mode, NumParams
+*/
+    err = CreateGlueToC( "F4711"  , i++, C_RETURNS_VALUE, 1 );
+    if( err < 0 ) return err;
+    err = CreateGlueToC( "BE-GONE", i++, C_RETURNS_VALUE, 2 );
+    if( err < 0 ) return err;
+
+    return 0;
+}
+#else
+Err CompileCustomFunctions( void ) { return 0; }
+#endif

custom/01-be-gone/demo.fth

@@ -0,0 +1,18 @@
+\ f4711 is a clear indicator that compilation of custom functions was successful
+." f4711( 0, 1, 10, 100, 1000 ) = ( "
+   0 f4711 . ." , "
+   1 f4711 . ." , "
+  10 f4711 . ." , "
+ 100 f4711 . ." , "
+1000 f4711 . ." )"
+CR
+
+\ example of passing passing strings from PForth to custom C code
+." be-gone: "
+s" terrible_nuisance.asm" be-gone dup 0= 
+if 
+  ." works."
+  drop
+else
+  ." returns error=" .
+then CR

custom/01-be-gone/go-v0.sh

@@ -0,0 +1,42 @@
+#!/bin/sh
+
+# Compile pForth with custom code and show that this works. 
+# We assume a posix shell and system (but adaption should be easy to others).
+# Note: This is the easiest solution but ignores PForths best practices set up in pfcustom.c
+# Warning: This patches the existing source tree and might create confusion when not used on separate Git branch in case an error occurs.
+# Tested on MSYS2-Cygwin, Linux, FreeBSD (X86_64 architecture each), NetBSD (i386 architecture)
+
+# save original C sources and copy demo sources. Thus we do not need to change the make file.
+mv ../../csrc/pfcustom.c ../../csrc/pfcustom_c.original
+cp ../cf_helpers.h  ../../csrc/
+cp cf_demo1.c       ../../csrc/pfcustom.c
+
+echo
+echo "----------------------------------------"
+echo "make pforth (skip standalone executable)"
+echo "----------------------------------------"
+MAKE_CMD=`./get-make-cmd.sh`
+cd ../../platforms/unix/
+# We would not even need to define DPF_USER_CUSTOM since it is only used in the original pfcustom.c we overwrote.
+PF_USER_CUSTOM="1" $MAKE_CMD clean pforth.dic
+
+# create a nuisance to delete
+mv ../../csrc/cf_helpers.h ./terrible_nuisance.asm
+
+echo
+echo "---------------------------"
+echo "show that custom code works"
+echo "---------------------------"
+./pforth -q ../../custom/01-be-gone/demo.fth
+
+echo
+echo "----------------------------"
+echo "restore original source tree"
+echo "----------------------------"
+mv ../../csrc/pfcustom_c.original ../../csrc/pfcustom.c 
+$MAKE_CMD clean
+
+echo
+echo "-----------------"
+echo "That's all folks!"
+echo "-----------------"

custom/01-be-gone/go-v1.sh

@@ -0,0 +1,42 @@
+#!/bin/sh
+
+# Compile pForth with custom code and show that this works. 
+# We assume a posix shell and system (but adaption should be easy to others).
+# This improved version only compiles the custom code defined in CF_SOURCES.
+# Warning: This patches the existing source tree and might create confusion when not used on separate Git branch in case an error occurs.
+# Tested on MSYS2-Cygwin, Linux, FreeBSD (X86_64 architecture each), NetBSD (i386 architecture)
+
+# copy demo sources. Thus we do not need to change the make file.
+
+cp ../cf_helpers.h  ../../csrc/
+cp cf_demo1.c       ../../csrc/
+
+echo
+echo "----------------------------------------"
+echo "make pforth (skip standalone executable)"
+echo "----------------------------------------"
+MAKE_CMD=`../get-make-cmd.sh`
+cd ../../platforms/unix/
+
+CF_SOURCES="cf_demo1.c" $MAKE_CMD clean pforth.dic
+
+# create a nuisance to delete
+mv ../../csrc/cf_helpers.h ./terrible_nuisance.asm
+
+echo
+echo "---------------------------"
+echo "show that custom code works"
+echo "---------------------------"
+./pforth -q ../../custom/01-be-gone/demo.fth
+
+echo
+echo "----------------------------"
+echo "restore original source tree"
+echo "----------------------------"
+rm ../../csrc/cf_demo1.c
+CF_SOURCES="cf_demo1.c" $MAKE_CMD clean
+
+echo
+echo "-----------------"
+echo "That's all folks!"
+echo "-----------------"

custom/02-argc-argv/cf_demo2.c

@@ -0,0 +1,122 @@
+#include "pf_all.h"      /* lots of stuff */
+#include<stdlib.h>       /* calloc */
+#include<string.h>       /* strlen */
+
+/* 
+ * put forward declarations here if necessary
+*/
+
+void fillScriptParams( int startItem, int NoItems, char *argv[] );
+
+/****************************************************************
+** Step 1: Put your own special glue routines here
+**     or link them in from another file or library.
+****************************************************************/
+
+/* exported functions */
+
+static cell_t cf_f4711( cell_t Val )
+{/* a quick way to check that custom words are available
+ */
+    return 11 + 47*Val;
+}
+
+
+struct PascalString {
+    char* data;
+    size_t len;
+} ;
+typedef struct PascalString* PascalStringPtr;
+
+static struct  {
+    PascalStringPtr args;
+    int             cnt;
+} ScriptParams;
+
+void fillScriptParams( int startItem, int NoItems, char *argv[] ) {
+	int i;
+    if( startItem < NoItems ) {
+        ScriptParams.cnt = NoItems - startItem;
+        ScriptParams.args = (PascalStringPtr) calloc( ScriptParams.cnt, sizeof(struct PascalString) );
+		for( i=0; i<ScriptParams.cnt; i++ )  {
+			char* progParam = argv[i+startItem];
+			ScriptParams.args[i].data = progParam;
+			ScriptParams.args[i].len  = strlen(progParam);
+		}
+    }
+}
+
+static cell_t cf_argc()
+{/* number of command line parameters after '--'
+ */ return ScriptParams.cnt;
+}
+
+static cell_t cf_argv( cell_t paramNo )
+{/* return argv[paramNo] as '--> caddr len'   OR in case of error  '--> 0 -1'
+ */ cell_t len = -1;  /* assume something will go wrong */
+    cell_t data = 0;  /* dito                           */
+    if( 0<=paramNo  &&  paramNo < ScriptParams.cnt ) {
+        data = (cell_t) ScriptParams.args[paramNo].data;
+        len  = ScriptParams.args[paramNo].len;
+    }
+    PUSH_DATA_STACK( (cell_t) data );
+    return len;
+}
+
+
+
+/****************************************************************
+** Step 2: Create CustomFunctionTable.
+**     Do not change the name of CustomFunctionTable!
+**     It is used by the pForth kernel.
+****************************************************************/
+
+#ifdef PF_NO_GLOBAL_INIT
+#define NUM_CUSTOM_FUNCTIONS  (3)
+CFunc0 CustomFunctionTable[NUM_CUSTOM_FUNCTIONS];
+
+Err LoadCustomFunctionTable( void )
+{
+    CustomFunctionTable[0] = cf_f4711;
+    CustomFunctionTable[1] = cf_argc;
+    CustomFunctionTable[2] = cf_argv;
+    return 0;
+}
+
+#else
+CFunc0 CustomFunctionTable[] =
+{
+    (CFunc0) cf_f4711,
+    (CFunc0) cf_argc,
+    (CFunc0) cf_argv
+};
+#endif
+
+
+/****************************************************************
+** Step 3: Add custom functions to the dictionary.
+**     Do not change the name of CompileCustomFunctions!
+**     It is called by the pForth kernel.
+****************************************************************/
+
+#if (!defined(PF_NO_INIT)) && (!defined(PF_NO_SHELL))
+Err CompileCustomFunctions( void )
+{
+    Err err;
+    int i = 0;
+/* Compile Forth words that call your custom functions.
+** Make sure order of functions matches that in LoadCustomFunctionTable().
+** Parameters are: Name in UPPER CASE, Function, Index, Mode, NumParams
+*/
+    err = CreateGlueToC( "F4711", i++, C_RETURNS_VALUE, 1 );
+    if( err < 0 ) return err;
+    err = CreateGlueToC( "ARGC" , i++, C_RETURNS_VALUE, 0 );
+    if( err < 0 ) return err;
+    err = CreateGlueToC( "ARGV" , i++, C_RETURNS_VALUE, 1 );
+    if( err < 0 ) return err;
+
+    return 0;
+}
+#else
+Err CompileCustomFunctions( void ) { return 0; }
+#endif

custom/02-argc-argv/demo.correct_output

@@ -0,0 +1,4 @@
+argc=3 
+argv[0] = '01: One FORTH to'
+argv[1] = '02:find'
+argv[2] = '03:them'

custom/02-argc-argv/demo.fth

@@ -0,0 +1,7 @@
+argc ." argc=" . cr
+
+argc 0 do
+  i dup 
+  ." argv[" (.) type ." ] = '" 
+  argv type ." '" cr
+loop

custom/02-argc-argv/diff-pf_main.c

@@ -0,0 +1,25 @@
+*** old-pf_main.c	Wed Jan  1 21:13:11 2025
+--- new-pf_main.c	Wed Jan  1 21:11:33 2025
+***************
+*** 58,63 ****
+--- 58,64 ----
+  }
+  #else
+
++ void fillScriptParams( int startItem, int NoItems, char *argv[] );  /* forward declaration for cf_demo2.c */
+  int main( int argc, char **argv )
+  {
+  #ifdef PF_STATIC_DIC
+***************
+*** 90,95 ****
+--- 91,100 ----
+              c = *s++;
+              switch(c)
+              {
++             case '-': /* call code in cf_demo2.c then skip remaining arguments */
++ 				fillScriptParams( i+1, argc, argv );
++                 i = argc; 
++                 break;
+              case 'i':
+                  IfInit = TRUE;
+                  DicName = NULL;