~aleteoryx/uxn

ref: fecde3e896101f20ed3ece0b43938aabda4d3b1d uxn/lzw.tal -rw-r--r-- 1.8 KiB
fecde3e8Aleteoryx rewritten for 4096 codes 7 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|00 @System/vector $2 &expansion $2 &wst $1 &rst $1 &metadata $2 &r $2 &g $2 &b $2 &debug $1 &state $1
|10 @Console/vector $2 &read $5 &type $1 &write $1 &error $1


%dup3 ( a b c -- a b c a b c ) { ROTk ROT ROT }
%dbg ( -- ) { [ LIT2 01 -System/debug ] DEO }

|100
@on-reset ( -> )
	#ffff #00 LUT/insert POP2
	#ffff LIT "A LUT/insert
	LIT "B LUT/insert LIT "C LUT/insert POP2

	#0002 LIT "C LUT/lookup dbg
	;putc-visitor LUT/visit
	BRK

@putc-visitor ( id* -- )
	LUT/get .Console/write DEO POP2
	JMP2r

( @LUT )

( visitor is a pointer to a routine of the form ( id* -- ) )
@LUT/visit ( id* visitor* -- first-sym )
	,/visitor STR2
	/walk-up DUP2 /get ,/visitret STR POP2
	&visitloop
		DUP2 [ LIT2 &visitor $2 ] JSR2
		/toaddr LDA2 INC2k ORA
		?{ POP2 [ LIT &visitret $1 ] JMP2r }
		!/visitloop

@LUT/walk-up ( id* -- root-id* )
	#ffff SWP2 ( -1* node* )
	&walkloop
		STH2k /toaddr STA2k ( save child ptr )
		NIP2 INC2 INC2 LDA2 ( new-node* `node* )
		STH2r SWP2 ( node* new-node* )
		INC2k ORA ?/walkloop
	POP2 JMP2r


@LUT/insert ( parent* sym -- id* )
	ROT ROT
	,/size LDR2 /id-ok? ?{ POP2 POP2 POP #ffff JMP2r }
	STH2k /toaddr
	INC2 INC2 STA2k ( parent* )
	NIP2 INC2 INC2 STA ( sym )
	STH2rk INC2 ,/size STR2
	STH2r JMP2r

@LUT/get ( id* -- parent* sym )
	/toaddr INC2 INC2 LDA2k ( parent* )
	SWP2 INC2 INC2 LDA ( sym )
	JMP2r

@LUT/lookup ( parent* sym -- id* )
	[ LIT2r 0000 ]
	&lookuploop
		dup3
		STH2rk [ LIT2 &size 0000 ]
		LTH2 ?{ POP2r POP2 POP2 POP2 #ffff JMP2r }
		STH2rk /get ( parent1* sym1  parent2* sym2 )
		STH ROT STH NEQ2 NEQr STHr ORA ( parent1 != parent2 || sym1 != sym2 )
		INC2r ?/lookuploop
	POP2 POP STH2r #0001 SUB2 JMP2r

@LUT/toaddr ( id* -- addr* )
	#0005 MUL2 ;/workspace ADD2
	JMP2r

@LUT/id-ok? ( id* -- id* ok? )
	DUP2 #5000 LTH2 JMP2r

@LUT/workspace $5000