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

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