Last active
April 16, 2024 21:50
-
-
Save tkurtbond/b629cdff2d70e31b0e1527f1ead14462 to your computer and use it in GitHub Desktop.
Singly Linked List implementation using gforth's structs, less commented
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-less-comments.fs - Singly Linked List implementation in forth using gforth's structs, less comments. | |
struct | |
cell% field node-text \ address of counted string | |
cell% field node-next \ address of next node | |
end-struct node% | |
: node-init ( text-addr next-addr node-addr -- ) tuck node-next ! node-text ! ; | |
: node-type ( node-addr -- ) node-text @ count type ; | |
: node-traverse ( first-addr -- ) | |
begin dup @ 0<> while cr dup @ node-type @ node-next repeat drop | |
; | |
: node-text-compare ( node1-addr node2-addr -- flag ) | |
node-text @ count rot node-text @ count 2swap compare | |
; | |
: node-insert ( 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