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 *
parse_a_string(fcode_env_t * env,int * lenp)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
constant(fcode_env_t * env)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
buffer_colon(fcode_env_t * env)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
value(fcode_env_t * env)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
variable(fcode_env_t * env)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
defer(fcode_env_t * env)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
field(fcode_env_t * env)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
bye(fcode_env_t * env)123 bye(fcode_env_t *env)
124 {
125 exit(0);
126 }
127
128 void
do_resume(fcode_env_t * env)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
return_to_interact(fcode_env_t * env)139 return_to_interact(fcode_env_t *env)
140 {
141 if (jmp_buf_ptr)
142 longjmp(*jmp_buf_ptr, 1);
143 }
144
145 void
do_interact(fcode_env_t * env)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
temp_base(fcode_env_t * env,fstack_t base)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
temp_decimal(fcode_env_t * env)251 temp_decimal(fcode_env_t *env)
252 {
253 temp_base(env, 10);
254 }
255
256 static void
temp_hex(fcode_env_t * env)257 temp_hex(fcode_env_t *env)
258 {
259 temp_base(env, 0x10);
260 }
261
262 static void
temp_binary(fcode_env_t * env)263 temp_binary(fcode_env_t *env)
264 {
265 temp_base(env, 2);
266 }
267
268 static void
do_hex(fcode_env_t * env)269 do_hex(fcode_env_t *env)
270 {
271 env->num_base = 0x10;
272 }
273
274 static void
do_decimal(fcode_env_t * env)275 do_decimal(fcode_env_t *env)
276 {
277 env->num_base = 10;
278 }
279
280 static void
do_binary(fcode_env_t * env)281 do_binary(fcode_env_t *env)
282 {
283 env->num_base = 2;
284 }
285
286 static void
do_clear(fcode_env_t * env)287 do_clear(fcode_env_t *env)
288 {
289 DS = env->ds0;
290 }
291
292 static void
action_one(fcode_env_t * env)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
do_if(fcode_env_t * env)306 do_if(fcode_env_t *env)
307 {
308 branch_common(env, 1, 1, 0);
309 }
310
311 void
do_else(fcode_env_t * env)312 do_else(fcode_env_t *env)
313 {
314 branch_common(env, 1, 0, 1);
315 bresolve(env);
316 }
317
318 void
do_then(fcode_env_t * env)319 do_then(fcode_env_t *env)
320 {
321 bresolve(env);
322 }
323
324 void
do_of(fcode_env_t * env)325 do_of(fcode_env_t *env)
326 {
327 branch_common(env, 0, 2, 0);
328 }
329
330 void
load_file(fcode_env_t * env)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
load(fcode_env_t * env)361 load(fcode_env_t *env)
362 {
363 parse_word(env);
364 if (TOS > 0)
365 load_file(env);
366 }
367
368 void
fevaluate(fcode_env_t * env)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
fload(fcode_env_t * env)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
add_line_to_history(fcode_env_t * env,char * line)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
do_emit_chars(fcode_env_t * env,char c,int n)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
do_emit_str(fcode_env_t * env,char * str,int n)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 *
find_next_word(char * cursor,char * eol)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 *
find_prev_word(char * buf,char * cursor)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
redraw_line(fcode_env_t * env,char * prev_l,char * prev_cursor,char * prev_eol,char * new_l,char * new_cursor,char * new_eol)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
do_save_buf(char * save_buf,char * buf,int n)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
read_line(fcode_env_t * env)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
set_prompt(fcode_env_t * env)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
_init(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