( Title: Single-Ended, Double-Linked Lists File: sdlist.fs Version: 1.2.4 Author: David N. Williams License: LGPL Last revision: August 28, 2021 ) \ Copyright (C) 2000-2002, 2021 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. Forth 200x compatible except for: - Case sensitivity. - Assumption that zero does not occur as an address. Uses REQUIRED from the optional File-Access word set. Uses LOCALS| from the optional Locals word set. Please see the file NOTATION. The only words from the following files that are actually used here are mentioned in the accompanying comments. The rest complete the glossary so that only this file need be loaded for single-ended, double-linked list applications. ) s" nodespace.fs" REQUIRED \ for UNUSE-NODE s" sendlist.fs" REQUIRED \ for CURRENT-LIST s" dnode.fs" REQUIRED \ but not used here \ *** WORDS ( SDINSERT-AFTER SDPREPEND SDUNLINK SDUNLINK-FIRST SDUNUSE SDUNUSE-FIRST ) \ *** SINGLE-ENDED, DOUBLE-LINKED LIST OPERATIONS ( These words assume that the current list is single-ended and double-linked, and that all nodes have headers for double linking and belong to the current node space. ) : sdinsert-after ( node node.before -- ) ( Assume that node.before is in the current list, and that node is unlinked. Insert node into the list just after node.before. ) ( before) dup ( nx) @ LOCALS| after before node | before node cell+ ( prev) ! \ node <- before after node ( nx) ! \ node -> after node before ( nx) ! \ before -> node after IF \ node is not last node after cell+ ( prev) ! \ after <- node THEN ; : sdinsert-before ( node node.after -- ) ( Assume that node.after is in the current list, and that node is unlinked. Insert node into the list just before node.after. Note: This code is identical to that for DDINSERT-BEFORE. ) ( after) dup cell+ ( prev) @ LOCALS| before after node | before node cell+ ( prev) ! \ node <- before after node ( nx) ! \ node -> after node after cell+ ( prev) ! \ after <- node node before IF ( node) before ( nx) ! \ before -> node ELSE ( node) current-list ( head) ! \ node is new first THEN ; : sdprepend ( node -- ) ( Assume that node is unlinked. Prepend it to the beginning of the current list. ) current-list ( head) @ LOCALS| first node | first node ( nx) ! \ node -> first 0 node cell+ ( prev) ! \ node <- zero node current-list ( head) ! \ node is new first first IF \ list was not empty node first cell+ ( prev) ! \ first <- node THEN ; \ current-list ( head) @ \ ( first) dup IF \ list was not empty \ ( node first) 2dup cell+ ( prev) ! \ first <- node \ THEN \ ( node first) over ( nx) ! \ node -> first \ ( node) 0 over cell+ ( prev) ! \ node <- zero \ ( node) current-list ( head) ! ; \ node is new first \ NOTE: If the application only builds lists but never removes \ anything from them, all words beyond this point can be omitted. : sdunlink ( node -- ) ( Assume that node is in the current list. Unlink it. ) ( node) dup cell+ ( prev) @ ( node before) over ( nx) @ LOCALS| after before node | before IF \ node is not first after before ( nx) ! \ before -> after ELSE after current-list ( head) ! \ after is new first THEN after IF \ node is not last before after cell+ ( prev) ! \ after <- before THEN ; : sdunuse ( node -- ) ( Assume that node is in the current list. Unlink it, and link it into the unused chain in the current node space. ) ( node) dup sdunlink ( node) unuse-node ; \ *** STACK OPERATIONS ( Together with SDPREPEND, the two words SDUNLINK-FIRST and SDUNUSE-FIRST below implement the basic push, pop, and drop operations for a stack, i.e., a LIFO list. ) : sdunlink-first ( -- node|0 ) ( If the current list is not empty, unlink and leave its first node. Otherwise leave zero. ) 0 ( dummy) current-list ( head) @ LOCALS| first second | first ( nonempty?) IF first @ to second second current-list ( head) ! second IF 0 second cell+ ( prev) ! THEN THEN first ; \ current-list ( head) @ ( first) dup \ ( nonempty?) IF \ ( first) dup @ ( second) dup current-list ( head) ! \ ( second) dup IF \ 0 swap ( 0 second) cell+ ( prev) ! \ second <- zero \ ELSE ( second) drop \ THEN ( first) \ THEN ( first) ; : sdunuse-first ( -- ) ( If the current list is not empty, unlink its first node, and link it into the unused chain in the current node space. Otherwise do nothing. ) sdunlink-first ( node|0) unuse-node ;