struct
  cell% field list-val
  cell% field list-next
end-struct list%

: new-list { list1 val -- list2 }
  list% %allot { list2 }
  list1 list2 list-next !
  val   list2 list-val  ! 
  list2 ;

: .list ( list -- )
  begin { l }
    l while
      l list-val @ .
      l list-next @
  repeat ;

: insert-end { val listp -- }
  listp begin { lp1 }
    lp1 @ while
      lp1 @ list-next
  repeat
  0 val new-list lp1 ! ;

: copy-node { list1 -- list2 }
  list1 list-next @ list1 list-val @ new-list ;

0 5 new-list constant list1
list1 constant list2
0 5 new-list constant list3
cr list1 .list
cr list2 .list
cr list3 .list
6 list1 list-val !
cr
cr list1 .list
cr list2 .list
cr list3 .list
list1 8 new-list constant list4
cr
cr list1 .list
cr list2 .list
cr list3 .list
cr list4 .list
cell% %allot constant listp1
list4 listp1 !
9 listp1 insert-end
cr
cr list1 .list
cr list2 .list
cr list3 .list
cr list4 .list
list4 copy-node constant list5
cr
cr list1 .list
cr list2 .list
cr list3 .list
cr list4 .list
cr list5 .list
2 list5 list-val !
cr
cr list1 .list
cr list2 .list
cr list3 .list
cr list4 .list
cr list5 .list
cr bye