1: \ prims2cl.fs Primitives to c-library code
2:
3: \ Copyright (C) 1998,1999,2001,2003,2007 Free Software Foundation, Inc.
4:
5: \ This file is part of Gforth.
6:
7: \ Gforth is free software; you can redistribute it and/or
8: \ modify it under the terms of the GNU General Public License
9: \ as published by the Free Software Foundation, either version 3
10: \ of the License, or (at your option) any later version.
11:
12: \ This program is distributed in the hope that it will be useful,
13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: \ GNU General Public License for more details.
16:
17: \ You should have received a copy of the GNU General Public License
18: \ along with this program. If not, see http://www.gnu.org/licenses/.
19:
20: \ Author: Jens Wilke
21: \ Revision Log
22: \ 09oct97jaw V1.0 Initial Version
23:
24: include ./prims2x.fs
25:
26: Create InputFile 130 chars allot
27:
28: : c-code
29: InputFile count ['] output-c-func ['] abort process-file
30: ;
31:
32: : c-names
33: InputFile count ['] output-funclabel ['] abort process-file
34: ;
35:
36: : forth-names
37: InputFile count ['] output-forthname dup process-file
38: ;
39:
40: : .\
41: 0 word count pad place pad count postpone sliteral postpone type postpone cr ; immediate
42:
43: : c-header
44: .\ #include "engine/forth.h"
45: .\ extern char *cstr(Char *from, UCell size, int clear);
46: .\ extern char *tilde_cstr(Char *from, UCell size, int clear);
47: .\
48: .\ #undef TOS
49: .\ #define TOS sp[0]
50: .\ #undef IF_TOS
51: .\ #define IF_TOS(x)
52: .\ #undef NEXT_P2
53: .\ #define NEXT_P2
54: .\ #undef NEXT_P1
55: .\ #define NEXT_P1
56: .\ #undef NEXT_P0
57: .\ #define NEXT_P0
58: .\ #undef NAME
59: .\ #define NAME(x)
60: .\ #undef DEF_CA
61: .\ #define DEF_CA
62: .\ #undef I_
63: .\ #define I_ I_
64: .\
65: .\ #define NAME_LEN 32
66: .\ #define NULL 0
67: .\
68: ;
69:
70: : catalog
71: .\ void *catalog(int p)
72: .\ {
73: .\ static void *ADDR_TABLE[]={
74: c-names
75: .\ };
76: .\ static char NAME_TABLE[][NAME_LEN]={
77: forth-names
78: .\ };
79: ." int funcs=" function-number @ s>d <# #S #> type ." ;" cr
80: .\
81: .\ static struct { void *func;
82: .\ char len;
83: .\ char name[NAME_LEN];
84: .\ }f;
85: .\
86: .\ switch (p)
87: .\ { case -2: /*
88: .\ We return the table known words
89: .\ don't use this!!!
90: .\ */
91: .\ return (NAME_TABLE[0]);
92: .\
93: .\ case -1: /*
94: .\ Return number of words in this module
95: .\ */
96: .\ return ((void *) funcs);
97: .\ }
98: .\ /*
99: .\ Check for valid function number
100: .\ */
101: .\ if (p<0 || p>=funcs) return (0);
102: .\ /*
103: .\ Find matching forth word and return its address
104: .\ */
105: .\ strcpy(f.name,NAME_TABLE[p]);
106: .\ f.len=strlen(f.name);
107: .\ f.func=ADDR_TABLE[p];
108: .\ return (&f);
109: .\ }
110: ;
111:
112: : main
113: c-header
114: c-code
115: catalog
116: ;
117:
118: : file
119: bl word count InputFile place ;
120:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>