From owner-svn-soc-all@FreeBSD.ORG Thu Jun 11 22:14:13 2015 Return-Path: Delivered-To: svn-soc-all@hub.freebsd.org Received: from mx1.freebsd.org (mx1.freebsd.org [IPv6:2001:1900:2254:206a::19:1]) (using TLSv1.2 with cipher AECDH-AES256-SHA (256/256 bits)) (No client certificate requested) by hub.freebsd.org (Postfix) with ESMTPS id 81C81294 for ; Thu, 11 Jun 2015 22:14:13 +0000 (UTC) (envelope-from clord@FreeBSD.org) Received: from socsvn.freebsd.org (socsvn.freebsd.org [IPv6:2001:1900:2254:206a::50:2]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (Client did not present a certificate) by mx1.freebsd.org (Postfix) with ESMTPS id 6DD711B0F for ; Thu, 11 Jun 2015 22:14:13 +0000 (UTC) (envelope-from clord@FreeBSD.org) Received: from socsvn.freebsd.org ([127.0.1.124]) by socsvn.freebsd.org (8.14.9/8.14.9) with ESMTP id t5BMEDmq091506 for ; Thu, 11 Jun 2015 22:14:13 GMT (envelope-from clord@FreeBSD.org) Received: (from www@localhost) by socsvn.freebsd.org (8.14.9/8.14.9/Submit) id t5BMEAuL091452 for svn-soc-all@FreeBSD.org; Thu, 11 Jun 2015 22:14:10 GMT (envelope-from clord@FreeBSD.org) Date: Thu, 11 Jun 2015 22:14:10 GMT Message-Id: <201506112214.t5BMEAuL091452@socsvn.freebsd.org> X-Authentication-Warning: socsvn.freebsd.org: www set sender to clord@FreeBSD.org using -f From: clord@FreeBSD.org To: svn-soc-all@FreeBSD.org Subject: socsvn commit: r286978 - in soc2015/clord/head/sys/contrib/ficl: . aarch64 amd64 arm i386 mips mips64 powerpc softwords sparc64 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-BeenThere: svn-soc-all@freebsd.org X-Mailman-Version: 2.1.20 Precedence: list List-Id: SVN commit messages for the entire Summer of Code repository List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 11 Jun 2015 22:14:13 -0000 Author: clord Date: Thu Jun 11 22:14:09 2015 New Revision: 286978 URL: http://svnweb.FreeBSD.org/socsvn/?view=rev&rev=286978 Log: Add FreeBSD ficl customizations back into vendor code Added: soc2015/clord/head/sys/contrib/ficl/aarch64/ - copied from r286905, soc2015/clord/head/sys/boot/ficl/aarch64/ soc2015/clord/head/sys/contrib/ficl/amd64/ - copied from r286905, soc2015/clord/head/sys/boot/ficl/amd64/ soc2015/clord/head/sys/contrib/ficl/arm/ - copied from r286905, soc2015/clord/head/sys/boot/ficl/arm/ soc2015/clord/head/sys/contrib/ficl/i386/ - copied from r286905, soc2015/clord/head/sys/boot/ficl/i386/ soc2015/clord/head/sys/contrib/ficl/loader.c - copied unchanged from r286905, soc2015/clord/head/sys/boot/ficl/loader.c soc2015/clord/head/sys/contrib/ficl/mips/ - copied from r286905, soc2015/clord/head/sys/boot/ficl/mips/ soc2015/clord/head/sys/contrib/ficl/mips64/ - copied from r286905, soc2015/clord/head/sys/boot/ficl/mips64/ soc2015/clord/head/sys/contrib/ficl/powerpc/ - copied from r286905, soc2015/clord/head/sys/boot/ficl/powerpc/ soc2015/clord/head/sys/contrib/ficl/sparc64/ - copied from r286905, soc2015/clord/head/sys/boot/ficl/sparc64/ Modified: soc2015/clord/head/sys/contrib/ficl/dict.c soc2015/clord/head/sys/contrib/ficl/ficl.c soc2015/clord/head/sys/contrib/ficl/ficl.h soc2015/clord/head/sys/contrib/ficl/fileaccess.c soc2015/clord/head/sys/contrib/ficl/float.c soc2015/clord/head/sys/contrib/ficl/math64.c soc2015/clord/head/sys/contrib/ficl/math64.h soc2015/clord/head/sys/contrib/ficl/prefix.c soc2015/clord/head/sys/contrib/ficl/search.c soc2015/clord/head/sys/contrib/ficl/softwords/classes.fr soc2015/clord/head/sys/contrib/ficl/softwords/ficlclass.fr soc2015/clord/head/sys/contrib/ficl/softwords/ficllocal.fr soc2015/clord/head/sys/contrib/ficl/softwords/fileaccess.fr soc2015/clord/head/sys/contrib/ficl/softwords/forml.fr soc2015/clord/head/sys/contrib/ficl/softwords/ifbrack.fr soc2015/clord/head/sys/contrib/ficl/softwords/jhlocal.fr soc2015/clord/head/sys/contrib/ficl/softwords/marker.fr soc2015/clord/head/sys/contrib/ficl/softwords/oo.fr soc2015/clord/head/sys/contrib/ficl/softwords/prefix.fr soc2015/clord/head/sys/contrib/ficl/softwords/softcore.fr soc2015/clord/head/sys/contrib/ficl/softwords/string.fr soc2015/clord/head/sys/contrib/ficl/stack.c soc2015/clord/head/sys/contrib/ficl/testmain.c soc2015/clord/head/sys/contrib/ficl/tools.c soc2015/clord/head/sys/contrib/ficl/unix.c soc2015/clord/head/sys/contrib/ficl/vm.c soc2015/clord/head/sys/contrib/ficl/words.c Modified: soc2015/clord/head/sys/contrib/ficl/dict.c ============================================================================== --- soc2015/clord/head/sys/contrib/ficl/dict.c Thu Jun 11 21:13:05 2015 (r286977) +++ soc2015/clord/head/sys/contrib/ficl/dict.c Thu Jun 11 22:14:09 2015 (r286978) @@ -3,7 +3,7 @@ ** Forth Inspired Command Language - dictionary methods ** Author: John Sadler (john_sadler@alum.mit.edu) ** Created: 19 July 1997 -** $Id: dict.c,v 1.12 2001-10-28 10:59:22-08 jsadler Exp jsadler $ +** $Id: dict.c,v 1.14 2001/12/05 07:21:34 jsadler Exp $ *******************************************************************/ /* ** This file implements the dictionary -- FICL's model of @@ -51,12 +51,22 @@ ** SUCH DAMAGE. */ -#include -#include /* sprintf */ -#include +/* $FreeBSD$ */ + +#ifdef TESTMAIN +#include #include +#else +#include +#endif +#include #include "ficl.h" +/* Dictionary on-demand resizing control variables */ +CELL dictThreshold; +CELL dictIncrease; + + static char *dictCopyName(FICL_DICT *pDict, STRINGINFO si); /************************************************************************** @@ -378,11 +388,14 @@ FICL_DICT *pDict; size_t nAlloc; - nAlloc = sizeof (FICL_DICT) + nCells * sizeof (CELL) - + sizeof (FICL_HASH) + (nHash - 1) * sizeof (FICL_WORD *); + nAlloc = sizeof (FICL_HASH) + nCells * sizeof (CELL) + + (nHash - 1) * sizeof (FICL_WORD *); - pDict = ficlMalloc(nAlloc); + pDict = ficlMalloc(sizeof (FICL_DICT)); assert(pDict); + memset(pDict, 0, sizeof (FICL_DICT)); + pDict->dict = ficlMalloc(nAlloc); + assert(pDict->dict); pDict->size = nCells; dictEmpty(pDict, nHash); @@ -537,7 +550,6 @@ ); } - /************************************************************************** d i c t L o o k u p ** Find the FICL_WORD that matches the given name and length. @@ -833,4 +845,20 @@ return; } +/************************************************************************** + d i c t C h e c k T h r e s h o l d +** Verify if an increase in the dictionary size is warranted, and do it if +** so. +**************************************************************************/ + +void dictCheckThreshold(FICL_DICT* dp) +{ + if( dictCellsAvail(dp) < dictThreshold.u ) { + dp->dict = ficlMalloc( dictIncrease.u * sizeof (CELL) ); + assert(dp->dict); + dp->here = dp->dict; + dp->size = dictIncrease.u; + dictAlign(dp); + } +} Modified: soc2015/clord/head/sys/contrib/ficl/ficl.c ============================================================================== --- soc2015/clord/head/sys/contrib/ficl/ficl.c Thu Jun 11 21:13:05 2015 (r286977) +++ soc2015/clord/head/sys/contrib/ficl/ficl.c Thu Jun 11 22:14:09 2015 (r286978) @@ -3,7 +3,7 @@ ** Forth Inspired Command Language - external interface ** Author: John Sadler (john_sadler@alum.mit.edu) ** Created: 19 July 1997 -** $Id: ficl.c,v 1.17 2001-12-04 17:58:11-08 jsadler Exp jsadler $ +** $Id: ficl.c,v 1.16 2001/12/05 07:21:34 jsadler Exp $ *******************************************************************/ /* ** This is an ANS Forth interpreter written in C. @@ -55,7 +55,13 @@ ** SUCH DAMAGE. */ +/* $FreeBSD$ */ + +#ifdef TESTMAIN #include +#else +#include +#endif #include #include "ficl.h" @@ -407,8 +413,10 @@ case VM_OUTOFTEXT: vmPopIP(pVM); +#ifdef TESTMAIN if ((pVM->state != COMPILE) && (pVM->sourceID.i == 0)) ficlTextOut(pVM, FICL_PROMPT, 0); +#endif break; case VM_USEREXIT: @@ -681,10 +689,7 @@ **************************************************************************/ static void ficlSetVersionEnv(FICL_SYSTEM *pSys) { - int major = 0; - int minor = 0; - sscanf(FICL_VER, "%d.%d", &major, &minor); - ficlSetEnvD(pSys, "ficl-version", major, minor); + ficlSetEnvD(pSys, "ficl-version", FICL_VER_MAJOR, FICL_VER_MINOR); ficlSetEnv (pSys, "ficl-robust", FICL_ROBUST); return; } Modified: soc2015/clord/head/sys/contrib/ficl/ficl.h ============================================================================== --- soc2015/clord/head/sys/contrib/ficl/ficl.h Thu Jun 11 21:13:05 2015 (r286977) +++ soc2015/clord/head/sys/contrib/ficl/ficl.h Thu Jun 11 22:14:09 2015 (r286978) @@ -4,7 +4,7 @@ ** Author: John Sadler (john_sadler@alum.mit.edu) ** Created: 19 July 1997 ** Dedicated to RHS, in loving memory -** $Id: ficl.h,v 1.19 2001-12-04 17:58:07-08 jsadler Exp jsadler $ +** $Id: ficl.h,v 1.18 2001/12/05 07:21:34 jsadler Exp $ *******************************************************************/ /* ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu) @@ -41,6 +41,8 @@ ** SUCH DAMAGE. */ +/* $FreeBSD$ */ + #if !defined (__FICL_H__) #define __FICL_H__ /* @@ -217,7 +219,6 @@ #include "sysdep.h" #include /* UCHAR_MAX */ -#include /* ** Forward declarations... read on. @@ -236,7 +237,9 @@ /* ** the Good Stuff starts here... */ -#define FICL_VER "3.03" +#define FICL_VER "3.03" +#define FICL_VER_MAJOR 3 +#define FICL_VER_MINOR 3 #if !defined (FICL_PROMPT) #define FICL_PROMPT "ok> " #endif @@ -732,7 +735,7 @@ FICL_HASH *pSearch[FICL_DEFAULT_VOCS]; int nLists; unsigned size; /* Number of cells in dict (total)*/ - CELL dict[1]; /* Base of dictionary memory */ + CELL *dict; /* Base of dictionary memory */ }; void *alignPtr(void *ptr); @@ -754,6 +757,7 @@ int dictCellsAvail (FICL_DICT *pDict); int dictCellsUsed (FICL_DICT *pDict); void dictCheck (FICL_DICT *pDict, FICL_VM *pVM, int n); +void dictCheckThreshold(FICL_DICT* dp); FICL_DICT *dictCreate(unsigned nCELLS); FICL_DICT *dictCreateHashed(unsigned nCells, unsigned nHash); FICL_HASH *dictCreateWordlist(FICL_DICT *dp, int nBuckets); @@ -969,6 +973,14 @@ int ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord); /* +** ficlExecFD(FICL_VM *pVM, int fd); + * Evaluates text from file passed in via fd. + * Execution returns when all of file has been executed or an + * error occurs. + */ +int ficlExecFD(FICL_VM *pVM, int fd); + +/* ** Create a new VM from the heap, and link it into the system VM list. ** Initializes the VM and binds default sized stacks to it. Returns the ** address of the VM, or NULL if an error occurs. @@ -1091,7 +1103,33 @@ WORDKIND ficlWordClassify(FICL_WORD *pFW); +/* +** Dictionary on-demand resizing +*/ +extern CELL dictThreshold; +extern CELL dictIncrease; + +/* +** Various FreeBSD goodies +*/ + +#if defined(__i386__) && !defined(TESTMAIN) +extern void ficlOutb(FICL_VM *pVM); +extern void ficlInb(FICL_VM *pVM); +#endif +extern void ficlSetenv(FICL_VM *pVM); +extern void ficlSetenvq(FICL_VM *pVM); +extern void ficlGetenv(FICL_VM *pVM); +extern void ficlUnsetenv(FICL_VM *pVM); +extern void ficlCopyin(FICL_VM *pVM); +extern void ficlCopyout(FICL_VM *pVM); +extern void ficlFindfile(FICL_VM *pVM); +extern void ficlCcall(FICL_VM *pVM); +#if !defined(TESTMAIN) +extern void ficlPnpdevices(FICL_VM *pVM); +extern void ficlPnphandlers(FICL_VM *pVM); +#endif /* ** Used with File-Access wordset. @@ -1104,11 +1142,13 @@ #define FICL_FAM_OPEN_MODE(fam) ((fam) & (FICL_FAM_READ | FICL_FAM_WRITE | FICL_FAM_APPEND)) +#if (FICL_WANT_FILE) typedef struct ficlFILE { FILE *f; char filename[256]; } ficlFILE; +#endif #ifdef __cplusplus } Modified: soc2015/clord/head/sys/contrib/ficl/fileaccess.c ============================================================================== --- soc2015/clord/head/sys/contrib/ficl/fileaccess.c Thu Jun 11 21:13:05 2015 (r286977) +++ soc2015/clord/head/sys/contrib/ficl/fileaccess.c Thu Jun 11 22:14:09 2015 (r286978) @@ -1,3 +1,5 @@ +/* $FreeBSD$ */ + #include #include #include @@ -418,6 +420,6 @@ ficlSetEnv(pSys, "file-ext", FICL_TRUE); #endif /* FICL_HAVE_FTRUNCATE */ #else - &pSys; + (void)pSys; #endif /* FICL_WANT_FILE */ } Modified: soc2015/clord/head/sys/contrib/ficl/float.c ============================================================================== --- soc2015/clord/head/sys/contrib/ficl/float.c Thu Jun 11 21:13:05 2015 (r286977) +++ soc2015/clord/head/sys/contrib/ficl/float.c Thu Jun 11 22:14:09 2015 (r286978) @@ -4,7 +4,7 @@ ** ANS Forth FLOAT word-set written in C ** Author: Guy Carver & John Sadler (john_sadler@alum.mit.edu) ** Created: Apr 2001 -** $Id: float.c,v 1.8 2001-12-04 17:58:16-08 jsadler Exp jsadler $ +** $Id: float.c,v 1.8 2001/12/05 07:21:34 jsadler Exp $ *******************************************************************/ /* ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu) @@ -41,6 +41,8 @@ ** SUCH DAMAGE. */ +/* $FreeBSD$ */ + #include #include #include Copied: soc2015/clord/head/sys/contrib/ficl/loader.c (from r286905, soc2015/clord/head/sys/boot/ficl/loader.c) ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ soc2015/clord/head/sys/contrib/ficl/loader.c Thu Jun 11 22:14:09 2015 (r286978, copy of r286905, soc2015/clord/head/sys/boot/ficl/loader.c) @@ -0,0 +1,953 @@ +/*- + * Copyright (c) 2000 Daniel Capo Sobral + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + * SUCH DAMAGE. + * + * $FreeBSD$ + */ + +/******************************************************************* +** l o a d e r . c +** Additional FICL words designed for FreeBSD's loader +** +*******************************************************************/ + +#ifdef TESTMAIN +#include +#include +#include +#include +#include +#include +#include +#else +#include +#endif +#include "bootstrap.h" +#include +#include "ficl.h" + +/* FreeBSD's loader interaction words and extras + * + * setenv ( value n name n' -- ) + * setenv? ( value n name n' flag -- ) + * getenv ( addr n -- addr' n' | -1 ) + * unsetenv ( addr n -- ) + * copyin ( addr addr' len -- ) + * copyout ( addr addr' len -- ) + * findfile ( name len type len' -- addr ) + * pnpdevices ( -- addr ) + * pnphandlers ( -- addr ) + * ccall ( [[...[p10] p9] ... p1] n addr -- result ) + * .# ( value -- ) + */ + +void +ficlSetenv(FICL_VM *pVM) +{ +#ifndef TESTMAIN + char *name, *value; +#endif + char *namep, *valuep; + int names, values; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 4, 0); +#endif + names = stackPopINT(pVM->pStack); + namep = (char*) stackPopPtr(pVM->pStack); + values = stackPopINT(pVM->pStack); + valuep = (char*) stackPopPtr(pVM->pStack); + +#ifndef TESTMAIN + name = (char*) ficlMalloc(names+1); + if (!name) + vmThrowErr(pVM, "Error: out of memory"); + strncpy(name, namep, names); + name[names] = '\0'; + value = (char*) ficlMalloc(values+1); + if (!value) + vmThrowErr(pVM, "Error: out of memory"); + strncpy(value, valuep, values); + value[values] = '\0'; + + setenv(name, value, 1); + ficlFree(name); + ficlFree(value); +#endif + + return; +} + +void +ficlSetenvq(FICL_VM *pVM) +{ +#ifndef TESTMAIN + char *name, *value; +#endif + char *namep, *valuep; + int names, values, overwrite; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 5, 0); +#endif + overwrite = stackPopINT(pVM->pStack); + names = stackPopINT(pVM->pStack); + namep = (char*) stackPopPtr(pVM->pStack); + values = stackPopINT(pVM->pStack); + valuep = (char*) stackPopPtr(pVM->pStack); + +#ifndef TESTMAIN + name = (char*) ficlMalloc(names+1); + if (!name) + vmThrowErr(pVM, "Error: out of memory"); + strncpy(name, namep, names); + name[names] = '\0'; + value = (char*) ficlMalloc(values+1); + if (!value) + vmThrowErr(pVM, "Error: out of memory"); + strncpy(value, valuep, values); + value[values] = '\0'; + + setenv(name, value, overwrite); + ficlFree(name); + ficlFree(value); +#endif + + return; +} + +void +ficlGetenv(FICL_VM *pVM) +{ +#ifndef TESTMAIN + char *name, *value; +#endif + char *namep; + int names; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 2, 2); +#endif + names = stackPopINT(pVM->pStack); + namep = (char*) stackPopPtr(pVM->pStack); + +#ifndef TESTMAIN + name = (char*) ficlMalloc(names+1); + if (!name) + vmThrowErr(pVM, "Error: out of memory"); + strncpy(name, namep, names); + name[names] = '\0'; + + value = getenv(name); + ficlFree(name); + + if(value != NULL) { + stackPushPtr(pVM->pStack, value); + stackPushINT(pVM->pStack, strlen(value)); + } else +#endif + stackPushINT(pVM->pStack, -1); + + return; +} + +void +ficlUnsetenv(FICL_VM *pVM) +{ +#ifndef TESTMAIN + char *name; +#endif + char *namep; + int names; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 2, 0); +#endif + names = stackPopINT(pVM->pStack); + namep = (char*) stackPopPtr(pVM->pStack); + +#ifndef TESTMAIN + name = (char*) ficlMalloc(names+1); + if (!name) + vmThrowErr(pVM, "Error: out of memory"); + strncpy(name, namep, names); + name[names] = '\0'; + + unsetenv(name); + ficlFree(name); +#endif + + return; +} + +void +ficlCopyin(FICL_VM *pVM) +{ + void* src; + vm_offset_t dest; + size_t len; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 3, 0); +#endif + + len = stackPopINT(pVM->pStack); + dest = stackPopINT(pVM->pStack); + src = stackPopPtr(pVM->pStack); + +#ifndef TESTMAIN + archsw.arch_copyin(src, dest, len); +#endif + + return; +} + +void +ficlCopyout(FICL_VM *pVM) +{ + void* dest; + vm_offset_t src; + size_t len; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 3, 0); +#endif + + len = stackPopINT(pVM->pStack); + dest = stackPopPtr(pVM->pStack); + src = stackPopINT(pVM->pStack); + +#ifndef TESTMAIN + archsw.arch_copyout(src, dest, len); +#endif + + return; +} + +void +ficlFindfile(FICL_VM *pVM) +{ +#ifndef TESTMAIN + char *name, *type; +#endif + char *namep, *typep; + struct preloaded_file* fp; + int names, types; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 4, 1); +#endif + + types = stackPopINT(pVM->pStack); + typep = (char*) stackPopPtr(pVM->pStack); + names = stackPopINT(pVM->pStack); + namep = (char*) stackPopPtr(pVM->pStack); +#ifndef TESTMAIN + name = (char*) ficlMalloc(names+1); + if (!name) + vmThrowErr(pVM, "Error: out of memory"); + strncpy(name, namep, names); + name[names] = '\0'; + type = (char*) ficlMalloc(types+1); + if (!type) + vmThrowErr(pVM, "Error: out of memory"); + strncpy(type, typep, types); + type[types] = '\0'; + + fp = file_findfile(name, type); +#else + fp = NULL; +#endif + stackPushPtr(pVM->pStack, fp); + + return; +} + +#ifndef TESTMAIN +#ifdef HAVE_PNP + +void +ficlPnpdevices(FICL_VM *pVM) +{ + static int pnp_devices_initted = 0; +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 0, 1); +#endif + + if(!pnp_devices_initted) { + STAILQ_INIT(&pnp_devices); + pnp_devices_initted = 1; + } + + stackPushPtr(pVM->pStack, &pnp_devices); + + return; +} + +void +ficlPnphandlers(FICL_VM *pVM) +{ +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 0, 1); +#endif + + stackPushPtr(pVM->pStack, pnphandlers); + + return; +} + +#endif + +#endif /* ndef TESTMAIN */ + +void +ficlCcall(FICL_VM *pVM) +{ + int (*func)(int, ...); + int result, p[10]; + int nparam, i; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 2, 0); +#endif + + func = stackPopPtr(pVM->pStack); + nparam = stackPopINT(pVM->pStack); + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, nparam, 1); +#endif + + for (i = 0; i < nparam; i++) + p[i] = stackPopINT(pVM->pStack); + + result = func(p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7], p[8], + p[9]); + + stackPushINT(pVM->pStack, result); + + return; +} + +/************************************************************************** + f i c l E x e c F D +** reads in text from file fd and passes it to ficlExec() + * returns VM_OUTOFTEXT on success or the ficlExec() error code on + * failure. + */ +#define nLINEBUF 256 +int ficlExecFD(FICL_VM *pVM, int fd) +{ + char cp[nLINEBUF]; + int nLine = 0, rval = VM_OUTOFTEXT; + char ch; + CELL id; + + id = pVM->sourceID; + pVM->sourceID.i = fd; + + /* feed each line to ficlExec */ + while (1) { + int status, i; + + i = 0; + while ((status = read(fd, &ch, 1)) > 0 && ch != '\n') + cp[i++] = ch; + nLine++; + if (!i) { + if (status < 1) + break; + continue; + } + rval = ficlExecC(pVM, cp, i); + if(rval != VM_QUIT && rval != VM_USEREXIT && rval != VM_OUTOFTEXT) + { + pVM->sourceID = id; + return rval; + } + } + /* + ** Pass an empty line with SOURCE-ID == -1 to flush + ** any pending REFILLs (as required by FILE wordset) + */ + pVM->sourceID.i = -1; + ficlExec(pVM, ""); + + pVM->sourceID = id; + return rval; +} + +static void displayCellNoPad(FICL_VM *pVM) +{ + CELL c; +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 1, 0); +#endif + c = stackPop(pVM->pStack); + ltoa((c).i, pVM->pad, pVM->base); + vmTextOut(pVM, pVM->pad, 0); + return; +} + +/* isdir? - Return whether an fd corresponds to a directory. + * + * isdir? ( fd -- bool ) + */ +static void isdirQuestion(FICL_VM *pVM) +{ + struct stat sb; + FICL_INT flag; + int fd; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 1, 1); +#endif + + fd = stackPopINT(pVM->pStack); + flag = FICL_FALSE; + do { + if (fd < 0) + break; + if (fstat(fd, &sb) < 0) + break; + if (!S_ISDIR(sb.st_mode)) + break; + flag = FICL_TRUE; + } while (0); + stackPushINT(pVM->pStack, flag); +} + +/* fopen - open a file and return new fd on stack. + * + * fopen ( ptr count mode -- fd ) + */ +static void pfopen(FICL_VM *pVM) +{ + int mode, fd, count; + char *ptr, *name; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 3, 1); +#endif + + mode = stackPopINT(pVM->pStack); /* get mode */ + count = stackPopINT(pVM->pStack); /* get count */ + ptr = stackPopPtr(pVM->pStack); /* get ptr */ + + if ((count < 0) || (ptr == NULL)) { + stackPushINT(pVM->pStack, -1); + return; + } + + /* ensure that the string is null terminated */ + name = (char *)malloc(count+1); + bcopy(ptr,name,count); + name[count] = 0; + + /* open the file */ + fd = open(name, mode); + free(name); + stackPushINT(pVM->pStack, fd); + return; +} + +/* fclose - close a file who's fd is on stack. + * + * fclose ( fd -- ) + */ +static void pfclose(FICL_VM *pVM) +{ + int fd; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 1, 0); +#endif + fd = stackPopINT(pVM->pStack); /* get fd */ + if (fd != -1) + close(fd); + return; +} + +/* fread - read file contents + * + * fread ( fd buf nbytes -- nread ) + */ +static void pfread(FICL_VM *pVM) +{ + int fd, len; + char *buf; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 3, 1); +#endif + len = stackPopINT(pVM->pStack); /* get number of bytes to read */ + buf = stackPopPtr(pVM->pStack); /* get buffer */ + fd = stackPopINT(pVM->pStack); /* get fd */ + if (len > 0 && buf && fd != -1) + stackPushINT(pVM->pStack, read(fd, buf, len)); + else + stackPushINT(pVM->pStack, -1); + return; +} + +/* freaddir - read directory contents + * + * freaddir ( fd -- ptr len TRUE | FALSE ) + */ +static void pfreaddir(FICL_VM *pVM) +{ +#ifdef TESTMAIN + static struct dirent dirent; + struct stat sb; + char *buf; + off_t off, ptr; + u_int blksz; + int bufsz; +#endif + struct dirent *d; + int fd; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 1, 3); +#endif + + fd = stackPopINT(pVM->pStack); +#if TESTMAIN + /* + * The readdirfd() function is specific to the loader environment. + * We do the best we can to make freaddir work, but it's not at + * all guaranteed. + */ + d = NULL; + buf = NULL; + do { + if (fd == -1) + break; + if (fstat(fd, &sb) == -1) + break; + blksz = (sb.st_blksize) ? sb.st_blksize : getpagesize(); + if ((blksz & (blksz - 1)) != 0) + break; + buf = malloc(blksz); + if (buf == NULL) + break; + off = lseek(fd, 0LL, SEEK_CUR); + if (off == -1) + break; + ptr = off; + if (lseek(fd, 0, SEEK_SET) == -1) + break; + bufsz = getdents(fd, buf, blksz); + while (bufsz > 0 && bufsz <= ptr) { + ptr -= bufsz; + bufsz = getdents(fd, buf, blksz); + } + if (bufsz <= 0) + break; + d = (void *)(buf + ptr); + dirent = *d; + off += d->d_reclen; + d = (lseek(fd, off, SEEK_SET) != off) ? NULL : &dirent; + } while (0); + if (buf != NULL) + free(buf); +#else + d = readdirfd(fd); +#endif + if (d != NULL) { + stackPushPtr(pVM->pStack, d->d_name); + stackPushINT(pVM->pStack, strlen(d->d_name)); + stackPushINT(pVM->pStack, FICL_TRUE); + } else { + stackPushINT(pVM->pStack, FICL_FALSE); + } +} + +/* fload - interpret file contents + * + * fload ( fd -- ) + */ +static void pfload(FICL_VM *pVM) +{ + int fd; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 1, 0); +#endif + fd = stackPopINT(pVM->pStack); /* get fd */ + if (fd != -1) + ficlExecFD(pVM, fd); + return; +} + +/* fwrite - write file contents + * + * fwrite ( fd buf nbytes -- nwritten ) + */ +static void pfwrite(FICL_VM *pVM) +{ + int fd, len; + char *buf; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 3, 1); +#endif + len = stackPopINT(pVM->pStack); /* get number of bytes to read */ + buf = stackPopPtr(pVM->pStack); /* get buffer */ + fd = stackPopINT(pVM->pStack); /* get fd */ + if (len > 0 && buf && fd != -1) + stackPushINT(pVM->pStack, write(fd, buf, len)); + else + stackPushINT(pVM->pStack, -1); + return; +} + +/* fseek - seek to a new position in a file + * + * fseek ( fd ofs whence -- pos ) + */ +static void pfseek(FICL_VM *pVM) +{ + int fd, pos, whence; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 3, 1); +#endif + whence = stackPopINT(pVM->pStack); + pos = stackPopINT(pVM->pStack); + fd = stackPopINT(pVM->pStack); + stackPushINT(pVM->pStack, lseek(fd, pos, whence)); + return; +} + +/* key - get a character from stdin + * + * key ( -- char ) + */ +static void key(FICL_VM *pVM) +{ +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 0, 1); +#endif + stackPushINT(pVM->pStack, getchar()); + return; +} + +/* key? - check for a character from stdin (FACILITY) + * + * key? ( -- flag ) + */ +static void keyQuestion(FICL_VM *pVM) +{ +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 0, 1); +#endif +#ifdef TESTMAIN + /* XXX Since we don't fiddle with termios, let it always succeed... */ + stackPushINT(pVM->pStack, FICL_TRUE); +#else + /* But here do the right thing. */ + stackPushINT(pVM->pStack, ischar()? FICL_TRUE : FICL_FALSE); +#endif + return; +} + +/* seconds - gives number of seconds since beginning of time + * + * beginning of time is defined as: + * + * BTX - number of seconds since midnight + * FreeBSD - number of seconds since Jan 1 1970 + * + * seconds ( -- u ) + */ +static void pseconds(FICL_VM *pVM) +{ +#if FICL_ROBUST > 1 + vmCheckStack(pVM,0,1); +#endif + stackPushUNS(pVM->pStack, (FICL_UNS) time(NULL)); + return; +} + +/* ms - wait at least that many milliseconds (FACILITY) + * + * ms ( u -- ) + * + */ +static void ms(FICL_VM *pVM) +{ +#if FICL_ROBUST > 1 + vmCheckStack(pVM,1,0); +#endif +#ifdef TESTMAIN + usleep(stackPopUNS(pVM->pStack)*1000); +#else + delay(stackPopUNS(pVM->pStack)*1000); +#endif + return; +} *** DIFF OUTPUT TRUNCATED AT 1000 LINES ***