1 /*
2 * Copyright (c) 2000 Daniel Capo Sobral
3 * All rights reserved.
4 *
5 * Redistribution and use in source and binary forms, with or without
6 * modification, are permitted provided that the following conditions
7 * are met:
8 * 1. Redistributions of source code must retain the above copyright
9 * notice, this list of conditions and the following disclaimer.
10 * 2. Redistributions in binary form must reproduce the above copyright
11 * notice, this list of conditions and the following disclaimer in the
12 * documentation and/or other materials provided with the distribution.
13 *
14 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
15 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
16 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
17 * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
18 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
19 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
20 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
21 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
22 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
23 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
24 * SUCH DAMAGE.
25 *
26 * $FreeBSD$
27 */
28
29 /*
30 * l o a d e r . c
31 * Additional FICL words designed for FreeBSD's loader
32 */
33
34 #ifndef _STANDALONE
35 #include <sys/types.h>
36 #include <sys/stat.h>
37 #include <dirent.h>
38 #include <fcntl.h>
39 #include <stdio.h>
40 #include <stdlib.h>
41 #include <unistd.h>
42 #include <strings.h>
43 #include <termios.h>
44 #else
45 #include <stand.h>
46 #include "bootstrap.h"
47 #endif
48 #ifdef _STANDALONE
49 #include <uuid.h>
50 #else
51 #include <uuid/uuid.h>
52 #endif
53 #include <string.h>
54 #include "ficl.h"
55
56 /*
57 * FreeBSD's loader interaction words and extras
58 *
59 * setenv ( value n name n' -- )
60 * setenv? ( value n name n' flag -- )
61 * getenv ( addr n -- addr' n' | -1 )
62 * unsetenv ( addr n -- )
63 * copyin ( addr addr' len -- )
64 * copyout ( addr addr' len -- )
65 * findfile ( name len type len' -- addr )
66 * ccall ( [[...[p10] p9] ... p1] n addr -- result )
67 * uuid-from-string ( addr n -- addr' )
68 * uuid-to-string ( addr' -- addr n | -1 )
69 * .# ( value -- )
70 */
71
72 void
73 ficlSetenv(ficlVm *pVM)
74 {
75 char *name, *value;
76 char *namep, *valuep;
77 int names, values;
78
79 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 4, 0);
80
81 names = ficlStackPopInteger(ficlVmGetDataStack(pVM));
82 namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
83 values = ficlStackPopInteger(ficlVmGetDataStack(pVM));
84 valuep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
85
86 name = (char *)ficlMalloc(names+1);
87 if (!name)
88 ficlVmThrowError(pVM, "Error: out of memory");
89 strncpy(name, namep, names);
90 name[names] = '\0';
91 value = (char *)ficlMalloc(values+1);
92 if (!value)
93 ficlVmThrowError(pVM, "Error: out of memory");
94 strncpy(value, valuep, values);
95 value[values] = '\0';
96
97 setenv(name, value, 1);
98 ficlFree(name);
99 ficlFree(value);
100 }
101
102 void
103 ficlSetenvq(ficlVm *pVM)
104 {
105 char *name, *value;
106 char *namep, *valuep;
107 int names, values, overwrite;
108
109 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 5, 0);
110
111 overwrite = ficlStackPopInteger(ficlVmGetDataStack(pVM));
112 names = ficlStackPopInteger(ficlVmGetDataStack(pVM));
113 namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
114 values = ficlStackPopInteger(ficlVmGetDataStack(pVM));
115 valuep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
116
117 name = (char *)ficlMalloc(names+1);
118 if (!name)
119 ficlVmThrowError(pVM, "Error: out of memory");
120 strncpy(name, namep, names);
121 name[names] = '\0';
122 value = (char *)ficlMalloc(values+1);
123 if (!value)
124 ficlVmThrowError(pVM, "Error: out of memory");
125 strncpy(value, valuep, values);
126 value[values] = '\0';
127
128 setenv(name, value, overwrite);
129 ficlFree(name);
130 ficlFree(value);
131 }
132
133 void
134 ficlGetenv(ficlVm *pVM)
135 {
136 char *name, *value;
137 char *namep;
138 int names;
139
140 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 2);
141
142 names = ficlStackPopInteger(ficlVmGetDataStack(pVM));
143 namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
144
145 name = (char *)ficlMalloc(names+1);
146 if (!name)
147 ficlVmThrowError(pVM, "Error: out of memory");
148 strncpy(name, namep, names);
149 name[names] = '\0';
150
151 value = getenv(name);
152 ficlFree(name);
153
154 if (value != NULL) {
155 ficlStackPushPointer(ficlVmGetDataStack(pVM), value);
156 ficlStackPushInteger(ficlVmGetDataStack(pVM), strlen(value));
157 } else
158 ficlStackPushInteger(ficlVmGetDataStack(pVM), -1);
159 }
160
161 void
162 ficlUnsetenv(ficlVm *pVM)
163 {
164 char *name;
165 char *namep;
166 int names;
167
168 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 0);
169
170 names = ficlStackPopInteger(ficlVmGetDataStack(pVM));
171 namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
172
173 name = (char *)ficlMalloc(names+1);
174 if (!name)
175 ficlVmThrowError(pVM, "Error: out of memory");
176 strncpy(name, namep, names);
177 name[names] = '\0';
178
179 unsetenv(name);
180 ficlFree(name);
181 }
182
183 void
184 ficlCopyin(ficlVm *pVM)
185 {
186 #ifdef _STANDALONE
187 void* src;
188 vm_offset_t dest;
189 size_t len;
190 #endif
191
192 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 0);
193
194 #ifdef _STANDALONE
195 len = ficlStackPopInteger(ficlVmGetDataStack(pVM));
196 dest = ficlStackPopInteger(ficlVmGetDataStack(pVM));
197 src = ficlStackPopPointer(ficlVmGetDataStack(pVM));
198 archsw.arch_copyin(src, dest, len);
199 #else
200 (void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
201 (void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
202 (void) ficlStackPopPointer(ficlVmGetDataStack(pVM));
203 #endif
204 }
205
206 void
207 ficlCopyout(ficlVm *pVM)
208 {
209 #ifdef _STANDALONE
210 void* dest;
211 vm_offset_t src;
212 size_t len;
213 #endif
214
215 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 0);
216
217 #ifdef _STANDALONE
218 len = ficlStackPopInteger(ficlVmGetDataStack(pVM));
219 dest = ficlStackPopPointer(ficlVmGetDataStack(pVM));
220 src = ficlStackPopInteger(ficlVmGetDataStack(pVM));
221 archsw.arch_copyout(src, dest, len);
222 #else
223 (void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
224 (void) ficlStackPopPointer(ficlVmGetDataStack(pVM));
225 (void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
226 #endif
227 }
228
229 void
230 ficlFindfile(ficlVm *pVM)
231 {
232 #ifdef _STANDALONE
233 char *name, *type;
234 char *namep, *typep;
235 int names, types;
236 #endif
237 struct preloaded_file *fp;
238
239 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 4, 1);
240
241 #ifdef _STANDALONE
242 types = ficlStackPopInteger(ficlVmGetDataStack(pVM));
243 typep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
244 names = ficlStackPopInteger(ficlVmGetDataStack(pVM));
245 namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM));
246
247 name = (char *)ficlMalloc(names+1);
248 if (!name)
249 ficlVmThrowError(pVM, "Error: out of memory");
250 strncpy(name, namep, names);
251 name[names] = '\0';
252 type = (char *)ficlMalloc(types+1);
253 if (!type)
254 ficlVmThrowError(pVM, "Error: out of memory");
255 strncpy(type, typep, types);
256 type[types] = '\0';
257
258 fp = file_findfile(name, type);
259 #else
260 (void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
261 (void) ficlStackPopPointer(ficlVmGetDataStack(pVM));
262 (void) ficlStackPopInteger(ficlVmGetDataStack(pVM));
263 (void) ficlStackPopPointer(ficlVmGetDataStack(pVM));
264
265 fp = NULL;
266 #endif
267 ficlStackPushPointer(ficlVmGetDataStack(pVM), fp);
268 }
269
270 void
271 ficlCcall(ficlVm *pVM)
272 {
273 int (*func)(int, ...);
274 int result, p[10];
275 int nparam, i;
276
277 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 0);
278
279 func = (int (*)(int, ...))ficlStackPopPointer(ficlVmGetDataStack(pVM));
280 nparam = ficlStackPopInteger(ficlVmGetDataStack(pVM));
281
282 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), nparam, 1);
283
284 for (i = 0; i < nparam; i++)
285 p[i] = ficlStackPopInteger(ficlVmGetDataStack(pVM));
286
287 result = func(p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7], p[8],
288 p[9]);
289
290 ficlStackPushInteger(ficlVmGetDataStack(pVM), result);
291 }
292
293 void
294 ficlUuidFromString(ficlVm *pVM)
295 {
296 char *uuid;
297 char *uuid_ptr;
298 int uuid_size;
299 uuid_t *u;
300 #ifdef _STANDALONE
301 uint32_t status;
302 #else
303 int status;
304 #endif
305
306 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 0);
307
308 uuid_size = ficlStackPopInteger(ficlVmGetDataStack(pVM));
309 uuid_ptr = ficlStackPopPointer(ficlVmGetDataStack(pVM));
310
311 uuid = ficlMalloc(uuid_size + 1);
312 if (!uuid)
313 ficlVmThrowError(pVM, "Error: out of memory");
314 (void) memcpy(uuid, uuid_ptr, uuid_size);
315 uuid[uuid_size] = '\0';
316
317 u = ficlMalloc(sizeof (*u));
318 #ifdef _STANDALONE
319 uuid_from_string(uuid, u, &status);
320 ficlFree(uuid);
321 if (status != uuid_s_ok) {
322 ficlFree(u);
323 u = NULL;
324 }
325 #else
326 status = uuid_parse(uuid, *u);
327 ficlFree(uuid);
328 if (status != 0) {
329 ficlFree(u);
330 u = NULL;
331 }
332 #endif
333 ficlStackPushPointer(ficlVmGetDataStack(pVM), u);
334 }
335
336 void
337 ficlUuidToString(ficlVm *pVM)
338 {
339 char *uuid;
340 uuid_t *u;
341 #ifdef _STANDALONE
342 uint32_t status;
343 #endif
344
345 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0);
346
347 u = ficlStackPopPointer(ficlVmGetDataStack(pVM));
348 #ifdef _STANDALONE
349 uuid_to_string(u, &uuid, &status);
350 if (status == uuid_s_ok) {
351 ficlStackPushPointer(ficlVmGetDataStack(pVM), uuid);
352 ficlStackPushInteger(ficlVmGetDataStack(pVM), strlen(uuid));
353 } else
354 #else
355 uuid = ficlMalloc(UUID_PRINTABLE_STRING_LENGTH);
356 if (uuid != NULL) {
357 uuid_unparse(*u, uuid);
358 ficlStackPushPointer(ficlVmGetDataStack(pVM), uuid);
359 ficlStackPushInteger(ficlVmGetDataStack(pVM), strlen(uuid));
360 } else
361 #endif
362 ficlStackPushInteger(ficlVmGetDataStack(pVM), -1);
363 }
364
365 /*
366 * f i c l E x e c F D
367 * reads in text from file fd and passes it to ficlExec()
368 * returns FICL_VM_STATUS_OUT_OF_TEXT on success or the ficlExec() error
369 * code on failure.
370 */
371 #define nLINEBUF 256
372 int
373 ficlExecFD(ficlVm *pVM, int fd)
374 {
375 char cp[nLINEBUF];
376 int nLine = 0, rval = FICL_VM_STATUS_OUT_OF_TEXT;
377 char ch;
378 ficlCell id;
379 ficlString s;
380
381 id = pVM->sourceId;
382 pVM->sourceId.i = fd+1; /* in loader we can get 0, there is no stdin */
383
384 /* feed each line to ficlExec */
385 while (1) {
386 int status, i;
387
388 i = 0;
389 while ((status = read(fd, &ch, 1)) > 0 && ch != '\n')
390 cp[i++] = ch;
391 nLine++;
392 if (!i) {
393 if (status < 1)
394 break;
395 continue;
396 }
397 if (cp[i] == '\n')
398 cp[i] = '\0';
399
400 FICL_STRING_SET_POINTER(s, cp);
401 FICL_STRING_SET_LENGTH(s, i);
402
403 rval = ficlVmExecuteString(pVM, s);
404 if (rval != FICL_VM_STATUS_QUIT &&
405 rval != FICL_VM_STATUS_USER_EXIT &&
406 rval != FICL_VM_STATUS_OUT_OF_TEXT) {
407 pVM->sourceId = id;
408 (void) ficlVmEvaluate(pVM, "");
409 return (rval);
410 }
411 }
412 pVM->sourceId = id;
413
414 /*
415 * Pass an empty line with SOURCE-ID == -1 to flush
416 * any pending REFILLs (as required by FILE wordset)
417 */
418 (void) ficlVmEvaluate(pVM, "");
419
420 if (rval == FICL_VM_STATUS_USER_EXIT)
421 ficlVmThrow(pVM, FICL_VM_STATUS_USER_EXIT);
422
423 return (rval);
424 }
425
426 static void displayCellNoPad(ficlVm *pVM)
427 {
428 ficlCell c;
429 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0);
430
431 c = ficlStackPop(ficlVmGetDataStack(pVM));
432 ficlLtoa((c).i, pVM->pad, pVM->base);
433 ficlVmTextOut(pVM, pVM->pad);
434 }
435
436 /*
437 * isdir? - Return whether an fd corresponds to a directory.
438 *
439 * isdir? ( fd -- bool )
440 */
441 static void
442 isdirQuestion(ficlVm *pVM)
443 {
444 struct stat sb;
445 ficlInteger flag;
446 int fd;
447
448 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 1);
449
450 fd = ficlStackPopInteger(ficlVmGetDataStack(pVM));
451 flag = FICL_FALSE;
452 do {
453 if (fd < 0)
454 break;
455 if (fstat(fd, &sb) < 0)
456 break;
457 if (!S_ISDIR(sb.st_mode))
458 break;
459 flag = FICL_TRUE;
460 } while (0);
461 ficlStackPushInteger(ficlVmGetDataStack(pVM), flag);
462 }
463
464 /*
465 * fopen - open a file and return new fd on stack.
466 *
467 * fopen ( ptr count mode -- fd )
468 */
469 extern char *get_dev(const char *);
470
471 static void
472 pfopen(ficlVm *pVM)
473 {
474 int mode, fd, count;
475 char *ptr, *name;
476 #ifndef _STANDALONE
477 char *tmp;
478 #endif
479
480 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 1);
481
482 mode = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get mode */
483 count = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get count */
484 ptr = ficlStackPopPointer(ficlVmGetDataStack(pVM)); /* get ptr */
485
486 if ((count < 0) || (ptr == NULL)) {
487 ficlStackPushInteger(ficlVmGetDataStack(pVM), -1);
488 return;
489 }
490
491 /* ensure that the string is null terminated */
492 name = (char *)malloc(count+1);
493 bcopy(ptr, name, count);
494 name[count] = 0;
495 #ifndef _STANDALONE
496 tmp = get_dev(name);
497 free(name);
498 name = tmp;
499 #endif
500
501 /* open the file */
502 fd = open(name, mode);
503 free(name);
504 ficlStackPushInteger(ficlVmGetDataStack(pVM), fd);
505 }
506
507 /*
508 * fclose - close a file who's fd is on stack.
509 * fclose ( fd -- )
510 */
511 static void
512 pfclose(ficlVm *pVM)
513 {
514 int fd;
515
516 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0);
517
518 fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */
519 if (fd != -1)
520 close(fd);
521 }
522
523 /*
524 * fread - read file contents
525 * fread ( fd buf nbytes -- nread )
526 */
527 static void
528 pfread(ficlVm *pVM)
529 {
530 int fd, len;
531 char *buf;
532
533 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 1);
534
535 len = ficlStackPopInteger(ficlVmGetDataStack(pVM));
536 buf = ficlStackPopPointer(ficlVmGetDataStack(pVM)); /* get buffer */
537 fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */
538 if (len > 0 && buf && fd != -1)
539 ficlStackPushInteger(ficlVmGetDataStack(pVM),
540 read(fd, buf, len));
541 else
542 ficlStackPushInteger(ficlVmGetDataStack(pVM), -1);
543 }
544
545 /*
546 * fopendir - open directory
547 *
548 * fopendir ( addr len -- ptr TRUE | FALSE )
549 */
550 static void pfopendir(ficlVm *pVM)
551 {
552 #ifndef _STANDALONE
553 DIR *dir;
554 char *tmp;
555 #else
556 struct stat sb;
557 int fd;
558 #endif
559 int count;
560 char *ptr, *name;
561 ficlInteger flag = FICL_FALSE;
562
563 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 1);
564
565 count = ficlStackPopInteger(ficlVmGetDataStack(pVM));
566 ptr = ficlStackPopPointer(ficlVmGetDataStack(pVM)); /* get ptr */
567
568 if ((count < 0) || (ptr == NULL)) {
569 ficlStackPushInteger(ficlVmGetDataStack(pVM), -1);
570 return;
571 }
572 /* ensure that the string is null terminated */
573 name = (char *)malloc(count+1);
574 bcopy(ptr, name, count);
575 name[count] = 0;
576 #ifndef _STANDALONE
577 tmp = get_dev(name);
578 free(name);
579 name = tmp;
580 #else
581 fd = open(name, O_RDONLY);
582 free(name);
583 do {
584 if (fd < 0)
585 break;
586 if (fstat(fd, &sb) < 0)
587 break;
588 if (!S_ISDIR(sb.st_mode))
589 break;
590 flag = FICL_TRUE;
591 ficlStackPushInteger(ficlVmGetDataStack(pVM), fd);
592 ficlStackPushInteger(ficlVmGetDataStack(pVM), flag);
593 return;
594 } while (0);
595
596 if (fd >= 0)
597 close(fd);
598
599 ficlStackPushInteger(ficlVmGetDataStack(pVM), flag);
600 return;
601 #endif
602 #ifndef _STANDALONE
603 dir = opendir(name);
604 if (dir == NULL) {
605 ficlStackPushInteger(ficlVmGetDataStack(pVM), flag);
606 return;
607 } else
608 flag = FICL_TRUE;
609
610 ficlStackPushPointer(ficlVmGetDataStack(pVM), dir);
611 ficlStackPushInteger(ficlVmGetDataStack(pVM), flag);
612 #endif
613 }
614
615 /*
616 * freaddir - read directory contents
617 * freaddir ( fd -- ptr len TRUE | FALSE )
618 */
619 static void
620 pfreaddir(ficlVm *pVM)
621 {
622 #ifndef _STANDALONE
623 static DIR *dir = NULL;
624 #else
625 int fd;
626 #endif
627 struct dirent *d = NULL;
628
629 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 3);
630 /*
631 * libstand readdir does not always return . nor .. so filter
632 * them out to have consistent behaviour.
633 */
634 #ifndef _STANDALONE
635 dir = ficlStackPopPointer(ficlVmGetDataStack(pVM));
636 if (dir != NULL)
637 do {
638 d = readdir(dir);
639 if (d != NULL && strcmp(d->d_name, ".") == 0)
640 continue;
641 if (d != NULL && strcmp(d->d_name, "..") == 0)
642 continue;
643 break;
644 } while (d != NULL);
645 #else
646 fd = ficlStackPopInteger(ficlVmGetDataStack(pVM));
647 if (fd != -1)
648 do {
649 d = readdirfd(fd);
650 if (d != NULL && strcmp(d->d_name, ".") == 0)
651 continue;
652 if (d != NULL && strcmp(d->d_name, "..") == 0)
653 continue;
654 break;
655 } while (d != NULL);
656 #endif
657 if (d != NULL) {
658 ficlStackPushPointer(ficlVmGetDataStack(pVM), d->d_name);
659 ficlStackPushInteger(ficlVmGetDataStack(pVM),
660 strlen(d->d_name));
661 ficlStackPushInteger(ficlVmGetDataStack(pVM), FICL_TRUE);
662 } else {
663 ficlStackPushInteger(ficlVmGetDataStack(pVM), FICL_FALSE);
664 }
665 }
666
667 /*
668 * fclosedir - close a dir on stack.
669 *
670 * fclosedir ( fd -- )
671 */
672 static void
673 pfclosedir(ficlVm *pVM)
674 {
675 #ifndef _STANDALONE
676 DIR *dir;
677 #else
678 int fd;
679 #endif
680
681 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0);
682
683 #ifndef _STANDALONE
684 dir = ficlStackPopPointer(ficlVmGetDataStack(pVM)); /* get dir */
685 if (dir != NULL)
686 closedir(dir);
687 #else
688 fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */
689 if (fd != -1)
690 close(fd);
691 #endif
692 }
693
694 /*
695 * fload - interpret file contents
696 *
697 * fload ( fd -- )
698 */
699 static void pfload(ficlVm *pVM)
700 {
701 int fd;
702
703 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0);
704
705 fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */
706 if (fd != -1)
707 ficlExecFD(pVM, fd);
708 }
709
710 /*
711 * fwrite - write file contents
712 *
713 * fwrite ( fd buf nbytes -- nwritten )
714 */
715 static void
716 pfwrite(ficlVm *pVM)
717 {
718 int fd, len;
719 char *buf;
720
721 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 1);
722
723 len = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* bytes to read */
724 buf = ficlStackPopPointer(ficlVmGetDataStack(pVM)); /* get buffer */
725 fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */
726 if (len > 0 && buf && fd != -1)
727 ficlStackPushInteger(ficlVmGetDataStack(pVM),
728 write(fd, buf, len));
729 else
730 ficlStackPushInteger(ficlVmGetDataStack(pVM), -1);
731 }
732
733 /*
734 * fseek - seek to a new position in a file
735 *
736 * fseek ( fd ofs whence -- pos )
737 */
738 static void
739 pfseek(ficlVm *pVM)
740 {
741 int fd, pos, whence;
742
743 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 1);
744
745 whence = ficlStackPopInteger(ficlVmGetDataStack(pVM));
746 pos = ficlStackPopInteger(ficlVmGetDataStack(pVM));
747 fd = ficlStackPopInteger(ficlVmGetDataStack(pVM));
748 ficlStackPushInteger(ficlVmGetDataStack(pVM), lseek(fd, pos, whence));
749 }
750
751 /*
752 * key - get a character from stdin
753 *
754 * key ( -- char )
755 */
756 static void
757 key(ficlVm *pVM)
758 {
759 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 0, 1);
760
761 ficlStackPushInteger(ficlVmGetDataStack(pVM), getchar());
762 }
763
764 /*
765 * key? - check for a character from stdin (FACILITY)
766 * key? ( -- flag )
767 */
768 static void
769 keyQuestion(ficlVm *pVM)
770 {
771 #ifndef _STANDALONE
772 char ch = -1;
773 struct termios oldt;
774 struct termios newt;
775 #endif
776
777 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 0, 1);
778
779 #ifndef _STANDALONE
780 tcgetattr(STDIN_FILENO, &oldt);
781 newt = oldt;
782 newt.c_lflag &= ~(ICANON | ECHO);
783 newt.c_cc[VMIN] = 0;
784 newt.c_cc[VTIME] = 0;
785 tcsetattr(STDIN_FILENO, TCSANOW, &newt);
786 ch = getchar();
787 tcsetattr(STDIN_FILENO, TCSANOW, &oldt);
788
789 if (ch != -1)
790 (void) ungetc(ch, stdin);
791
792 ficlStackPushInteger(ficlVmGetDataStack(pVM),
793 ch != -1? FICL_TRUE : FICL_FALSE);
794 #else
795 ficlStackPushInteger(ficlVmGetDataStack(pVM),
796 ischar()? FICL_TRUE : FICL_FALSE);
797 #endif
798 }
799
800 /*
801 * seconds - gives number of seconds since beginning of time
802 *
803 * beginning of time is defined as:
804 *
805 * BTX - number of seconds since midnight
806 * FreeBSD - number of seconds since Jan 1 1970
807 *
808 * seconds ( -- u )
809 */
810 static void
811 pseconds(ficlVm *pVM)
812 {
813 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 0, 1);
814
815 ficlStackPushUnsigned(ficlVmGetDataStack(pVM),
816 (ficlUnsigned) time(NULL));
817 }
818
819 /*
820 * ms - wait at least that many milliseconds (FACILITY)
821 * ms ( u -- )
822 */
823 static void
824 ms(ficlVm *pVM)
825 {
826 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0);
827
828 #ifndef _STANDALONE
829 usleep(ficlStackPopUnsigned(ficlVmGetDataStack(pVM)) * 1000);
830 #else
831 delay(ficlStackPopUnsigned(ficlVmGetDataStack(pVM)) * 1000);
832 #endif
833 }
834
835 /*
836 * fkey - get a character from a file
837 * fkey ( file -- char )
838 */
839 static void
840 fkey(ficlVm *pVM)
841 {
842 int i, fd;
843 char ch;
844
845 FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 1);
846
847 fd = ficlStackPopInteger(ficlVmGetDataStack(pVM));
848 i = read(fd, &ch, 1);
849 ficlStackPushInteger(ficlVmGetDataStack(pVM), i > 0 ? ch : -1);
850 }
851
852 /*
853 * Retrieves free space remaining on the dictionary
854 */
855 static void
856 freeHeap(ficlVm *pVM)
857 {
858 ficlStackPushInteger(ficlVmGetDataStack(pVM),
859 ficlDictionaryCellsAvailable(ficlVmGetDictionary(pVM)));
860 }
861
862 /*
863 * f i c l C o m p i l e P l a t f o r m
864 * Build FreeBSD platform extensions into the system dictionary
865 */
866 void
867 ficlSystemCompilePlatform(ficlSystem *pSys)
868 {
869 ficlDictionary *dp = ficlSystemGetDictionary(pSys);
870 ficlDictionary *env = ficlSystemGetEnvironment(pSys);
871 #ifdef _STANDALONE
872 ficlCompileFcn **fnpp;
873 #endif
874
875 FICL_SYSTEM_ASSERT(pSys, dp);
876 FICL_SYSTEM_ASSERT(pSys, env);
877
878 ficlDictionarySetPrimitive(dp, ".#", displayCellNoPad,
879 FICL_WORD_DEFAULT);
880 ficlDictionarySetPrimitive(dp, "isdir?", isdirQuestion,
881 FICL_WORD_DEFAULT);
882 ficlDictionarySetPrimitive(dp, "fopen", pfopen, FICL_WORD_DEFAULT);
883 ficlDictionarySetPrimitive(dp, "fclose", pfclose, FICL_WORD_DEFAULT);
884 ficlDictionarySetPrimitive(dp, "fread", pfread, FICL_WORD_DEFAULT);
885 ficlDictionarySetPrimitive(dp, "fopendir", pfopendir,
886 FICL_WORD_DEFAULT);
887 ficlDictionarySetPrimitive(dp, "freaddir", pfreaddir,
888 FICL_WORD_DEFAULT);
889 ficlDictionarySetPrimitive(dp, "fclosedir", pfclosedir,
890 FICL_WORD_DEFAULT);
891 ficlDictionarySetPrimitive(dp, "fload", pfload, FICL_WORD_DEFAULT);
892 ficlDictionarySetPrimitive(dp, "fkey", fkey, FICL_WORD_DEFAULT);
893 ficlDictionarySetPrimitive(dp, "fseek", pfseek, FICL_WORD_DEFAULT);
894 ficlDictionarySetPrimitive(dp, "fwrite", pfwrite, FICL_WORD_DEFAULT);
895 ficlDictionarySetPrimitive(dp, "key", key, FICL_WORD_DEFAULT);
896 ficlDictionarySetPrimitive(dp, "key?", keyQuestion, FICL_WORD_DEFAULT);
897 ficlDictionarySetPrimitive(dp, "ms", ms, FICL_WORD_DEFAULT);
898 ficlDictionarySetPrimitive(dp, "seconds", pseconds, FICL_WORD_DEFAULT);
899 ficlDictionarySetPrimitive(dp, "heap?", freeHeap, FICL_WORD_DEFAULT);
900
901 ficlDictionarySetPrimitive(dp, "setenv", ficlSetenv, FICL_WORD_DEFAULT);
902 ficlDictionarySetPrimitive(dp, "setenv?", ficlSetenvq,
903 FICL_WORD_DEFAULT);
904 ficlDictionarySetPrimitive(dp, "getenv", ficlGetenv, FICL_WORD_DEFAULT);
905 ficlDictionarySetPrimitive(dp, "unsetenv", ficlUnsetenv,
906 FICL_WORD_DEFAULT);
907 ficlDictionarySetPrimitive(dp, "copyin", ficlCopyin, FICL_WORD_DEFAULT);
908 ficlDictionarySetPrimitive(dp, "copyout", ficlCopyout,
909 FICL_WORD_DEFAULT);
910 ficlDictionarySetPrimitive(dp, "findfile", ficlFindfile,
911 FICL_WORD_DEFAULT);
912 ficlDictionarySetPrimitive(dp, "ccall", ficlCcall, FICL_WORD_DEFAULT);
913 ficlDictionarySetPrimitive(dp, "uuid-from-string", ficlUuidFromString,
914 FICL_WORD_DEFAULT);
915 ficlDictionarySetPrimitive(dp, "uuid-to-string", ficlUuidToString,
916 FICL_WORD_DEFAULT);
917 #ifdef _STANDALONE
918 /* Register words from linker set. */
919 SET_FOREACH(fnpp, Xficl_compile_set)
920 (*fnpp)(pSys);
921 #endif
922
923 #if defined(__i386__) || defined(__amd64__)
924 ficlDictionarySetConstant(env, "arch-i386", FICL_TRUE);
925 ficlDictionarySetConstant(env, "arch-sparc", FICL_FALSE);
926 #endif
927 #ifdef __sparc
928 ficlDictionarySetConstant(env, "arch-i386", FICL_FALSE);
929 ficlDictionarySetConstant(env, "arch-sparc", FICL_TRUE);
930 #endif
931 }