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 ** Permission to use, copy, modify, and/or distribute this
  18 ** software for any purpose with or without fee is hereby granted.
  19 **
  20 ** THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
  21 ** WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
  22 ** WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
  23 ** THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
  24 ** CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
  25 ** FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
  26 ** CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  27 ** OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  28 **
  29 ***************************************************************/
  30
  31
  32 #include "pf_all.h"
  33
  34 static cell_t CTest0( cell_t Val );
  35 static void CTest1( cell_t Val1, cell_t Val2 );
  36
  37 /****************************************************************
  38 ** Step 1: Put your own special glue routines here
  39 **     or link them in from another file or library.
  40 ****************************************************************/
  41 static cell_t CTest0( cell_t Val )
  42 {
  43     MSG_NUM_D("CTest0: Val = ", Val);
  44     return Val+1;
  45 }
  46
  47 static void CTest1( cell_t Val1, cell_t Val2 )
  48 {
  49
  50     MSG("CTest1: Val1 = "); ffDot(Val1);
  51     MSG_NUM_D(", Val2 = ", Val2);
  52 }
  53
  54 /****************************************************************
  55 ** Step 2: Create CustomFunctionTable.
  56 **     Do not change the name of CustomFunctionTable!
  57 **     It is used by the pForth kernel.
  58 ****************************************************************/
  59
  60 #ifdef PF_NO_GLOBAL_INIT
  61 /******************
  62 ** If your loader does not support global initialization, then you
  63 ** must define PF_NO_GLOBAL_INIT and provide a function to fill
  64 ** the table. Some embedded system loaders require this!
  65 ** Do not change the name of LoadCustomFunctionTable()!
  66 ** It is called by the pForth kernel.
  67 */
  68 #define NUM_CUSTOM_FUNCTIONS  (2)
  69 CFunc0 CustomFunctionTable[NUM_CUSTOM_FUNCTIONS];
  70
  71 Err LoadCustomFunctionTable( void )
  72 {
  73     CustomFunctionTable[0] = CTest0;
  74     CustomFunctionTable[1] = CTest1;
  75     return 0;
  76 }
  77
  78 #else
  79 /******************
  80 ** If your loader supports global initialization (most do.) then just
  81 ** create the table like this.
  82 */
  83 CFunc0 CustomFunctionTable[] =
  84 {
  85     (CFunc0) CTest0,
  86     (CFunc0) CTest1
  87 };
  88 #endif
  89
  90 /****************************************************************
  91 ** Step 3: Add custom functions to the dictionary.
  92 **     Do not change the name of CompileCustomFunctions!
  93 **     It is called by the pForth kernel.
  94 ****************************************************************/
  95
  96 #if (!defined(PF_NO_INIT)) && (!defined(PF_NO_SHELL))
  97 Err CompileCustomFunctions( void )
  98 {
  99     Err err;
 100     int i = 0;
 101 /* Compile Forth words that call your custom functions.
 102 ** Make sure order of functions matches that in LoadCustomFunctionTable().
 103 ** Parameters are: Name in UPPER CASE, Function, Index, Mode, NumParams
 104 */
 105     err = CreateGlueToC( "CTEST0", i++, C_RETURNS_VALUE, 1 );
 106     if( err < 0 ) return err;
 107     err = CreateGlueToC( "CTEST1", i++, C_RETURNS_VOID, 2 );
 108     if( err < 0 ) return err;
 109
 110     return 0;
 111 }
 112 #else
 113 Err CompileCustomFunctions( void ) { return 0; }
 114 #endif
 115
 116 /****************************************************************
 117 ** Step 4: Recompile using compiler option PF_USER_CUSTOM
 118 **         and link with your code.
 119 **         Then rebuild the Forth using "pforth -i system.fth"
 120 **         Test:   10 Ctest0 ( should print message then '11' )
 121 ****************************************************************/
 122
 123 #endif  /* PF_USER_CUSTOM */
 124