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