We will often want to check if certain conditions are true, halting if they are not.
assertion support +≡: assert ( n -- )
0= if abort then ;
In several places in this program, singly linked lists are useful. As we are interested primarily in inserting in elements at the end of a list (or are indifferent as to the order). We will standardize on a list root with this structure:
We will need a word to create list roots in a variable:
utility words +≡: linked-list
create 0 , 0 , ;
In allocating memory for lists, we will assume sufficient memory is available.
utility words +≡: allocate' ( n -- a )
allocate 0= assert ;
We will also the allocated memory for simplicity.
utility words +≡: zero ( a n -- )
0 fill ;
: allocate0 ( n -- a )
dup allocate' swap 2dup zero drop ;
Support adding a new link to the end of a chain.
utility words +≡: chain-new ( n -- a )
1+ cells allocate0 ;
: chain-fillout ( .. a n -- a )
0 do dup i 1+ cells + swap >r ! r> loop ;
: chain-link ( ..n -- a )
dup chain-new swap chain-fillout ;
: chain-first ( ..n head[t] -- )
>r chain-link r> 2dup ! cell+ ! ;
: chain-rest ( ..n head[t] -- )
>r chain-link r> 2dup cell+ @ ! cell+ ! ;
: chain ( ..n head[t] -- )
dup @ if chain-rest else chain-first then ;
And walking down the list.
utility words +≡: ->next ( a -- a' ) @ ;
We will need to clone strings occasionally.
utility words +≡: $clone ( $ - $ )
dup allocate 0= assert swap 2dup >r >r move r> r> ;
We will also need to duplicate three items off the stack.
utility words +≡: 3dup ( xyz -- xyzxyz )
dup 2over rot ;
: file!-dangle ( A A -- fileid )
atom-string@ r/w bin create-file 0= assert
swap over >r atom-string@ r> write-file 0= assert
dup flush-file 0= assert
;
: file! ( A A -- )
file!-dangle
close-file 0= assert
;
: file!-tmp ( A A -- fileid )
file!-dangle
dup 0 s>d rot reposition-file 0= assert
;