@@ -19,13 +19,12 @@ MAX 4 * 1+ constant: LEN
19
19
LEN buffer: arrow
20
20
variable: rownum
21
21
variable: idx
22
- : sort ( n n -- n n ) 2dup > if swap then ;
23
- : pack ( n n -- n ) sort 16 lshift or ;
22
+ : pack ( n n -- n ) 16 lshift or ;
24
23
: unpack ( n -- n n ) dup 16rFFFF and swap 16 rshift ;
25
- : at ( i -- n n ) jumps @ unpack ;
26
- : add ( row1 row2 -- ) idx @ MAX < if pack idx @ jumps ! idx ++ else 2drop then ;
24
+ : at ( i -- dst-row src-row ) jumps @ unpack ;
25
+ : add ( dst-row src-row -- ) idx @ MAX < if pack idx @ jumps ! idx ++ else 2drop then ;
27
26
: jump? ( addr -- bool ) @ dup ['] branch0 = swap ['] branch = or ;
28
- : positions ( branch-addr -- row1 row2 ) cell + @ cell / rownum @ 1+ + rownum @ ;
27
+ : positions ( branch-addr -- dst-row src-row ) cell + @ cell / rownum @ 1+ + rownum @ ;
29
28
30
29
: collect-jumps ( xt -- )
31
30
0 idx ! 1 rownum !
@@ -36,15 +35,14 @@ variable: idx
36
35
until
37
36
1 rownum ! drop ;
38
37
39
- : head? ( n n -- bool ) rownum @ = swap rownum @ = or ; \ arrow head
40
38
: head ( -- )
41
39
idx @ 0 ?do
42
- i at head? if
43
- $< i 1+ 4 * 3 - arrow + c!
44
- $- i 1+ 4 * 2 - arrow + c!
45
- then
40
+ i at ( dst-row src-row )
41
+ rownum @ = if $- i 1+ 4 * 3 - arrow + c! $> i 1+ 4 * 2 - arrow + c! then
42
+ rownum @ = if $< i 1+ 4 * 3 - arrow + c! $- i 1+ 4 * 2 - arrow + c! then
46
43
loop ;
47
- : body? ( n n -- bool ) rownum @ > swap rownum @ < and ;
44
+ : sort ( n n -- n n ) 2dup > if swap then ;
45
+ : body? ( n n -- bool ) sort rownum @ > swap rownum @ < and ;
48
46
: body ( -- ) idx @ 0 ?do i at body? if $| i 1+ 4 * 1- arrow + c! then loop ; \ arrow body
49
47
: clear ( -- ) LEN 0 do 32 i arrow + c! loop ;
50
48
: .arrow ( -- ) clear body head arrow LEN type-counted cr ;
0 commit comments