File:
[gforth] /
gforth /
Attic /
forth.h
Revision
1.27:
download - view:
text,
annotated -
select for diffs
Sat Dec 28 17:19:24 1996 UTC (27 years, 3 months ago) by
anton
Branches:
MAIN
CVS tags:
HEAD
use mmap for allocating the dictionary and the stacks on some systems
added installdirs target to Makefile.in.
Use mkinstalldirs instead of install-sh -d.
added version-stamp to avoid recompiling everything after changing Makefile.in.
mostly fixed the maiming of words containing '/' in TAGS
added options --clear-dictionary and --debug.
1: /* common header file
2:
3: Copyright (C) 1995 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 2
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, write to the Free Software
19: Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20: */
21:
22: #include "config.h"
23: #include <limits.h>
24: #if defined(NeXT)
25: # include <libc.h>
26: #endif /* NeXT */
27:
28: typedef void *Label;
29:
30: /* symbol indexed constants */
31:
32: #define DOCOL 0
33: #define DOCON 1
34: #define DOVAR 2
35: #define DOUSER 3
36: #define DODEFER 4
37: #define DOFIELD 5
38: #define DODOES 6
39: #define DOESJUMP 7
40:
41: #include "machine.h"
42:
43: /* Forth data types */
44: /* Cell and UCell must be the same size as a pointer */
45: typedef CELL_TYPE Cell;
46: typedef unsigned CELL_TYPE UCell;
47: #define CELL_BITS (sizeof(Cell) * CHAR_BIT)
48: typedef Cell Bool;
49: #define FLAG(b) (-(b))
50: #define FILEIO(error) (FLAG(error) & -37)
51: #define FILEEXIST(error) (FLAG(error) & -38)
52:
53: #define F_TRUE (FLAG(0==0))
54: #define F_FALSE (FLAG(0!=0))
55:
56: typedef unsigned char Char;
57: typedef double Float;
58: typedef char *Address;
59:
60: #ifdef BUGGY_LONG_LONG
61: typedef struct {
62: Cell hi;
63: UCell lo;
64: } DCell;
65:
66: typedef struct {
67: UCell hi;
68: UCell lo;
69: } UDCell;
70:
71: #define FETCH_DCELL(d,lo,hi) ((d)=(typeof(d)){(hi),(lo)})
72: #define STORE_DCELL(d,low,high) ({ \
73: typeof(d) _d = (d); \
74: (low) = _d.lo; \
75: (high)= _d.hi; \
76: })
77:
78: #define LONG2UD(l) ({UDCell _ud; _ud.hi=0; _ud.lo=(Cell)(l); _ud;})
79: #define UD2LONG(ud) ((long)(ud.lo))
80: #define DZERO ((DCell){0,0})
81:
82: #else /* ! defined(BUGGY_LONG_LONG) */
83:
84: /* DCell and UDCell must be twice as large as Cell */
85: typedef DOUBLE_CELL_TYPE DCell;
86: typedef unsigned DOUBLE_CELL_TYPE UDCell;
87:
88: typedef union {
89: struct {
90: #ifdef WORDS_BIGENDIAN
91: Cell high;
92: UCell low;
93: #else
94: UCell low;
95: Cell high;
96: #endif;
97: } cells;
98: DCell dcell;
99: } Double_Store;
100:
101: #define FETCH_DCELL(d,lo,hi) ({ \
102: Double_Store _d; \
103: _d.cells.low = (lo); \
104: _d.cells.high = (hi); \
105: (d) = _d.dcell; \
106: })
107:
108: #define STORE_DCELL(d,lo,hi) ({ \
109: Double_Store _d; \
110: _d.dcell = (d); \
111: (lo) = _d.cells.low; \
112: (hi) = _d.cells.high; \
113: })
114:
115: #define LONG2UD(l) ((UDCell)(l))
116: #define UD2LONG(ud) ((long)(ud))
117: #define DZERO ((DCell)0)
118:
119: #endif /* ! defined(BUGGY_LONG_LONG) */
120:
121: #ifdef DIRECT_THREADED
122: typedef Label Xt;
123: #else
124: typedef Label *Xt;
125: #endif
126:
127: #ifndef DIRECT_THREADED
128: /* i.e. indirect threaded */
129: /* the direct threaded version is machine dependent and resides in machine.h */
130:
131: /* PFA gives the parameter field address corresponding to a cfa */
132: #define PFA(cfa) (((Cell *)cfa)+2)
133: /* PFA1 is a special version for use just after a NEXT1 */
134: #define PFA1(cfa) PFA(cfa)
135: /* CODE_ADDRESS is the address of the code jumped to through the code field */
136: #define CODE_ADDRESS(cfa) (*(Label *)(cfa))
137: /* DOES_CODE is the Forth code does jumps to */
138: #define DOES_CODE(cfa) ({Xt _cfa=(Xt)(cfa); \
139: _cfa[0] == symbols[DODOES] ? _cfa[1] : NULL;})
140: #define DOES_CODE1(cfa) (cfa[1])
141: /* MAKE_CF creates an appropriate code field at the cfa;
142: ca is the code address */
143: #define MAKE_CF(cfa,ca) ((*(Label *)(cfa)) = ((Label)ca))
144: /* make a code field for a defining-word-defined word */
145: #define MAKE_DOES_CF(cfa,does_code) ({MAKE_CF(cfa,symbols[DODOES]); \
146: ((Cell *)cfa)[1] = (Cell)does_code;})
147: /* the does handler resides between DOES> and the following Forth code */
148: #define DOES_HANDLER_SIZE (2*sizeof(Cell))
149: #define MAKE_DOES_HANDLER(addr) 0 /* do nothing */
150: #endif /* !defined(DIRECT_THREADED) */
151:
152: #ifdef DEBUG
153: # define NAME(string) fprintf(stderr,"%08lx: "string"\n",(Cell)ip);
154: #else
155: # define NAME(string)
156: #endif
157:
158: #define CF(const) (-const-2)
159:
160: #define CF_NIL -1
161:
162: #ifndef FLUSH_ICACHE
163: #warning flush-icache probably will not work (see manual)
164: # define FLUSH_ICACHE(addr,size)
165: #endif
166:
167: #ifdef DIRECT_THREADED
168: #define CACHE_FLUSH(addr,size) FLUSH_ICACHE(addr,size)
169: #else
170: #define CACHE_FLUSH(addr,size)
171: #endif
172:
173: #ifdef USE_TOS
174: #define IF_TOS(x) x
175: #else
176: #define IF_TOS(x)
177: #define TOS (sp[0])
178: #endif
179:
180: #ifdef USE_FTOS
181: #define IF_FTOS(x) x
182: #else
183: #define IF_FTOS(x)
184: #define FTOS (fp[0])
185: #endif
186:
187: Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp);
188:
189: /* dblsub routines */
190: DCell dnegate(DCell d1);
191: UDCell ummul (UCell a, UCell b);
192: DCell mmul (Cell a, Cell b);
193: UDCell umdiv (UDCell u, UCell v);
194: DCell smdiv (DCell num, Cell denom);
195: DCell fmdiv (DCell num, Cell denom);
196:
197: int memcasecmp(const char *s1, const char *s2, long n);
198:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>