sys/boot/ficl/loader.c

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