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 35#ifdef TESTMAIN 36#include <sys/types.h> 37#include <sys/stat.h> 38#include <dirent.h> 39#include <fcntl.h> 40#include <stdio.h> 41#include <stdlib.h> 42#include <unistd.h> 43#else 44#include <stand.h> 45#endif 46#include "bootstrap.h" 47#include <string.h> 48#include <uuid.h> 49#include "ficl.h" 50 51/* FreeBSD's loader interaction words and extras 52 * 53 * setenv ( value n name n' -- ) 54 * setenv? ( value n name n' flag -- ) 55 * getenv ( addr n -- addr' n' | -1 ) 56 * unsetenv ( addr n -- ) 57 * copyin ( addr addr' len -- ) 58 * copyout ( addr addr' len -- ) 59 * findfile ( name len type len' -- addr ) 60 * pnpdevices ( -- addr ) 61 * pnphandlers ( -- addr ) 62 * ccall ( [[...[p10] p9] ... p1] n addr -- result ) 63 * uuid-from-string ( addr n -- addr' ) 64 * uuid-to-string ( addr' -- addr n ) 65 * .# ( value -- ) 66 */ 67 68void 69ficlSetenv(FICL_VM *pVM) 70{ 71#ifndef TESTMAIN 72 char *name, *value; 73#endif 74 char *namep, *valuep; 75 int names, values; 76 77#if FICL_ROBUST > 1 78 vmCheckStack(pVM, 4, 0); 79#endif 80 names = stackPopINT(pVM->pStack); 81 namep = (char*) stackPopPtr(pVM->pStack); 82 values = stackPopINT(pVM->pStack); 83 valuep = (char*) stackPopPtr(pVM->pStack); 84 85#ifndef TESTMAIN 86 name = (char*) ficlMalloc(names+1); 87 if (!name) 88 vmThrowErr(pVM, "Error: out of memory"); 89 strncpy(name, namep, names); 90 name[names] = '\0'; 91 value = (char*) ficlMalloc(values+1); 92 if (!value) 93 vmThrowErr(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#endif 101 102 return; 103} 104 105void 106ficlSetenvq(FICL_VM *pVM) 107{ 108#ifndef TESTMAIN 109 char *name, *value; 110#endif 111 char *namep, *valuep; 112 int names, values, overwrite; 113 114#if FICL_ROBUST > 1 115 vmCheckStack(pVM, 5, 0); 116#endif 117 overwrite = stackPopINT(pVM->pStack); 118 names = stackPopINT(pVM->pStack); 119 namep = (char*) stackPopPtr(pVM->pStack); 120 values = stackPopINT(pVM->pStack); 121 valuep = (char*) stackPopPtr(pVM->pStack); 122 123#ifndef TESTMAIN 124 name = (char*) ficlMalloc(names+1); 125 if (!name) 126 vmThrowErr(pVM, "Error: out of memory"); 127 strncpy(name, namep, names); 128 name[names] = '\0'; 129 value = (char*) ficlMalloc(values+1); 130 if (!value) 131 vmThrowErr(pVM, "Error: out of memory"); 132 strncpy(value, valuep, values); 133 value[values] = '\0'; 134 135 setenv(name, value, overwrite); 136 ficlFree(name); 137 ficlFree(value); 138#endif 139 140 return; 141} 142 143void 144ficlGetenv(FICL_VM *pVM) 145{ 146#ifndef TESTMAIN 147 char *name, *value; 148#endif 149 char *namep; 150 int names; 151 152#if FICL_ROBUST > 1 153 vmCheckStack(pVM, 2, 2); 154#endif 155 names = stackPopINT(pVM->pStack); 156 namep = (char*) stackPopPtr(pVM->pStack); 157 158#ifndef TESTMAIN 159 name = (char*) ficlMalloc(names+1); 160 if (!name) 161 vmThrowErr(pVM, "Error: out of memory"); 162 strncpy(name, namep, names); 163 name[names] = '\0'; 164 165 value = getenv(name); 166 ficlFree(name); 167 168 if(value != NULL) { 169 stackPushPtr(pVM->pStack, value); 170 stackPushINT(pVM->pStack, strlen(value)); 171 } else 172#endif 173 stackPushINT(pVM->pStack, -1); 174 175 return; 176} 177 178void 179ficlUnsetenv(FICL_VM *pVM) 180{ 181#ifndef TESTMAIN 182 char *name; 183#endif 184 char *namep; 185 int names; 186 187#if FICL_ROBUST > 1 188 vmCheckStack(pVM, 2, 0); 189#endif 190 names = stackPopINT(pVM->pStack); 191 namep = (char*) stackPopPtr(pVM->pStack); 192 193#ifndef TESTMAIN 194 name = (char*) ficlMalloc(names+1); 195 if (!name) 196 vmThrowErr(pVM, "Error: out of memory"); 197 strncpy(name, namep, names); 198 name[names] = '\0'; 199 200 unsetenv(name); 201 ficlFree(name); 202#endif 203 204 return; 205} 206 207void 208ficlCopyin(FICL_VM *pVM) 209{ 210 void* src; 211 vm_offset_t dest; 212 size_t len; 213 214#if FICL_ROBUST > 1 215 vmCheckStack(pVM, 3, 0); 216#endif 217 218 len = stackPopINT(pVM->pStack); 219 dest = stackPopINT(pVM->pStack); 220 src = stackPopPtr(pVM->pStack); 221 222#ifndef TESTMAIN 223 archsw.arch_copyin(src, dest, len); 224#endif 225 226 return; 227} 228 229void 230ficlCopyout(FICL_VM *pVM) 231{ 232 void* dest; 233 vm_offset_t src; 234 size_t len; 235 236#if FICL_ROBUST > 1 237 vmCheckStack(pVM, 3, 0); 238#endif 239 240 len = stackPopINT(pVM->pStack); 241 dest = stackPopPtr(pVM->pStack); 242 src = stackPopINT(pVM->pStack); 243 244#ifndef TESTMAIN 245 archsw.arch_copyout(src, dest, len); 246#endif 247 248 return; 249} 250 251void 252ficlFindfile(FICL_VM *pVM) 253{ 254#ifndef TESTMAIN 255 char *name, *type; 256#endif 257 char *namep, *typep; 258 struct preloaded_file* fp; 259 int names, types; 260 261#if FICL_ROBUST > 1 262 vmCheckStack(pVM, 4, 1); 263#endif 264 265 types = stackPopINT(pVM->pStack); 266 typep = (char*) stackPopPtr(pVM->pStack); 267 names = stackPopINT(pVM->pStack); 268 namep = (char*) stackPopPtr(pVM->pStack); 269#ifndef TESTMAIN 270 name = (char*) ficlMalloc(names+1); 271 if (!name) 272 vmThrowErr(pVM, "Error: out of memory"); 273 strncpy(name, namep, names); 274 name[names] = '\0'; 275 type = (char*) ficlMalloc(types+1); 276 if (!type) 277 vmThrowErr(pVM, "Error: out of memory"); 278 strncpy(type, typep, types); 279 type[types] = '\0'; 280 281 fp = file_findfile(name, type); 282#else 283 fp = NULL; 284#endif 285 stackPushPtr(pVM->pStack, fp); 286 287 return; 288} 289 290#ifndef TESTMAIN 291 292/* isvirtualized? - Return whether the loader runs under a 293 * hypervisor. 294 * 295 * isvirtualized? ( -- flag ) 296 */ 297static void 298ficlIsvirtualizedQ(FICL_VM *pVM) 299{ 300 FICL_INT flag; 301 const char *hv; 302 303#if FICL_ROBUST > 1 304 vmCheckStack(pVM, 0, 1); 305#endif 306 307 hv = (archsw.arch_hypervisor != NULL) 308 ? (*archsw.arch_hypervisor)() 309 : NULL; 310 flag = (hv != NULL) ? FICL_TRUE : FICL_FALSE; 311 stackPushINT(pVM->pStack, flag); 312} 313 314#endif /* ndef TESTMAIN */ 315 316void 317ficlCcall(FICL_VM *pVM) 318{ 319 int (*func)(int, ...); 320 int result, p[10]; 321 int nparam, i; 322 323#if FICL_ROBUST > 1 324 vmCheckStack(pVM, 2, 0); 325#endif 326 327 func = stackPopPtr(pVM->pStack); 328 nparam = stackPopINT(pVM->pStack); 329 330#if FICL_ROBUST > 1 331 vmCheckStack(pVM, nparam, 1); 332#endif 333 334 for (i = 0; i < nparam; i++) 335 p[i] = stackPopINT(pVM->pStack); 336 337 result = func(p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7], p[8], 338 p[9]); 339 340 stackPushINT(pVM->pStack, result); 341 342 return; 343} 344 345void 346ficlUuidFromString(FICL_VM *pVM) 347{ 348#ifndef TESTMAIN 349 char *uuid; 350 uint32_t status; 351#endif 352 char *uuidp; 353 int uuids; 354 uuid_t *u; 355 356#if FICL_ROBUST > 1 357 vmCheckStack(pVM, 2, 0); 358#endif 359 360 uuids = stackPopINT(pVM->pStack); 361 uuidp = (char *) stackPopPtr(pVM->pStack); 362 363#ifndef TESTMAIN 364 uuid = (char *)ficlMalloc(uuids + 1); 365 if (!uuid) 366 vmThrowErr(pVM, "Error: out of memory"); 367 strncpy(uuid, uuidp, uuids); 368 uuid[uuids] = '\0'; 369 370 u = (uuid_t *)ficlMalloc(sizeof (*u)); 371 372 uuid_from_string(uuid, u, &status); 373 ficlFree(uuid); 374 if (status != uuid_s_ok) { 375 ficlFree(u); 376 u = NULL; 377 } 378#else 379 u = NULL; 380#endif 381 stackPushPtr(pVM->pStack, u); 382 383 384 return; 385} 386 387void 388ficlUuidToString(FICL_VM *pVM) 389{ 390#ifndef TESTMAIN 391 char *uuid; 392 uint32_t status; 393#endif 394 uuid_t *u; 395 396#if FICL_ROBUST > 1 397 vmCheckStack(pVM, 1, 0); 398#endif 399 400 u = (uuid_t *)stackPopPtr(pVM->pStack); 401 402#ifndef TESTMAIN 403 uuid_to_string(u, &uuid, &status); 404 if (status != uuid_s_ok) { 405 stackPushPtr(pVM->pStack, uuid); 406 stackPushINT(pVM->pStack, strlen(uuid)); 407 } else 408#endif 409 stackPushINT(pVM->pStack, -1); 410 411 return; 412} 413 414/************************************************************************** 415 f i c l E x e c F D 416** reads in text from file fd and passes it to ficlExec() 417 * returns VM_OUTOFTEXT on success or the ficlExec() error code on 418 * failure. 419 */ 420#define nLINEBUF 256 421int ficlExecFD(FICL_VM *pVM, int fd) 422{ 423 char cp[nLINEBUF]; 424 int nLine = 0, rval = VM_OUTOFTEXT; 425 char ch; 426 CELL id; 427 428 id = pVM->sourceID; 429 pVM->sourceID.i = fd; 430 431 /* feed each line to ficlExec */ 432 while (1) { 433 int status, i; 434 435 i = 0; 436 while ((status = read(fd, &ch, 1)) > 0 && ch != '\n') 437 cp[i++] = ch; 438 nLine++; 439 if (!i) { 440 if (status < 1) 441 break; 442 continue; 443 } 444 rval = ficlExecC(pVM, cp, i); 445 if(rval != VM_QUIT && rval != VM_USEREXIT && rval != VM_OUTOFTEXT) 446 { 447 pVM->sourceID = id; 448 return rval; 449 } 450 } 451 /* 452 ** Pass an empty line with SOURCE-ID == -1 to flush 453 ** any pending REFILLs (as required by FILE wordset) 454 */ 455 pVM->sourceID.i = -1; 456 ficlExec(pVM, ""); 457 458 pVM->sourceID = id; 459 return rval; 460} 461 462static void displayCellNoPad(FICL_VM *pVM) 463{ 464 CELL c; 465#if FICL_ROBUST > 1 466 vmCheckStack(pVM, 1, 0); 467#endif 468 c = stackPop(pVM->pStack); 469 ltoa((c).i, pVM->pad, pVM->base); 470 vmTextOut(pVM, pVM->pad, 0); 471 return; 472} 473 474/* isdir? - Return whether an fd corresponds to a directory. 475 * 476 * isdir? ( fd -- bool ) 477 */ 478static void isdirQuestion(FICL_VM *pVM) 479{ 480 struct stat sb; 481 FICL_INT flag; 482 int fd; 483 484#if FICL_ROBUST > 1 485 vmCheckStack(pVM, 1, 1); 486#endif 487 488 fd = stackPopINT(pVM->pStack); 489 flag = FICL_FALSE; 490 do { 491 if (fd < 0) 492 break; 493 if (fstat(fd, &sb) < 0) 494 break; 495 if (!S_ISDIR(sb.st_mode)) 496 break; 497 flag = FICL_TRUE; 498 } while (0); 499 stackPushINT(pVM->pStack, flag); 500} 501 502/* fopen - open a file and return new fd on stack. 503 * 504 * fopen ( ptr count mode -- fd ) 505 */ 506static void pfopen(FICL_VM *pVM) 507{ 508 int mode, fd, count; 509 char *ptr, *name; 510 511#if FICL_ROBUST > 1 512 vmCheckStack(pVM, 3, 1); 513#endif 514 515 mode = stackPopINT(pVM->pStack); /* get mode */ 516 count = stackPopINT(pVM->pStack); /* get count */ 517 ptr = stackPopPtr(pVM->pStack); /* get ptr */ 518 519 if ((count < 0) || (ptr == NULL)) { 520 stackPushINT(pVM->pStack, -1); 521 return; 522 } 523 524 /* ensure that the string is null terminated */ 525 name = (char *)malloc(count+1); 526 bcopy(ptr,name,count); 527 name[count] = 0; 528 529 /* open the file */ 530 fd = open(name, mode); 531#ifdef LOADER_VERIEXEC 532 if (fd >= 0) { 533 if (verify_file(fd, name, 0, VE_GUESS, __func__) < 0) { 534 /* not verified writing ok but reading is not */ 535 if ((mode & O_ACCMODE) != O_WRONLY) { 536 close(fd); 537 fd = -1; 538 } 539 } else { 540 /* verified reading ok but writing is not */ 541 if ((mode & O_ACCMODE) != O_RDONLY) { 542 close(fd); 543 fd = -1; 544 } 545 } 546 } 547#endif 548 free(name); 549 stackPushINT(pVM->pStack, fd); 550 return; 551} 552 553/* fclose - close a file who's fd is on stack. 554 * 555 * fclose ( fd -- ) 556 */ 557static void pfclose(FICL_VM *pVM) 558{ 559 int fd; 560 561#if FICL_ROBUST > 1 562 vmCheckStack(pVM, 1, 0); 563#endif 564 fd = stackPopINT(pVM->pStack); /* get fd */ 565 if (fd != -1) 566 close(fd); 567 return; 568} 569 570/* fread - read file contents 571 * 572 * fread ( fd buf nbytes -- nread ) 573 */ 574static void pfread(FICL_VM *pVM) 575{ 576 int fd, len; 577 char *buf; 578 579#if FICL_ROBUST > 1 580 vmCheckStack(pVM, 3, 1); 581#endif 582 len = stackPopINT(pVM->pStack); /* get number of bytes to read */ 583 buf = stackPopPtr(pVM->pStack); /* get buffer */ 584 fd = stackPopINT(pVM->pStack); /* get fd */ 585 if (len > 0 && buf && fd != -1) 586 stackPushINT(pVM->pStack, read(fd, buf, len)); 587 else 588 stackPushINT(pVM->pStack, -1); 589 return; 590} 591 592/* freaddir - read directory contents 593 * 594 * freaddir ( fd -- ptr len TRUE | FALSE ) 595 */ 596static void pfreaddir(FICL_VM *pVM) 597{ 598#ifdef TESTMAIN 599 static struct dirent dirent; 600 struct stat sb; 601 char *buf; 602 off_t off, ptr; 603 u_int blksz; 604 int bufsz; 605#endif 606 struct dirent *d; 607 int fd; 608 609#if FICL_ROBUST > 1 610 vmCheckStack(pVM, 1, 3); 611#endif 612 613 fd = stackPopINT(pVM->pStack); 614#if TESTMAIN 615 /* 616 * The readdirfd() function is specific to the loader environment. 617 * We do the best we can to make freaddir work, but it's not at 618 * all guaranteed. 619 */ 620 d = NULL; 621 buf = NULL; 622 do { 623 if (fd == -1) 624 break; 625 if (fstat(fd, &sb) == -1) 626 break; 627 blksz = (sb.st_blksize) ? sb.st_blksize : getpagesize(); 628 if ((blksz & (blksz - 1)) != 0) 629 break; 630 buf = malloc(blksz); 631 if (buf == NULL) 632 break; 633 off = lseek(fd, 0LL, SEEK_CUR); 634 if (off == -1) 635 break; 636 ptr = off; 637 if (lseek(fd, 0, SEEK_SET) == -1) 638 break; 639 bufsz = getdents(fd, buf, blksz); 640 while (bufsz > 0 && bufsz <= ptr) { 641 ptr -= bufsz; 642 bufsz = getdents(fd, buf, blksz); 643 } 644 if (bufsz <= 0) 645 break; 646 d = (void *)(buf + ptr); 647 dirent = *d; 648 off += d->d_reclen; 649 d = (lseek(fd, off, SEEK_SET) != off) ? NULL : &dirent; 650 } while (0); 651 if (buf != NULL) 652 free(buf); 653#else 654 d = readdirfd(fd); 655#endif 656 if (d != NULL) { 657 stackPushPtr(pVM->pStack, d->d_name); 658 stackPushINT(pVM->pStack, strlen(d->d_name)); 659 stackPushINT(pVM->pStack, FICL_TRUE); 660 } else { 661 stackPushINT(pVM->pStack, FICL_FALSE); 662 } 663} 664 665/* fload - interpret file contents 666 * 667 * fload ( fd -- ) 668 */ 669static void pfload(FICL_VM *pVM) 670{ 671 int fd; 672 673#if FICL_ROBUST > 1 674 vmCheckStack(pVM, 1, 0); 675#endif 676 fd = stackPopINT(pVM->pStack); /* get fd */ 677 if (fd != -1) 678 ficlExecFD(pVM, fd); 679 return; 680} 681 682/* fwrite - write file contents 683 * 684 * fwrite ( fd buf nbytes -- nwritten ) 685 */ 686static void pfwrite(FICL_VM *pVM) 687{ 688 int fd, len; 689 char *buf; 690 691#if FICL_ROBUST > 1 692 vmCheckStack(pVM, 3, 1); 693#endif 694 len = stackPopINT(pVM->pStack); /* get number of bytes to read */ 695 buf = stackPopPtr(pVM->pStack); /* get buffer */ 696 fd = stackPopINT(pVM->pStack); /* get fd */ 697 if (len > 0 && buf && fd != -1) 698 stackPushINT(pVM->pStack, write(fd, buf, len)); 699 else 700 stackPushINT(pVM->pStack, -1); 701 return; 702} 703 704/* fseek - seek to a new position in a file 705 * 706 * fseek ( fd ofs whence -- pos ) 707 */ 708static void pfseek(FICL_VM *pVM) 709{ 710 int fd, pos, whence; 711 712#if FICL_ROBUST > 1 713 vmCheckStack(pVM, 3, 1); 714#endif 715 whence = stackPopINT(pVM->pStack); 716 pos = stackPopINT(pVM->pStack); 717 fd = stackPopINT(pVM->pStack); 718 stackPushINT(pVM->pStack, lseek(fd, pos, whence)); 719 return; 720} 721 722/* key - get a character from stdin 723 * 724 * key ( -- char ) 725 */ 726static void key(FICL_VM *pVM) 727{ 728#if FICL_ROBUST > 1 729 vmCheckStack(pVM, 0, 1); 730#endif 731 stackPushINT(pVM->pStack, getchar()); 732 return; 733} 734 735/* key? - check for a character from stdin (FACILITY) 736 * 737 * key? ( -- flag ) 738 */ 739static void keyQuestion(FICL_VM *pVM) 740{ 741#if FICL_ROBUST > 1 742 vmCheckStack(pVM, 0, 1); 743#endif 744#ifdef TESTMAIN 745 /* XXX Since we don't fiddle with termios, let it always succeed... */ 746 stackPushINT(pVM->pStack, FICL_TRUE); 747#else 748 /* But here do the right thing. */ 749 stackPushINT(pVM->pStack, ischar()? FICL_TRUE : FICL_FALSE); 750#endif 751 return; 752} 753 754/* seconds - gives number of seconds since beginning of time 755 * 756 * beginning of time is defined as: 757 * 758 * BTX - number of seconds since midnight 759 * FreeBSD - number of seconds since Jan 1 1970 760 * 761 * seconds ( -- u ) 762 */ 763static void pseconds(FICL_VM *pVM) 764{ 765#if FICL_ROBUST > 1 766 vmCheckStack(pVM,0,1); 767#endif 768 stackPushUNS(pVM->pStack, (FICL_UNS) time(NULL)); 769 return; 770} 771 772/* ms - wait at least that many milliseconds (FACILITY) 773 * 774 * ms ( u -- ) 775 * 776 */ 777static void ms(FICL_VM *pVM) 778{ 779#if FICL_ROBUST > 1 780 vmCheckStack(pVM,1,0); 781#endif 782#ifdef TESTMAIN 783 usleep(stackPopUNS(pVM->pStack)*1000); 784#else 785 delay(stackPopUNS(pVM->pStack)*1000); 786#endif 787 return; 788} 789 790/* fkey - get a character from a file 791 * 792 * fkey ( file -- char ) 793 */ 794static void fkey(FICL_VM *pVM) 795{ 796 int i, fd; 797 char ch; 798 799#if FICL_ROBUST > 1 800 vmCheckStack(pVM, 1, 1); 801#endif 802 fd = stackPopINT(pVM->pStack); 803 i = read(fd, &ch, 1); 804 stackPushINT(pVM->pStack, i > 0 ? ch : -1); 805 return; 806} 807 808 809/* 810** Retrieves free space remaining on the dictionary 811*/ 812 813static void freeHeap(FICL_VM *pVM) 814{ 815 stackPushINT(pVM->pStack, dictCellsAvail(ficlGetDict(pVM->pSys))); 816} 817 818 819/******************* Increase dictionary size on-demand ******************/ 820 821static void ficlDictThreshold(FICL_VM *pVM) 822{ 823 stackPushPtr(pVM->pStack, &dictThreshold); 824} 825 826static void ficlDictIncrease(FICL_VM *pVM) 827{ 828 stackPushPtr(pVM->pStack, &dictIncrease); 829} 830 831/************************************************************************** 832 f i c l C o m p i l e P l a t f o r m 833** Build FreeBSD platform extensions into the system dictionary 834**************************************************************************/ 835void ficlCompilePlatform(FICL_SYSTEM *pSys) 836{ 837 ficlCompileFcn **fnpp; 838 FICL_DICT *dp = pSys->dp; 839 assert (dp); 840 841 dictAppendWord(dp, ".#", displayCellNoPad, FW_DEFAULT); 842 dictAppendWord(dp, "isdir?", isdirQuestion, FW_DEFAULT); 843 dictAppendWord(dp, "fopen", pfopen, FW_DEFAULT); 844 dictAppendWord(dp, "fclose", pfclose, FW_DEFAULT); 845 dictAppendWord(dp, "fread", pfread, FW_DEFAULT); 846 dictAppendWord(dp, "freaddir", pfreaddir, FW_DEFAULT); 847 dictAppendWord(dp, "fload", pfload, FW_DEFAULT); 848 dictAppendWord(dp, "fkey", fkey, FW_DEFAULT); 849 dictAppendWord(dp, "fseek", pfseek, FW_DEFAULT); 850 dictAppendWord(dp, "fwrite", pfwrite, FW_DEFAULT); 851 dictAppendWord(dp, "key", key, FW_DEFAULT); 852 dictAppendWord(dp, "key?", keyQuestion, FW_DEFAULT); 853 dictAppendWord(dp, "ms", ms, FW_DEFAULT); 854 dictAppendWord(dp, "seconds", pseconds, FW_DEFAULT); 855 dictAppendWord(dp, "heap?", freeHeap, FW_DEFAULT); 856 dictAppendWord(dp, "dictthreshold", ficlDictThreshold, FW_DEFAULT); 857 dictAppendWord(dp, "dictincrease", ficlDictIncrease, FW_DEFAULT); 858 859 dictAppendWord(dp, "setenv", ficlSetenv, FW_DEFAULT); 860 dictAppendWord(dp, "setenv?", ficlSetenvq, FW_DEFAULT); 861 dictAppendWord(dp, "getenv", ficlGetenv, FW_DEFAULT); 862 dictAppendWord(dp, "unsetenv", ficlUnsetenv, FW_DEFAULT); 863 dictAppendWord(dp, "copyin", ficlCopyin, FW_DEFAULT); 864 dictAppendWord(dp, "copyout", ficlCopyout, FW_DEFAULT); 865 dictAppendWord(dp, "findfile", ficlFindfile, FW_DEFAULT); 866 dictAppendWord(dp, "ccall", ficlCcall, FW_DEFAULT); 867 dictAppendWord(dp, "uuid-from-string", ficlUuidFromString, FW_DEFAULT); 868 dictAppendWord(dp, "uuid-to-string", ficlUuidToString, FW_DEFAULT); 869#ifndef TESTMAIN 870 dictAppendWord(dp, "isvirtualized?",ficlIsvirtualizedQ, FW_DEFAULT); 871#endif 872 873 SET_FOREACH(fnpp, Xficl_compile_set) 874 (*fnpp)(pSys); 875 876#if defined(__i386__) 877 ficlSetEnv(pSys, "arch-i386", FICL_TRUE); 878 ficlSetEnv(pSys, "arch-powerpc", FICL_FALSE); 879#elif defined(__powerpc__) 880 ficlSetEnv(pSys, "arch-i386", FICL_FALSE); 881 ficlSetEnv(pSys, "arch-powerpc", FICL_TRUE); 882#endif 883 884 return; 885} 886