( Title: List Node Space Management File: nodespace.fs Version: 1.2.3 Author: David N. Williams License: LGPL Last revision: September 10, 2006 ) \ Copyright (C) 2000-2002 David N. Williams ( This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or at your option any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. Please see the file POLITENESS included with this distribution. ANS Forth compatible except for: - Case sensitivity. - Assumption that zero does not occur as an address. Uses LOCALS| from the Locals extension word set. Please see the file NOTATION. ) s" undef.fs" INCLUDED \ ensure [UNDEFINED] [UNDEFINED] field: [IF] : field: ( offset size -- offset+size ) create over , + DOES> ( struc -- struc+offset ) @ + ; [THEN] \ *** WORDS ( Global value: CURRENT-NODES Node-space structure: /NODE-SPACE-HEADER >#NODES >/NODE-DATA >/NODE-HEADER >BEGIN-NODES >LAST-UNUSED INITIALIZE-NODES MAKE-NODES 0UNUSED-NODES ?NEW-NODE NEW-NODE UNUSE-NODE Uncommentable: MAKE-NODES: DUMP-NODES NODES-UNUSED ) \ *** GLOBALS ( Most of the words in this file read the value CURRENT-NODES, which holds the address of the current node space. When there is only one node space, CURRENT-NODES needs to be set only once, for example, in the phrase MAKE-NODES TO CURRENT-NODES, where MAKE-NODES is defined below. The uncommentable word MAKE-NODES:, provided below, defines words that do this automatically; but that's overkill when there's only one node space. When there is more than one node space, a better strategy would be to include the automatic setting of CURRENT-NODES in list words that set CURRENT-LIST. See the discussion of uncommentable words SEND-LIST: and DEND-LIST: in sendlist.fs and dendlist.fs. ) 0 value current-nodes \ user must initialize \ *** NODE SPACE STRUCTURE ( A node space is a memory block that contains a header and a collection of data nodes, all of which have the same header size and the same data size. Node headers are assumed to contain at least one cell. Each node space has a chain of unused nodes, traversable only backwards from the end, linked through the first cell in the node headers. When used this way, we call that cell the PREVUNUSED field. Except for its unused chain, a node space contains no explicit information about list headers, which describe the beginning and/or end of linked lists of data nodes, and which reside elsewhere. ) \ MAKE-NODES assumes this structure: 0 ( offset) 1 cells field: >#nodes \ both used and unused, nonzero 1 cells field: >/node-header \ node header field size 1 cells field: >/node-data \ node data field size 1 cells field: >last-unused \ zero if all nodes are used, \ else points to last unused node dup constant /node-space-header 1 cells field: >begin-nodes \ start of nodes memory ( offset) drop : initialize-nodes ( space -- ) ( Assume the node space has been allocated with padding to make each node aligned, and with the header filled in. Make an unused chain out of the rest of the space, and point the LAST-UNUSED field at the last node in the chain. Any other links and data are untouched. A factor in MAKE-NODES. ) ( space) >r r@ >/node-header @ r@ >/node-data @ aligned + ( padded.node.size) r@ >#nodes @ r@ >begin-nodes ( first.node) r> LOCALS| space node #nodes /node | #nodes 0 DO node /node - node ! \ point node at previous node node /node + to node \ move to next node LOOP 0 space >begin-nodes ! node /node - ( prev.node) space >last-unused ! ; : make-nodes ( #nodes /node.data /node.header -- space ) ( Make an aligned node space, and fill in its header according to the node space structure. Assume that /node.header is at least one cell, and is an aligned size. Initialize to all nodes in the unused chain, leaving the node header beyond the first cell and the node data fields untouched. ) align here LOCALS| space /node.header /node.data #nodes | #nodes , /node.header , /node.data , 0 ( last.unused) , \ set by INITIALIZE-NODES /node.header /node.data aligned + #nodes * ( /nodes) allot space initialize-nodes space ; 0 [IF] : make-nodes: ( "name" #nodes /node.data /node.header -- ) ( Make a node-space structure instance, and CREATE a word that sets CURRENT-NODES to the structure address. ) make-nodes create , DOES> ( -- ) @ ( space) to current-nodes ; [THEN] \ *** NODE SPACE OPERATIONS ( Node space words manage the allocation and deallocation of data nodes. They work for nodes with any linking scheme, including both single and double, as long as there is at least one cell in the node header. A node is said to be "unlinked" if it is not linked into any list or unused chain. ) : new-node ( -- node ) ( Unlink one node from the end of the unused chain in the current node space, and return its address, or zero if none is available. Assume that the first node in a nonempty unused chain has zero in its PREVUNUSED field. If there is only one node to unlink, that zero propagates to LAST-UNUSED. ) current-nodes >last-unused @ ( node) dup IF ( node) dup @ current-nodes >last-unused ! THEN ( node|0) ; : ?new-node ( -- node ) ( Execute NEW-NODE and leave the node if one is available in the current node-space, otherwise throw an error. ) new-node dup 0= ABORT" ***No unused nodes in the current node space." ; : unuse-node ( node -- ) ( Assume that the node is unlinked. If node is zero, do nothing. Otherwise add it to the end of the unused chain in the current node space. There is no check to see whether the node is actually in the space. If the unused chain is initially empty, the zero in LAST-UNUSED propagates to the PREVUNUSED field of node, making it not only last but first in the chain. It is up to the user to ensure that the data size for node is the same as that of the nodes in space. Otherwise, a subsequent NEW-NODE might have a surprising result. ) LOCALS| node | node IF current-nodes >last-unused @ node ! node current-nodes >last-unused ! THEN ; \ ( node) ?dup IF \ current-nodes >last-unused @ over ( last node) ! \ ( node) current-nodes >last-unused ! \ THEN ; : 0unused-nodes ( -- ) ( Zero the bytes in the data fields of all unused nodes in the current space. An expected use is just after the creation of a node-space instance, where all nodes are in the unused chain, as in this example: <#nodes> make-nodes constant mynodes mynodes to current-nodes 0unused-nodes In any case, do nothing if CURRENT-NODES is zero or if its unused chain is empty. ) current-nodes IF current-nodes >last-unused @ ( node) ?dup IF BEGIN ( node) dup WHILE ( node) dup current-nodes >/node-header @ + current-nodes >/node-data @ 0 fill ( node) @ REPEAT ( 0) drop THEN THEN ; 0 [IF] \ *** UNCOMMENTABLE WORDS : nodes-unused ( -- u ) ( Leave the number of nodes in the unused chain in the current node space. ) 0 ( #unused) current-nodes >last-unused @ BEGIN ( #unused node) dup WHILE swap 1+ swap @ REPEAT ( node) drop ; : dump-nodes ( -- ) ( Do a hex dump of the current node space. For debugging. ) current-nodes >/node-header @ current-nodes >/node-data @ aligned + current-nodes >#nodes @ * ( padded.nodes.size) /node-space-header + current-nodes swap ( space size) dump ; [THEN]