Imported Upstream version 21
[debian/pforth] / 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, Devid 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 int32 CTest0( int32 Val );
32 static void CTest1( int32 Val1, cell 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 int32 CTest0( int32 Val )
39 {
40         MSG_NUM_D("CTest0: Val = ", Val);
41         return Val+1;
42 }
43
44 static void CTest1( int32 Val1, cell 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 void *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
81 void *CustomFunctionTable[] =
82 {
83         (void *)CTest0,
84         (void *)CTest1
85 };      
86 #endif
87
88 /****************************************************************
89 ** Step 3: Add custom functions to the dictionary.
90 **     Do not change the name of CompileCustomFunctions!
91 **     It is called by the pForth kernel.
92 ****************************************************************/
93
94 #if (!defined(PF_NO_INIT)) && (!defined(PF_NO_SHELL))
95 Err CompileCustomFunctions( void )
96 {
97         Err err;
98
99 /* Compile Forth words that call your custom functions.
100 ** Make sure order of functions matches that in LoadCustomFunctionTable().
101 ** Parameters are: Name in UPPER CASE, Function, Index, Mode, NumParams
102 */
103         err = CreateGlueToC( "CTEST0", 0, C_RETURNS_VALUE, 1 );
104         if( err < 0 ) return err;
105         err = CreateGlueToC( "CTEST1", 1, C_RETURNS_VOID, 2 );
106         if( err < 0 ) return err;
107         
108         return 0;
109 }
110 #else
111 Err CompileCustomFunctions( void ) { return 0; }
112 #endif
113
114 /****************************************************************
115 ** Step 4: Recompile using compiler option PF_USER_CUSTOM
116 **         and link with your code.
117 **         Then rebuild the Forth using "pforth -i"
118 **         Test:   10 Ctest0 ( should print message then '11' )
119 ****************************************************************/
120
121 #endif  /* PF_USER_CUSTOM */
122