Annotation of gforth/forth.h, revision 1.26
1.19 anton 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.
1.1 anton 20: */
21:
1.21 anton 22: #include "config.h"
23: #include <limits.h>
1.26 ! pazsan 24: #if defined(NeXT)
! 25: # include <libc.h>
! 26: #endif /* NeXT */
1.21 anton 27:
1.1 anton 28: typedef void *Label;
29:
1.2 pazsan 30: /* symbol indexed constants */
31:
32: #define DOCOL 0
33: #define DOCON 1
34: #define DOVAR 2
35: #define DOUSER 3
1.8 anton 36: #define DODEFER 4
1.16 anton 37: #define DOFIELD 5
1.14 pazsan 38: #define DODOES 6
39: #define DOESJUMP 7
1.6 benschop 40:
1.1 anton 41: #include "machine.h"
42:
43: /* Forth data types */
1.21 anton 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)
1.20 pazsan 48: typedef Cell Bool;
1.1 anton 49: #define FLAG(b) (-(b))
1.5 pazsan 50: #define FILEIO(error) (FLAG(error) & -37)
51: #define FILEEXIST(error) (FLAG(error) & -38)
1.1 anton 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:
1.21 anton 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:
1.1 anton 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))
1.25 anton 137: /* DOES_CODE is the Forth code does jumps to */
1.24 anton 138: #define DOES_CODE(cfa) ({Xt _cfa=(Xt)(cfa); \
139: _cfa[0] == symbols[DODOES] ? _cfa[1] : NULL;})
140: #define DOES_CODE1(cfa) (cfa[1])
1.1 anton 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 */
1.2 pazsan 145: #define MAKE_DOES_CF(cfa,does_code) ({MAKE_CF(cfa,symbols[DODOES]); \
1.1 anton 146: ((Cell *)cfa)[1] = (Cell)does_code;})
147: /* the does handler resides between DOES> and the following Forth code */
1.13 pazsan 148: #define DOES_HANDLER_SIZE (2*sizeof(Cell))
1.1 anton 149: #define MAKE_DOES_HANDLER(addr) 0 /* do nothing */
1.21 anton 150: #endif /* !defined(DIRECT_THREADED) */
1.1 anton 151:
152: #ifdef DEBUG
1.18 pazsan 153: # define NAME(string) fprintf(stderr,"%08lx: "string"\n",(Cell)ip);
1.1 anton 154: #else
155: # define NAME(string)
156: #endif
1.2 pazsan 157:
158: #define CF(const) (-const-2)
159:
160: #define CF_NIL -1
1.3 pazsan 161:
1.15 anton 162: #ifndef FLUSH_ICACHE
1.16 anton 163: #warning flush-icache probably will not work (see manual)
1.17 pazsan 164: # define FLUSH_ICACHE(addr,size)
1.15 anton 165: #endif
166:
167: #ifdef DIRECT_THREADED
168: #define CACHE_FLUSH(addr,size) FLUSH_ICACHE(addr,size)
169: #else
1.17 pazsan 170: #define CACHE_FLUSH(addr,size)
1.3 pazsan 171: #endif
1.21 anton 172:
173: Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp);
174:
175: /* dblsub routines */
176: DCell dnegate(DCell d1);
177: UDCell ummul (UCell a, UCell b);
178: DCell mmul (Cell a, Cell b);
179: UDCell umdiv (UDCell u, UCell v);
180: DCell smdiv (DCell num, Cell denom);
181: DCell fmdiv (DCell num, Cell denom);
182:
1.22 anton 183: int memcasecmp(const char *s1, const char *s2, long n);
184:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to forth.h CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth