Commit | Line | Data |
---|---|---|
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 | ||
68 | static 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 | ||
128 | extern char *substr(); | |
129 | ||
130 | extern int path_open(); | |
131 | ||
132 | void keyqmode(void); | |
133 | void linemode(void); | |
134 | void keymode(void); | |
135 | void restoremode(void); | |
136 | ||
137 | extern long f_open(), f_creat(); | |
138 | extern long f_close(), f_read(), f_write(); | |
139 | extern long f_ioctl(); | |
140 | extern long f_lseek(); | |
141 | extern long f_crstr(); | |
142 | extern long c_key(); | |
143 | extern long c_emit(); | |
144 | extern long c_keyques(); | |
145 | extern long c_cr(); | |
146 | extern long fileques(); | |
147 | extern long f_unlink(); | |
148 | extern long c_expect(); | |
149 | extern long c_type(); | |
150 | extern long syserror(); | |
151 | extern int errno; /* Wherever the error code goes */ | |
152 | extern long s_bye(); | |
153 | extern long emacs(); | |
154 | extern long pr_error(); | |
155 | extern long s_signal(); | |
156 | extern long s_system(); | |
157 | extern long s_chdir(); | |
158 | extern long s_getwd(); | |
159 | extern long m_alloc(); | |
160 | extern long m_free(); | |
161 | extern long c_getenv(); | |
162 | extern long today(); | |
163 | extern long timez(); | |
164 | extern long timezstr(); | |
165 | extern long s_flushcache(); | |
166 | extern long f_init(), f_op(), f_move(), f_rows(), f_cols(); | |
167 | extern long pathname(); | |
168 | extern long m_sbrk(); | |
169 | #ifdef PPCSIM | |
170 | extern long printnum(), mmap(), close(), open(); | |
171 | #endif | |
172 | #ifdef DLOPEN | |
173 | extern long dlopen(), dlsym(), dlerror(), dlclose(); | |
174 | #endif | |
175 | ||
176 | void error(char *str1, char *str2); | |
177 | ||
178 | extern long find_next(); | |
179 | ||
180 | long save_image(/* char *name, header_t *header */); | |
181 | long bootstrap(/* char *name */); | |
182 | long includefile(/* char *name */); | |
183 | long refill(/* char *adr, fd, actual not-eof? error? */); | |
184 | long stack_syscall(); | |
185 | ||
186 | #define UNIMPL(x) printf("%s:%d: Unimplemented syscall " #x "\n", \ | |
187 | __FILE__, __LINE__) | |
188 | ||
189 | long ((*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 | ||
306 | extern void exit_handler(); | |
307 | #ifdef BSD | |
308 | extern void cont_handler(); | |
309 | extern void stop_handler(); | |
310 | #endif /* BSD */ | |
311 | ||
312 | #ifdef EMACS | |
313 | char *genvp; | |
314 | #endif | |
315 | ||
316 | char *progname; | |
317 | char sccs_get_cmd[128]; /* sccs get command string */ | |
318 | int uflag = 0; /* controls auto execution of sccs get */ | |
319 | int vflag = 0; /* controls reporting of file names */ | |
320 | int xref_enabled = 0; | |
321 | int xref_enable_forward_refs = 0; | |
322 | int show_symbols = 0; | |
323 | int compile_errors = 0; | |
324 | int compile_msgs = 0; | |
325 | int compile_warnings = 0; | |
326 | ||
327 | /* | |
328 | * Execute the MicroEmacs editor. | |
329 | */ | |
330 | extern char *emacs_main(); | |
331 | char *fake_argv[] = { "micro-emacs", "dontexit", 0 }; | |
332 | long | |
333 | emacs(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 | ||
344 | static 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 | ||
375 | static void | |
376 | usage(void) | |
377 | { | |
378 | printf(help_msg); | |
379 | } | |
380 | ||
381 | static void | |
382 | create_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 | ||
394 | int | |
395 | main(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 | */ | |
624 | int | |
625 | getnum(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 | |
639 | void | |
640 | stop_handler(void) | |
641 | { | |
642 | restoremode(); | |
643 | kill(0, SIGSTOP); | |
644 | } | |
645 | void | |
646 | cont_handler(void) | |
647 | { | |
648 | keymode(); | |
649 | } | |
650 | #endif /* BSD */ | |
651 | ||
652 | void | |
653 | exit_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 | */ | |
669 | long | |
670 | c_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 | ||
718 | long | |
719 | c_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 | */ | |
735 | long | |
736 | c_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 | */ | |
750 | long | |
751 | fileques() | |
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 | */ | |
760 | char * | |
761 | getmem(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> | |
778 | struct termios ostate; | |
779 | struct termios lstate; | |
780 | struct termios kstate; | |
781 | struct termios kqstate; | |
782 | ||
783 | #define M_ORIG 0 | |
784 | #define M_KEY 1 | |
785 | #define M_LINE 2 | |
786 | #define M_KEYQ 3 | |
787 | static lmode = M_ORIG; | |
788 | ||
789 | void | |
790 | initline(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 | ||
838 | void | |
839 | linemode(void) | |
840 | { | |
841 | initline(); | |
842 | if (lmode != M_LINE) { | |
843 | tcsetattr(0, TCSANOW, &lstate); | |
844 | lmode = M_LINE; | |
845 | } | |
846 | } | |
847 | ||
848 | void | |
849 | keyqmode(void) | |
850 | { | |
851 | initline(); | |
852 | if (lmode != M_KEYQ) { | |
853 | tcsetattr(0, TCSANOW, &kqstate); | |
854 | lmode = M_KEYQ; | |
855 | } | |
856 | } | |
857 | ||
858 | void | |
859 | keymode(void) | |
860 | { | |
861 | initline(); | |
862 | if (lmode != M_KEY) { | |
863 | tcsetattr(0, TCSANOW, &kstate); | |
864 | lmode = M_KEY; | |
865 | } | |
866 | } | |
867 | ||
868 | void | |
869 | restoremode(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 | */ | |
883 | long | |
884 | c_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 | */ | |
903 | long | |
904 | c_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 | */ | |
915 | long | |
916 | c_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 | */ | |
927 | long | |
928 | f_crstr(void) | |
929 | { | |
930 | return ((long)"\1\n"); | |
931 | } | |
932 | ||
933 | long | |
934 | s_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 | */ | |
958 | void | |
959 | error(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. */ | |
968 | long | |
969 | syserror() | |
970 | { | |
971 | extern int errno; | |
972 | ||
973 | return ((long)errno); | |
974 | } | |
975 | ||
976 | /* Display an error message */ | |
977 | ||
978 | long | |
979 | pr_error(errnum) | |
980 | long errnum; | |
981 | { | |
982 | errno = errnum; | |
983 | perror(""); | |
984 | } | |
985 | ||
986 | long | |
987 | f_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 | ||
1006 | long | |
1007 | f_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 | ||
1015 | long | |
1016 | f_read(long fd, char *buf, long cnt) | |
1017 | { | |
1018 | return (read((int)fd, buf, cnt)); | |
1019 | } | |
1020 | ||
1021 | long | |
1022 | f_write(long fd, char *buf, long cnt) | |
1023 | { | |
1024 | return (write((int)fd, buf, cnt)); | |
1025 | } | |
1026 | ||
1027 | long | |
1028 | f_close(long fd) | |
1029 | { | |
1030 | extern int close(); | |
1031 | ||
1032 | return ((long)close((int)fd)); | |
1033 | } | |
1034 | ||
1035 | long | |
1036 | f_unlink(char *name) | |
1037 | { | |
1038 | extern int unlink(); | |
1039 | ||
1040 | return ((long)unlink(name)); | |
1041 | } | |
1042 | ||
1043 | long | |
1044 | f_lseek(long fd, long offset, long flag) | |
1045 | { | |
1046 | extern long lseek(); | |
1047 | ||
1048 | return (lseek((int)fd, offset, (int)flag)); | |
1049 | } | |
1050 | ||
1051 | long | |
1052 | f_ioctl(long fd, long code, char *buf) | |
1053 | { | |
1054 | return ((long)ioctl((int)fd, (int)code, buf)); | |
1055 | } | |
1056 | ||
1057 | long | |
1058 | s_signal(long signo, void (*adr)()) | |
1059 | { | |
1060 | return ((long)signal((int)signo, (void (*)())adr)); | |
1061 | } | |
1062 | ||
1063 | long | |
1064 | s_system(char *str) | |
1065 | { | |
1066 | int i; | |
1067 | linemode(); | |
1068 | i = system(str); | |
1069 | keymode(); | |
1070 | ||
1071 | return ((long)i); | |
1072 | } | |
1073 | ||
1074 | long | |
1075 | s_chdir(char *str) | |
1076 | { | |
1077 | return ((long)chdir(str)); | |
1078 | } | |
1079 | ||
1080 | long | |
1081 | s_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 | |
1089 | long | |
1090 | m_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 */ | |
1103 | long | |
1104 | m_free(long size, char *adr) | |
1105 | { | |
1106 | free(adr); | |
1107 | } | |
1108 | ||
1109 | long | |
1110 | f_init(void) | |
1111 | { | |
1112 | UNIMPL(f_init); | |
1113 | } | |
1114 | ||
1115 | long | |
1116 | f_op(void) | |
1117 | { | |
1118 | UNIMPL(f_op); | |
1119 | } | |
1120 | ||
1121 | long | |
1122 | f_move(void) | |
1123 | { | |
1124 | UNIMPL(f_move); | |
1125 | } | |
1126 | ||
1127 | long | |
1128 | f_rows(void) | |
1129 | { | |
1130 | UNIMPL(f_rows); | |
1131 | } | |
1132 | ||
1133 | long | |
1134 | f_cols(void) | |
1135 | { | |
1136 | UNIMPL(f_cols); | |
1137 | } | |
1138 | ||
1139 | long | |
1140 | m_sbrk(long size) | |
1141 | { | |
1142 | return ((long)sbrk(size)); | |
1143 | } | |
1144 | ||
1145 | long | |
1146 | c_getenv(char *str) | |
1147 | { | |
1148 | return ((long)getenv(str)); | |
1149 | } | |
1150 | ||
1151 | long | |
1152 | today(void) | |
1153 | { | |
1154 | long tadd; | |
1155 | extern struct tm *localtime(); | |
1156 | ||
1157 | time(&tadd); | |
1158 | return ((long)localtime(&tadd)); | |
1159 | } | |
1160 | ||
1161 | long | |
1162 | timez(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 */ | |
1184 | long | |
1185 | timezstr(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 | */ | |
1194 | long | |
1195 | s_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 | */ | |
1207 | char fnb[300]; | |
1208 | int | |
1209 | path_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 | ||
1246 | executable(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 */ | |
1256 | long | |
1257 | pathname(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 | ||
1288 | char * | |
1289 | substr(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 | ||
1313 | char * | |
1314 | sccs_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 | */ | |
1345 | int | |
1346 | isobsolete(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 | ||
1367 | char * | |
1368 | sccs_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 | ||
1381 | char * | |
1382 | expand_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 | |
1432 | long | |
1433 | find_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 | ||
1470 | long | |
1471 | stack_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 | } |