git.gag.com Git - debian/pforth/blob - csrc/pfcustom.c

   1 /* @(#) pfcustom.c 98/01/26 1.3 */\r
   2 \r
   3 #ifndef PF_USER_CUSTOM\r
   4 \r
   5 /***************************************************************\r
   6 ** Call Custom Functions for pForth\r
   7 **\r
   8 ** Create a file similar to this and compile it into pForth\r
   9 ** by setting -DPF_USER_CUSTOM="mycustom.c"\r
  10 **\r
  11 ** Using this, you could, for example, call X11 from Forth.\r
  12 ** See "pf_cglue.c" for more information.\r
  13 **\r
  14 ** Author: Phil Burk\r
  15 ** Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom\r
  16 **\r
  17 ** The pForth software code is dedicated to the public domain,\r
  18 ** and any third party may reproduce, distribute and modify\r
  19 ** the pForth software code or any derivative works thereof\r
  20 ** without any compensation or license.  The pForth software\r
  21 ** code is provided on an "as is" basis without any warranty\r
  22 ** of any kind, including, without limitation, the implied\r
  23 ** warranties of merchantability and fitness for a particular\r
  24 ** purpose and their equivalents under the laws of any jurisdiction.\r
  25 **\r
  26 ***************************************************************/\r
  27 \r
  28 \r
  29 #include "pf_all.h"\r
  30 \r
  31 static cell_t CTest0( cell_t Val );\r
  32 static void CTest1( cell_t Val1, cell_t Val2 );\r
  33 \r
  34 /****************************************************************\r
  35 ** Step 1: Put your own special glue routines here\r
  36 **     or link them in from another file or library.\r
  37 ****************************************************************/\r
  38 static cell_t CTest0( cell_t Val )\r
  39 {\r
  40         MSG_NUM_D("CTest0: Val = ", Val);\r
  41         return Val+1;\r
  42 }\r
  43 \r
  44 static void CTest1( cell_t Val1, cell_t Val2 )\r
  45 {\r
  46 \r
  47         MSG("CTest1: Val1 = "); ffDot(Val1);\r
  48         MSG_NUM_D(", Val2 = ", Val2);\r
  49 }\r
  50 \r
  51 /****************************************************************\r
  52 ** Step 2: Create CustomFunctionTable.\r
  53 **     Do not change the name of CustomFunctionTable!\r
  54 **     It is used by the pForth kernel.\r
  55 ****************************************************************/\r
  56 \r
  57 #ifdef PF_NO_GLOBAL_INIT\r
  58 /******************\r
  59 ** If your loader does not support global initialization, then you\r
  60 ** must define PF_NO_GLOBAL_INIT and provide a function to fill\r
  61 ** the table. Some embedded system loaders require this!\r
  62 ** Do not change the name of LoadCustomFunctionTable()!\r
  63 ** It is called by the pForth kernel.\r
  64 */\r
  65 #define NUM_CUSTOM_FUNCTIONS  (2)\r
  66 CFunc0 CustomFunctionTable[NUM_CUSTOM_FUNCTIONS];\r
  67 \r
  68 Err LoadCustomFunctionTable( void )\r
  69 {\r
  70         CustomFunctionTable[0] = CTest0;\r
  71         CustomFunctionTable[1] = CTest1;\r
  72         return 0;\r
  73 }\r
  74 \r
  75 #else\r
  76 /******************\r
  77 ** If your loader supports global initialization (most do.) then just\r
  78 ** create the table like this.\r
  79 */\r
  80 void *CustomFunctionTable[] =\r
  81 {\r
  82         (CFunc0) CTest0,\r
  83         (CFunc0) CTest1\r
  84 };      \r
  85 #endif\r
  86 \r
  87 /****************************************************************\r
  88 ** Step 3: Add custom functions to the dictionary.\r
  89 **     Do not change the name of CompileCustomFunctions!\r
  90 **     It is called by the pForth kernel.\r
  91 ****************************************************************/\r
  92 \r
  93 #if (!defined(PF_NO_INIT)) && (!defined(PF_NO_SHELL))\r
  94 Err CompileCustomFunctions( void )\r
  95 {\r
  96         Err err;\r
  97         int i = 0;\r
  98 /* Compile Forth words that call your custom functions.\r
  99 ** Make sure order of functions matches that in LoadCustomFunctionTable().\r
 100 ** Parameters are: Name in UPPER CASE, Function, Index, Mode, NumParams\r
 101 */\r
 102         err = CreateGlueToC( "CTEST0", i++, C_RETURNS_VALUE, 1 );\r
 103         if( err < 0 ) return err;\r
 104         err = CreateGlueToC( "CTEST1", i++, C_RETURNS_VOID, 2 );\r
 105         if( err < 0 ) return err;\r
 106         \r
 107         return 0;\r
 108 }\r
 109 #else\r
 110 Err CompileCustomFunctions( void ) { return 0; }\r
 111 #endif\r
 112 \r
 113 /****************************************************************\r
 114 ** Step 4: Recompile using compiler option PF_USER_CUSTOM\r
 115 **         and link with your code.\r
 116 **         Then rebuild the Forth using "pforth -i system.fth"\r
 117 **         Test:   10 Ctest0 ( should print message then '11' )\r
 118 ****************************************************************/\r
 119 \r
 120 #endif  /* PF_USER_CUSTOM */\r
 121 \r