Initial commit of OpenSPARC T2 architecture model.
[OpenSPARC-T2-SAM] / obp / obp / os / unix / wrapper.c
CommitLineData
920dae64
AT
1/*
2* ========== Copyright Header Begin ==========================================
3*
4* Hypervisor Software File: wrapper.c
5*
6* Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
7*
8* - Do no alter or remove copyright notices
9*
10* - Redistribution and use of this software in source and binary forms, with
11* or without modification, are permitted provided that the following
12* conditions are met:
13*
14* - Redistribution of source code must retain the above copyright notice,
15* this list of conditions and the following disclaimer.
16*
17* - Redistribution in binary form must reproduce the above copyright notice,
18* this list of conditions and the following disclaimer in the
19* documentation and/or other materials provided with the distribution.
20*
21* Neither the name of Sun Microsystems, Inc. or the names of contributors
22* may be used to endorse or promote products derived from this software
23* without specific prior written permission.
24*
25* This software is provided "AS IS," without a warranty of any kind.
26* ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
27* INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
28* PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
29* MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
30* ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
31* DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
32* OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
33* FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
34* DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
35* ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
36* SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
37*
38* You acknowledge that this software is not designed, licensed or
39* intended for use in the design, construction, operation or maintenance of
40* any nuclear facility.
41*
42* ========== Copyright Header End ============================================
43*/
44/*
45 * @(#)wrapper.c 2.29 02/09/23
46 * Copyright 1985-1994 Bradley Forthware
47 * Copyright 2001-2002 Sun Microsystems, Inc. All Rights Reserved
48 * Use is subject to license terms.
49 *
50 * This is the C wrapper program for Forthmacs. There are 3 problems to
51 * solve in porting Forthmacs to a different machine.
52 *
53 * 1) What is the format of a binary file
54 * 2) How are I/O system calls invoked
55 * 3) At which address will the binary run (relocation)
56 *
57 * This C program finesses problems 1 and 2 by assuming that the C
58 * compiler/linker knows how to do those those things. The Forth
59 * interpreter itself is stored in a file whose format is system-independent.
60 * The C program mallocs an array, reads the Forth image into that array,
61 * and calls the array as a subroutine, passing it the address of another
62 * array containing entry points for I/O subroutines.
63 *
64 * The Forth interpreter relocates itself from a relocation bitmap
65 * which is part of the Forth image file.
66 */
67
68static char sccsid[] = "wrapper.c 2.4 91/07/25";
69
70/*
71 * Dynamic loader for Forth. This program reads in a binary image of
72 * a Forth system and executes it. It connects standard input to the
73 * Forth input stream (key and expect) and puts the Forth output stream
74 * (emit and type) on standard output.
75 *
76 * An array of entry points for system calls is provided to the Forth
77 * system, so that Forth doesn't have to know the details of how to
78 * invoke system calls.
79 *
80 * Synopsis:
81 *
82 * forth [ -e dict-size ] [ -d <forth-binary>.dic ] [ -u ]
83 *
84 * dict-size is an optional decimal number specifying the number of
85 * kilobytes of dictionary extension space to allocate. The dictionary
86 * extension space is the amount that the dictionary may grow as a result
87 * of additional compilation, ALLOTing, etc. If the dict-size argument
88 * is omitted, a default value DEF_DICT is used.
89 *
90 * <forth-binary> is the name of the ".dic" file containing the forth binary
91 * image. The binary image is in a system-independent format, which contains
92 * a header, the relocatable program image, and a relocation bitmap.
93 *
94 * If there is no such argument, the default binary file DEF_EXE is used.
95 *
96 * The Forth system may determine whether the input stream is coming from
97 * a file or from standard input by calling the function "fileques()".
98 * This is useful for deciding whether or not to prompt if it is possible
99 * to redirect the input stream to a file.
100 */
101
102#include <stdio.h>
103#include <stdlib.h>
104#include <unistd.h>
105#include <fcntl.h>
106#include <strings.h>
107
108#include <sys/types.h>
109#include <sys/time.h>
110#include <sys/param.h>
111#include <sys/stat.h>
112
113#include <signal.h>
114
115#include "wrapper.h"
116#include "xref.h"
117#include "defines.h"
118
119#ifdef SYS5
120#define signal sigset
121#endif
122
123/*
124 * deprecate all syscalls above 45
125 */
126#define UNIMPL_FSYS
127
128extern char *substr();
129
130extern int path_open();
131
132void keyqmode(void);
133void linemode(void);
134void keymode(void);
135void restoremode(void);
136
137extern long f_open(), f_creat();
138extern long f_close(), f_read(), f_write();
139extern long f_ioctl();
140extern long f_lseek();
141extern long f_crstr();
142extern long c_key();
143extern long c_emit();
144extern long c_keyques();
145extern long c_cr();
146extern long fileques();
147extern long f_unlink();
148extern long c_expect();
149extern long c_type();
150extern long syserror();
151extern int errno; /* Wherever the error code goes */
152extern long s_bye();
153extern long emacs();
154extern long pr_error();
155extern long s_signal();
156extern long s_system();
157extern long s_chdir();
158extern long s_getwd();
159extern long m_alloc();
160extern long m_free();
161extern long c_getenv();
162extern long today();
163extern long timez();
164extern long timezstr();
165extern long s_flushcache();
166extern long f_init(), f_op(), f_move(), f_rows(), f_cols();
167extern long pathname();
168extern long m_sbrk();
169#ifdef PPCSIM
170extern long printnum(), mmap(), close(), open();
171#endif
172#ifdef DLOPEN
173extern long dlopen(), dlsym(), dlerror(), dlclose();
174#endif
175
176void error(char *str1, char *str2);
177
178extern long find_next();
179
180long save_image(/* char *name, header_t *header */);
181long bootstrap(/* char *name */);
182long includefile(/* char *name */);
183long refill(/* char *adr, fd, actual not-eof? error? */);
184long stack_syscall();
185
186#define UNIMPL(x) printf("%s:%d: Unimplemented syscall " #x "\n", \
187 __FILE__, __LINE__)
188
189long ((*functions[])()) = {
190/* 0 1 */
191 c_key, c_emit,
192
193 /* 2 3 4 5 */
194 f_open, f_creat, f_close, f_read,
195
196 /* 6 7 8 */
197 f_write, f_ioctl, c_keyques,
198
199 /* 9 10 11 12 */
200 s_bye, f_lseek, f_unlink, fileques,
201
202 /* 13 14 15 */
203 c_type, c_expect, syserror,
204
205 /* 16 17 18 */
206 today, timez, timezstr,
207
208 /* 19 20 */
209#if 0
210 fork, execve,
211#else
212 0L, 0L,
213#endif
214 /* 21 */
215 c_getenv,
216
217 /* 22 23 */
218 s_system, s_signal,
219
220 /* 24 25 */
221 s_chdir, s_getwd,
222
223 /* 26 27 28 */
224 m_alloc, c_cr, f_crstr,
225
226 /* 29 30 31 */
227 s_flushcache, pr_error, emacs,
228
229 /* 32 */
230 m_free,
231
232 /* 33 34 35 36 37 */
233 f_init, f_op, f_move, f_rows, f_cols,
234
235 /* 38 */
236 pathname,
237
238#ifdef PPCSIM
239 /* 39 40 41 42 */
240 printnum, mmap, open, close,
241#else
242 /* 39 */
243 m_sbrk,
244
245 /* 40 41 42 43 */
246#ifdef DLOPEN
247 dlopen, dlsym, dlerror, dlclose,
248#else
249 0, 0, 0, 0,
250#endif
251 /* 44 */
252#ifdef SIMFORTH
253 find_next,
254#else
255 0,
256#endif
257 /* 45, , 46 , 47 , 48 */
258 stack_syscall, 0, 0, 0,
259
260 /* 49, 50 51 , 52 */
261 0, 0, 0, 0,
262
263 /* 53, 54, 55, */
264 0, 0, 0,
265
266 /* 56 */
267 stack_syscall,
268
269#endif
270 /* EOT */
271 0
272};
273
274/*
275 * Function semantics:
276 *
277 * Functions which are the names of Unix system calls have the semantics
278 * of those Unix system calls.
279 *
280 * char c_key(); Gets next input character
281 * no echo or editing, don't wait for a newline.
282 * c_emit(char c); Outputs the character.
283 * long f_open(char *path, long mode); Opens a file.
284 * Mode must agree with wrsys.fth
285 * long f_creat(char *path, long mode); Creates a file.
286 * Mode must agree with wrsys.fth
287 * long f_read(long fd, char *buf, long cnt); Reads from a file
288 * long f_write(long fd, char *buf, long cnt); Writes to a file
289 * long f_ioctl(long fd, long code, char *buf); Is not used right now.
290 * long c_keyques(); True if a keystroke is pending.
291 * If you can't implement this, return false.
292 * s_bye(long status); Cleans up and exits.
293 * long f_lseek(long fd, long offset, long whence);Changes file position.
294 * Whence: 0 - from start of file 1 - from current pos. 2 - from end
295 * long f_unlink(char *path); Deletes a file.
296 * long fileques(); True if input stream has been
297 * redirected away from a keyboard.
298 * long c_type(long len, char *addr); Outputs len characters.
299 * long c_expect(long max, char *buffer); Reads an edited line of input.
300 * long c_cr(); Advances to next line.
301 * long f_crstr() Returns file line terminator.
302 * long syserror(); Error code from the last
303 * failed system call.
304 */
305
306extern void exit_handler();
307#ifdef BSD
308extern void cont_handler();
309extern void stop_handler();
310#endif /* BSD */
311
312#ifdef EMACS
313char *genvp;
314#endif
315
316char *progname;
317char sccs_get_cmd[128]; /* sccs get command string */
318int uflag = 0; /* controls auto execution of sccs get */
319int vflag = 0; /* controls reporting of file names */
320int xref_enabled = 0;
321int xref_enable_forward_refs = 0;
322int show_symbols = 0;
323int compile_errors = 0;
324int compile_msgs = 0;
325int compile_warnings = 0;
326
327/*
328 * Execute the MicroEmacs editor.
329 */
330extern char *emacs_main();
331char *fake_argv[] = { "micro-emacs", "dontexit", 0 };
332long
333emacs(void)
334{
335#ifdef EMACS
336 char *eret;
337
338 eret = emacs_main(2, fake_argv, genvp);
339 keymode();
340 return ((long)eret);
341#endif
342}
343
344static char *help_msg =
345"Forth [flags] [forth-flags]\n"
346"[Flags] may be some of:\n"
347" -h : help\n"
348" -d <file> : use dictionary <file>\n"
349" -e <Kb> : set dictionary extent\n"
350" -L : little endian mode"
351#ifndef PPC
352" (unused)"
353#endif
354" \n"
355" -D <symbol> : define <symbol>, value follows optional =\n"
356" -U <symbol> : undefine <symbol>\n"
357" -S : show all defined symbols at exit\n"
358" -F : enable forward XREF definitions (metacompiler)\n"
359" -u : enable SCCS get\n"
360" -v : verbose mode\n"
361" -x <file> : Xref save to <file>\n"
362"\n"
363" Any flag not recognised above terminates the argument parsing; it and\n"
364" all subsequent args will be passed to the forth engine, all forth flags\n"
365" must therefore appear after the wrapper flags\n"
366"\n"
367" Example:\n"
368" # forth -e 900 -d ${BP}/fm/kernel/sparc/k32t32.dic -x forth.xref\n"
369"\n"
370" Which translates to: Run 32bit forth with 32bit tokens, \n"
371" extend dictionary to 900KB, using forth.xref as the reference index file\n"
372"\n";
373
374
375static void
376usage(void)
377{
378 printf(help_msg);
379}
380
381static void
382create_xref_symbol(char *name, char *value)
383{
384 char *tstr;
385
386 tstr = malloc(strlen(name) + strlen(value) + 2);
387 /* set the default limit */
388 sprintf(tstr, "%s=%s", name, value);
389 undef_symbol(name, CMD_UNDEF);
390 define_symbol(tstr, CMD_DEFINE);
391 free(tstr);
392}
393
394int
395main(int argc, char *argv[], char *envp)
396{
397 char *loadaddr;
398 long cnt;
399 int f, c;
400 long dictsize, extrasize, imagesize;
401 char *dictend;
402 int extrak;
403 extern char *optarg;
404 extern int optind;
405 int little_endian;
406 int input_args = 0;
407 char *dictfile;
408 char *getmem();
409 header_t header;
410 char **fargv;
411 int fargc;
412 int extraargs;
413
414 progname = *argv;
415
416#ifdef EMACS
417 /*
418 * We only look at the last 5 characters of the name in case
419 * the path name was explicitly specified, e.g. /usr/bin/emacs
420 */
421 if ((strlen(progname) >= 5) &&
422 (strcmp(substr(progname, -5, 5), "emacs") == 0)) {
423 emacs_main(argc, argv, envp);
424 exit(0);
425 }
426#endif
427
428 opterr = 0;
429 vflag = 0;
430 extrak = -1;
431 dictfile = DEF_EXE;
432 little_endian = 0;
433 extraargs = 0;
434 fargv = malloc(((argc+5) * sizeof (char *)));
435 memset(fargv, 0, ((argc+5) * sizeof (char *)));
436 fargc = 0;
437 fargv[fargc++] = argv[0];
438
439 while ((extraargs == 0) &&
440 ((c = getopt(argc, argv, "he:d:Luvx:X:r:l:D:U:SF")) != EOF))
441 switch (c) {
442
443 case 'h':
444 usage();
445 exit(1);
446 break;
447
448 case 'x':
449 create_xref_symbol("XREF-FILE", optarg);
450#if 0
451 fargv[fargc++] = "-x";
452#endif
453 break;
454
455 case 'e':
456 extrak = getnum(optarg);
457 input_args |= 2;
458 break;
459
460 case 'd':
461 dictfile = optarg;
462 input_args |= 1;
463 break;
464
465 case 'L':
466 little_endian = 1;
467 break;
468
469 case 'u':
470 uflag = 1;
471 break;
472
473 case 'v':
474 vflag++;
475 break;
476
477 case 'D':
478 define_symbol(optarg, CMD_DEFINE);
479 break;
480
481 case 'U':
482 undef_symbol(optarg, CMD_UNDEF);
483 break;
484
485 case 'S':
486 show_symbols = 1;
487 break;
488
489 case 'F':
490 xref_enable_forward_refs = 1;
491 break;
492
493 default:
494 if (extraargs == 0)
495 extraargs = optind-1;
496 break;
497 }
498
499 if (extraargs || (argc - optind)) {
500 if (extraargs == 0) extraargs = optind;
501 while (extraargs < argc) {
502 fargv[fargc++] = argv[extraargs++];
503 }
504 }
505 fargv[fargc] = "";
506#if 0
507 {
508 int i;
509
510 for (i = 0; i < fargc; i++) {
511 printf("Farg[%d] = %s\n", i, fargv[i]);
512 }
513 }
514#endif
515 if ((input_args & 1) == 0) {
516 printf("Warning: falling back to default dictionary: %s\n",
517 dictfile);
518 }
519
520 /* Open file for reading */
521 if ((f = path_open(dictfile)) < 0) {
522 error("forth: Can't open dictionary file ", dictfile);
523 exit(1);
524 }
525
526#ifdef SCCS
527 strcpy(sccs_get_cmd, "sccs ");
528 if (getenv("SCCSFLAGS") != NULL)
529 strcat(sccs_get_cmd, getenv("SCCSFLAGS"));
530 strcat(sccs_get_cmd, " get ");
531 if (getenv("SCCSGETFLAGS") == NULL)
532 strcat(sccs_get_cmd, " -s");
533 else
534 strcat(sccs_get_cmd, getenv("SCCSGETFLAGS"));
535 strcat(sccs_get_cmd, " ");
536#endif SCCS
537
538 /*
539 * Read just the header into a separate buffer,
540 * use it to find the size of text+data+bss, allocate that
541 * much memory plus sizeof(header), copy header to the
542 * new place, then read the rest of the file.
543 */
544 if (f_read(f, (char *)&header, (long)sizeof (header)) !=
545 (long)sizeof (header)) {
546 error("forth: Can't read dictionary file header", "");
547 exit(1);
548 }
549
550 /*
551 * Determine the dictionary growth size.
552 * First priority: command line specification
553 * Second priority: h_blen header field
554 * Default: DEF_DICT
555 */
556 if (extrak == -1)
557 extrasize = header.h_blen ? header.h_blen : DEF_DICT;
558 else
559 extrasize = (long)extrak * 1024L;
560
561 /* imagesize is the number of bytes to read from the file */
562
563 imagesize = header.h_tlen + header.h_dlen
564 + header.h_trlen + header.h_drlen;
565
566 /* dictsize is the total amount of dictionary memory to allocate */
567
568 dictsize = sizeof (header) + imagesize + extrasize;
569 dictsize = ROUNDUP(dictsize, DICT_SIZE_ALIGNMENT);
570
571 loadaddr = (char *)getmem(dictsize);
572
573 memcpy(loadaddr, &header, sizeof (header));
574
575 if (f_read(f, loadaddr+sizeof (header), imagesize) != imagesize) {
576 error("forth: The dictionary file is too short", "");
577 exit(1);
578 }
579
580 f_close(f);
581
582 keymode();
583
584#ifdef SIMFORTH
585 simulate(sizeof (functions)/sizeof (void *), loadaddr,
586 (long)loadaddr+dictsize, functions, fargc, fargv);
587#else /* SIMFORTH */
588 signal(SIGHUP, exit_handler);
589 signal(SIGINT, exit_handler);
590 signal(SIGILL, exit_handler);
591 signal(SIGIOT, exit_handler);
592 signal(SIGTRAP, exit_handler);
593 signal(SIGFPE, exit_handler);
594 signal(SIGEMT, exit_handler);
595 signal(SIGBUS, exit_handler);
596 signal(SIGSEGV, exit_handler);
597 signal(SIGSYS, exit_handler);
598#ifdef BSD
599 signal(SIGCONT, cont_handler);
600 signal(SIGTSTP, stop_handler);
601#endif /* BSD */
602
603 s_flushcache(); /* We're about to execute data! */
604
605 /*
606 * Call the Forth interpreter as a subroutine. If it returns,
607 * exit with its return value as the status code.
608 */
609#ifdef PPCSIM
610 simulate(0, loadaddr+sizeof (header),
611 loadaddr, functions, ((long)loadaddr+dictsize - 16) & ~15,
612 argc, argv, little_endian);
613#else
614 s_bye((*(long (*)())(loadaddr+sizeof (header)))
615 (loadaddr, functions, (long)loadaddr+dictsize, fargc, fargv));
616#endif
617#endif /* SIMFORTH */
618}
619
620/*
621 * If the input string contains only decimal digits, returns the base 10
622 * number represented by that digit string. Otherwise returns -1.
623 */
624int
625getnum(char *s)
626{
627 int digit, n;
628
629 for (n = 0; *s; s++) {
630 digit = *s - '0';
631 if ((digit < 0) || (digit > 9))
632 return (-1);
633 n = n * 10 + digit;
634 }
635 return (n);
636}
637
638#ifdef BSD
639void
640stop_handler(void)
641{
642 restoremode();
643 kill(0, SIGSTOP);
644}
645void
646cont_handler(void)
647{
648 keymode();
649}
650#endif /* BSD */
651
652void
653exit_handler(int sig)
654{
655 psignal(sig, "forth");
656
657 if (sig == SIGINT) {
658 s_bye(0L);
659 } else {
660 restoremode();
661 kill(0, SIGQUIT);
662 }
663}
664
665/*
666 * Returns true if a key has been typed on the keyboard since the last
667 * call to c_key().
668 */
669long
670c_keyques(void)
671{
672 int nchars = 0;
673
674 fflush(stdout);
675
676#ifdef FreeBSD
677 if ((nchars = stdin->_r) == 0) {
678 char c[1];
679 keyqmode();
680 nchars = read(0, c, 1) > 0;
681 if (nchars)
682 ungetc(c[0], stdin);
683 }
684#else
685#ifdef IRIS
686 return (0);
687#endif
688#endif
689 {
690 char c[1];
691 keyqmode();
692 nchars = read(0, c, 1) > 0;
693 if (nchars)
694 ungetc(c[0], stdin);
695 }
696
697 return ((long)nchars);
698}
699
700/*
701 * Get the next character from the input stream.
702 */
703/*
704 * There is a minor problem under Regulus relating to interrupted system
705 * calls. If the user types the INTERRUPT character (e.g. DEL) while
706 * Forth is waiting for input, the read system call will be interrupted.
707 * Forth will field the signal thus generated, save the state, and return
708 * to the Forth interpreter. If the user then tries to restart from the
709 * saved state, the restarted system call will return 0, which is the same
710 * code that is returned for end-of-file. This is especially nasty when
711 * using the Regulus standard-I/O package, because when it see the 0-length
712 * read, it set a flag in the stdio file descriptor and returns EOF
713 * forevermore. What we really want to happen is for the read system call
714 * to restart cleanly and continue waiting for input, rather than returning
715 * 0.
716 */
717
718long
719c_key(void)
720{
721 int c;
722
723 keymode();
724
725 fflush(stdout);
726 if ((c = getc(stdin)) != EOF)
727 return (c);
728
729 s_bye(0L);
730}
731
732/*
733 * Send the character c to the output stream.
734 */
735long
736c_emit(long c)
737{
738 putchar((int)c);
739 fflush(stdout);
740 return (0);
741}
742
743/*
744 * This routine is called by the Forth system to determine whether
745 * its input stream is connected to a file or to a terminal.
746 * It uses this information to decide whether or not to
747 * prompt at the beginning of a line. If you are running in an environment
748 * where input cannot be redirected away from the terminal, just return 0L.
749 */
750long
751fileques()
752{
753 return (!isatty(fileno(stdin)));
754}
755
756/*
757 * Get at least "size" bytes of memory, returning the starting address
758 * of the memory.
759 */
760char *
761getmem(size)
762 long size;
763{
764 char *start;
765
766 start = (char *)sbrk(size+DICT_ORIGIN_ALIGNMENT+DICT_HEADER_SIZE);
767
768 if (start == (char *)-1) {
769 error("forth: couldn't get memory", "");
770 exit(1);
771 }
772 return ((char *)((ulong_t)
773 ROUNDUP(start+DICT_HEADER_SIZE, DICT_ORIGIN_ALIGNMENT)
774 - DICT_HEADER_SIZE));
775}
776
777#include <termios.h>
778struct termios ostate;
779struct termios lstate;
780struct termios kstate;
781struct termios kqstate;
782
783#define M_ORIG 0
784#define M_KEY 1
785#define M_LINE 2
786#define M_KEYQ 3
787static lmode = M_ORIG;
788
789void
790initline(void)
791{
792 if (lmode != M_ORIG)
793 return;
794
795 tcgetattr(0, &ostate); /* save old state */
796
797 tcgetattr(0, &lstate); /* base of line state */
798 lstate.c_iflag |= IXON|IXANY|IXOFF; /* XON/XOFF */
799 lstate.c_iflag |= ICRNL; /* CR/NL munging */
800#ifndef FreeBSD
801 lstate.c_iflag &= ~(IUCLC); /* no case folding */
802#endif
803/* Always turning on ONLCR is safe, but it is a pain in an EMACS window */
804#ifdef notdef
805 lstate.c_oflag |= OPOST|ONLCR; /* Map NL to CR-LF */
806 lstate.c_oflag &= ~(OLCUC); /* No case folding */
807 lstate.c_oflag &= ~(OCRNL|ONLRET); /* Don't swap cr and lf */
808#else
809 lstate.c_oflag |= OPOST;
810#endif
811 lstate.c_lflag |= ICANON|ECHO; /* Line editing on */
812 lstate.c_cc[VMIN] = 1; /* Don't hold up input */
813 lstate.c_cc[VTIME] = 0; /* No input delay */
814
815 tcgetattr(0, &kstate); /* base of key state */
816 kstate.c_iflag &= ~(IXON|IXANY|IXOFF); /* no XON/XOFF */
817 kstate.c_iflag &= ~(INLCR|ICRNL); /* no CR/NL munging */
818#ifndef FreeBSD
819 kstate.c_iflag &= ~(IUCLC); /* no case folding */
820#endif
821/* Always turning on ONLCR is safe, but it is a pain in an EMACS window */
822#ifdef notdef
823 kstate.c_oflag |= OPOST|ONLCR; /* Map NL to CR-LF */
824 kstate.c_oflag &= ~(OLCUC); /* No case folding */
825 kstate.c_oflag &= ~(OCRNL|ONLRET); /* Don't swap cr and lf */
826#else
827 kstate.c_oflag |= OPOST; /* */
828#endif
829 kstate.c_lflag &= ~(ICANON|ECHO); /* No editing characters */
830 kstate.c_cc[VMIN] = 1; /* Don't hold up input */
831 kstate.c_cc[VTIME] = 0; /* No input delay */
832
833 kqstate = kstate;
834 kqstate.c_cc[VMIN] = 0; /* Poll for character */
835
836}
837
838void
839linemode(void)
840{
841 initline();
842 if (lmode != M_LINE) {
843 tcsetattr(0, TCSANOW, &lstate);
844 lmode = M_LINE;
845 }
846}
847
848void
849keyqmode(void)
850{
851 initline();
852 if (lmode != M_KEYQ) {
853 tcsetattr(0, TCSANOW, &kqstate);
854 lmode = M_KEYQ;
855 }
856}
857
858void
859keymode(void)
860{
861 initline();
862 if (lmode != M_KEY) {
863 tcsetattr(0, TCSANOW, &kstate);
864 lmode = M_KEY;
865 }
866}
867
868void
869restoremode(void)
870{
871 initline();
872 if (lmode != M_ORIG) {
873 tcsetattr(0, TCSANOW, &ostate);
874 lmode = M_ORIG;
875 }
876}
877
878/*
879 * Get an edited line of input from the keyboard, placing it at buffer.
880 * At most "max" characters will be placed in the buffer.
881 * The line terminator character is not stored in the buffer.
882 */
883long
884c_expect(long max, char *buffer)
885{
886 int c;
887 char *p = buffer;
888
889 linemode();
890
891 fflush(stdout);
892 while (max-- && ((c = getc(stdin)) != '\n') && (c != EOF))
893 *p++ = c;
894 if (c == EOF)
895 *p++ = '\n';
896 keymode();
897 return ((long)(p - buffer));
898}
899
900/*
901 * Send len characters from the buffer at addr to the output stream.
902 */
903long
904c_type(long len, char *addr)
905{
906 while (len--)
907 putchar(*addr++);
908 fflush(stdout);
909 return (0);
910}
911
912/*
913 * Sends an end-of-line sequence to the output stream.
914 */
915long
916c_cr(void)
917{
918 putchar('\n');
919 fflush(stdout);
920 return (0);
921}
922
923/*
924 * Returns the end-of-line sequence that is used within files as
925 * a packed (leading count byte) string.
926 */
927long
928f_crstr(void)
929{
930 return ((long)"\1\n");
931}
932
933long
934s_bye(code)
935 long code;
936{
937 restoremode();
938#ifdef SIMFORTH
939 simexit();
940#endif /* SIMFORTH */
941 xref_generate(0);
942 finish_symbols(show_symbols); /* display? */
943 finish_symbols(0); /* force a free if not already done */
944 if (compile_msgs || compile_errors) {
945 fprintf(stderr,
946 "%s: Compile completed with "
947 "%d messages, %d warnings, %d errors\n",
948 (compile_errors ? "ERROR" : "NOTICE"),
949 compile_msgs, compile_warnings, compile_errors);
950 }
951 exit((int)(code|compile_errors));
952}
953
954/*
955 * Display the two strings, followed by an newline, on the error output
956 * stream.
957 */
958void
959error(char *str1, char *str2)
960{
961 write(2, str1, strlen(str1));
962 write(2, str2, strlen(str2));
963 write(2, "\n", 1);
964}
965
966
967/* Find the error code returned by the last failing system call. */
968long
969syserror()
970{
971 extern int errno;
972
973 return ((long)errno);
974}
975
976/* Display an error message */
977
978long
979pr_error(errnum)
980 long errnum;
981{
982 errno = errnum;
983 perror("");
984}
985
986long
987f_open(char *name, long flag, long mode)
988{
989 char *expand_name();
990 char *sccs_get();
991
992 if (vflag)
993 printf("File: %s\n", name);
994
995 name = expand_name(name);
996#ifdef SCCS
997
998 if (uflag)
999 if (isobsolete(name) == 1)
1000 s_system(sccs_get(name));
1001#endif SCCS
1002
1003 return ((long)open(name, (int)flag, (int)mode));
1004}
1005
1006long
1007f_creat(char *name, long mode)
1008{
1009 char *expand_name();
1010
1011 name = expand_name(name);
1012 return ((long)open(name, O_RDWR|O_CREAT|O_TRUNC, (int)mode));
1013}
1014
1015long
1016f_read(long fd, char *buf, long cnt)
1017{
1018 return (read((int)fd, buf, cnt));
1019}
1020
1021long
1022f_write(long fd, char *buf, long cnt)
1023{
1024 return (write((int)fd, buf, cnt));
1025}
1026
1027long
1028f_close(long fd)
1029{
1030 extern int close();
1031
1032 return ((long)close((int)fd));
1033}
1034
1035long
1036f_unlink(char *name)
1037{
1038 extern int unlink();
1039
1040 return ((long)unlink(name));
1041}
1042
1043long
1044f_lseek(long fd, long offset, long flag)
1045{
1046 extern long lseek();
1047
1048 return (lseek((int)fd, offset, (int)flag));
1049}
1050
1051long
1052f_ioctl(long fd, long code, char *buf)
1053{
1054 return ((long)ioctl((int)fd, (int)code, buf));
1055}
1056
1057long
1058s_signal(long signo, void (*adr)())
1059{
1060 return ((long)signal((int)signo, (void (*)())adr));
1061}
1062
1063long
1064s_system(char *str)
1065{
1066 int i;
1067 linemode();
1068 i = system(str);
1069 keymode();
1070
1071 return ((long)i);
1072}
1073
1074long
1075s_chdir(char *str)
1076{
1077 return ((long)chdir(str));
1078}
1079
1080long
1081s_getwd(char *buf)
1082{
1083 return ((long)getcwd(buf, MAXPATHLEN));
1084}
1085
1086#ifdef SYS5
1087#define bzero(b, n) (void *)memset(b, 0, n)
1088#endif SYS5
1089long
1090m_alloc(long size)
1091{
1092 long r;
1093
1094#ifdef PPCSIM
1095 size = (size+7) & ~7;
1096#endif
1097 r = (long)malloc(size);
1098 if (r) bzero((char *)r, size);
1099 return (r);
1100}
1101
1102/* ARGSUSED */
1103long
1104m_free(long size, char *adr)
1105{
1106 free(adr);
1107}
1108
1109long
1110f_init(void)
1111{
1112 UNIMPL(f_init);
1113}
1114
1115long
1116f_op(void)
1117{
1118 UNIMPL(f_op);
1119}
1120
1121long
1122f_move(void)
1123{
1124 UNIMPL(f_move);
1125}
1126
1127long
1128f_rows(void)
1129{
1130 UNIMPL(f_rows);
1131}
1132
1133long
1134f_cols(void)
1135{
1136 UNIMPL(f_cols);
1137}
1138
1139long
1140m_sbrk(long size)
1141{
1142 return ((long)sbrk(size));
1143}
1144
1145long
1146c_getenv(char *str)
1147{
1148 return ((long)getenv(str));
1149}
1150
1151long
1152today(void)
1153{
1154 long tadd;
1155 extern struct tm *localtime();
1156
1157 time(&tadd);
1158 return ((long)localtime(&tadd));
1159}
1160
1161long
1162timez(void)
1163{
1164#ifdef BSD
1165 static struct timeval t;
1166 static struct timezone tz;
1167 extern int gettimeofday();
1168
1169 gettimeofday(&t, &tz);
1170 return ((long)tz.tz_minuteswest);
1171#endif
1172#ifdef SYS5
1173 time_t clock;
1174
1175 tzset();
1176 return (timezone/60);
1177#endif
1178#ifdef MINIWRAPPER
1179 return ((long)480); /* Assume PST */
1180#endif
1181}
1182
1183/* Return a string representing the name of the time zone */
1184long
1185timezstr(void)
1186{
1187 return ((long)""); /* Regulus doesn't seem to have this */
1188}
1189
1190/*
1191 * Flush the data cache if necessary and possible. Used after writing
1192 * instructions into the dictionary.
1193 */
1194long
1195s_flushcache()
1196{
1197#ifdef NeXT
1198 asm("trap #2");
1199#endif
1200}
1201
1202/*
1203 * Tries to open the named file looking in each directory of the
1204 * search path specified by the environment variable FTHPATH.
1205 * Returns file descriptor or -1 if not found
1206 */
1207char fnb[300];
1208int
1209path_open(char *fn)
1210{
1211 static char *path;
1212 register char *dp;
1213 int fd;
1214 register char *lpath;
1215
1216 if (fn == NULL)
1217 return (-1);
1218
1219 if (path == NULL) {
1220 path = getenv("FTHPATH");
1221 if (path == NULL) {
1222 path = getenv("FPATH");
1223 }
1224 }
1225 if (path == NULL)
1226 path = DEF_FPATH;
1227
1228 lpath = (*fn == '/') ? "" : path;
1229 do {
1230 dp = fnb;
1231 while (*lpath && *lpath != ':')
1232 *dp++ = *lpath++;
1233 if (dp != fnb)
1234 *dp++ = '/';
1235 strcpy(dp, fn);
1236 fd = open(fnb, 0);
1237 if (fd >= 0)
1238 return (fd);
1239 } while (*lpath++);
1240 fd = open(fn, 0);
1241 if (fd >= 0)
1242 return (fd);
1243 return (-1);
1244}
1245
1246executable(char *filename) /* True if file is executable */
1247{
1248 struct stat stbuf;
1249
1250 return ((stat(filename, &stbuf) == 0) &&
1251 ((stbuf.st_mode & S_IFMT) == S_IFREG) &&
1252 (access(filename, 1) == 0));
1253}
1254
1255/* Find fname for symbol table */
1256long
1257pathname(void)
1258{
1259 static char buf[256];
1260 char *cp, *cp2;
1261
1262 cp = getenv("PATH");
1263 if (cp == NULL)
1264 cp = DEF_PATH;
1265 if ((*cp == ':') || (*progname == '/')) {
1266 cp++;
1267 if (executable(progname)) {
1268 strcpy(buf, progname);
1269 return ((long)buf);
1270 }
1271 }
1272 while (*cp) {
1273 /* copy over current directory and then append progname */
1274 cp2 = buf;
1275 while ((*cp != 0) && (*cp != ':')) {
1276 *cp2++ = *cp++;
1277 }
1278 *cp2++ = '/';
1279 strcpy(cp2, progname);
1280 if (*cp) cp++;
1281 if (!executable(buf)) continue;
1282 return ((long)buf);
1283 }
1284 strcpy(buf, progname);
1285 return ((long)buf);
1286}
1287
1288char *
1289substr(char *str, int pos, int n)
1290{
1291 int len = strlen(str);
1292 static char outstr[128];
1293
1294 if (pos < 0)
1295 pos += len+1;
1296 if (pos <= 0)
1297 pos = 1;
1298 if (n < 0)
1299 n += len;
1300 if (pos + n - 1 > len) {
1301 n = len + 1 - pos;
1302 if (n < 0)
1303 n = 0;
1304 }
1305 strncpy(outstr, str + pos - 1, n);
1306 outstr[n] = '\0';
1307
1308 return (outstr);
1309}
1310
1311#ifdef SCCS
1312
1313char *
1314sccs_name(char *name)
1315{
1316 static char sccsname[512];
1317 char *p;
1318 int dirlen;
1319
1320 /* Find the beginning of the last filename component */
1321
1322 if ((p = strrchr(name, '/')) == NULL)
1323 p = name;
1324 else
1325 p++;
1326
1327 dirlen = p - name;
1328
1329 strcpy(sccsname, name); /* Copy whole path */
1330 strcpy(sccsname+dirlen, "SCCS/s."); /* Merge in "SCCS/s." */
1331 strcat(sccsname, p); /* Put filename back */
1332
1333 return (sccsname);
1334
1335}
1336
1337/*
1338 * file | SCCS | obsolete (return value)
1339 * -----+------+------------------------
1340 * Y | Y | ? (SCCS > file)
1341 * N | Y | Y (1)
1342 * Y | N | N (0)
1343 * N | N | Error (-1)
1344 */
1345int
1346isobsolete(char *name)
1347{
1348 struct stat status, sccsstatus;
1349 int file, sccsfile;
1350
1351 file = stat(name, &status);
1352 sccsfile = stat(sccs_name(name), &sccsstatus);
1353
1354 /* If the file is missing, it is deemed "obsolete" */
1355 if (file == -1) {
1356 if (sccsfile == -1)
1357 return (-1); /* Both file and SCCS file missing */
1358 else
1359 return (1); /* file missing, SCCS file is there */
1360 }
1361 if (sccsfile == -1)
1362 return (0); /* file is there, no SCCS file */
1363 else /* Both exist, compare times */
1364 return ((sccsstatus.st_mtime > status.st_mtime) ? 1 : 0);
1365}
1366
1367char *
1368sccs_get(char *name)
1369{
1370 static char str[512];
1371
1372 strcpy(str, sccs_get_cmd);
1373 strcat(str, name);
1374 strcat(str, " -G");
1375 strcat(str, name);
1376 return (str);
1377}
1378
1379#endif SCCS
1380
1381char *
1382expand_name(char *name)
1383{
1384 char envvar[64], *fnamep, *envp, paren;
1385 static char fullname[256];
1386 int ndx = 0;
1387
1388 fnamep = name;
1389 fullname[0] = '\0';
1390
1391 if (*fnamep == '$') {
1392 fnamep++;
1393 if ((*fnamep == '{') || (*fnamep == '(')) {
1394 /* multi char env variable */
1395 if (*fnamep == '{')
1396 paren = '}';
1397 else
1398 paren = ')';
1399 fnamep++;
1400
1401 envvar[ndx++] = *(fnamep++);
1402
1403 while ((*fnamep != paren) && (ndx < 64) &&
1404 (*fnamep != '\0')) {
1405 envvar[ndx++] = *(fnamep++);
1406 }
1407 if (*fnamep == paren) {
1408 fnamep++;
1409 } else {
1410 ndx = 0;
1411 fnamep = name;
1412 }
1413 } else {
1414 /* single char env. var. */
1415 envvar[ndx++] = *(fnamep++);
1416 }
1417 envvar[ndx] = '\0';
1418
1419 if (ndx > 0 && (envp = getenv(envvar)) != NULL) {
1420 strcpy(fullname, envp);
1421 strcat(fullname, fnamep);
1422 return (fullname);
1423 } else {
1424 printf("Can't find environment variable %s in %s\n",
1425 envvar, name);
1426 }
1427 }
1428 return (fnamep);
1429}
1430
1431#ifdef SIMFORTH
1432long
1433find_next(int tshift, int token_size, int origin, char *link, char *str)
1434{
1435 int len, nextlen;
1436 char *namep;
1437 char *p = str;
1438
1439 len = strlen(p);
1440
1441 if (tshift == 0)
1442 link = (char *)((*(unsigned long *)(link)) +(origin));
1443 else
1444 link = (char *)((*(unsigned short *)(link) << tshift) +(origin));
1445
1446 while (link != (char *)origin) {
1447 p = str;
1448 namep = link - token_size - 1;
1449 nextlen = (*namep) & 0x1f;
1450 namep = namep - nextlen;
1451 if (len == nextlen)
1452 while (nextlen--)
1453 if (*(namep++) != *(p++))
1454 break;
1455 if (nextlen == -1)
1456 return (((long)link)-token_size);
1457
1458 if (tshift == 0)
1459 link = (char *)((*(unsigned long *)(link-token_size))
1460 +(origin));
1461 else
1462 link = (char *)((*(unsigned short *)(link-token_size)
1463 << tshift) +(origin));
1464 }
1465
1466 return (0);
1467}
1468#endif /* SIMFORTH */
1469
1470long
1471stack_syscall(long p)
1472{
1473 extern fstackp ((*sfunctions[])(fstackp));
1474 int fsyscall;
1475 fstackp stack = (fstackp)p;
1476#if 1
1477 fsyscall = POP(stack);
1478#if 0
1479 printf("fsyscall: %x\n", fsyscall);
1480 printf("fptr: %x\n", sfunctions[fsyscall]);
1481#endif
1482 return ((long)((sfunctions[fsyscall])(stack)));
1483#else
1484 int a, b, c;
1485
1486 a = POP(stack);
1487 b = POP(stack);
1488 c = POP(stack);
1489 printf("tos = %x, tos-1 = %x, tos-2 = %x\n", a, b, c);
1490 PUSH(a+1, stack);
1491 PUSH(b+1, stack);
1492 PUSH(c+1, stack);
1493 return ((long)stack);
1494#endif
1495}