xref: /titanic_52/usr/src/lib/efcode/engine/interactive.c (revision 06e46062ef4f5f4b687cbafb4518fb123fe23920)
1 /*
2  * CDDL HEADER START
3  *
4  * The contents of this file are subject to the terms of the
5  * Common Development and Distribution License, Version 1.0 only
6  * (the "License").  You may not use this file except in compliance
7  * with the License.
8  *
9  * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
10  * or http://www.opensolaris.org/os/licensing.
11  * See the License for the specific language governing permissions
12  * and limitations under the License.
13  *
14  * When distributing Covered Code, include this CDDL HEADER in each
15  * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
16  * If applicable, add the following below this CDDL HEADER, with the
17  * fields enclosed by brackets "[]" replaced with your own identifying
18  * information: Portions Copyright [yyyy] [name of copyright owner]
19  *
20  * CDDL HEADER END
21  */
22 /*
23  * Copyright (c) 2000 by Sun Microsystems, Inc.
24  * All rights reserved.
25  */
26 
27 #pragma ident	"%Z%%M%	%I%	%E% SMI"
28 
29 #include <stdio.h>
30 #include <stdlib.h>
31 #include <unistd.h>
32 #include <string.h>
33 #include <fcntl.h>
34 #include <setjmp.h>
35 #include <sys/stat.h>
36 
37 #include <fcode/private.h>
38 #include <fcode/log.h>
39 
40 void (*to_ptr)(fcode_env_t *env) = do_set_action;
41 jmp_buf *jmp_buf_ptr = NULL;
42 
43 char *
44 parse_a_string(fcode_env_t *env, int *lenp)
45 {
46 	parse_word(env);
47 	return (pop_a_string(env, lenp));
48 }
49 
50 void
51 constant(fcode_env_t *env)
52 {
53 	char *name;
54 	int len;
55 
56 	name = parse_a_string(env, &len);
57 	env->instance_mode = 0;
58 	make_common_access(env, name, len, 1, 0,
59 	    &do_constant, &do_constant, NULL);
60 }
61 
62 void
63 buffer_colon(fcode_env_t *env)
64 {
65 	char *name;
66 	int len;
67 
68 	PUSH(DS, 0);
69 	name = parse_a_string(env, &len);
70 	make_common_access(env, name, len, 2,
71 	    env->instance_mode, &noop, &noop, &set_buffer_actions);
72 }
73 
74 void
75 value(fcode_env_t *env)
76 {
77 	char *name;
78 	int len;
79 
80 	name = parse_a_string(env, &len);
81 	make_common_access(env, name, len, 1,
82 	    env->instance_mode, &noop, &noop, &set_value_actions);
83 }
84 
85 void
86 variable(fcode_env_t *env)
87 {
88 	char *name;
89 	int len;
90 
91 	PUSH(DS, 0);
92 	name = parse_a_string(env, &len);
93 	make_common_access(env, name, len, 1,
94 	    env->instance_mode, &instance_variable, &do_create, NULL);
95 }
96 
97 void
98 defer(fcode_env_t *env)
99 {
100 	static void (*crash_ptr)(fcode_env_t *env) = do_crash;
101 	char *name;
102 	int len;
103 
104 	PUSH(DS, (fstack_t)&crash_ptr);
105 	name = parse_a_string(env, &len);
106 	make_common_access(env, name, len, 1,
107 		env->instance_mode, &noop, &noop, &set_defer_actions);
108 }
109 
110 void
111 field(fcode_env_t *env)
112 {
113 	char *name;
114 	int len;
115 
116 	over(env);
117 	name = parse_a_string(env, &len);
118 	make_common_access(env, name, len, 1, 0, &do_field, &do_field, NULL);
119 	add(env);
120 }
121 
122 void
123 bye(fcode_env_t *env)
124 {
125 	exit(0);
126 }
127 
128 void
129 do_resume(fcode_env_t *env)
130 {
131 	if (env->interactive) env->interactive--;
132 	COMPLETE_INTERRUPT;
133 }
134 
135 /*
136  * In interactive mode, jmp_buf_ptr should be non-null.
137  */
138 void
139 return_to_interact(fcode_env_t *env)
140 {
141 	if (jmp_buf_ptr)
142 		longjmp(*jmp_buf_ptr, 1);
143 }
144 
145 void
146 do_interact(fcode_env_t *env)
147 {
148 	int level;
149 	jmp_buf jmp_env;
150 	jmp_buf *ojmp_ptr;
151 	error_frame new;
152 	input_typ *old_input = env->input;
153 
154 	log_message(MSG_INFO, "Type resume to return\n");
155 	env->interactive++;
156 	level = env->interactive;
157 
158 	ojmp_ptr = jmp_buf_ptr;
159 	jmp_buf_ptr = &jmp_env;
160 	env->input->separator = ' ';
161 	env->input->maxlen = 256;
162 	env->input->buffer = MALLOC(env->input->maxlen);
163 	env->input->scanptr = env->input->buffer;
164 
165 	if (setjmp(jmp_env)) {
166 		if (in_forth_abort > 1) {
167 			RS = env->rs0;
168 			DS = env->ds0;
169 			MYSELF = 0;
170 			IP = 0;
171 			env->input = old_input;
172 			env->order_depth = 0;
173 		} else {
174 			RS		= new.rs;
175 			DS		= new.ds;
176 			MYSELF		= new.myself;
177 			IP		= new.ip;
178 			env->input	= old_input;
179 		}
180 		do_forth(env);
181 		do_definitions(env);
182 		in_forth_abort = 0;
183 	} else {
184 		new.rs		= RS;
185 		new.ds		= DS;
186 		new.myself	= MYSELF;
187 		new.ip		= IP;
188 	}
189 
190 	while (env->interactive == level) {
191 		int wlen;
192 		char *p;
193 
194 		DEBUGF(SHOW_RS, output_return_stack(env, 0, MSG_FC_DEBUG));
195 		DEBUGF(SHOW_STACK, output_data_stack(env, MSG_FC_DEBUG));
196 
197 #define	USE_READLINE
198 #ifdef USE_READLINE
199 		{
200 			char *line;
201 			void read_line(fcode_env_t *);
202 
203 			read_line(env);
204 			if ((line = pop_a_string(env, NULL)) == NULL)
205 				continue;
206 
207 			env->input->scanptr = strcpy(env->input->buffer, line);
208 		}
209 #else
210 		if (isatty(fileno(stdin)))
211 			printf("ok ");
212 
213 		env->input->scanptr = fgets(env->input->buffer,
214 		    env->input->maxlen, stdin);
215 
216 		if (feof(stdin))
217 			break;
218 
219 		if (env->input->scanptr == NULL)
220 			continue;
221 #endif
222 
223 		if ((p = strpbrk(env->input->scanptr, "\n\r")) != NULL)
224 			*p = '\0';
225 
226 		if ((wlen = strlen(env->input->scanptr)) == 0)
227 			continue;
228 
229 		PUSH(DS, (fstack_t)env->input->buffer);
230 		PUSH(DS, wlen);
231 		evaluate(env);
232 	}
233 
234 	jmp_buf_ptr = ojmp_ptr;
235 	FREE(env->input->buffer);
236 }
237 
238 static void
239 temp_base(fcode_env_t *env, fstack_t base)
240 {
241 	fstack_t obase;
242 
243 	obase = env->num_base;
244 	env->num_base = base;
245 	parse_word(env);
246 	evaluate(env);
247 	env->num_base = obase;
248 }
249 
250 static void
251 temp_decimal(fcode_env_t *env)
252 {
253 	temp_base(env, 10);
254 }
255 
256 static void
257 temp_hex(fcode_env_t *env)
258 {
259 	temp_base(env, 0x10);
260 }
261 
262 static void
263 temp_binary(fcode_env_t *env)
264 {
265 	temp_base(env, 2);
266 }
267 
268 static void
269 do_hex(fcode_env_t *env)
270 {
271 	env->num_base = 0x10;
272 }
273 
274 static void
275 do_decimal(fcode_env_t *env)
276 {
277 	env->num_base = 10;
278 }
279 
280 static void
281 do_binary(fcode_env_t *env)
282 {
283 	env->num_base = 2;
284 }
285 
286 static void
287 do_clear(fcode_env_t *env)
288 {
289 	DS = env->ds0;
290 }
291 
292 static void
293 action_one(fcode_env_t *env)
294 {
295 
296 	do_tick(env);
297 	if (env->state) {
298 		COMPILE_TOKEN(&to_ptr);
299 	} else {
300 		PUSH(DS, 1);
301 		perform_action(env);
302 	}
303 }
304 
305 void
306 do_if(fcode_env_t *env)
307 {
308 	branch_common(env, 1, 1, 0);
309 }
310 
311 void
312 do_else(fcode_env_t *env)
313 {
314 	branch_common(env, 1, 0, 1);
315 	bresolve(env);
316 }
317 
318 void
319 do_then(fcode_env_t *env)
320 {
321 	bresolve(env);
322 }
323 
324 void
325 do_of(fcode_env_t *env)
326 {
327 	branch_common(env, 0, 2, 0);
328 }
329 
330 void
331 load_file(fcode_env_t *env)
332 {
333 	int fd;
334 	int len, n;
335 	char *name;
336 	char *buffer;
337 	struct stat buf;
338 
339 	CHECK_DEPTH(env, 2, "load-file");
340 	name = pop_a_string(env, &len);
341 	log_message(MSG_INFO, "load_file: '%s'\n", name);
342 	fd = open(name, O_RDONLY);
343 	if (fd < 0) {
344 		forth_perror(env, "Can't open '%s'", name);
345 	}
346 	fstat(fd, &buf);
347 	len = buf.st_size;
348 	buffer = MALLOC(len);
349 	if (buffer == 0)
350 		forth_perror(env, "load_file: MALLOC(%d)", len);
351 
352 	if ((n = read(fd, buffer, len)) < 0)
353 		forth_perror(env, "read error '%s'", name);
354 
355 	close(fd);
356 	PUSH(DS, (fstack_t)buffer);
357 	PUSH(DS, (fstack_t)n);
358 }
359 
360 void
361 load(fcode_env_t *env)
362 {
363 	parse_word(env);
364 	if (TOS > 0)
365 		load_file(env);
366 }
367 
368 void
369 fevaluate(fcode_env_t *env)
370 {
371 	char *buffer;
372 	int bytes, len;
373 
374 	two_dup(env);
375 	buffer = pop_a_string(env, &len);
376 	for (bytes = 0; bytes < len; bytes++) {
377 		if ((buffer[bytes] == '\n') || (buffer[bytes] == '\r'))
378 			buffer[bytes] = ' ';
379 	}
380 	evaluate(env);
381 }
382 
383 void
384 fload(fcode_env_t *env)
385 {
386 	char *buffer;
387 
388 	load(env);
389 	two_dup(env);
390 	buffer = pop_a_string(env, NULL);
391 	fevaluate(env);
392 	FREE(buffer);
393 }
394 
395 #include <sys/termio.h>
396 
397 #define	MAX_LINE_BUF	20
398 
399 static char *history_lines[MAX_LINE_BUF];
400 int num_lines = 0;
401 
402 static void
403 add_line_to_history(fcode_env_t *env, char *line)
404 {
405 	int i;
406 
407 	if (num_lines < MAX_LINE_BUF)
408 		history_lines[num_lines++] = STRDUP(line);
409 	else {
410 		FREE(history_lines[0]);
411 		for (i = 0; i < MAX_LINE_BUF - 1; i++)
412 			history_lines[i] = history_lines[i + 1];
413 		history_lines[MAX_LINE_BUF - 1] = STRDUP(line);
414 	}
415 }
416 
417 static void
418 do_emit_chars(fcode_env_t *env, char c, int n)
419 {
420 	int i;
421 
422 	for (i = 0; i < n; i++)
423 		do_emit(env, c);
424 }
425 
426 static void
427 do_emit_str(fcode_env_t *env, char *str, int n)
428 {
429 	int i;
430 
431 	for (i = 0; i < n; i++)
432 		do_emit(env, *str++);
433 }
434 
435 static char *
436 find_next_word(char *cursor, char *eol)
437 {
438 	while (cursor < eol && *cursor != ' ')
439 		cursor++;
440 	while (cursor < eol && *cursor == ' ')
441 		cursor++;
442 	return (cursor);
443 }
444 
445 static char *
446 find_prev_word(char *buf, char *cursor)
447 {
448 	int skippedword = 0;
449 
450 	if (cursor == buf)
451 		return (cursor);
452 	cursor--;
453 	while (cursor > buf && *cursor == ' ')
454 		cursor--;
455 	while (cursor > buf && *cursor != ' ') {
456 		skippedword++;
457 		cursor--;
458 	}
459 	if (skippedword && *cursor == ' ')
460 		cursor++;
461 	return (cursor);
462 }
463 
464 void
465 redraw_line(fcode_env_t *env, char *prev_l, char *prev_cursor, char *prev_eol,
466     char *new_l, char *new_cursor, char *new_eol)
467 {
468 	int len;
469 
470 	/* backup to beginning of previous line */
471 	do_emit_chars(env, '\b', prev_cursor - prev_l);
472 
473 	/* overwrite new line */
474 	do_emit_str(env, new_l, new_eol - new_l);
475 
476 	/* Output blanks to erase previous line chars if old line was longer */
477 	len = max(0, (prev_eol - prev_l) - (new_eol - new_l));
478 	do_emit_chars(env, ' ', len);
479 
480 	/* Backup cursor for new line */
481 	do_emit_chars(env, '\b', len + (new_eol - new_cursor));
482 }
483 
484 #define	MAX_LINE_SIZE	256
485 
486 static void
487 do_save_buf(char *save_buf, char *buf, int n)
488 {
489 	n = max(0, min(n, MAX_LINE_SIZE));
490 	memcpy(save_buf, buf, n);
491 	save_buf[n] = '\0';
492 }
493 
494 char prompt_string[80] = "ok ";
495 
496 void
497 read_line(fcode_env_t *env)
498 {
499 	char buf[MAX_LINE_SIZE+1], save_buf[MAX_LINE_SIZE+1];
500 	char save_line[MAX_LINE_SIZE+1];
501 	char *p, *cursor, *eol, *tp, *cp;
502 	fstack_t d;
503 	int saw_esc = 0, do_quote = 0, i, cur_line, len, my_line, save_cursor;
504 	struct termio termio, savetermio;
505 
506 	if (!isatty(fileno(stdin))) {
507 		fgets(buf, sizeof (buf), stdin);
508 		push_string(env, buf, strlen(buf));
509 		return;
510 	}
511 	printf(prompt_string);
512 	fflush(stdout);
513 	ioctl(fileno(stdin), TCGETA, &termio);
514 	savetermio = termio;
515 	termio.c_lflag &= ~(ICANON|ECHO|ECHOE|IEXTEN);
516 	termio.c_cc[VTIME] = 0;
517 	termio.c_cc[VMIN] = 1;
518 	ioctl(fileno(stdin), TCSETA, &termio);
519 	my_line = cur_line = num_lines;
520 	save_buf[0] = '\0';
521 	for (cursor = eol = buf; ; ) {
522 		for (d = FALSE; d == FALSE; d = POP(DS))
523 			keyquestion(env);
524 		key(env);
525 		d = POP(DS);
526 		if (do_quote) {
527 			do_quote = 0;
528 			if ((cursor - buf) < MAX_LINE_SIZE) {
529 				*cursor++ = d;
530 				if (cursor > eol)
531 					eol = cursor;
532 				do_emit(env, d);
533 			}
534 			continue;
535 		}
536 		if (saw_esc) {
537 			saw_esc = 0;
538 			switch (d) {
539 
540 			default:		/* Ignore anything else */
541 				continue;
542 
543 			case 'b':	/* Move backward one word */
544 			case 'B':
545 				tp = find_prev_word(buf, cursor);
546 				if (tp < cursor) {
547 					do_emit_chars(env, '\b', cursor - tp);
548 					cursor = tp;
549 				}
550 				continue;
551 
552 			case 'f':	/* Move forward one word */
553 			case 'F':
554 				tp = find_next_word(cursor, eol);
555 				if (tp > cursor) {
556 					do_emit_str(env, tp, tp - cursor);
557 					cursor = tp;
558 				}
559 				continue;
560 
561 			case 'h':	/* Erase from beginning of word to */
562 			case 'H':	/* just before cursor, saving chars */
563 				d = CTRL('w');
564 				break;
565 
566 			case 'd':
567 			case 'D':
568 				tp = find_next_word(cursor, eol);
569 				if (tp <= cursor)
570 					continue;
571 				len = tp - cursor;
572 				do_save_buf(save_buf, cursor, len);
573 				memmove(cursor, tp, eol - tp);
574 				redraw_line(env, buf, cursor, eol, buf, cursor,
575 				    eol - len);
576 				eol -= len;
577 				continue;
578 			}
579 		}
580 		switch (d) {
581 
582 		default:
583 			if ((cursor - buf) < MAX_LINE_SIZE) {
584 				*cursor++ = d;
585 				if (cursor > eol)
586 					eol = cursor;
587 				do_emit(env, d);
588 			}
589 			continue;
590 
591 		case CTRL('['):		/* saw esc. character */
592 			saw_esc = 1;
593 			continue;
594 
595 		case CTRL('f'):		/* move forward one char */
596 			if (cursor < eol)
597 				do_emit(env, *cursor++);
598 			continue;
599 
600 		case CTRL('a'):		/* cursor to beginning of line */
601 			do_emit_chars(env, '\b', cursor - buf);
602 			cursor = buf;
603 			continue;
604 
605 		case CTRL('e'):		/* cursor to end of line */
606 			do_emit_str(env, cursor, eol - cursor);
607 			cursor = eol;
608 			continue;
609 
610 
611 		case CTRL('n'):		/* Move to next line in buffer */
612 		case CTRL('p'):		/* Move to previous line in buffer */
613 			if (d == CTRL('p')) {
614 				if (cur_line <= 0)
615 					continue;
616 				if (my_line == cur_line) {
617 					do_save_buf(save_line, buf, eol - buf);
618 					save_cursor = cursor - buf;
619 				}
620 				cur_line--;
621 			} else {
622 				if (cur_line >= num_lines)
623 					continue;
624 				cur_line++;
625 				if (cur_line == num_lines) {
626 					len = strlen(save_line);
627 					redraw_line(env, buf, cursor, eol,
628 					    save_line, save_line + save_cursor,
629 					    save_line + len);
630 					strcpy(buf, save_line);
631 					eol = buf + len;
632 					cursor = buf + save_cursor;
633 					continue;
634 				}
635 			}
636 			p = history_lines[cur_line];
637 			len = strlen(p);
638 			redraw_line(env, buf, cursor, eol, p, p, p + len);
639 			strcpy(buf, history_lines[cur_line]);
640 			cursor = buf;
641 			eol = buf + len;
642 			continue;
643 
644 		case CTRL('o'):		/* Insert newline */
645 			continue;
646 
647 		case CTRL('k'):		/* Erase from cursor to eol, saving */
648 					/* chars, at eol, joins two lines */
649 			if (cursor == eol) {
650 				if (cur_line >= num_lines)
651 					continue;
652 				if (cur_line == num_lines - 1) {
653 					p = save_line;
654 					len = strlen(save_line);
655 					num_lines -= 1;
656 					my_line = num_lines;
657 				} else {
658 					cur_line++;
659 					p = history_lines[cur_line];
660 					len = strlen(p);
661 				}
662 				len = min(len, MAX_LINE_SIZE - (eol - buf));
663 				memcpy(eol, p, len);
664 				redraw_line(env, buf, cursor, eol, buf, cursor,
665 				    eol + len);
666 				eol += len;
667 				continue;
668 			}
669 			do_save_buf(save_buf, cursor, eol - cursor);
670 			redraw_line(env, buf, cursor, eol, buf, cursor,
671 			    cursor);
672 			eol = cursor;
673 			continue;
674 
675 		case CTRL('w'):		/* Erase word */
676 			tp = find_prev_word(buf, cursor);
677 			if (tp == cursor)
678 				continue;
679 			len = cursor - tp;
680 			do_save_buf(save_buf, tp, len);
681 			memmove(tp, cursor, eol - cursor);
682 			redraw_line(env, buf, cursor, eol, buf, cursor - len,
683 			    eol - len);
684 			eol -= len;
685 			cursor -= len;
686 			continue;
687 
688 		case CTRL('u'):		/* Erases line, saving chars */
689 			do_save_buf(save_buf, buf, eol - buf);
690 			redraw_line(env, buf, cursor, eol, buf, buf, buf);
691 			cursor = buf;
692 			eol = buf;
693 			continue;
694 
695 		case CTRL('y'):		/* Insert save buffer before cursor */
696 			len = min(strlen(save_buf),
697 			    MAX_LINE_SIZE - (eol - buf));
698 			if (len == 0)
699 				continue;
700 			memmove(cursor + len, cursor, eol - cursor);
701 			memcpy(cursor, save_buf, len);
702 			redraw_line(env, buf, cursor, eol, buf, cursor + len,
703 			    eol + len);
704 			cursor += len;
705 			eol += len;
706 			continue;
707 
708 		case CTRL('q'):		/* Quote next char */
709 			do_quote = 1;
710 			continue;
711 
712 		case CTRL('l'):		/* Display edit buffer */
713 			do_emit(env, '\n');
714 			for (i = 0; i < num_lines; i++) {
715 				do_emit_str(env, history_lines[i],
716 				    strlen(history_lines[i]));
717 				do_emit(env, '\n');
718 			}
719 			redraw_line(env, buf, buf, buf, buf, cursor, eol);
720 			continue;
721 
722 		case CTRL('r'):		/* redraw line */
723 			redraw_line(env, buf, cursor, eol, buf, cursor, eol);
724 			continue;
725 
726 		case CTRL('c'):		/* Exit script editor */
727 			continue;
728 
729 		case CTRL('b'):		/* backup cursor */
730 			if (cursor <= buf)
731 				continue;
732 			cursor--;
733 			do_emit(env, '\b');
734 			continue;
735 
736 		case CTRL('h'):		/* Backspace */
737 		case 0x7f:		/* DEL */
738 			if (cursor <= buf)
739 				continue;
740 			memmove(cursor - 1, cursor, eol - cursor);
741 			redraw_line(env, buf, cursor, eol, buf, cursor - 1,
742 			    eol - 1);
743 			cursor--;
744 			eol--;
745 			continue;
746 
747 		case '\r':
748 		case '\n':
749 			*eol = '\0';
750 			do_emit(env, '\n');
751 			break;
752 		}
753 		break;
754 	}
755 	add_line_to_history(env, buf);
756 	ioctl(fileno(stdin), TCSETA, &savetermio);
757 	push_string(env, buf, strlen(buf));
758 }
759 
760 static void
761 set_prompt(fcode_env_t *env)
762 {
763 	char *prompt;
764 
765 	if ((prompt = parse_a_string(env, NULL)) != NULL)
766 		strncpy(prompt_string, prompt, sizeof (prompt_string));
767 }
768 
769 #pragma init(_init)
770 
771 static void
772 _init(void)
773 {
774 	fcode_env_t *env = initial_env;
775 
776 	ASSERT(env);
777 	NOTICE;
778 
779 	FORTH(IMMEDIATE,	"if",			do_if);
780 	FORTH(IMMEDIATE,	"else",			do_else);
781 	FORTH(IMMEDIATE,	"then",			do_then);
782 	FORTH(IMMEDIATE,	"case",			bcase);
783 	FORTH(IMMEDIATE,	"of",			do_of);
784 	FORTH(IMMEDIATE,	"endof",		do_else);
785 	FORTH(IMMEDIATE,	"endcase",		bendcase);
786 	FORTH(IMMEDIATE,	"value",		value);
787 	FORTH(IMMEDIATE,	"variable",		variable);
788 	FORTH(IMMEDIATE,	"constant",		constant);
789 	FORTH(IMMEDIATE,	"defer",		defer);
790 	FORTH(IMMEDIATE,	"buffer:",		buffer_colon);
791 	FORTH(IMMEDIATE,	"field",		field);
792 	FORTH(IMMEDIATE,	"struct",		zero);
793 	FORTH(IMMEDIATE,	"to",			action_one);
794 	FORTH(IMMEDIATE,	"d#",			temp_decimal);
795 	FORTH(IMMEDIATE,	"h#",			temp_hex);
796 	FORTH(IMMEDIATE,	"b#",			temp_binary);
797 	FORTH(0,		"decimal",		do_decimal);
798 	FORTH(0,		"hex",			do_hex);
799 	FORTH(0,		"binary",		do_binary);
800 	FORTH(0,		"clear",		do_clear);
801 	FORTH(IMMEDIATE,	"bye",			bye);
802 	FORTH(0,		"interact",		do_interact);
803 	FORTH(IMMEDIATE,	"resume",		do_resume);
804 	FORTH(0,		"fload",		fload);
805 	FORTH(0,		"load",			load);
806 	FORTH(0,		"read-line",		read_line);
807 	FORTH(0,		"set-prompt",		set_prompt);
808 }
809