1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
/* @(#) pfcustom.c 98/01/26 1.3 */
#ifndef PF_USER_CUSTOM
/***************************************************************
** Call Custom Functions for pForth
**
** Create a file similar to this and compile it into pForth
** by setting -DPF_USER_CUSTOM="mycustom.c"
**
** Using this, you could, for example, call X11 from Forth.
** See "pf_cglue.c" for more information.
**
** Author: Phil Burk
** Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
**
** Permission to use, copy, modify, and/or distribute this
** software for any purpose with or without fee is hereby granted.
**
** THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
** WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
** WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
** THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
** CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
** FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
** CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
** OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
**
***************************************************************/
#include "pf_all.h"
static cell_t CTest0( cell_t Val );
static void CTest1( cell_t Val1, cell_t Val2 );
/****************************************************************
** Step 1: Put your own special glue routines here
** or link them in from another file or library.
****************************************************************/
static cell_t CTest0( cell_t Val )
{
MSG_NUM_D("CTest0: Val = ", Val);
return Val+1;
}
static void CTest1( cell_t Val1, cell_t Val2 )
{
MSG("CTest1: Val1 = "); ffDot(Val1);
MSG_NUM_D(", Val2 = ", Val2);
}
/****************************************************************
** 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] = CTest0;
CustomFunctionTable[1] = CTest1;
return 0;
}
#else
/******************
** If your loader supports global initialization (most do.) then just
** create the table like this.
*/
CFunc0 CustomFunctionTable[] =
{
(CFunc0) CTest0,
(CFunc0) CTest1
};
#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( "CTEST0", i++, C_RETURNS_VALUE, 1 );
if( err < 0 ) return err;
err = CreateGlueToC( "CTEST1", i++, C_RETURNS_VOID, 2 );
if( err < 0 ) return err;
return 0;
}
#else
Err CompileCustomFunctions( void ) { return 0; }
#endif
/****************************************************************
** Step 4: Recompile using compiler option PF_USER_CUSTOM
** and link with your code.
** Then rebuild the Forth using "pforth -i system.fth"
** Test: 10 Ctest0 ( should print message then '11' )
****************************************************************/
#endif /* PF_USER_CUSTOM */
|
