stand/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 <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
  68 void
  69 ficlSetenv(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
 105 void
 106 ficlSetenvq(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
 143 void
 144 ficlGetenv(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
 178 void
 179 ficlUnsetenv(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
 207 void
 208 ficlCopyin(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
 229 void
 230 ficlCopyout(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
 251 void
 252 ficlFindfile(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  */
 297 static void
 298 ficlIsvirtualizedQ(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
 316 void
 317 ficlCcall(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
 345 void
 346 ficlUuidFromString(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
 387 void
 388 ficlUuidToString(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
 421 int 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
 462 static 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  */
 478 static 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  */
 506 static 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  */
 557 static 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  */
 574 static 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  */
 596 static 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  */
 669 static 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  */
 686 static 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  */
 708 static 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  */
 726 static 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  */
 739 static 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  */
 763 static 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  */
 777 static 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  */
 794 static 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
 813 static void freeHeap(FICL_VM *pVM)
 814 {
 815     stackPushINT(pVM->pStack, dictCellsAvail(ficlGetDict(pVM->pSys)));
 816 }
 817
 818
 819 /******************* Increase dictionary size on-demand ******************/
 820
 821 static void ficlDictThreshold(FICL_VM *pVM)
 822 {
 823     stackPushPtr(pVM->pStack, &dictThreshold);
 824 }
 825
 826 static 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 **************************************************************************/
 835 void 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 }