From owner-freebsd-bugs  Fri Jan 15 02:10:40 1999
Return-Path: <owner-freebsd-bugs@FreeBSD.ORG>
Received: (from majordom@localhost)
          by hub.freebsd.org (8.8.8/8.8.8) id CAA19711
          for freebsd-bugs-outgoing; Fri, 15 Jan 1999 02:10:40 -0800 (PST)
          (envelope-from owner-freebsd-bugs@FreeBSD.ORG)
Received: from freefall.freebsd.org (freefall.FreeBSD.ORG [204.216.27.21])
          by hub.freebsd.org (8.8.8/8.8.8) with ESMTP id CAA19702
          for <freebsd-bugs@FreeBSD.org>; Fri, 15 Jan 1999 02:10:38 -0800 (PST)
          (envelope-from gnats@FreeBSD.org)
Received: (from gnats@localhost)
	by freefall.freebsd.org (8.8.8/8.8.5) id CAA29333;
	Fri, 15 Jan 1999 02:10:01 -0800 (PST)
Received: from peach.ocn.ne.jp (peach.ocn.ne.jp [210.145.254.87])
          by hub.freebsd.org (8.8.8/8.8.8) with ESMTP id CAA19557
          for <FreeBSD-gnats-submit@freebsd.org>; Fri, 15 Jan 1999 02:09:04 -0800 (PST)
          (envelope-from dcs@newsguy.com)
Received: from daniel.sobral by peach.ocn.ne.jp (8.9.1a/OCN) id TAA13802; Fri, 15 Jan 1999 19:07:51 +0900 (JST)
Received: (from root@localhost)
	by daniel.sobral (8.9.1/8.9.1) id TAA00385;
	Fri, 15 Jan 1999 19:02:08 +0900 (JST)
	(envelope-from root)
Message-Id: <199901151002.TAA00385@daniel.sobral>
Date: Fri, 15 Jan 1999 19:02:08 +0900 (JST)
From: dcs@newsguy.com
Reply-To: dcs@newsguy.com
To: FreeBSD-gnats-submit@FreeBSD.ORG
X-Send-Pr-Version: 3.2
Subject: kern/9514: ANS Forth memory-alloc word set for FICL
Sender: owner-freebsd-bugs@FreeBSD.ORG
Precedence: bulk
X-Loop: FreeBSD.org


>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