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 void
 291 ficlCcall(FICL_VM *pVM)
 292 {
 293         int (*func)(int, ...);
 294         int result, p[10];
 295         int nparam, i;
 296
 297 #if FICL_ROBUST > 1
 298         vmCheckStack(pVM, 2, 0);
 299 #endif
 300
 301         func = stackPopPtr(pVM->pStack);
 302         nparam = stackPopINT(pVM->pStack);
 303
 304 #if FICL_ROBUST > 1
 305         vmCheckStack(pVM, nparam, 1);
 306 #endif
 307
 308         for (i = 0; i < nparam; i++)
 309                 p[i] = stackPopINT(pVM->pStack);
 310
 311         result = func(p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7], p[8],
 312             p[9]);
 313
 314         stackPushINT(pVM->pStack, result);
 315
 316         return;
 317 }
 318
 319 void
 320 ficlUuidFromString(FICL_VM *pVM)
 321 {
 322 #ifndef TESTMAIN
 323         char    *uuid;
 324         uint32_t status;
 325 #endif
 326         char    *uuidp;
 327         int     uuids;
 328         uuid_t  *u;
 329
 330 #if FICL_ROBUST > 1
 331         vmCheckStack(pVM, 2, 0);
 332 #endif
 333
 334         uuids = stackPopINT(pVM->pStack);
 335         uuidp = (char *) stackPopPtr(pVM->pStack);
 336
 337 #ifndef TESTMAIN
 338         uuid = (char *)ficlMalloc(uuids + 1);
 339         if (!uuid)
 340                 vmThrowErr(pVM, "Error: out of memory");
 341         strncpy(uuid, uuidp, uuids);
 342         uuid[uuids] = '\0';
 343
 344         u = (uuid_t *)ficlMalloc(sizeof (*u));
 345
 346         uuid_from_string(uuid, u, &status);
 347         ficlFree(uuid);
 348         if (status != uuid_s_ok) {
 349                 ficlFree(u);
 350                 u = NULL;
 351         }
 352 #else
 353         u = NULL;
 354 #endif
 355         stackPushPtr(pVM->pStack, u);
 356
 357
 358         return;
 359 }
 360
 361 void
 362 ficlUuidToString(FICL_VM *pVM)
 363 {
 364 #ifndef TESTMAIN
 365         char    *uuid;
 366         uint32_t status;
 367 #endif
 368         uuid_t  *u;
 369
 370 #if FICL_ROBUST > 1
 371         vmCheckStack(pVM, 1, 0);
 372 #endif
 373
 374         u = (uuid_t *)stackPopPtr(pVM->pStack);
 375
 376 #ifndef TESTMAIN
 377         uuid_to_string(u, &uuid, &status);
 378         if (status != uuid_s_ok) {
 379                 stackPushPtr(pVM->pStack, uuid);
 380                 stackPushINT(pVM->pStack, strlen(uuid));
 381         } else
 382 #endif
 383                 stackPushINT(pVM->pStack, -1);
 384
 385         return;
 386 }
 387
 388 /**************************************************************************
 389                         f i c l E x e c F D
 390 ** reads in text from file fd and passes it to ficlExec()
 391  * returns VM_OUTOFTEXT on success or the ficlExec() error code on
 392  * failure.
 393  */
 394 #define nLINEBUF 256
 395 int ficlExecFD(FICL_VM *pVM, int fd)
 396 {
 397     char    cp[nLINEBUF];
 398     int     nLine = 0, rval = VM_OUTOFTEXT;
 399     char    ch;
 400     CELL    id;
 401
 402     id = pVM->sourceID;
 403     pVM->sourceID.i = fd;
 404
 405     /* feed each line to ficlExec */
 406     while (1) {
 407         int status, i;
 408
 409         i = 0;
 410         while ((status = read(fd, &ch, 1)) > 0 && ch != '\n')
 411             cp[i++] = ch;
 412         nLine++;
 413         if (!i) {
 414             if (status < 1)
 415                 break;
 416             continue;
 417         }
 418         rval = ficlExecC(pVM, cp, i);
 419         if(rval != VM_QUIT && rval != VM_USEREXIT && rval != VM_OUTOFTEXT)
 420         {
 421             pVM->sourceID = id;
 422             return rval;
 423         }
 424     }
 425     /*
 426     ** Pass an empty line with SOURCE-ID == -1 to flush
 427     ** any pending REFILLs (as required by FILE wordset)
 428     */
 429     pVM->sourceID.i = -1;
 430     ficlExec(pVM, "");
 431
 432     pVM->sourceID = id;
 433     return rval;
 434 }
 435
 436 static void displayCellNoPad(FICL_VM *pVM)
 437 {
 438     CELL c;
 439 #if FICL_ROBUST > 1
 440     vmCheckStack(pVM, 1, 0);
 441 #endif
 442     c = stackPop(pVM->pStack);
 443     ltoa((c).i, pVM->pad, pVM->base);
 444     vmTextOut(pVM, pVM->pad, 0);
 445     return;
 446 }
 447
 448 /*      isdir? - Return whether an fd corresponds to a directory.
 449  *
 450  * isdir? ( fd -- bool )
 451  */
 452 static void isdirQuestion(FICL_VM *pVM)
 453 {
 454     struct stat sb;
 455     FICL_INT flag;
 456     int fd;
 457
 458 #if FICL_ROBUST > 1
 459     vmCheckStack(pVM, 1, 1);
 460 #endif
 461
 462     fd = stackPopINT(pVM->pStack);
 463     flag = FICL_FALSE;
 464     do {
 465         if (fd < 0)
 466             break;
 467         if (fstat(fd, &sb) < 0)
 468             break;
 469         if (!S_ISDIR(sb.st_mode))
 470             break;
 471         flag = FICL_TRUE;
 472     } while (0);
 473     stackPushINT(pVM->pStack, flag);
 474 }
 475
 476 /*          fopen - open a file and return new fd on stack.
 477  *
 478  * fopen ( ptr count mode -- fd )
 479  */
 480 static void pfopen(FICL_VM *pVM)
 481 {
 482     int     mode, fd, count;
 483     char    *ptr, *name;
 484
 485 #if FICL_ROBUST > 1
 486     vmCheckStack(pVM, 3, 1);
 487 #endif
 488
 489     mode = stackPopINT(pVM->pStack);    /* get mode */
 490     count = stackPopINT(pVM->pStack);   /* get count */
 491     ptr = stackPopPtr(pVM->pStack);     /* get ptr */
 492
 493     if ((count < 0) || (ptr == NULL)) {
 494         stackPushINT(pVM->pStack, -1);
 495         return;
 496     }
 497
 498     /* ensure that the string is null terminated */
 499     name = (char *)malloc(count+1);
 500     bcopy(ptr,name,count);
 501     name[count] = 0;
 502
 503     /* open the file */
 504     fd = open(name, mode);
 505 #ifdef LOADER_VERIEXEC
 506     if (fd >= 0) {
 507         if (verify_file(fd, name, 0, VE_GUESS) < 0) {
 508             /* not verified writing ok but reading is not */
 509             if ((mode & O_ACCMODE) != O_WRONLY) {
 510                 close(fd);
 511                 fd = -1;
 512             }
 513         } else {
 514             /* verified reading ok but writing is not */
 515             if ((mode & O_ACCMODE) != O_RDONLY) {
 516                 close(fd);
 517                 fd = -1;
 518             }
 519         }
 520     }
 521 #endif
 522     free(name);
 523     stackPushINT(pVM->pStack, fd);
 524     return;
 525 }
 526
 527 /*          fclose - close a file who's fd is on stack.
 528  *
 529  * fclose ( fd -- )
 530  */
 531 static void pfclose(FICL_VM *pVM)
 532 {
 533     int fd;
 534
 535 #if FICL_ROBUST > 1
 536     vmCheckStack(pVM, 1, 0);
 537 #endif
 538     fd = stackPopINT(pVM->pStack); /* get fd */
 539     if (fd != -1)
 540         close(fd);
 541     return;
 542 }
 543
 544 /*          fread - read file contents
 545  *
 546  * fread  ( fd buf nbytes  -- nread )
 547  */
 548 static void pfread(FICL_VM *pVM)
 549 {
 550     int     fd, len;
 551     char *buf;
 552
 553 #if FICL_ROBUST > 1
 554     vmCheckStack(pVM, 3, 1);
 555 #endif
 556     len = stackPopINT(pVM->pStack); /* get number of bytes to read */
 557     buf = stackPopPtr(pVM->pStack); /* get buffer */
 558     fd = stackPopINT(pVM->pStack); /* get fd */
 559     if (len > 0 && buf && fd != -1)
 560         stackPushINT(pVM->pStack, read(fd, buf, len));
 561     else
 562         stackPushINT(pVM->pStack, -1);
 563     return;
 564 }
 565
 566 /*      freaddir - read directory contents
 567  *
 568  * freaddir ( fd -- ptr len TRUE | FALSE )
 569  */
 570 static void pfreaddir(FICL_VM *pVM)
 571 {
 572 #ifdef TESTMAIN
 573     static struct dirent dirent;
 574     struct stat sb;
 575     char *buf;
 576     off_t off, ptr;
 577     u_int blksz;
 578     int bufsz;
 579 #endif
 580     struct dirent *d;
 581     int fd;
 582
 583 #if FICL_ROBUST > 1
 584     vmCheckStack(pVM, 1, 3);
 585 #endif
 586
 587     fd = stackPopINT(pVM->pStack);
 588 #if TESTMAIN
 589     /*
 590      * The readdirfd() function is specific to the loader environment.
 591      * We do the best we can to make freaddir work, but it's not at
 592      * all guaranteed.
 593      */
 594     d = NULL;
 595     buf = NULL;
 596     do {
 597         if (fd == -1)
 598             break;
 599         if (fstat(fd, &sb) == -1)
 600             break;
 601         blksz = (sb.st_blksize) ? sb.st_blksize : getpagesize();
 602         if ((blksz & (blksz - 1)) != 0)
 603             break;
 604         buf = malloc(blksz);
 605         if (buf == NULL)
 606             break;
 607         off = lseek(fd, 0LL, SEEK_CUR);
 608         if (off == -1)
 609             break;
 610         ptr = off;
 611         if (lseek(fd, 0, SEEK_SET) == -1)
 612             break;
 613         bufsz = getdents(fd, buf, blksz);
 614         while (bufsz > 0 && bufsz <= ptr) {
 615             ptr -= bufsz;
 616             bufsz = getdents(fd, buf, blksz);
 617         }
 618         if (bufsz <= 0)
 619             break;
 620         d = (void *)(buf + ptr);
 621         dirent = *d;
 622         off += d->d_reclen;
 623         d = (lseek(fd, off, SEEK_SET) != off) ? NULL : &dirent;
 624     } while (0);
 625     if (buf != NULL)
 626         free(buf);
 627 #else
 628     d = readdirfd(fd);
 629 #endif
 630     if (d != NULL) {
 631         stackPushPtr(pVM->pStack, d->d_name);
 632         stackPushINT(pVM->pStack, strlen(d->d_name));
 633         stackPushINT(pVM->pStack, FICL_TRUE);
 634     } else {
 635         stackPushINT(pVM->pStack, FICL_FALSE);
 636     }
 637 }
 638
 639 /*          fload - interpret file contents
 640  *
 641  * fload  ( fd -- )
 642  */
 643 static void pfload(FICL_VM *pVM)
 644 {
 645     int     fd;
 646
 647 #if FICL_ROBUST > 1
 648     vmCheckStack(pVM, 1, 0);
 649 #endif
 650     fd = stackPopINT(pVM->pStack); /* get fd */
 651     if (fd != -1)
 652         ficlExecFD(pVM, fd);
 653     return;
 654 }
 655
 656 /*          fwrite - write file contents
 657  *
 658  * fwrite  ( fd buf nbytes  -- nwritten )
 659  */
 660 static void pfwrite(FICL_VM *pVM)
 661 {
 662     int     fd, len;
 663     char *buf;
 664
 665 #if FICL_ROBUST > 1
 666     vmCheckStack(pVM, 3, 1);
 667 #endif
 668     len = stackPopINT(pVM->pStack); /* get number of bytes to read */
 669     buf = stackPopPtr(pVM->pStack); /* get buffer */
 670     fd = stackPopINT(pVM->pStack); /* get fd */
 671     if (len > 0 && buf && fd != -1)
 672         stackPushINT(pVM->pStack, write(fd, buf, len));
 673     else
 674         stackPushINT(pVM->pStack, -1);
 675     return;
 676 }
 677
 678 /*          fseek - seek to a new position in a file
 679  *
 680  * fseek  ( fd ofs whence  -- pos )
 681  */
 682 static void pfseek(FICL_VM *pVM)
 683 {
 684     int     fd, pos, whence;
 685
 686 #if FICL_ROBUST > 1
 687     vmCheckStack(pVM, 3, 1);
 688 #endif
 689     whence = stackPopINT(pVM->pStack);
 690     pos = stackPopINT(pVM->pStack);
 691     fd = stackPopINT(pVM->pStack);
 692     stackPushINT(pVM->pStack, lseek(fd, pos, whence));
 693     return;
 694 }
 695
 696 /*           key - get a character from stdin
 697  *
 698  * key ( -- char )
 699  */
 700 static void key(FICL_VM *pVM)
 701 {
 702 #if FICL_ROBUST > 1
 703     vmCheckStack(pVM, 0, 1);
 704 #endif
 705     stackPushINT(pVM->pStack, getchar());
 706     return;
 707 }
 708
 709 /*           key? - check for a character from stdin (FACILITY)
 710  *
 711  * key? ( -- flag )
 712  */
 713 static void keyQuestion(FICL_VM *pVM)
 714 {
 715 #if FICL_ROBUST > 1
 716     vmCheckStack(pVM, 0, 1);
 717 #endif
 718 #ifdef TESTMAIN
 719     /* XXX Since we don't fiddle with termios, let it always succeed... */
 720     stackPushINT(pVM->pStack, FICL_TRUE);
 721 #else
 722     /* But here do the right thing. */
 723     stackPushINT(pVM->pStack, ischar()? FICL_TRUE : FICL_FALSE);
 724 #endif
 725     return;
 726 }
 727
 728 /* seconds - gives number of seconds since beginning of time
 729  *
 730  * beginning of time is defined as:
 731  *
 732  *      BTX     - number of seconds since midnight
 733  *      FreeBSD - number of seconds since Jan 1 1970
 734  *
 735  * seconds ( -- u )
 736  */
 737 static void pseconds(FICL_VM *pVM)
 738 {
 739 #if FICL_ROBUST > 1
 740     vmCheckStack(pVM,0,1);
 741 #endif
 742     stackPushUNS(pVM->pStack, (FICL_UNS) time(NULL));
 743     return;
 744 }
 745
 746 /* ms - wait at least that many milliseconds (FACILITY)
 747  *
 748  * ms ( u -- )
 749  *
 750  */
 751 static void ms(FICL_VM *pVM)
 752 {
 753 #if FICL_ROBUST > 1
 754     vmCheckStack(pVM,1,0);
 755 #endif
 756 #ifdef TESTMAIN
 757     usleep(stackPopUNS(pVM->pStack)*1000);
 758 #else
 759     delay(stackPopUNS(pVM->pStack)*1000);
 760 #endif
 761     return;
 762 }
 763
 764 /*           fkey - get a character from a file
 765  *
 766  * fkey ( file -- char )
 767  */
 768 static void fkey(FICL_VM *pVM)
 769 {
 770     int i, fd;
 771     char ch;
 772
 773 #if FICL_ROBUST > 1
 774     vmCheckStack(pVM, 1, 1);
 775 #endif
 776     fd = stackPopINT(pVM->pStack);
 777     i = read(fd, &ch, 1);
 778     stackPushINT(pVM->pStack, i > 0 ? ch : -1);
 779     return;
 780 }
 781
 782
 783 /*
 784 ** Retrieves free space remaining on the dictionary
 785 */
 786
 787 static void freeHeap(FICL_VM *pVM)
 788 {
 789     stackPushINT(pVM->pStack, dictCellsAvail(ficlGetDict(pVM->pSys)));
 790 }
 791
 792
 793 /******************* Increase dictionary size on-demand ******************/
 794
 795 static void ficlDictThreshold(FICL_VM *pVM)
 796 {
 797     stackPushPtr(pVM->pStack, &dictThreshold);
 798 }
 799
 800 static void ficlDictIncrease(FICL_VM *pVM)
 801 {
 802     stackPushPtr(pVM->pStack, &dictIncrease);
 803 }
 804
 805 /**************************************************************************
 806                         f i c l C o m p i l e P l a t f o r m
 807 ** Build FreeBSD platform extensions into the system dictionary
 808 **************************************************************************/
 809 void ficlCompilePlatform(FICL_SYSTEM *pSys)
 810 {
 811     ficlCompileFcn **fnpp;
 812     FICL_DICT *dp = pSys->dp;
 813     assert (dp);
 814
 815     dictAppendWord(dp, ".#",        displayCellNoPad,    FW_DEFAULT);
 816     dictAppendWord(dp, "isdir?",    isdirQuestion,  FW_DEFAULT);
 817     dictAppendWord(dp, "fopen",     pfopen,         FW_DEFAULT);
 818     dictAppendWord(dp, "fclose",    pfclose,        FW_DEFAULT);
 819     dictAppendWord(dp, "fread",     pfread,         FW_DEFAULT);
 820     dictAppendWord(dp, "freaddir",  pfreaddir,      FW_DEFAULT);
 821     dictAppendWord(dp, "fload",     pfload,         FW_DEFAULT);
 822     dictAppendWord(dp, "fkey",      fkey,           FW_DEFAULT);
 823     dictAppendWord(dp, "fseek",     pfseek,         FW_DEFAULT);
 824     dictAppendWord(dp, "fwrite",    pfwrite,        FW_DEFAULT);
 825     dictAppendWord(dp, "key",       key,            FW_DEFAULT);
 826     dictAppendWord(dp, "key?",      keyQuestion,    FW_DEFAULT);
 827     dictAppendWord(dp, "ms",        ms,             FW_DEFAULT);
 828     dictAppendWord(dp, "seconds",   pseconds,       FW_DEFAULT);
 829     dictAppendWord(dp, "heap?",     freeHeap,       FW_DEFAULT);
 830     dictAppendWord(dp, "dictthreshold", ficlDictThreshold, FW_DEFAULT);
 831     dictAppendWord(dp, "dictincrease", ficlDictIncrease, FW_DEFAULT);
 832
 833     dictAppendWord(dp, "setenv",    ficlSetenv,     FW_DEFAULT);
 834     dictAppendWord(dp, "setenv?",   ficlSetenvq,    FW_DEFAULT);
 835     dictAppendWord(dp, "getenv",    ficlGetenv,     FW_DEFAULT);
 836     dictAppendWord(dp, "unsetenv",  ficlUnsetenv,   FW_DEFAULT);
 837     dictAppendWord(dp, "copyin",    ficlCopyin,     FW_DEFAULT);
 838     dictAppendWord(dp, "copyout",   ficlCopyout,    FW_DEFAULT);
 839     dictAppendWord(dp, "findfile",  ficlFindfile,   FW_DEFAULT);
 840     dictAppendWord(dp, "ccall",     ficlCcall,      FW_DEFAULT);
 841     dictAppendWord(dp, "uuid-from-string", ficlUuidFromString, FW_DEFAULT);
 842     dictAppendWord(dp, "uuid-to-string", ficlUuidToString, FW_DEFAULT);
 843
 844     SET_FOREACH(fnpp, Xficl_compile_set)
 845         (*fnpp)(pSys);
 846
 847 #if defined(__i386__)
 848     ficlSetEnv(pSys, "arch-i386",         FICL_TRUE);
 849     ficlSetEnv(pSys, "arch-powerpc",      FICL_FALSE);
 850 #elif defined(__powerpc__)
 851     ficlSetEnv(pSys, "arch-i386",         FICL_FALSE);
 852     ficlSetEnv(pSys, "arch-powerpc",      FICL_TRUE);
 853 #endif
 854
 855     return;
 856 }