Last active
April 16, 2024 21:44
-
-
Save tkurtbond/88f0835147c3d4d13441f57f2e8bf128 to your computer and use it in GitHub Desktop.
Singly Linked List implementation in forth using gforth's structs.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
\ sllist.fs - Singly Linked List implementation in forth using gforth's structs. | |
\G A node contains the address of the next node and the address of a | |
\G counted string. | |
struct | |
cell% field node-text \ address of counted string | |
cell% field node-next \ address of next node | |
end-struct node% | |
\G Initialize a node given the address of a counted string and the | |
\G address of the next node, for building lists manually. | |
: node-init ( text-addr next-node-addr node-addr -- ) | |
tuck ( text-addr node-addr next-node-addr node-addr ) | |
node-next ! ( text-addr node-addr ) | |
node-text ! | |
; | |
\G Given the address of a node display its text on the screen. | |
: node-type ( node-addr -- ) node-text @ count type ; | |
\G Given the address of an cell pointing to the first node in a | |
\G list, step down the list of nodes and display the text of each node | |
\G to the screen. | |
: node-traverse ( first-addr -- ) | |
begin | |
dup @ 0<> | |
while | |
cr dup @ node-type | |
@ node-next | |
repeat | |
drop | |
; | |
\G Given the addresses of two nodes compare their texts in the manner | |
\G of COMPARE, so node1 text < node2 text leaves -1, node1 text = | |
\G node2 text leaves 0, and node1 text > node2 text leaves 1. | |
: node-text-compare ( node1-addr node2-addr -- flag ) | |
node-text @ count rot node-text @ count 2swap compare | |
; | |
\G Given the address of a new node and the address of a pointer to a | |
\G list of nodesd insert the new node in order its node-text. | |
: node-insert ( new-node-addr p-addr ) | |
dup @ 0= if ( new-node-addr p-addr ) | |
\ p-addr @ is null, so the new node is first element in the list, | |
\ so just save its address in p. | |
! | |
exit | |
then | |
2dup @ node-text-compare -1 = if | |
\ The new node text is < the first node text, so save it as the first | |
\ node. | |
2dup @ ( new-node-addr p-addr new-node-addr first-node-addr ) | |
swap node-next ! \ Save the first node in node-next of the new node. | |
! \ Save the new node in the list header. | |
exit | |
then | |
( new-node-addr p-addr ) \ When we get here we know p is not null | |
begin | |
dup @ node-next @ 0<> \ Is next entry null? | |
while ( new-node-addr p-addr ) | |
2dup @ node-text-compare 1 = \ Is the next's node-text > the new nodes'? | |
while ( new-node-addr p-addr ) | |
@ node-next \ move to the next node. | |
repeat then | |
\ When we get here we want to add the new node *after* the old node. | |
( new-node-addr p-addr ) | |
2dup ( new-node-addr p-addr new-node-addr p-addr ) | |
@ node-next @ ( new-node-addr p-addr new-node-addr old-node.next ) | |
swap ( new-node-addr p-addr old-node new-node-addr ) | |
\ Store address of old node in new node's node-next slot. | |
node-next ! ( new-node-addr p-addr ) | |
\ Store address of new node in next-node slot of node pointed to by p. | |
@ node-next ! | |
; | |
: node-insert-uncommented ( new-node-addr p-addr ) | |
dup @ 0= if ! exit then | |
2dup @ node-text-compare -1 = if 2dup @ swap node-next ! ! exit then | |
begin | |
dup @ node-next @ 0<> | |
while | |
2dup @ node-text-compare 1 = | |
while | |
@ node-next | |
repeat then | |
2dup @ node-next @ swap | |
node-next ! | |
@ node-next ! | |
; | |
\ Build the initial list manually. | |
\ Create some strings. | |
create s1 ," a" | |
create s2 ," m" | |
create s3 ," x" | |
\ Create some nodes and initialize them, making links between them. | |
node% %allot constant n3 s3 0 n3 node-init | |
node% %allot constant n2 s2 n3 n2 node-init | |
node% %allot constant n1 s1 n2 n1 node-init | |
variable l1 n1 l1 ! \ original list | |
\ Create some other nodes for later use with the l2 list. | |
create s4 ," o" | |
create s5 ," x" | |
create s6 ," h" | |
create s7 ," a" | |
create s8 ," m" | |
create s9 ," z" | |
node% %allot constant n4 s4 0 n4 node-init | |
node% %allot constant n5 s5 0 n5 node-init | |
node% %allot constant n6 s6 0 n6 node-init | |
node% %allot constant n7 s7 0 n7 node-init | |
node% %allot constant n8 s8 0 n8 node-init | |
node% %allot constant n9 s9 0 n9 node-init | |
node% %allot constant n10 s8 0 n10 node-init | |
node% %allot constant n11 s7 0 n11 node-init | |
node% %allot constant n12 s9 0 n12 node-init | |
variable l2 0 l2 ! \ the other list | |
\ Use hex when debugging, because you'll be looking at long 8 byte addresses. | |
hex | |
\ Words for debugging | |
: type-data ( -- ) | |
cr ." l2: " l2 . | |
cr ." n4 : " n4 . n4 node-type space n4 node-next @ . | |
cr ." n5 : " n5 . n5 node-type space n5 node-next @ . | |
cr ." n6 : " n6 . n6 node-type space n6 node-next @ . | |
cr ." n7 : " n7 . n7 node-type space n7 node-next @ . | |
cr ." n8 : " n8 . n8 node-type space n8 node-next @ . | |
cr ." n9 : " n9 . n9 node-type space n9 node-next @ . | |
cr ." n10: " n10 . n10 node-type space n10 node-next @ . | |
cr ." n11: " n11 . n11 node-type space n11 node-next @ . | |
cr ." n12: " n12 . n12 node-type space n12 node-next @ . | |
; | |
: node-next-clear ( node-addr -- ) node-next 0 swap ! ; | |
: clear-data ( -- ) | |
n4 node-next-clear | |
n5 node-next-clear | |
n6 node-next-clear | |
n7 node-next-clear | |
n8 node-next-clear | |
n9 node-next-clear | |
n10 node-next-clear | |
n11 node-next-clear | |
n12 node-next-clear | |
0 l2 ! | |
; | |
: add ( node list s-addr n ) | |
cr ." Add " 3 pick node-type space type | |
dup node-insert | |
cr l2 node-traverse cr | |
; | |
: add ( node list s-addr n ) | |
cr ." Add " 3 pick node-type space type | |
tuck node-insert | |
cr node-traverse cr | |
; | |
cr .( ==== First list, l1, built manually ==========================================) | |
l1 node-traverse cr | |
1 [IF] | |
cr .( ==== Second list, l2 =========================================================) | |
clear-data | |
cr ." Before adds: " .s | |
n4 l2 s" to empty list using n4 " add | |
cr ." After first add: " .s | |
n6 l2 s" to list using n6" add | |
n5 l2 s" to list using n5" add | |
n7 l2 s" to list using n7" add | |
n8 l2 s" to list using n8" add | |
n9 l2 s" to list using n9" add | |
n10 l2 s" to list using n10" add | |
n11 l2 s" to list using n11" add | |
n12 l2 s" to list using n12" add | |
cr .( ==== Second list, build 2 ===================================================) | |
clear-data | |
n4 l2 s" to empty list using n4" add | |
n5 l2 s" to list after existing node using n5" add | |
n6 l2 s" to list at front using n6" add | |
cr .( ==== Third list, build 3 ======================================================) | |
clear-data | |
n4 l2 s" to empty list using n4" add | |
n6 l2 s" to list before existing node n6" add | |
n9 l2 s" to list at end using n9" add | |
[THEN] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment