socsvn commit: r286978 - in soc2015/clord/head/sys/contrib/ficl: . aarch64 amd64 arm i386 mips mips64 powerpc softwords sparc64
clord at FreeBSD.org
clord at FreeBSD.org
Thu Jun 11 22:14:13 UTC 2015
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 at 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 <stdlib.h>
-#include <stdio.h> /* sprintf */
-#include <string.h>
+/* $FreeBSD$ */
+
+#ifdef TESTMAIN
+#include <stdio.h>
#include <ctype.h>
+#else
+#include <stand.h>
+#endif
+#include <string.h>
#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 at 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 <stdlib.h>
+#else
+#include <stand.h>
+#endif
#include <string.h>
#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 at 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 at 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 <limits.h> /* UCHAR_MAX */
-#include <stdio.h>
/*
** 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 <errno.h>
#include <stdlib.h>
#include <stdio.h>
@@ -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 at 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 at alum.mit.edu)
@@ -41,6 +41,8 @@
** SUCH DAMAGE.
*/
+/* $FreeBSD$ */
+
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
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 <sys/types.h>
+#include <sys/stat.h>
+#include <dirent.h>
+#include <fcntl.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#else
+#include <stand.h>
+#endif
+#include "bootstrap.h"
+#include <string.h>
+#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 ***
More information about the svn-soc-all
mailing list