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
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.
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]
23 * Copyright (c) 2000 by Sun Microsystems, Inc.
24 * All rights reserved.
27 #pragma ident "%Z%%M% %I% %E% SMI"
37 #include <fcode/private.h>
38 #include <fcode/log.h>
40 void (*to_ptr
)(fcode_env_t
*env
) = do_set_action
;
41 jmp_buf *jmp_buf_ptr
= NULL
;
44 parse_a_string(fcode_env_t
*env
, int *lenp
)
47 return (pop_a_string(env
, lenp
));
51 constant(fcode_env_t
*env
)
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
);
63 buffer_colon(fcode_env_t
*env
)
69 name
= parse_a_string(env
, &len
);
70 make_common_access(env
, name
, len
, 2,
71 env
->instance_mode
, &noop
, &noop
, &set_buffer_actions
);
75 value(fcode_env_t
*env
)
80 name
= parse_a_string(env
, &len
);
81 make_common_access(env
, name
, len
, 1,
82 env
->instance_mode
, &noop
, &noop
, &set_value_actions
);
86 variable(fcode_env_t
*env
)
92 name
= parse_a_string(env
, &len
);
93 make_common_access(env
, name
, len
, 1,
94 env
->instance_mode
, &instance_variable
, &do_create
, NULL
);
98 defer(fcode_env_t
*env
)
100 static void (*crash_ptr
)(fcode_env_t
*env
) = do_crash
;
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
);
111 field(fcode_env_t
*env
)
117 name
= parse_a_string(env
, &len
);
118 make_common_access(env
, name
, len
, 1, 0, &do_field
, &do_field
, NULL
);
123 bye(fcode_env_t
*env
)
129 do_resume(fcode_env_t
*env
)
131 if (env
->interactive
) env
->interactive
--;
136 * In interactive mode, jmp_buf_ptr should be non-null.
139 return_to_interact(fcode_env_t
*env
)
142 longjmp(*jmp_buf_ptr
, 1);
146 do_interact(fcode_env_t
*env
)
152 input_typ
*old_input
= env
->input
;
154 log_message(MSG_INFO
, "Type resume to return\n");
156 level
= env
->interactive
;
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
;
165 if (setjmp(jmp_env
)) {
166 if (in_forth_abort
> 1) {
171 env
->input
= old_input
;
172 env
->order_depth
= 0;
178 env
->input
= old_input
;
190 while (env
->interactive
== level
) {
194 DEBUGF(SHOW_RS
, output_return_stack(env
, 0, MSG_FC_DEBUG
));
195 DEBUGF(SHOW_STACK
, output_data_stack(env
, MSG_FC_DEBUG
));
201 void read_line(fcode_env_t
*);
204 if ((line
= pop_a_string(env
, NULL
)) == NULL
)
207 env
->input
->scanptr
= strcpy(env
->input
->buffer
, line
);
210 if (isatty(fileno(stdin
)))
213 env
->input
->scanptr
= fgets(env
->input
->buffer
,
214 env
->input
->maxlen
, stdin
);
219 if (env
->input
->scanptr
== NULL
)
223 if ((p
= strpbrk(env
->input
->scanptr
, "\n\r")) != NULL
)
226 if ((wlen
= strlen(env
->input
->scanptr
)) == 0)
229 PUSH(DS
, (fstack_t
)env
->input
->buffer
);
234 jmp_buf_ptr
= ojmp_ptr
;
235 FREE(env
->input
->buffer
);
239 temp_base(fcode_env_t
*env
, fstack_t base
)
243 obase
= env
->num_base
;
244 env
->num_base
= base
;
247 env
->num_base
= obase
;
251 temp_decimal(fcode_env_t
*env
)
257 temp_hex(fcode_env_t
*env
)
259 temp_base(env
, 0x10);
263 temp_binary(fcode_env_t
*env
)
269 do_hex(fcode_env_t
*env
)
271 env
->num_base
= 0x10;
275 do_decimal(fcode_env_t
*env
)
281 do_binary(fcode_env_t
*env
)
287 do_clear(fcode_env_t
*env
)
293 action_one(fcode_env_t
*env
)
298 COMPILE_TOKEN(&to_ptr
);
306 do_if(fcode_env_t
*env
)
308 branch_common(env
, 1, 1, 0);
312 do_else(fcode_env_t
*env
)
314 branch_common(env
, 1, 0, 1);
319 do_then(fcode_env_t
*env
)
325 do_of(fcode_env_t
*env
)
327 branch_common(env
, 0, 2, 0);
331 load_file(fcode_env_t
*env
)
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
);
344 forth_perror(env
, "Can't open '%s'", name
);
348 buffer
= MALLOC(len
);
350 forth_perror(env
, "load_file: MALLOC(%d)", len
);
352 if ((n
= read(fd
, buffer
, len
)) < 0)
353 forth_perror(env
, "read error '%s'", name
);
356 PUSH(DS
, (fstack_t
)buffer
);
357 PUSH(DS
, (fstack_t
)n
);
361 load(fcode_env_t
*env
)
369 fevaluate(fcode_env_t
*env
)
375 buffer
= pop_a_string(env
, &len
);
376 for (bytes
= 0; bytes
< len
; bytes
++) {
377 if ((buffer
[bytes
] == '\n') || (buffer
[bytes
] == '\r'))
384 fload(fcode_env_t
*env
)
390 buffer
= pop_a_string(env
, NULL
);
395 #include <sys/termio.h>
397 #define MAX_LINE_BUF 20
399 static char *history_lines
[MAX_LINE_BUF
];
403 add_line_to_history(fcode_env_t
*env
, char *line
)
407 if (num_lines
< MAX_LINE_BUF
)
408 history_lines
[num_lines
++] = STRDUP(line
);
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
);
418 do_emit_chars(fcode_env_t
*env
, char c
, int n
)
422 for (i
= 0; i
< n
; i
++)
427 do_emit_str(fcode_env_t
*env
, char *str
, int n
)
431 for (i
= 0; i
< n
; i
++)
432 do_emit(env
, *str
++);
436 find_next_word(char *cursor
, char *eol
)
438 while (cursor
< eol
&& *cursor
!= ' ')
440 while (cursor
< eol
&& *cursor
== ' ')
446 find_prev_word(char *buf
, char *cursor
)
453 while (cursor
> buf
&& *cursor
== ' ')
455 while (cursor
> buf
&& *cursor
!= ' ') {
459 if (skippedword
&& *cursor
== ' ')
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
)
470 /* backup to beginning of previous line */
471 do_emit_chars(env
, '\b', prev_cursor
- prev_l
);
473 /* overwrite new line */
474 do_emit_str(env
, new_l
, new_eol
- new_l
);
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
);
480 /* Backup cursor for new line */
481 do_emit_chars(env
, '\b', len
+ (new_eol
- new_cursor
));
484 #define MAX_LINE_SIZE 256
487 do_save_buf(char *save_buf
, char *buf
, int n
)
489 n
= max(0, min(n
, MAX_LINE_SIZE
));
490 memcpy(save_buf
, buf
, n
);
494 char prompt_string
[80] = "ok ";
497 read_line(fcode_env_t
*env
)
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
;
503 int saw_esc
= 0, do_quote
= 0, i
, cur_line
, len
, my_line
, save_cursor
;
504 struct termio termio
, savetermio
;
506 if (!isatty(fileno(stdin
))) {
507 fgets(buf
, sizeof (buf
), stdin
);
508 push_string(env
, buf
, strlen(buf
));
511 printf(prompt_string
);
513 ioctl(fileno(stdin
), TCGETA
, &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
;
521 for (cursor
= eol
= buf
; ; ) {
522 for (d
= FALSE
; d
== FALSE
; d
= POP(DS
))
528 if ((cursor
- buf
) < MAX_LINE_SIZE
) {
540 default: /* Ignore anything else */
543 case 'b': /* Move backward one word */
545 tp
= find_prev_word(buf
, cursor
);
547 do_emit_chars(env
, '\b', cursor
- tp
);
552 case 'f': /* Move forward one word */
554 tp
= find_next_word(cursor
, eol
);
556 do_emit_str(env
, tp
, tp
- cursor
);
561 case 'h': /* Erase from beginning of word to */
562 case 'H': /* just before cursor, saving chars */
568 tp
= find_next_word(cursor
, eol
);
572 do_save_buf(save_buf
, cursor
, len
);
573 memmove(cursor
, tp
, eol
- tp
);
574 redraw_line(env
, buf
, cursor
, eol
, buf
, cursor
,
583 if ((cursor
- buf
) < MAX_LINE_SIZE
) {
591 case CTRL('['): /* saw esc. character */
595 case CTRL('f'): /* move forward one char */
597 do_emit(env
, *cursor
++);
600 case CTRL('a'): /* cursor to beginning of line */
601 do_emit_chars(env
, '\b', cursor
- buf
);
605 case CTRL('e'): /* cursor to end of line */
606 do_emit_str(env
, cursor
, eol
- cursor
);
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')) {
616 if (my_line
== cur_line
) {
617 do_save_buf(save_line
, buf
, eol
- buf
);
618 save_cursor
= cursor
- buf
;
622 if (cur_line
>= num_lines
)
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
,
630 strcpy(buf
, save_line
);
632 cursor
= buf
+ save_cursor
;
636 p
= history_lines
[cur_line
];
638 redraw_line(env
, buf
, cursor
, eol
, p
, p
, p
+ len
);
639 strcpy(buf
, history_lines
[cur_line
]);
644 case CTRL('o'): /* Insert newline */
647 case CTRL('k'): /* Erase from cursor to eol, saving */
648 /* chars, at eol, joins two lines */
650 if (cur_line
>= num_lines
)
652 if (cur_line
== num_lines
- 1) {
654 len
= strlen(save_line
);
659 p
= history_lines
[cur_line
];
662 len
= min(len
, MAX_LINE_SIZE
- (eol
- buf
));
664 redraw_line(env
, buf
, cursor
, eol
, buf
, cursor
,
669 do_save_buf(save_buf
, cursor
, eol
- cursor
);
670 redraw_line(env
, buf
, cursor
, eol
, buf
, cursor
,
675 case CTRL('w'): /* Erase word */
676 tp
= find_prev_word(buf
, cursor
);
680 do_save_buf(save_buf
, tp
, len
);
681 memmove(tp
, cursor
, eol
- cursor
);
682 redraw_line(env
, buf
, cursor
, eol
, buf
, cursor
- len
,
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
);
695 case CTRL('y'): /* Insert save buffer before cursor */
696 len
= min(strlen(save_buf
),
697 MAX_LINE_SIZE
- (eol
- buf
));
700 memmove(cursor
+ len
, cursor
, eol
- cursor
);
701 memcpy(cursor
, save_buf
, len
);
702 redraw_line(env
, buf
, cursor
, eol
, buf
, cursor
+ len
,
708 case CTRL('q'): /* Quote next char */
712 case CTRL('l'): /* Display edit buffer */
714 for (i
= 0; i
< num_lines
; i
++) {
715 do_emit_str(env
, history_lines
[i
],
716 strlen(history_lines
[i
]));
719 redraw_line(env
, buf
, buf
, buf
, buf
, cursor
, eol
);
722 case CTRL('r'): /* redraw line */
723 redraw_line(env
, buf
, cursor
, eol
, buf
, cursor
, eol
);
726 case CTRL('c'): /* Exit script editor */
729 case CTRL('b'): /* backup cursor */
736 case CTRL('h'): /* Backspace */
740 memmove(cursor
- 1, cursor
, eol
- cursor
);
741 redraw_line(env
, buf
, cursor
, eol
, buf
, cursor
- 1,
755 add_line_to_history(env
, buf
);
756 ioctl(fileno(stdin
), TCSETA
, &savetermio
);
757 push_string(env
, buf
, strlen(buf
));
761 set_prompt(fcode_env_t
*env
)
765 if ((prompt
= parse_a_string(env
, NULL
)) != NULL
)
766 strncpy(prompt_string
, prompt
, sizeof (prompt_string
));
774 fcode_env_t
*env
= initial_env
;
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
);