Date: Fri, 15 Jan 1999 19:02:08 +0900 (JST) From: dcs@newsguy.com To: FreeBSD-gnats-submit@FreeBSD.ORG Subject: kern/9514: ANS Forth memory-alloc word set for FICL Message-ID: <199901151002.TAA00385@daniel.sobral>
next in thread | raw e-mail | index | archive | help
>Number: 9514
>Category: kern
>Synopsis: Some people might foolishly think dynamic memory useful... :-)
>Confidential: no
>Severity: non-critical
>Priority: low
>Responsible: freebsd-bugs
>State: open
>Quarter:
>Keywords:
>Date-Required:
>Class: change-request
>Submitter-Id: current-users
>Arrival-Date: Fri Jan 15 02:10:01 PST 1999
>Closed-Date:
>Last-Modified:
>Originator: Daniel C. Sobral
>Release: FreeBSD 3.0-CURRENT i386
>Organization:
>Environment:
Current as of Jan 12/1999.
>Description:
FICL currently does not provide dynamic memory allocation words.
>How-To-Repeat:
UTSL.
>Fix:
The following patch adds ANS Forth MEMORY-ALLOC word set. It
was generated against kern/9412, though. Patch against current available
on request.
--- sysdep.c 1999/01/15 09:12:50 1.1
+++ sysdep.c 1999/01/15 09:15:32
@@ -63,6 +63,11 @@
return malloc(size);
}
+void *ficlRealloc (void *p, size_t size)
+{
+ return realloc(p, size);
+}
+
void ficlFree (void *p)
{
free(p);
--- sysdep.h 1999/01/15 09:16:47 1.1
+++ sysdep.h 1999/01/15 09:17:16
@@ -215,6 +215,7 @@
struct vm;
void ficlTextOut(struct vm *pVM, char *msg, int fNewline);
void *ficlMalloc (size_t size);
+void *ficlRealloc (void *p, size_t size);
void ficlFree (void *p);
/*
--- words.c 1999/01/11 17:29:14 1.4
+++ words.c 1999/01/15 09:49:48
@@ -4051,6 +4051,48 @@
return;
}
+/*************** freebsd added memory-alloc handling words ******************/
+
+static void allocate(FICL_VM *pVM)
+{
+ size_t size;
+ void *p;
+
+ size = stackPopINT32(pVM->pStack);
+ p = ficlMalloc(size);
+ stackPushPtr(pVM->pStack, p);
+ if (p)
+ stackPushINT32(pVM->pStack, 0);
+ else
+ stackPushINT32(pVM->pStack, 1);
+}
+
+static void free4th(FICL_VM *pVM)
+{
+ void *p;
+
+ p = stackPopPtr(pVM->pStack);
+ ficlFree(p);
+ stackPushINT32(pVM->pStack, 0);
+}
+
+static void resize(FICL_VM *pVM)
+{
+ size_t size;
+ void *new, *old;
+
+ size = stackPopINT32(pVM->pStack);
+ old = stackPopPtr(pVM->pStack);
+ new = ficlRealloc(old, size);
+ if (new) {
+ stackPushPtr(pVM->pStack, new);
+ stackPushINT32(pVM->pStack, 0);
+ } else {
+ stackPushPtr(pVM->pStack, old);
+ stackPushINT32(pVM->pStack, 1);
+ }
+}
+
/***************** freebsd added exception handling words *******************/
/*
@@ -4541,6 +4583,15 @@
ficlSetEnv("exception", FICL_TRUE);
ficlSetEnv("exception-ext", FICL_TRUE);
+
+ /*
+ ** MEMORY-ALLOC word set
+ */
+ dictAppendWord(dp, "allocate", allocate, FW_DEFAULT);
+ dictAppendWord(dp, "free", free4th, FW_DEFAULT);
+ dictAppendWord(dp, "resize", resize, FW_DEFAULT);
+
+ ficlSetEnv("memory-alloc", FICL_TRUE);
/*
** Set CORE environment query values
>Release-Note:
>Audit-Trail:
>Unformatted:
To Unsubscribe: send mail to majordomo@FreeBSD.org
with "unsubscribe freebsd-bugs" in the body of the message
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?199901151002.TAA00385>