1a1bf3f78SToomas Soome /* 2a1bf3f78SToomas Soome * Copyright (c) 2000 Daniel Capo Sobral 3a1bf3f78SToomas Soome * All rights reserved. 4a1bf3f78SToomas Soome * 5a1bf3f78SToomas Soome * Redistribution and use in source and binary forms, with or without 6a1bf3f78SToomas Soome * modification, are permitted provided that the following conditions 7a1bf3f78SToomas Soome * are met: 8a1bf3f78SToomas Soome * 1. Redistributions of source code must retain the above copyright 9a1bf3f78SToomas Soome * notice, this list of conditions and the following disclaimer. 10a1bf3f78SToomas Soome * 2. Redistributions in binary form must reproduce the above copyright 11a1bf3f78SToomas Soome * notice, this list of conditions and the following disclaimer in the 12a1bf3f78SToomas Soome * documentation and/or other materials provided with the distribution. 13a1bf3f78SToomas Soome * 14a1bf3f78SToomas Soome * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 15a1bf3f78SToomas Soome * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16a1bf3f78SToomas Soome * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 17a1bf3f78SToomas Soome * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 18a1bf3f78SToomas Soome * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 19a1bf3f78SToomas Soome * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 20a1bf3f78SToomas Soome * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 21a1bf3f78SToomas Soome * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 22a1bf3f78SToomas Soome * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 23a1bf3f78SToomas Soome * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 24a1bf3f78SToomas Soome * SUCH DAMAGE. 25a1bf3f78SToomas Soome * 26a1bf3f78SToomas Soome * $FreeBSD$ 27a1bf3f78SToomas Soome */ 28a1bf3f78SToomas Soome 29a1bf3f78SToomas Soome /* 30a1bf3f78SToomas Soome * l o a d e r . c 31a1bf3f78SToomas Soome * Additional FICL words designed for FreeBSD's loader 32a1bf3f78SToomas Soome */ 33a1bf3f78SToomas Soome 34a1bf3f78SToomas Soome #ifndef STAND 35a1bf3f78SToomas Soome #include <sys/types.h> 36a1bf3f78SToomas Soome #include <sys/stat.h> 37a1bf3f78SToomas Soome #include <dirent.h> 38a1bf3f78SToomas Soome #include <fcntl.h> 39a1bf3f78SToomas Soome #include <stdio.h> 40a1bf3f78SToomas Soome #include <stdlib.h> 41a1bf3f78SToomas Soome #include <unistd.h> 42a1bf3f78SToomas Soome #include <strings.h> 43a1bf3f78SToomas Soome #include <termios.h> 44a1bf3f78SToomas Soome #else 45a1bf3f78SToomas Soome #include <stand.h> 46a1bf3f78SToomas Soome #ifdef __i386__ 47a1bf3f78SToomas Soome #include <machine/cpufunc.h> 48a1bf3f78SToomas Soome #endif 49a1bf3f78SToomas Soome #include "bootstrap.h" 50a1bf3f78SToomas Soome #endif 51065446baSToomas Soome #ifdef STAND 52065446baSToomas Soome #include <uuid.h> 53065446baSToomas Soome #else 54065446baSToomas Soome #include <uuid/uuid.h> 55065446baSToomas Soome #endif 56a1bf3f78SToomas Soome #include <string.h> 57a1bf3f78SToomas Soome #include "ficl.h" 58a1bf3f78SToomas Soome 59a1bf3f78SToomas Soome /* 60a1bf3f78SToomas Soome * FreeBSD's loader interaction words and extras 61a1bf3f78SToomas Soome * 62a1bf3f78SToomas Soome * setenv ( value n name n' -- ) 63a1bf3f78SToomas Soome * setenv? ( value n name n' flag -- ) 64a1bf3f78SToomas Soome * getenv ( addr n -- addr' n' | -1 ) 65a1bf3f78SToomas Soome * unsetenv ( addr n -- ) 66a1bf3f78SToomas Soome * copyin ( addr addr' len -- ) 67a1bf3f78SToomas Soome * copyout ( addr addr' len -- ) 68a1bf3f78SToomas Soome * findfile ( name len type len' -- addr ) 69a1bf3f78SToomas Soome * ccall ( [[...[p10] p9] ... p1] n addr -- result ) 70065446baSToomas Soome * uuid-from-string ( addr n -- addr' ) 71065446baSToomas Soome * uuid-to-string ( addr' -- addr n | -1 ) 72a1bf3f78SToomas Soome * .# ( value -- ) 73a1bf3f78SToomas Soome */ 74a1bf3f78SToomas Soome 75a1bf3f78SToomas Soome void 76a1bf3f78SToomas Soome ficlSetenv(ficlVm *pVM) 77a1bf3f78SToomas Soome { 78a1bf3f78SToomas Soome char *name, *value; 79a1bf3f78SToomas Soome char *namep, *valuep; 80a1bf3f78SToomas Soome int names, values; 81a1bf3f78SToomas Soome 82a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 4, 0); 83a1bf3f78SToomas Soome 84a1bf3f78SToomas Soome names = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 85a1bf3f78SToomas Soome namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM)); 86a1bf3f78SToomas Soome values = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 87a1bf3f78SToomas Soome valuep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM)); 88a1bf3f78SToomas Soome 89a1bf3f78SToomas Soome name = (char *)ficlMalloc(names+1); 90a1bf3f78SToomas Soome if (!name) 91a1bf3f78SToomas Soome ficlVmThrowError(pVM, "Error: out of memory"); 92a1bf3f78SToomas Soome strncpy(name, namep, names); 93a1bf3f78SToomas Soome name[names] = '\0'; 94a1bf3f78SToomas Soome value = (char *)ficlMalloc(values+1); 95a1bf3f78SToomas Soome if (!value) 96a1bf3f78SToomas Soome ficlVmThrowError(pVM, "Error: out of memory"); 97a1bf3f78SToomas Soome strncpy(value, valuep, values); 98a1bf3f78SToomas Soome value[values] = '\0'; 99a1bf3f78SToomas Soome 100a1bf3f78SToomas Soome setenv(name, value, 1); 101a1bf3f78SToomas Soome ficlFree(name); 102a1bf3f78SToomas Soome ficlFree(value); 103a1bf3f78SToomas Soome } 104a1bf3f78SToomas Soome 105a1bf3f78SToomas Soome void 106a1bf3f78SToomas Soome ficlSetenvq(ficlVm *pVM) 107a1bf3f78SToomas Soome { 108a1bf3f78SToomas Soome char *name, *value; 109a1bf3f78SToomas Soome char *namep, *valuep; 110a1bf3f78SToomas Soome int names, values, overwrite; 111a1bf3f78SToomas Soome 112a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 5, 0); 113a1bf3f78SToomas Soome 114a1bf3f78SToomas Soome overwrite = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 115a1bf3f78SToomas Soome names = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 116a1bf3f78SToomas Soome namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM)); 117a1bf3f78SToomas Soome values = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 118a1bf3f78SToomas Soome valuep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM)); 119a1bf3f78SToomas Soome 120a1bf3f78SToomas Soome name = (char *)ficlMalloc(names+1); 121a1bf3f78SToomas Soome if (!name) 122a1bf3f78SToomas Soome ficlVmThrowError(pVM, "Error: out of memory"); 123a1bf3f78SToomas Soome strncpy(name, namep, names); 124a1bf3f78SToomas Soome name[names] = '\0'; 125a1bf3f78SToomas Soome value = (char *)ficlMalloc(values+1); 126a1bf3f78SToomas Soome if (!value) 127a1bf3f78SToomas Soome ficlVmThrowError(pVM, "Error: out of memory"); 128a1bf3f78SToomas Soome strncpy(value, valuep, values); 129a1bf3f78SToomas Soome value[values] = '\0'; 130a1bf3f78SToomas Soome 131a1bf3f78SToomas Soome setenv(name, value, overwrite); 132a1bf3f78SToomas Soome ficlFree(name); 133a1bf3f78SToomas Soome ficlFree(value); 134a1bf3f78SToomas Soome } 135a1bf3f78SToomas Soome 136a1bf3f78SToomas Soome void 137a1bf3f78SToomas Soome ficlGetenv(ficlVm *pVM) 138a1bf3f78SToomas Soome { 139a1bf3f78SToomas Soome char *name, *value; 140a1bf3f78SToomas Soome char *namep; 141a1bf3f78SToomas Soome int names; 142a1bf3f78SToomas Soome 143a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 2); 144a1bf3f78SToomas Soome 145a1bf3f78SToomas Soome names = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 146a1bf3f78SToomas Soome namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM)); 147a1bf3f78SToomas Soome 148a1bf3f78SToomas Soome name = (char *)ficlMalloc(names+1); 149a1bf3f78SToomas Soome if (!name) 150a1bf3f78SToomas Soome ficlVmThrowError(pVM, "Error: out of memory"); 151a1bf3f78SToomas Soome strncpy(name, namep, names); 152a1bf3f78SToomas Soome name[names] = '\0'; 153a1bf3f78SToomas Soome 154a1bf3f78SToomas Soome value = getenv(name); 155a1bf3f78SToomas Soome ficlFree(name); 156a1bf3f78SToomas Soome 157a1bf3f78SToomas Soome if (value != NULL) { 158a1bf3f78SToomas Soome ficlStackPushPointer(ficlVmGetDataStack(pVM), value); 159a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), strlen(value)); 160a1bf3f78SToomas Soome } else 161a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), -1); 162a1bf3f78SToomas Soome } 163a1bf3f78SToomas Soome 164a1bf3f78SToomas Soome void 165a1bf3f78SToomas Soome ficlUnsetenv(ficlVm *pVM) 166a1bf3f78SToomas Soome { 167a1bf3f78SToomas Soome char *name; 168a1bf3f78SToomas Soome char *namep; 169a1bf3f78SToomas Soome int names; 170a1bf3f78SToomas Soome 171a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 0); 172a1bf3f78SToomas Soome 173a1bf3f78SToomas Soome names = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 174a1bf3f78SToomas Soome namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM)); 175a1bf3f78SToomas Soome 176a1bf3f78SToomas Soome name = (char *)ficlMalloc(names+1); 177a1bf3f78SToomas Soome if (!name) 178a1bf3f78SToomas Soome ficlVmThrowError(pVM, "Error: out of memory"); 179a1bf3f78SToomas Soome strncpy(name, namep, names); 180a1bf3f78SToomas Soome name[names] = '\0'; 181a1bf3f78SToomas Soome 182a1bf3f78SToomas Soome unsetenv(name); 183a1bf3f78SToomas Soome ficlFree(name); 184a1bf3f78SToomas Soome } 185a1bf3f78SToomas Soome 186a1bf3f78SToomas Soome void 187a1bf3f78SToomas Soome ficlCopyin(ficlVm *pVM) 188a1bf3f78SToomas Soome { 189a1bf3f78SToomas Soome #ifdef STAND 190a1bf3f78SToomas Soome void* src; 191a1bf3f78SToomas Soome vm_offset_t dest; 192a1bf3f78SToomas Soome size_t len; 193a1bf3f78SToomas Soome #endif 194a1bf3f78SToomas Soome 195a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 0); 196a1bf3f78SToomas Soome 197a1bf3f78SToomas Soome #ifdef STAND 198a1bf3f78SToomas Soome len = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 199a1bf3f78SToomas Soome dest = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 200a1bf3f78SToomas Soome src = ficlStackPopPointer(ficlVmGetDataStack(pVM)); 201a1bf3f78SToomas Soome archsw.arch_copyin(src, dest, len); 202a1bf3f78SToomas Soome #else 203a1bf3f78SToomas Soome (void) ficlStackPopInteger(ficlVmGetDataStack(pVM)); 204a1bf3f78SToomas Soome (void) ficlStackPopInteger(ficlVmGetDataStack(pVM)); 205a1bf3f78SToomas Soome (void) ficlStackPopPointer(ficlVmGetDataStack(pVM)); 206a1bf3f78SToomas Soome #endif 207a1bf3f78SToomas Soome } 208a1bf3f78SToomas Soome 209a1bf3f78SToomas Soome void 210a1bf3f78SToomas Soome ficlCopyout(ficlVm *pVM) 211a1bf3f78SToomas Soome { 212a1bf3f78SToomas Soome #ifdef STAND 213a1bf3f78SToomas Soome void* dest; 214a1bf3f78SToomas Soome vm_offset_t src; 215a1bf3f78SToomas Soome size_t len; 216a1bf3f78SToomas Soome #endif 217a1bf3f78SToomas Soome 218a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 0); 219a1bf3f78SToomas Soome 220a1bf3f78SToomas Soome #ifdef STAND 221a1bf3f78SToomas Soome len = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 222a1bf3f78SToomas Soome dest = ficlStackPopPointer(ficlVmGetDataStack(pVM)); 223a1bf3f78SToomas Soome src = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 224a1bf3f78SToomas Soome archsw.arch_copyout(src, dest, len); 225a1bf3f78SToomas Soome #else 226a1bf3f78SToomas Soome (void) ficlStackPopInteger(ficlVmGetDataStack(pVM)); 227a1bf3f78SToomas Soome (void) ficlStackPopPointer(ficlVmGetDataStack(pVM)); 228a1bf3f78SToomas Soome (void) ficlStackPopInteger(ficlVmGetDataStack(pVM)); 229a1bf3f78SToomas Soome #endif 230a1bf3f78SToomas Soome } 231a1bf3f78SToomas Soome 232a1bf3f78SToomas Soome void 233a1bf3f78SToomas Soome ficlFindfile(ficlVm *pVM) 234a1bf3f78SToomas Soome { 235a1bf3f78SToomas Soome #ifdef STAND 236a1bf3f78SToomas Soome char *name, *type; 237a1bf3f78SToomas Soome char *namep, *typep; 238a1bf3f78SToomas Soome int names, types; 239a1bf3f78SToomas Soome #endif 240a1bf3f78SToomas Soome struct preloaded_file *fp; 241a1bf3f78SToomas Soome 242a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 4, 1); 243a1bf3f78SToomas Soome 244a1bf3f78SToomas Soome #ifdef STAND 245a1bf3f78SToomas Soome types = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 246a1bf3f78SToomas Soome typep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM)); 247a1bf3f78SToomas Soome names = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 248a1bf3f78SToomas Soome namep = (char *)ficlStackPopPointer(ficlVmGetDataStack(pVM)); 249a1bf3f78SToomas Soome 250a1bf3f78SToomas Soome name = (char *)ficlMalloc(names+1); 251a1bf3f78SToomas Soome if (!name) 252a1bf3f78SToomas Soome ficlVmThrowError(pVM, "Error: out of memory"); 253a1bf3f78SToomas Soome strncpy(name, namep, names); 254a1bf3f78SToomas Soome name[names] = '\0'; 255a1bf3f78SToomas Soome type = (char *)ficlMalloc(types+1); 256a1bf3f78SToomas Soome if (!type) 257a1bf3f78SToomas Soome ficlVmThrowError(pVM, "Error: out of memory"); 258a1bf3f78SToomas Soome strncpy(type, typep, types); 259a1bf3f78SToomas Soome type[types] = '\0'; 260a1bf3f78SToomas Soome 261a1bf3f78SToomas Soome fp = file_findfile(name, type); 262a1bf3f78SToomas Soome #else 263a1bf3f78SToomas Soome (void) ficlStackPopInteger(ficlVmGetDataStack(pVM)); 264a1bf3f78SToomas Soome (void) ficlStackPopPointer(ficlVmGetDataStack(pVM)); 265a1bf3f78SToomas Soome (void) ficlStackPopInteger(ficlVmGetDataStack(pVM)); 266a1bf3f78SToomas Soome (void) ficlStackPopPointer(ficlVmGetDataStack(pVM)); 267a1bf3f78SToomas Soome 268a1bf3f78SToomas Soome fp = NULL; 269a1bf3f78SToomas Soome #endif 270a1bf3f78SToomas Soome ficlStackPushPointer(ficlVmGetDataStack(pVM), fp); 271a1bf3f78SToomas Soome } 272a1bf3f78SToomas Soome 273a1bf3f78SToomas Soome void 274a1bf3f78SToomas Soome ficlCcall(ficlVm *pVM) 275a1bf3f78SToomas Soome { 276a1bf3f78SToomas Soome int (*func)(int, ...); 277a1bf3f78SToomas Soome int result, p[10]; 278a1bf3f78SToomas Soome int nparam, i; 279a1bf3f78SToomas Soome 280a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 0); 281a1bf3f78SToomas Soome 282a1bf3f78SToomas Soome func = (int (*)(int, ...))ficlStackPopPointer(ficlVmGetDataStack(pVM)); 283a1bf3f78SToomas Soome nparam = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 284a1bf3f78SToomas Soome 285a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), nparam, 1); 286a1bf3f78SToomas Soome 287a1bf3f78SToomas Soome for (i = 0; i < nparam; i++) 288a1bf3f78SToomas Soome p[i] = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 289a1bf3f78SToomas Soome 290a1bf3f78SToomas Soome result = func(p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7], p[8], 291a1bf3f78SToomas Soome p[9]); 292a1bf3f78SToomas Soome 293a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), result); 294a1bf3f78SToomas Soome } 295a1bf3f78SToomas Soome 296065446baSToomas Soome void 297065446baSToomas Soome ficlUuidFromString(ficlVm *pVM) 298065446baSToomas Soome { 299065446baSToomas Soome char *uuid; 300065446baSToomas Soome char *uuid_ptr; 301065446baSToomas Soome int uuid_size; 302065446baSToomas Soome uuid_t *u; 303065446baSToomas Soome #ifdef STAND 304065446baSToomas Soome uint32_t status; 305065446baSToomas Soome #else 306065446baSToomas Soome int status; 307065446baSToomas Soome #endif 308065446baSToomas Soome 309065446baSToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 0); 310065446baSToomas Soome 311065446baSToomas Soome uuid_size = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 312065446baSToomas Soome uuid_ptr = ficlStackPopPointer(ficlVmGetDataStack(pVM)); 313065446baSToomas Soome 314065446baSToomas Soome uuid = ficlMalloc(uuid_size + 1); 315065446baSToomas Soome if (!uuid) 316065446baSToomas Soome ficlVmThrowError(pVM, "Error: out of memory"); 317065446baSToomas Soome (void) memcpy(uuid, uuid_ptr, uuid_size); 318065446baSToomas Soome uuid[uuid_size] = '\0'; 319065446baSToomas Soome 320065446baSToomas Soome u = ficlMalloc(sizeof (*u)); 321065446baSToomas Soome #ifdef STAND 322065446baSToomas Soome uuid_from_string(uuid, u, &status); 323065446baSToomas Soome ficlFree(uuid); 324065446baSToomas Soome if (status != uuid_s_ok) { 325065446baSToomas Soome ficlFree(u); 326065446baSToomas Soome u = NULL; 327065446baSToomas Soome } 328065446baSToomas Soome #else 329065446baSToomas Soome status = uuid_parse(uuid, *u); 330065446baSToomas Soome ficlFree(uuid); 331065446baSToomas Soome if (status != 0) { 332065446baSToomas Soome ficlFree(u); 333065446baSToomas Soome u = NULL; 334065446baSToomas Soome } 335065446baSToomas Soome #endif 336065446baSToomas Soome ficlStackPushPointer(ficlVmGetDataStack(pVM), u); 337065446baSToomas Soome } 338065446baSToomas Soome 339065446baSToomas Soome void 340065446baSToomas Soome ficlUuidToString(ficlVm *pVM) 341065446baSToomas Soome { 342065446baSToomas Soome char *uuid; 343065446baSToomas Soome uuid_t *u; 344065446baSToomas Soome #ifdef STAND 345065446baSToomas Soome uint32_t status; 346065446baSToomas Soome #endif 347065446baSToomas Soome 348065446baSToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0); 349065446baSToomas Soome 350065446baSToomas Soome u = ficlStackPopPointer(ficlVmGetDataStack(pVM)); 351065446baSToomas Soome #ifdef STAND 352065446baSToomas Soome uuid_to_string(u, &uuid, &status); 353065446baSToomas Soome if (status == uuid_s_ok) { 354065446baSToomas Soome ficlStackPushPointer(ficlVmGetDataStack(pVM), uuid); 355065446baSToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), strlen(uuid)); 356065446baSToomas Soome } else 357065446baSToomas Soome #else 358065446baSToomas Soome uuid = ficlMalloc(UUID_PRINTABLE_STRING_LENGTH); 359065446baSToomas Soome if (uuid != NULL) { 360065446baSToomas Soome uuid_unparse(*u, uuid); 361065446baSToomas Soome ficlStackPushPointer(ficlVmGetDataStack(pVM), uuid); 362065446baSToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), strlen(uuid)); 363065446baSToomas Soome } else 364065446baSToomas Soome #endif 365065446baSToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), -1); 366065446baSToomas Soome } 367065446baSToomas Soome 368a1bf3f78SToomas Soome /* 369a1bf3f78SToomas Soome * f i c l E x e c F D 370a1bf3f78SToomas Soome * reads in text from file fd and passes it to ficlExec() 371a1bf3f78SToomas Soome * returns FICL_VM_STATUS_OUT_OF_TEXT on success or the ficlExec() error 372a1bf3f78SToomas Soome * code on failure. 373a1bf3f78SToomas Soome */ 374a1bf3f78SToomas Soome #define nLINEBUF 256 375a1bf3f78SToomas Soome int 376a1bf3f78SToomas Soome ficlExecFD(ficlVm *pVM, int fd) 377a1bf3f78SToomas Soome { 378a1bf3f78SToomas Soome char cp[nLINEBUF]; 379a1bf3f78SToomas Soome int nLine = 0, rval = FICL_VM_STATUS_OUT_OF_TEXT; 380a1bf3f78SToomas Soome char ch; 381a1bf3f78SToomas Soome ficlCell id; 382a1bf3f78SToomas Soome ficlString s; 383a1bf3f78SToomas Soome 384a1bf3f78SToomas Soome id = pVM->sourceId; 385a1bf3f78SToomas Soome pVM->sourceId.i = fd+1; /* in loader we can get 0, there is no stdin */ 386a1bf3f78SToomas Soome 387a1bf3f78SToomas Soome /* feed each line to ficlExec */ 388a1bf3f78SToomas Soome while (1) { 389a1bf3f78SToomas Soome int status, i; 390a1bf3f78SToomas Soome 391a1bf3f78SToomas Soome i = 0; 392a1bf3f78SToomas Soome while ((status = read(fd, &ch, 1)) > 0 && ch != '\n') 393a1bf3f78SToomas Soome cp[i++] = ch; 394a1bf3f78SToomas Soome nLine++; 395a1bf3f78SToomas Soome if (!i) { 396a1bf3f78SToomas Soome if (status < 1) 397a1bf3f78SToomas Soome break; 398a1bf3f78SToomas Soome continue; 399a1bf3f78SToomas Soome } 400a1bf3f78SToomas Soome if (cp[i] == '\n') 401a1bf3f78SToomas Soome cp[i] = '\0'; 402a1bf3f78SToomas Soome 403a1bf3f78SToomas Soome FICL_STRING_SET_POINTER(s, cp); 404a1bf3f78SToomas Soome FICL_STRING_SET_LENGTH(s, i); 405a1bf3f78SToomas Soome 406a1bf3f78SToomas Soome rval = ficlVmExecuteString(pVM, s); 407a1bf3f78SToomas Soome if (rval != FICL_VM_STATUS_QUIT && 408a1bf3f78SToomas Soome rval != FICL_VM_STATUS_USER_EXIT && 409a1bf3f78SToomas Soome rval != FICL_VM_STATUS_OUT_OF_TEXT) { 410a1bf3f78SToomas Soome pVM->sourceId = id; 411a1bf3f78SToomas Soome (void) ficlVmEvaluate(pVM, ""); 412a1bf3f78SToomas Soome return (rval); 413a1bf3f78SToomas Soome } 414a1bf3f78SToomas Soome } 415a1bf3f78SToomas Soome pVM->sourceId = id; 416a1bf3f78SToomas Soome 417a1bf3f78SToomas Soome /* 418a1bf3f78SToomas Soome * Pass an empty line with SOURCE-ID == -1 to flush 419a1bf3f78SToomas Soome * any pending REFILLs (as required by FILE wordset) 420a1bf3f78SToomas Soome */ 421a1bf3f78SToomas Soome (void) ficlVmEvaluate(pVM, ""); 422a1bf3f78SToomas Soome 423a1bf3f78SToomas Soome if (rval == FICL_VM_STATUS_USER_EXIT) 424a1bf3f78SToomas Soome ficlVmThrow(pVM, FICL_VM_STATUS_USER_EXIT); 425a1bf3f78SToomas Soome 426a1bf3f78SToomas Soome return (rval); 427a1bf3f78SToomas Soome } 428a1bf3f78SToomas Soome 429a1bf3f78SToomas Soome static void displayCellNoPad(ficlVm *pVM) 430a1bf3f78SToomas Soome { 431a1bf3f78SToomas Soome ficlCell c; 432a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0); 433a1bf3f78SToomas Soome 434a1bf3f78SToomas Soome c = ficlStackPop(ficlVmGetDataStack(pVM)); 435a1bf3f78SToomas Soome ficlLtoa((c).i, pVM->pad, pVM->base); 436a1bf3f78SToomas Soome ficlVmTextOut(pVM, pVM->pad); 437a1bf3f78SToomas Soome } 438a1bf3f78SToomas Soome 439a1bf3f78SToomas Soome /* 440a1bf3f78SToomas Soome * isdir? - Return whether an fd corresponds to a directory. 441a1bf3f78SToomas Soome * 442a1bf3f78SToomas Soome * isdir? ( fd -- bool ) 443a1bf3f78SToomas Soome */ 444a1bf3f78SToomas Soome static void 445a1bf3f78SToomas Soome isdirQuestion(ficlVm *pVM) 446a1bf3f78SToomas Soome { 447a1bf3f78SToomas Soome struct stat sb; 448a1bf3f78SToomas Soome ficlInteger flag; 449a1bf3f78SToomas Soome int fd; 450a1bf3f78SToomas Soome 451a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 1); 452a1bf3f78SToomas Soome 453a1bf3f78SToomas Soome fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 454a1bf3f78SToomas Soome flag = FICL_FALSE; 455a1bf3f78SToomas Soome do { 456a1bf3f78SToomas Soome if (fd < 0) 457a1bf3f78SToomas Soome break; 458a1bf3f78SToomas Soome if (fstat(fd, &sb) < 0) 459a1bf3f78SToomas Soome break; 460a1bf3f78SToomas Soome if (!S_ISDIR(sb.st_mode)) 461a1bf3f78SToomas Soome break; 462a1bf3f78SToomas Soome flag = FICL_TRUE; 463a1bf3f78SToomas Soome } while (0); 464a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), flag); 465a1bf3f78SToomas Soome } 466a1bf3f78SToomas Soome 467a1bf3f78SToomas Soome /* 468a1bf3f78SToomas Soome * fopen - open a file and return new fd on stack. 469a1bf3f78SToomas Soome * 470a1bf3f78SToomas Soome * fopen ( ptr count mode -- fd ) 471a1bf3f78SToomas Soome */ 472a1bf3f78SToomas Soome extern char *get_dev(const char *); 473a1bf3f78SToomas Soome 474a1bf3f78SToomas Soome static void 475a1bf3f78SToomas Soome pfopen(ficlVm *pVM) 476a1bf3f78SToomas Soome { 477a1bf3f78SToomas Soome int mode, fd, count; 478a1bf3f78SToomas Soome char *ptr, *name; 479a1bf3f78SToomas Soome #ifndef STAND 480a1bf3f78SToomas Soome char *tmp; 481a1bf3f78SToomas Soome #endif 482a1bf3f78SToomas Soome 483a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 1); 484a1bf3f78SToomas Soome 485a1bf3f78SToomas Soome mode = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get mode */ 486a1bf3f78SToomas Soome count = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get count */ 487a1bf3f78SToomas Soome ptr = ficlStackPopPointer(ficlVmGetDataStack(pVM)); /* get ptr */ 488a1bf3f78SToomas Soome 489a1bf3f78SToomas Soome if ((count < 0) || (ptr == NULL)) { 490a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), -1); 491a1bf3f78SToomas Soome return; 492a1bf3f78SToomas Soome } 493a1bf3f78SToomas Soome 494a1bf3f78SToomas Soome /* ensure that the string is null terminated */ 495a1bf3f78SToomas Soome name = (char *)malloc(count+1); 496a1bf3f78SToomas Soome bcopy(ptr, name, count); 497a1bf3f78SToomas Soome name[count] = 0; 498a1bf3f78SToomas Soome #ifndef STAND 499a1bf3f78SToomas Soome tmp = get_dev(name); 500a1bf3f78SToomas Soome free(name); 501a1bf3f78SToomas Soome name = tmp; 502a1bf3f78SToomas Soome #endif 503a1bf3f78SToomas Soome 504a1bf3f78SToomas Soome /* open the file */ 505a1bf3f78SToomas Soome fd = open(name, mode); 506a1bf3f78SToomas Soome free(name); 507a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), fd); 508a1bf3f78SToomas Soome } 509a1bf3f78SToomas Soome 510a1bf3f78SToomas Soome /* 511a1bf3f78SToomas Soome * fclose - close a file who's fd is on stack. 512a1bf3f78SToomas Soome * fclose ( fd -- ) 513a1bf3f78SToomas Soome */ 514a1bf3f78SToomas Soome static void 515a1bf3f78SToomas Soome pfclose(ficlVm *pVM) 516a1bf3f78SToomas Soome { 517a1bf3f78SToomas Soome int fd; 518a1bf3f78SToomas Soome 519a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0); 520a1bf3f78SToomas Soome 521a1bf3f78SToomas Soome fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */ 522a1bf3f78SToomas Soome if (fd != -1) 523a1bf3f78SToomas Soome close(fd); 524a1bf3f78SToomas Soome } 525a1bf3f78SToomas Soome 526a1bf3f78SToomas Soome /* 527a1bf3f78SToomas Soome * fread - read file contents 528a1bf3f78SToomas Soome * fread ( fd buf nbytes -- nread ) 529a1bf3f78SToomas Soome */ 530a1bf3f78SToomas Soome static void 531a1bf3f78SToomas Soome pfread(ficlVm *pVM) 532a1bf3f78SToomas Soome { 533a1bf3f78SToomas Soome int fd, len; 534a1bf3f78SToomas Soome char *buf; 535a1bf3f78SToomas Soome 536a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 1); 537a1bf3f78SToomas Soome 538a1bf3f78SToomas Soome len = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 539a1bf3f78SToomas Soome buf = ficlStackPopPointer(ficlVmGetDataStack(pVM)); /* get buffer */ 540a1bf3f78SToomas Soome fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */ 541a1bf3f78SToomas Soome if (len > 0 && buf && fd != -1) 542a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), 543a1bf3f78SToomas Soome read(fd, buf, len)); 544a1bf3f78SToomas Soome else 545a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), -1); 546a1bf3f78SToomas Soome } 547a1bf3f78SToomas Soome 548a1bf3f78SToomas Soome /* 549a1bf3f78SToomas Soome * fopendir - open directory 550a1bf3f78SToomas Soome * 551a1bf3f78SToomas Soome * fopendir ( addr len -- ptr TRUE | FALSE ) 552a1bf3f78SToomas Soome */ 553a1bf3f78SToomas Soome static void pfopendir(ficlVm *pVM) 554a1bf3f78SToomas Soome { 555a1bf3f78SToomas Soome #ifndef STAND 556a1bf3f78SToomas Soome DIR *dir; 557a1bf3f78SToomas Soome char *tmp; 558a1bf3f78SToomas Soome #else 559a1bf3f78SToomas Soome struct stat sb; 560a1bf3f78SToomas Soome int fd; 561a1bf3f78SToomas Soome #endif 562a1bf3f78SToomas Soome int count; 563a1bf3f78SToomas Soome char *ptr, *name; 564a1bf3f78SToomas Soome ficlInteger flag = FICL_FALSE; 565a1bf3f78SToomas Soome 566a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 2, 1); 567a1bf3f78SToomas Soome 568a1bf3f78SToomas Soome count = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 569a1bf3f78SToomas Soome ptr = ficlStackPopPointer(ficlVmGetDataStack(pVM)); /* get ptr */ 570a1bf3f78SToomas Soome 571a1bf3f78SToomas Soome if ((count < 0) || (ptr == NULL)) { 572a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), -1); 573a1bf3f78SToomas Soome return; 574a1bf3f78SToomas Soome } 575a1bf3f78SToomas Soome /* ensure that the string is null terminated */ 576a1bf3f78SToomas Soome name = (char *)malloc(count+1); 577a1bf3f78SToomas Soome bcopy(ptr, name, count); 578a1bf3f78SToomas Soome name[count] = 0; 579a1bf3f78SToomas Soome #ifndef STAND 580a1bf3f78SToomas Soome tmp = get_dev(name); 581a1bf3f78SToomas Soome free(name); 582a1bf3f78SToomas Soome name = tmp; 583a1bf3f78SToomas Soome #else 584a1bf3f78SToomas Soome fd = open(name, O_RDONLY); 585a1bf3f78SToomas Soome free(name); 586a1bf3f78SToomas Soome do { 587a1bf3f78SToomas Soome if (fd < 0) 588a1bf3f78SToomas Soome break; 589a1bf3f78SToomas Soome if (fstat(fd, &sb) < 0) 590a1bf3f78SToomas Soome break; 591a1bf3f78SToomas Soome if (!S_ISDIR(sb.st_mode)) 592a1bf3f78SToomas Soome break; 593a1bf3f78SToomas Soome flag = FICL_TRUE; 594a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), fd); 595a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), flag); 596a1bf3f78SToomas Soome return; 597a1bf3f78SToomas Soome } while (0); 598a1bf3f78SToomas Soome 599a1bf3f78SToomas Soome if (fd >= 0) 600a1bf3f78SToomas Soome close(fd); 601a1bf3f78SToomas Soome 602a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), flag); 603a1bf3f78SToomas Soome return; 604a1bf3f78SToomas Soome #endif 605a1bf3f78SToomas Soome #ifndef STAND 606a1bf3f78SToomas Soome dir = opendir(name); 607a1bf3f78SToomas Soome if (dir == NULL) { 608a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), flag); 609a1bf3f78SToomas Soome return; 610a1bf3f78SToomas Soome } else 611a1bf3f78SToomas Soome flag = FICL_TRUE; 612a1bf3f78SToomas Soome 613a1bf3f78SToomas Soome ficlStackPushPointer(ficlVmGetDataStack(pVM), dir); 614a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), flag); 615a1bf3f78SToomas Soome #endif 616a1bf3f78SToomas Soome } 617a1bf3f78SToomas Soome 618a1bf3f78SToomas Soome /* 619a1bf3f78SToomas Soome * freaddir - read directory contents 620a1bf3f78SToomas Soome * freaddir ( fd -- ptr len TRUE | FALSE ) 621a1bf3f78SToomas Soome */ 622a1bf3f78SToomas Soome static void 623a1bf3f78SToomas Soome pfreaddir(ficlVm *pVM) 624a1bf3f78SToomas Soome { 625a1bf3f78SToomas Soome #ifndef STAND 626a1bf3f78SToomas Soome static DIR *dir = NULL; 627a1bf3f78SToomas Soome #else 628a1bf3f78SToomas Soome int fd; 629a1bf3f78SToomas Soome #endif 630a1bf3f78SToomas Soome struct dirent *d = NULL; 631a1bf3f78SToomas Soome 632a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 3); 633a1bf3f78SToomas Soome /* 634a1bf3f78SToomas Soome * libstand readdir does not always return . nor .. so filter 635a1bf3f78SToomas Soome * them out to have consistent behaviour. 636a1bf3f78SToomas Soome */ 637a1bf3f78SToomas Soome #ifndef STAND 638a1bf3f78SToomas Soome dir = ficlStackPopPointer(ficlVmGetDataStack(pVM)); 639a1bf3f78SToomas Soome if (dir != NULL) 640a1bf3f78SToomas Soome do { 641a1bf3f78SToomas Soome d = readdir(dir); 642a1bf3f78SToomas Soome if (d != NULL && strcmp(d->d_name, ".") == 0) 643a1bf3f78SToomas Soome continue; 644a1bf3f78SToomas Soome if (d != NULL && strcmp(d->d_name, "..") == 0) 645a1bf3f78SToomas Soome continue; 646a1bf3f78SToomas Soome break; 647a1bf3f78SToomas Soome } while (d != NULL); 648a1bf3f78SToomas Soome #else 649a1bf3f78SToomas Soome fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 650a1bf3f78SToomas Soome if (fd != -1) 651a1bf3f78SToomas Soome do { 652a1bf3f78SToomas Soome d = readdirfd(fd); 653a1bf3f78SToomas Soome if (d != NULL && strcmp(d->d_name, ".") == 0) 654a1bf3f78SToomas Soome continue; 655a1bf3f78SToomas Soome if (d != NULL && strcmp(d->d_name, "..") == 0) 656a1bf3f78SToomas Soome continue; 657a1bf3f78SToomas Soome break; 658a1bf3f78SToomas Soome } while (d != NULL); 659a1bf3f78SToomas Soome #endif 660a1bf3f78SToomas Soome if (d != NULL) { 661a1bf3f78SToomas Soome ficlStackPushPointer(ficlVmGetDataStack(pVM), d->d_name); 662a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), 663a1bf3f78SToomas Soome strlen(d->d_name)); 664a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), FICL_TRUE); 665a1bf3f78SToomas Soome } else { 666a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), FICL_FALSE); 667a1bf3f78SToomas Soome } 668a1bf3f78SToomas Soome } 669a1bf3f78SToomas Soome 670a1bf3f78SToomas Soome /* 671a1bf3f78SToomas Soome * fclosedir - close a dir on stack. 672a1bf3f78SToomas Soome * 673a1bf3f78SToomas Soome * fclosedir ( fd -- ) 674a1bf3f78SToomas Soome */ 675a1bf3f78SToomas Soome static void 676a1bf3f78SToomas Soome pfclosedir(ficlVm *pVM) 677a1bf3f78SToomas Soome { 678a1bf3f78SToomas Soome #ifndef STAND 679a1bf3f78SToomas Soome DIR *dir; 680a1bf3f78SToomas Soome #else 681a1bf3f78SToomas Soome int fd; 682a1bf3f78SToomas Soome #endif 683a1bf3f78SToomas Soome 684a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0); 685a1bf3f78SToomas Soome 686a1bf3f78SToomas Soome #ifndef STAND 687a1bf3f78SToomas Soome dir = ficlStackPopPointer(ficlVmGetDataStack(pVM)); /* get dir */ 688a1bf3f78SToomas Soome if (dir != NULL) 689a1bf3f78SToomas Soome closedir(dir); 690a1bf3f78SToomas Soome #else 691a1bf3f78SToomas Soome fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */ 692a1bf3f78SToomas Soome if (fd != -1) 693a1bf3f78SToomas Soome close(fd); 694a1bf3f78SToomas Soome #endif 695a1bf3f78SToomas Soome } 696a1bf3f78SToomas Soome 697a1bf3f78SToomas Soome /* 698a1bf3f78SToomas Soome * fload - interpret file contents 699a1bf3f78SToomas Soome * 700a1bf3f78SToomas Soome * fload ( fd -- ) 701a1bf3f78SToomas Soome */ 702a1bf3f78SToomas Soome static void pfload(ficlVm *pVM) 703a1bf3f78SToomas Soome { 704a1bf3f78SToomas Soome int fd; 705a1bf3f78SToomas Soome 706a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0); 707a1bf3f78SToomas Soome 708a1bf3f78SToomas Soome fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */ 709a1bf3f78SToomas Soome if (fd != -1) 710a1bf3f78SToomas Soome ficlExecFD(pVM, fd); 711a1bf3f78SToomas Soome } 712a1bf3f78SToomas Soome 713a1bf3f78SToomas Soome /* 714a1bf3f78SToomas Soome * fwrite - write file contents 715a1bf3f78SToomas Soome * 716a1bf3f78SToomas Soome * fwrite ( fd buf nbytes -- nwritten ) 717a1bf3f78SToomas Soome */ 718a1bf3f78SToomas Soome static void 719a1bf3f78SToomas Soome pfwrite(ficlVm *pVM) 720a1bf3f78SToomas Soome { 721a1bf3f78SToomas Soome int fd, len; 722a1bf3f78SToomas Soome char *buf; 723a1bf3f78SToomas Soome 724a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 1); 725a1bf3f78SToomas Soome 726a1bf3f78SToomas Soome len = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* bytes to read */ 727a1bf3f78SToomas Soome buf = ficlStackPopPointer(ficlVmGetDataStack(pVM)); /* get buffer */ 728a1bf3f78SToomas Soome fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); /* get fd */ 729a1bf3f78SToomas Soome if (len > 0 && buf && fd != -1) 730a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), 731a1bf3f78SToomas Soome write(fd, buf, len)); 732a1bf3f78SToomas Soome else 733a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), -1); 734a1bf3f78SToomas Soome } 735a1bf3f78SToomas Soome 736a1bf3f78SToomas Soome /* 737a1bf3f78SToomas Soome * fseek - seek to a new position in a file 738a1bf3f78SToomas Soome * 739a1bf3f78SToomas Soome * fseek ( fd ofs whence -- pos ) 740a1bf3f78SToomas Soome */ 741a1bf3f78SToomas Soome static void 742a1bf3f78SToomas Soome pfseek(ficlVm *pVM) 743a1bf3f78SToomas Soome { 744a1bf3f78SToomas Soome int fd, pos, whence; 745a1bf3f78SToomas Soome 746a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 3, 1); 747a1bf3f78SToomas Soome 748a1bf3f78SToomas Soome whence = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 749a1bf3f78SToomas Soome pos = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 750a1bf3f78SToomas Soome fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 751a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), lseek(fd, pos, whence)); 752a1bf3f78SToomas Soome } 753a1bf3f78SToomas Soome 754a1bf3f78SToomas Soome /* 755a1bf3f78SToomas Soome * key - get a character from stdin 756a1bf3f78SToomas Soome * 757a1bf3f78SToomas Soome * key ( -- char ) 758a1bf3f78SToomas Soome */ 759a1bf3f78SToomas Soome static void 760a1bf3f78SToomas Soome key(ficlVm *pVM) 761a1bf3f78SToomas Soome { 762a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 0, 1); 763a1bf3f78SToomas Soome 764a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), getchar()); 765a1bf3f78SToomas Soome } 766a1bf3f78SToomas Soome 767a1bf3f78SToomas Soome /* 768a1bf3f78SToomas Soome * key? - check for a character from stdin (FACILITY) 769a1bf3f78SToomas Soome * key? ( -- flag ) 770a1bf3f78SToomas Soome */ 771a1bf3f78SToomas Soome static void 772a1bf3f78SToomas Soome keyQuestion(ficlVm *pVM) 773a1bf3f78SToomas Soome { 774a1bf3f78SToomas Soome #ifndef STAND 775a1bf3f78SToomas Soome char ch = -1; 776a1bf3f78SToomas Soome struct termios oldt; 777a1bf3f78SToomas Soome struct termios newt; 778a1bf3f78SToomas Soome #endif 779a1bf3f78SToomas Soome 780a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 0, 1); 781a1bf3f78SToomas Soome 782a1bf3f78SToomas Soome #ifndef STAND 783a1bf3f78SToomas Soome tcgetattr(STDIN_FILENO, &oldt); 784a1bf3f78SToomas Soome newt = oldt; 785a1bf3f78SToomas Soome newt.c_lflag &= ~(ICANON | ECHO); 786a1bf3f78SToomas Soome newt.c_cc[VMIN] = 0; 787a1bf3f78SToomas Soome newt.c_cc[VTIME] = 0; 788a1bf3f78SToomas Soome tcsetattr(STDIN_FILENO, TCSANOW, &newt); 789a1bf3f78SToomas Soome ch = getchar(); 790a1bf3f78SToomas Soome tcsetattr(STDIN_FILENO, TCSANOW, &oldt); 791a1bf3f78SToomas Soome 792a1bf3f78SToomas Soome if (ch != -1) 793a1bf3f78SToomas Soome (void) ungetc(ch, stdin); 794a1bf3f78SToomas Soome 795a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), 796a1bf3f78SToomas Soome ch != -1? FICL_TRUE : FICL_FALSE); 797a1bf3f78SToomas Soome #else 798a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), 799a1bf3f78SToomas Soome ischar()? FICL_TRUE : FICL_FALSE); 800a1bf3f78SToomas Soome #endif 801a1bf3f78SToomas Soome } 802a1bf3f78SToomas Soome 803a1bf3f78SToomas Soome /* 804a1bf3f78SToomas Soome * seconds - gives number of seconds since beginning of time 805a1bf3f78SToomas Soome * 806a1bf3f78SToomas Soome * beginning of time is defined as: 807a1bf3f78SToomas Soome * 808a1bf3f78SToomas Soome * BTX - number of seconds since midnight 809a1bf3f78SToomas Soome * FreeBSD - number of seconds since Jan 1 1970 810a1bf3f78SToomas Soome * 811a1bf3f78SToomas Soome * seconds ( -- u ) 812a1bf3f78SToomas Soome */ 813a1bf3f78SToomas Soome static void 814a1bf3f78SToomas Soome pseconds(ficlVm *pVM) 815a1bf3f78SToomas Soome { 816a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 0, 1); 817a1bf3f78SToomas Soome 818a1bf3f78SToomas Soome ficlStackPushUnsigned(ficlVmGetDataStack(pVM), 819a1bf3f78SToomas Soome (ficlUnsigned) time(NULL)); 820a1bf3f78SToomas Soome } 821a1bf3f78SToomas Soome 822a1bf3f78SToomas Soome /* 823a1bf3f78SToomas Soome * ms - wait at least that many milliseconds (FACILITY) 824a1bf3f78SToomas Soome * ms ( u -- ) 825a1bf3f78SToomas Soome */ 826a1bf3f78SToomas Soome static void 827a1bf3f78SToomas Soome ms(ficlVm *pVM) 828a1bf3f78SToomas Soome { 829a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 0); 830a1bf3f78SToomas Soome 831a1bf3f78SToomas Soome #ifndef STAND 832a1bf3f78SToomas Soome usleep(ficlStackPopUnsigned(ficlVmGetDataStack(pVM)) * 1000); 833a1bf3f78SToomas Soome #else 834a1bf3f78SToomas Soome delay(ficlStackPopUnsigned(ficlVmGetDataStack(pVM)) * 1000); 835a1bf3f78SToomas Soome #endif 836a1bf3f78SToomas Soome } 837a1bf3f78SToomas Soome 838a1bf3f78SToomas Soome /* 839a1bf3f78SToomas Soome * fkey - get a character from a file 840a1bf3f78SToomas Soome * fkey ( file -- char ) 841a1bf3f78SToomas Soome */ 842a1bf3f78SToomas Soome static void 843a1bf3f78SToomas Soome fkey(ficlVm *pVM) 844a1bf3f78SToomas Soome { 845a1bf3f78SToomas Soome int i, fd; 846a1bf3f78SToomas Soome char ch; 847a1bf3f78SToomas Soome 848a1bf3f78SToomas Soome FICL_STACK_CHECK(ficlVmGetDataStack(pVM), 1, 1); 849a1bf3f78SToomas Soome 850a1bf3f78SToomas Soome fd = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 851a1bf3f78SToomas Soome i = read(fd, &ch, 1); 852a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), i > 0 ? ch : -1); 853a1bf3f78SToomas Soome } 854a1bf3f78SToomas Soome 855a1bf3f78SToomas Soome 856a1bf3f78SToomas Soome #ifdef STAND 857a1bf3f78SToomas Soome #ifdef __i386__ 858a1bf3f78SToomas Soome 859a1bf3f78SToomas Soome /* 860a1bf3f78SToomas Soome * outb ( port# c -- ) 861a1bf3f78SToomas Soome * Store a byte to I/O port number port# 862a1bf3f78SToomas Soome */ 863a1bf3f78SToomas Soome void 864a1bf3f78SToomas Soome ficlOutb(ficlVm *pVM) 865a1bf3f78SToomas Soome { 866a1bf3f78SToomas Soome uint8_t c; 867a1bf3f78SToomas Soome uint32_t port; 868a1bf3f78SToomas Soome 869a1bf3f78SToomas Soome port = ficlStackPopUnsigned(ficlVmGetDataStack(pVM)); 870a1bf3f78SToomas Soome c = ficlStackPopInteger(ficlVmGetDataStack(pVM)); 871a1bf3f78SToomas Soome outb(port, c); 872a1bf3f78SToomas Soome } 873a1bf3f78SToomas Soome 874a1bf3f78SToomas Soome /* 875a1bf3f78SToomas Soome * inb ( port# -- c ) 876a1bf3f78SToomas Soome * Fetch a byte from I/O port number port# 877a1bf3f78SToomas Soome */ 878a1bf3f78SToomas Soome void 879a1bf3f78SToomas Soome ficlInb(ficlVm *pVM) 880a1bf3f78SToomas Soome { 881a1bf3f78SToomas Soome uint8_t c; 882a1bf3f78SToomas Soome uint32_t port; 883a1bf3f78SToomas Soome 884a1bf3f78SToomas Soome port = ficlStackPopUnsigned(ficlVmGetDataStack(pVM)); 885a1bf3f78SToomas Soome c = inb(port); 886a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), c); 887a1bf3f78SToomas Soome } 888a1bf3f78SToomas Soome #endif 889a1bf3f78SToomas Soome #endif 890a1bf3f78SToomas Soome 891a1bf3f78SToomas Soome /* 892a1bf3f78SToomas Soome * Retrieves free space remaining on the dictionary 893a1bf3f78SToomas Soome */ 894a1bf3f78SToomas Soome static void 895a1bf3f78SToomas Soome freeHeap(ficlVm *pVM) 896a1bf3f78SToomas Soome { 897a1bf3f78SToomas Soome ficlStackPushInteger(ficlVmGetDataStack(pVM), 898a1bf3f78SToomas Soome ficlDictionaryCellsAvailable(ficlVmGetDictionary(pVM))); 899a1bf3f78SToomas Soome } 900a1bf3f78SToomas Soome 901a1bf3f78SToomas Soome /* 902a1bf3f78SToomas Soome * f i c l C o m p i l e P l a t f o r m 903a1bf3f78SToomas Soome * Build FreeBSD platform extensions into the system dictionary 904a1bf3f78SToomas Soome */ 905a1bf3f78SToomas Soome void 906a1bf3f78SToomas Soome ficlSystemCompilePlatform(ficlSystem *pSys) 907a1bf3f78SToomas Soome { 908a1bf3f78SToomas Soome ficlDictionary *dp = ficlSystemGetDictionary(pSys); 909a1bf3f78SToomas Soome ficlDictionary *env = ficlSystemGetEnvironment(pSys); 910*d5a0772bSToomas Soome #ifdef STAND 911*d5a0772bSToomas Soome ficlCompileFcn **fnpp; 912*d5a0772bSToomas Soome #endif 913a1bf3f78SToomas Soome 914a1bf3f78SToomas Soome FICL_SYSTEM_ASSERT(pSys, dp); 915a1bf3f78SToomas Soome FICL_SYSTEM_ASSERT(pSys, env); 916a1bf3f78SToomas Soome 917a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, ".#", displayCellNoPad, 918a1bf3f78SToomas Soome FICL_WORD_DEFAULT); 919a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "isdir?", isdirQuestion, 920a1bf3f78SToomas Soome FICL_WORD_DEFAULT); 921a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "fopen", pfopen, FICL_WORD_DEFAULT); 922a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "fclose", pfclose, FICL_WORD_DEFAULT); 923a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "fread", pfread, FICL_WORD_DEFAULT); 924a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "fopendir", pfopendir, 925a1bf3f78SToomas Soome FICL_WORD_DEFAULT); 926a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "freaddir", pfreaddir, 927a1bf3f78SToomas Soome FICL_WORD_DEFAULT); 928a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "fclosedir", pfclosedir, 929a1bf3f78SToomas Soome FICL_WORD_DEFAULT); 930a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "fload", pfload, FICL_WORD_DEFAULT); 931a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "fkey", fkey, FICL_WORD_DEFAULT); 932a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "fseek", pfseek, FICL_WORD_DEFAULT); 933a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "fwrite", pfwrite, FICL_WORD_DEFAULT); 934a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "key", key, FICL_WORD_DEFAULT); 935a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "key?", keyQuestion, FICL_WORD_DEFAULT); 936a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "ms", ms, FICL_WORD_DEFAULT); 937a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "seconds", pseconds, FICL_WORD_DEFAULT); 938a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "heap?", freeHeap, FICL_WORD_DEFAULT); 939a1bf3f78SToomas Soome 940a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "setenv", ficlSetenv, FICL_WORD_DEFAULT); 941a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "setenv?", ficlSetenvq, 942a1bf3f78SToomas Soome FICL_WORD_DEFAULT); 943a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "getenv", ficlGetenv, FICL_WORD_DEFAULT); 944a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "unsetenv", ficlUnsetenv, 945a1bf3f78SToomas Soome FICL_WORD_DEFAULT); 946a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "copyin", ficlCopyin, FICL_WORD_DEFAULT); 947a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "copyout", ficlCopyout, 948a1bf3f78SToomas Soome FICL_WORD_DEFAULT); 949a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "findfile", ficlFindfile, 950a1bf3f78SToomas Soome FICL_WORD_DEFAULT); 951a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "ccall", ficlCcall, FICL_WORD_DEFAULT); 952065446baSToomas Soome ficlDictionarySetPrimitive(dp, "uuid-from-string", ficlUuidFromString, 953065446baSToomas Soome FICL_WORD_DEFAULT); 954065446baSToomas Soome ficlDictionarySetPrimitive(dp, "uuid-to-string", ficlUuidToString, 955065446baSToomas Soome FICL_WORD_DEFAULT); 956a1bf3f78SToomas Soome #ifdef STAND 957a1bf3f78SToomas Soome #ifdef __i386__ 958a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "outb", ficlOutb, FICL_WORD_DEFAULT); 959a1bf3f78SToomas Soome ficlDictionarySetPrimitive(dp, "inb", ficlInb, FICL_WORD_DEFAULT); 960a1bf3f78SToomas Soome #endif 961*d5a0772bSToomas Soome /* Register words from linker set. */ 962*d5a0772bSToomas Soome SET_FOREACH(fnpp, Xficl_compile_set) 963*d5a0772bSToomas Soome (*fnpp)(pSys); 964a1bf3f78SToomas Soome #endif 965a1bf3f78SToomas Soome 966a1bf3f78SToomas Soome #if defined(__i386__) || defined(__amd64__) 967a1bf3f78SToomas Soome ficlDictionarySetConstant(env, "arch-i386", FICL_TRUE); 968a1bf3f78SToomas Soome ficlDictionarySetConstant(env, "arch-sparc", FICL_FALSE); 969a1bf3f78SToomas Soome #endif 970a1bf3f78SToomas Soome #ifdef __sparc 971a1bf3f78SToomas Soome ficlDictionarySetConstant(env, "arch-i386", FICL_FALSE); 972a1bf3f78SToomas Soome ficlDictionarySetConstant(env, "arch-sparc", FICL_TRUE); 973a1bf3f78SToomas Soome #endif 974a1bf3f78SToomas Soome } 975