projects / pforth / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Implement SAVE-INPUT and RESTORE-INPUT
[pforth] / csrc / pf_guts.h
CommitLineData
8e9db35f
PB		 1/* @(#) pf_guts.h 98/01/28 1.4 */
2#ifndef _pf_guts_h
3#define _pf_guts_h
4
5/***************************************************************
6** Include file for PForth, a Forth based on 'C'
7**
8** Author: Phil Burk
9** Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
10**
11** The pForth software code is dedicated to the public domain,
12** and any third party may reproduce, distribute and modify
13** the pForth software code or any derivative works thereof
14** without any compensation or license. The pForth software
15** code is provided on an "as is" basis without any warranty
16** of any kind, including, without limitation, the implied
17** warranties of merchantability and fitness for a particular
18** purpose and their equivalents under the laws of any jurisdiction.
19**
20***************************************************************/
21
22/*
23** PFORTH_VERSION changes when PForth is modified and released.
24** See README file for version info.
25*/
26#define PFORTH_VERSION "27"
27
28/*
29** PFORTH_FILE_VERSION changes when incompatible changes are made
30** in the ".dic" file format.
31**
32** FV3 - 950225 - Use ABS_TO_CODEREL for CodePtr. See file "pf_save.c".
33** FV4 - 950309 - Added NameSize and CodeSize to pfSaveForth().
34** FV5 - 950316 - Added Floats and reserved words.
35** FV6 - 961213 - Added ID_LOCAL_PLUSSTORE, ID_COLON_P, etc.
36** FV7 - 971203 - Added ID_FILL, (1LOCAL@), etc., ran out of reserved, resorted.
37** FV8 - 980818 - Added Endian flag.
38** FV9 - 20100503 - Added support for 64-bit CELL.
39*/
40#define PF_FILE_VERSION (9) /* Bump this whenever primitives added. */
41#define PF_EARLIEST_FILE_VERSION (9) /* earliest one still compatible */
42
43/***************************************************************
44** Sizes and other constants
45***************************************************************/
46
47#define TIB_SIZE (256)
48
49#ifndef FALSE
50 #define FALSE (0)
51#endif
52#ifndef TRUE
53 #define TRUE (1)
54#endif
55
56#define FFALSE (0)
57#define FTRUE (-1)
58#define BLANK (' ')
59
60#define FLAG_PRECEDENCE (0x80)
61#define FLAG_IMMEDIATE (0x40)
62#define FLAG_SMUDGE (0x20)
63#define MASK_NAME_SIZE (0x1F)
64
65/* Debug TRACE flags */
66#define TRACE_INNER (0x0002)
67#define TRACE_COMPILE (0x0004)
68#define TRACE_SPECIAL (0x0008)
69
70/* Numeric types returned by NUMBER? */
71#define NUM_TYPE_BAD (0)
72#define NUM_TYPE_SINGLE (1)
73#define NUM_TYPE_DOUBLE (2)
74#define NUM_TYPE_FLOAT (3)
75
76#define CREATE_BODY_OFFSET (3*sizeof(cell_t))
77
78/***************************************************************
79** Primitive Token IDS
80** Do NOT change the order of these IDs or dictionary files will break!
81***************************************************************/
82enum cforth_primitive_ids
83{
84 ID_EXIT = 0, /* ID_EXIT must always be zero. */
85/* Do NOT change the order of these IDs or dictionary files will break! */
86 ID_1MINUS,
87 ID_1PLUS,
88 ID_2DUP,
89 ID_2LITERAL,
90 ID_2LITERAL_P,
91 ID_2MINUS,
92 ID_2OVER,
93 ID_2PLUS,
94 ID_2SWAP,
95 ID_2_R_FETCH,
96 ID_2_R_FROM,
97 ID_2_TO_R,
98 ID_ACCEPT_P,
99 ID_ALITERAL,
100 ID_ALITERAL_P,
101 ID_ALLOCATE,
102 ID_AND,
103 ID_ARSHIFT,
104 ID_BAIL,
105 ID_BODY_OFFSET,
106 ID_BRANCH,
107 ID_BYE,
108 ID_CALL_C,
109 ID_CFETCH,
110 ID_CMOVE,
111 ID_CMOVE_UP,
112 ID_COLON,
113 ID_COLON_P,
114 ID_COMPARE,
115 ID_COMP_EQUAL,
116 ID_COMP_GREATERTHAN,
117 ID_COMP_LESSTHAN,
118 ID_COMP_NOT_EQUAL,
119 ID_COMP_U_GREATERTHAN,
120 ID_COMP_U_LESSTHAN,
121 ID_COMP_ZERO_EQUAL,
122 ID_COMP_ZERO_GREATERTHAN,
123 ID_COMP_ZERO_LESSTHAN,
124 ID_COMP_ZERO_NOT_EQUAL,
125 ID_CR,
126 ID_CREATE,
127 ID_CREATE_P,
128 ID_CSTORE,
129 ID_DEFER,
130 ID_DEFER_P,
131 ID_DEPTH,
132 ID_DIVIDE,
133 ID_DOT,
134 ID_DOTS,
135 ID_DO_P,
136 ID_DROP,
137 ID_DUMP,
138 ID_DUP,
139 ID_D_MINUS,
140 ID_D_MTIMES,
141 ID_D_MUSMOD,
142 ID_D_PLUS,
143 ID_D_UMSMOD,
144 ID_D_UMTIMES,
145 ID_EMIT,
146 ID_EMIT_P,
147 ID_EOL,
148 ID_ERRORQ_P,
149 ID_EXECUTE,
150 ID_FETCH,
151 ID_FILE_CLOSE,
152 ID_FILE_CREATE,
153 ID_FILE_OPEN,
154 ID_FILE_POSITION,
155 ID_FILE_READ,
156 ID_FILE_REPOSITION,
157 ID_FILE_RO,
158 ID_FILE_RW,
159 ID_FILE_SIZE,
160 ID_FILE_WRITE,
161 ID_FILL,
162 ID_FIND,
163 ID_FINDNFA,
164 ID_FLUSHEMIT,
165 ID_FREE,
166 ID_HERE,
167 ID_NUMBERQ_P,
168 ID_I,
169 ID_INCLUDE_FILE,
170 ID_J,
171 ID_KEY,
172 ID_LEAVE_P,
173 ID_LITERAL,
174 ID_LITERAL_P,
175 ID_LOADSYS,
176 ID_LOCAL_COMPILER,
177 ID_LOCAL_ENTRY,
178 ID_LOCAL_EXIT,
179 ID_LOCAL_FETCH,
180 ID_LOCAL_FETCH_1,
181 ID_LOCAL_FETCH_2,
182 ID_LOCAL_FETCH_3,
183 ID_LOCAL_FETCH_4,
184 ID_LOCAL_FETCH_5,
185 ID_LOCAL_FETCH_6,
186 ID_LOCAL_FETCH_7,
187 ID_LOCAL_FETCH_8,
188 ID_LOCAL_PLUSSTORE,
189 ID_LOCAL_STORE,
190 ID_LOCAL_STORE_1,
191 ID_LOCAL_STORE_2,
192 ID_LOCAL_STORE_3,
193 ID_LOCAL_STORE_4,
194 ID_LOCAL_STORE_5,
195 ID_LOCAL_STORE_6,
196 ID_LOCAL_STORE_7,
197 ID_LOCAL_STORE_8,
198 ID_LOOP_P,
199 ID_LSHIFT,
200 ID_MAX,
201 ID_MIN,
202 ID_MINUS,
203 ID_NAME_TO_PREVIOUS,
204 ID_NAME_TO_TOKEN,
205 ID_NOOP,
206 ID_NUMBERQ,
207 ID_OR,
208 ID_OVER,
209 ID_PICK,
210 ID_PLUS,
211 ID_PLUSLOOP_P,
212 ID_PLUS_STORE,
213 ID_QDO_P,
214 ID_QDUP,
215 ID_QTERMINAL,
216 ID_QUIT_P,
217 ID_REFILL,
218 ID_RESIZE,
08689895 219 ID_SOURCE_LINE_NUMBER_FETCH, /* used to be ID_RESTORE_INPUT */
8e9db35f
PB		 220 ID_ROLL,
221 ID_ROT,
222 ID_RP_FETCH,
223 ID_RP_STORE,
224 ID_RSHIFT,
225 ID_R_DROP,
226 ID_R_FETCH,
227 ID_R_FROM,
228 ID_SAVE_FORTH_P,
08689895 229 ID_SOURCE_LINE_NUMBER_STORE, /* used to be ID_SAVE_INPUT */
8e9db35f
PB		 230 ID_SCAN,
231 ID_SEMICOLON,
232 ID_SKIP,
233 ID_SOURCE,
234 ID_SOURCE_ID,
235 ID_SOURCE_ID_POP,
236 ID_SOURCE_ID_PUSH,
237 ID_SOURCE_SET,
238 ID_SP_FETCH,
239 ID_SP_STORE,
240 ID_STORE,
241 ID_SWAP,
242 ID_TEST1,
243 ID_TEST2,
244 ID_TEST3,
245 ID_TICK,
246 ID_TIMES,
247 ID_TO_R,
248 ID_TYPE,
249 ID_TYPE_P,
250 ID_VAR_BASE,
251 ID_VAR_CODE_BASE,
252 ID_VAR_CODE_LIMIT,
253 ID_VAR_CONTEXT,
254 ID_VAR_DP,
255 ID_VAR_ECHO,
256 ID_VAR_HEADERS_BASE,
257 ID_VAR_HEADERS_LIMIT,
258 ID_VAR_HEADERS_PTR,
259 ID_VAR_NUM_TIB,
260 ID_VAR_OUT,
261 ID_VAR_RETURN_CODE,
262 ID_VAR_SOURCE_ID,
263 ID_VAR_STATE,
264 ID_VAR_TO_IN,
265 ID_VAR_TRACE_FLAGS,
266 ID_VAR_TRACE_LEVEL,
267 ID_VAR_TRACE_STACK,
268 ID_VLIST,
269 ID_WORD,
270 ID_WORD_FETCH,
271 ID_WORD_STORE,
272 ID_XOR,
273 ID_ZERO_BRANCH,
274 ID_CATCH,
275 ID_THROW,
276 ID_INTERPRET,
277 ID_FILE_WO,
278 ID_FILE_BIN,
279 /* Added to support 64 bit operation. */
280 ID_CELL,
281 ID_CELLS,
282 /* DELETE-FILE */
283 ID_FILE_DELETE,
284/* If you add a word here, take away one reserved word below. */
285#ifdef PF_SUPPORT_FP
286/* Only reserve space if we are adding FP so that we can detect
287** unsupported primitives when loading dictionary.
288*/
289 ID_RESERVED01,
290 ID_RESERVED02,
291 ID_RESERVED03,
292 ID_RESERVED04,
293 ID_RESERVED05,
294 ID_RESERVED06,
295 ID_RESERVED07,
296 ID_RESERVED08,
297 ID_RESERVED09,
298 ID_RESERVED10,
299 ID_RESERVED11,
300 ID_RESERVED12,
301 ID_RESERVED13,
302 ID_FP_D_TO_F,
303 ID_FP_FSTORE,
304 ID_FP_FTIMES,
305 ID_FP_FPLUS,
306 ID_FP_FMINUS,
307 ID_FP_FSLASH,
308 ID_FP_F_ZERO_LESS_THAN,
309 ID_FP_F_ZERO_EQUALS,
310 ID_FP_F_LESS_THAN,
311 ID_FP_F_TO_D,
312 ID_FP_FFETCH,
313 ID_FP_FDEPTH,
314 ID_FP_FDROP,
315 ID_FP_FDUP,
316 ID_FP_FLITERAL,
317 ID_FP_FLITERAL_P,
318 ID_FP_FLOAT_PLUS,
319 ID_FP_FLOATS,
320 ID_FP_FLOOR,
321 ID_FP_FMAX,
322 ID_FP_FMIN,
323 ID_FP_FNEGATE,
324 ID_FP_FOVER,
325 ID_FP_FROT,
326 ID_FP_FROUND,
327 ID_FP_FSWAP,
328 ID_FP_FSTAR_STAR,
329 ID_FP_FABS,
330 ID_FP_FACOS,
331 ID_FP_FACOSH,
332 ID_FP_FALOG,
333 ID_FP_FASIN,
334 ID_FP_FASINH,
335 ID_FP_FATAN,
336 ID_FP_FATAN2,
337 ID_FP_FATANH,
338 ID_FP_FCOS,
339 ID_FP_FCOSH,
340 ID_FP_FLN,
341 ID_FP_FLNP1,
342 ID_FP_FLOG,
343 ID_FP_FSIN,
344 ID_FP_FSINCOS,
345 ID_FP_FSINH,
346 ID_FP_FSQRT,
347 ID_FP_FTAN,
348 ID_FP_FTANH,
349 ID_FP_FPICK,
350#endif
351/* Add new IDs by replacing reserved IDs or extending FP routines. */
352/* Do NOT change the order of these IDs or dictionary files will break! */
353 NUM_PRIMITIVES /* This must always be LAST */
354};
355
356
357
358/***************************************************************
359** THROW Codes
360***************************************************************/
361/* ANSI standard definitions needed by pForth */
362#define THROW_ABORT (-1)
363#define THROW_ABORT_QUOTE (-2)
364#define THROW_STACK_OVERFLOW (-3)
365#define THROW_STACK_UNDERFLOW (-4)
366#define THROW_UNDEFINED_WORD (-13)
367#define THROW_EXECUTING (-14)
368#define THROW_PAIRS (-22)
369#define THROW_FLOAT_STACK_UNDERFLOW ( -45)
370#define THROW_QUIT (-56)
371
372/* THROW codes unique to pForth */
373#define THROW_BYE (-256) /* Exit program. */
374#define THROW_SEMICOLON (-257) /* Error detected at ; */
375#define THROW_DEFERRED (-258) /* Not a deferred word. Used in system.fth */
376
377/***************************************************************
378** Structures
379***************************************************************/
380
381typedef struct pfTaskData_s
382{
383 cell_t *td_StackPtr; /* Primary data stack */
384 cell_t *td_StackBase;
385 cell_t *td_StackLimit;
386 cell_t *td_ReturnPtr; /* Return stack */
387 cell_t *td_ReturnBase;
388 cell_t *td_ReturnLimit;
389#ifdef PF_SUPPORT_FP
390 PF_FLOAT *td_FloatStackPtr;
391 PF_FLOAT *td_FloatStackBase;
392 PF_FLOAT *td_FloatStackLimit;
393#endif
394 cell_t *td_InsPtr; /* Instruction pointer, "PC" */
395 FileStream *td_InputStream;
396/* Terminal. */
397 char td_TIB[TIB_SIZE]; /* Buffer for terminal input. */
398 cell_t td_IN; /* Index into Source */
399 cell_t td_SourceNum; /* #TIB after REFILL */
400 char *td_SourcePtr; /* Pointer to TIB or other source. */
401 cell_t td_LineNumber; /* Incremented on every refill. */
402 cell_t td_OUT; /* Current output column. */
403} pfTaskData_t;
404
405typedef struct pfNode
406{
407 struct pfNode *n_Next;
408 struct pfNode *n_Prev;
409} pfNode;
410
411/* Structure of header entry in dictionary. These will be stored in dictionary specific endian format*/
412typedef struct cfNameLinks
413{
414 cell_t cfnl_PreviousName; /* name relative address of previous */
415 ExecToken cfnl_ExecToken; /* Execution token for word. */
416/* Followed by variable length name field. */
417} cfNameLinks;
418
419#define PF_DICF_ALLOCATED_SEGMENTS ( 0x0001)
420typedef struct pfDictionary_s
421{
422 pfNode dic_Node;
423 ucell_t dic_Flags;
424/* Headers contain pointers to names and dictionary. */
425
426 ucell_t dic_HeaderBaseUnaligned;
427
428 ucell_t dic_HeaderBase;
429 ucell_t dic_HeaderPtr;
430 ucell_t dic_HeaderLimit;
431/* Code segment contains tokenized code and data. */
432 ucell_t dic_CodeBaseUnaligned;
433 ucell_t dic_CodeBase;
434 union
435 {
436 cell_t *Cell;
437 uint8_t *Byte;
438 } dic_CodePtr;
439 ucell_t dic_CodeLimit;
440} pfDictionary_t;
441
442/* Save state of include when nesting files. */
443typedef struct IncludeFrame
444{
445 FileStream *inf_FileID;
446 cell_t inf_LineNumber;
447 cell_t inf_SourceNum;
448 cell_t inf_IN;
449 char inf_SaveTIB[TIB_SIZE];
450} IncludeFrame;
451
452#define MAX_INCLUDE_DEPTH (16)
453
454/***************************************************************
455** Prototypes
456***************************************************************/
457
458#ifdef __cplusplus
459extern "C" {
460#endif
461
462int pfCatch( ExecToken XT );
463
464#ifdef __cplusplus
465}
466#endif
467
468/***************************************************************
469** External Globals
470***************************************************************/
471extern pfTaskData_t *gCurrentTask;
472extern pfDictionary_t *gCurrentDictionary;
473extern char gScratch[TIB_SIZE];
474extern cell_t gNumPrimitives;
475
476extern ExecToken gLocalCompiler_XT; /* CFA of (LOCAL) compiler. */
477extern ExecToken gNumberQ_XT; /* XT of NUMBER? */
478extern ExecToken gQuitP_XT; /* XT of (QUIT) */
479extern ExecToken gAcceptP_XT; /* XT of ACCEPT */
480
481#define DEPTH_AT_COLON_INVALID (-100)
482extern cell_t gDepthAtColon;
483
484/* Global variables. */
485extern cell_t gVarContext; /* Points to last name field. */
486extern cell_t gVarState; /* 1 if compiling. */
487extern cell_t gVarBase; /* Numeric Base. */
488extern cell_t gVarEcho; /* Echo input from file. */
489extern cell_t gVarEchoAccept; /* Echo input from ACCEPT. */
490extern cell_t gVarTraceLevel;
491extern cell_t gVarTraceStack;
492extern cell_t gVarTraceFlags;
493extern cell_t gVarQuiet; /* Suppress unnecessary messages, OK, etc. */
494extern cell_t gVarReturnCode; /* Returned to caller of Forth, eg. UNIX shell. */
495
496extern IncludeFrame gIncludeStack[MAX_INCLUDE_DEPTH];
497extern cell_t gIncludeIndex;
498/***************************************************************
499** Macros
500***************************************************************/
501
502
503/* Endian specific macros for creating target dictionaries for machines with
504
505** different endian-ness.
506
507*/
508
509#if defined(PF_BIG_ENDIAN_DIC)
510
511#define WRITE_FLOAT_DIC WriteFloatBigEndian
512#define WRITE_CELL_DIC(addr,data) WriteCellBigEndian((uint8_t *)(addr),(ucell_t)(data))
513#define WRITE_SHORT_DIC(addr,data) Write16BigEndian((uint8_t *)(addr),(uint16_t)(data))
514#define READ_FLOAT_DIC ReadFloatBigEndian
515#define READ_CELL_DIC(addr) ReadCellBigEndian((const uint8_t *)(addr))
516#define READ_SHORT_DIC(addr) Read16BigEndian((const uint8_t *)(addr))
517
518#elif defined(PF_LITTLE_ENDIAN_DIC)
519
520#define WRITE_FLOAT_DIC WriteFloatLittleEndian
521#define WRITE_CELL_DIC(addr,data) WriteCellLittleEndian((uint8_t *)(addr),(ucell_t)(data))
522#define WRITE_SHORT_DIC(addr,data) Write16LittleEndian((uint8_t *)(addr),(uint16_t)(data))
523#define READ_FLOAT_DIC ReadFloatLittleEndian
524#define READ_CELL_DIC(addr) ReadCellLittleEndian((const uint8_t *)(addr))
525#define READ_SHORT_DIC(addr) Read16LittleEndian((const uint8_t *)(addr))
526
527#else
528
529#define WRITE_FLOAT_DIC(addr,data) { *((PF_FLOAT *)(addr)) = (PF_FLOAT)(data); }
530#define WRITE_CELL_DIC(addr,data) { *((cell_t *)(addr)) = (cell_t)(data); }
531#define WRITE_SHORT_DIC(addr,data) { *((int16_t *)(addr)) = (int16_t)(data); }
532#define READ_FLOAT_DIC(addr) ( *((PF_FLOAT *)(addr)) )
533#define READ_CELL_DIC(addr) ( *((const ucell_t *)(addr)) )
534#define READ_SHORT_DIC(addr) ( *((const uint16_t *)(addr)) )
535
536#endif
537
538
539#define HEADER_HERE (gCurrentDictionary->dic_HeaderPtr.Cell)
540#define CODE_HERE (gCurrentDictionary->dic_CodePtr.Cell)
541#define CODE_COMMA( N ) WRITE_CELL_DIC(CODE_HERE++,(N))
542#define NAME_BASE (gCurrentDictionary->dic_HeaderBase)
543#define CODE_BASE (gCurrentDictionary->dic_CodeBase)
544#define NAME_SIZE (gCurrentDictionary->dic_HeaderLimit - gCurrentDictionary->dic_HeaderBase)
545#define CODE_SIZE (gCurrentDictionary->dic_CodeLimit - gCurrentDictionary->dic_CodeBase)
546
547#define IN_CODE_DIC(addr) ( ( ((uint8_t *)(addr)) >= gCurrentDictionary->dic_CodeBase) && ( ((uint8_t *)(addr)) < gCurrentDictionary->dic_CodeLimit) )
548
549#define IN_NAME_DIC(addr) ( ( ((uint8_t *)(addr)) >= gCurrentDictionary->dic_HeaderBase) && ( ((uint8_t *)(addr)) < gCurrentDictionary->dic_HeaderLimit) )
550#define IN_DICS(addr) (IN_CODE_DIC(addr) || IN_NAME_DIC(addr))
551
552/* Address conversion */
553#define ABS_TO_NAMEREL( a ) ((cell_t) (((ucell_t) a) - NAME_BASE ))
554#define ABS_TO_CODEREL( a ) ((cell_t) (((ucell_t) a) - CODE_BASE ))
555#define NAMEREL_TO_ABS( a ) ((ucell_t) (((cell_t) a) + NAME_BASE))
556#define CODEREL_TO_ABS( a ) ((ucell_t) (((cell_t) a) + CODE_BASE))
557
558/* The check for >0 is only needed for CLONE testing. !!! */
559#define IsTokenPrimitive(xt) ((xt<gNumPrimitives) && (xt>=0))
560
561#define FREE_VAR(v) { if (v) { pfFreeMem((void *)(v)); v = 0; } }
562
563#define DATA_STACK_DEPTH (gCurrentTask->td_StackBase - gCurrentTask->td_StackPtr)
564#define DROP_DATA_STACK (gCurrentTask->td_StackPtr++)
565#define POP_DATA_STACK (*gCurrentTask->td_StackPtr++)
566#define PUSH_DATA_STACK(x) {*(--(gCurrentTask->td_StackPtr)) = (cell_t) x; }
567
568/* Force Quad alignment. */
569#define QUADUP(x) (((x)+3)&~3)
570
571#define MIN(a,b) ( ((a)<(b)) ? (a) : (b) )
572#define MAX(a,b) ( ((a)>(b)) ? (a) : (b) )
573
574
575#ifndef TOUCH
576 #define TOUCH(argument) ((void)argument)
577#endif
578
579/***************************************************************
580** I/O related macros
581***************************************************************/
582
583#define EMIT(c) ioEmit(c)
584#define EMIT_CR EMIT('\n');
585
586#define MSG(cs) pfMessage(cs)
587#define ERR(x) MSG(x)
588
589#define DBUG(x) /* PRT(x) */
590#define DBUGX(x) /* DBUG(x) */
591
592#define MSG_NUM_D(msg,num) { MSG(msg); ffDot((cell_t) num); EMIT_CR; }
593#define MSG_NUM_H(msg,num) { MSG(msg); ffDotHex((cell_t) num); EMIT_CR; }
594
595#define DBUG_NUM_D(msg,num) { pfDebugMessage(msg); pfDebugPrintDecimalNumber((cell_t) num); pfDebugMessage("\n"); }
596
597#endif /* _pf_guts_h */
Fork of 'github/philburk/pforth', a portable ANS-like Forth written in ANSI C.