-
Notifications
You must be signed in to change notification settings - Fork 1
/
day14_lib.tal
342 lines (288 loc) · 6.11 KB
/
day14_lib.tal
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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
( get-byte -- )
@parse-input
[ ;&get-byte-addr STA2 ]
;letter-map/reset JSR2
;&parse-polymer JSR2
;&get-byte JSR2 POP ( eat lf )
;&parse-rules JSR2
RTN
&parse-polymer
;polymer STH2
&parse-polymer-loop
;&get-byte JSR2
DUP #0a EQU ,&parse-polymer-done JCN
;letter-map/lookup JSR2
STH2rk STA
INC2r
,&parse-polymer-loop JMP
&parse-polymer-done
POP
( terminate )
#00 STH2r STA
RTN
&parse-rules
( byte cnt dest* -- )
;rules/reset JSR2
&parse-rules-loop
;&get-byte JSR2 ( elt1 )
DUP #00 EQU ;&parse-rules-done JCN2
;letter-map/lookup JSR2
;&get-byte JSR2 ( elt1 elt2 )
;letter-map/lookup JSR2
( idx1 idx2 )
;pair-index/make JSR2
( pair-idx )
;&get-byte JSR2 POP ( )
;&get-byte JSR2 POP ( - )
;&get-byte JSR2 POP ( > )
;&get-byte JSR2 POP ( )
;&get-byte JSR2 ;letter-map/lookup JSR2 ( pair-idx out-idx )
;rules/add JSR2
;&get-byte JSR2 POP ( lf )
;&parse-rules-loop JMP2
&parse-rules-done
POP
RTN
&get-byte
LIT2 [ &get-byte-addr $2 ] JMP2
@pair-index
( idx1 idx2 -- index )
&make
SWP #40 SFT ORA
RTN
( pair-idx -- )
&print
DUP #04 SFT ;letter-map/print JSR2
#0f AND ;letter-map/print JSR2
RTN
@letter-map
!
( letter -- index )
&lookup
DUP LIT 'A SUB #00 SWP ;&letter-to-index ADD2 STH2
STH2rk LDA ,&found JCN
[ ,&next-index LDR ] STH2rk STA
DUP [ ,&next-index LDR ] #00 SWP ;&index-to-letter ADD2 STA
[ ,&next-index LDR ] INC [ ,&next-index STR ]
&found
POP STH2r LDA
RTN
( index -- )
&print
#00 SWP ;&index-to-letter ADD2 LDA EMIT
RTN
( -- )
&reset
#01 [ ,&next-index STR ]
#00 #0020 ;&letter-to-index ;memset JSR2
#00 #0010 ;&index-to-letter ;memset JSR2
RTN
[ &letter-to-index $20 &index-to-letter $10 &next-index 01 ]
( -- )
@dump-polymer
;polymer
LDAk ,&loop JCN
POP2 RTN
&loop
( send ) LDAk ;letter-map/print JSR2
( incr ) INC2
( loop ) LDAk ,&loop JCN
POP2 RTN
( -- )
@dump-rules
;rules/dump JMP2
( -- )
@apply-rules
;pair-counts/clear-tmp JSR2
;&apply-visitor ;rules/foreach JSR2
;pair-counts/apply-tmp JSR2
RTN
( pair-idx out-idx )
&apply-visitor
OVR STH ( pair-idx out-idx : pair-idx )
STHk ( pair-idx out-idx : out-idx pair-idx )
OVR ;pair-counts/ptr JSR2 ( pair-count* )
STHr ( pair-count* out-idx )
;elt-counts/add JSR2
OVR #f0 AND OVR ORA
( new-pair1 )
STHrk
( new-pair1 pair-idx )
;pair-counts/add-tmp JSR2
OVR #0f AND OVR #40 SFT ORA
STHrk
( new-pair2 pair-idx )
;pair-counts/add-tmp JSR2
POPr
RTN
@elt-counts
[ &_counts $80 ]
( -- )
&init
#00 #0008 ;&_counts ;memset JSR2
;polymer
&init-loop
LDAk ;&increment JSR2
INC2
LDAk ,&init-loop JCN
POP2
RTN
( idx -- )
&increment
;&ptr JSR2
#01 ;add64-byte JSR2
RTN
( idx -- count* )
&ptr
#00 SWP 8** ;&_counts ADD2
RTN
( count* idx -- )
&add
;&ptr JSR2
SWP2 ;add64 JSR2
RTN
&dump
#0000 #0010 DO
DUP ;&ptr JSR2
DUP2 ;is-non-zero64 JSR2 NOT ,&dump-skip JCN
STH2 DUP ;letter-map/print JSR2
LIT ': EMIT
STH2r DUP2 ;print64/no-pad JSR2
SP
&dump-skip
POP2
LOOP
RTN
&minmax
#00 #0008 ;&_max ;memset JSR2
#ff #0008 ;&_min ;memset JSR2 #7f ;&_min #0007 ADD2 STA
#0000 #0010 DO
DUP ;&ptr JSR2
DUP2 ;is-non-zero64 JSR2 NOT ,&minmax-skip JCN
( count* )
;&_max OVR2 ;geq64 JSR2 ,¬-newmax JCN
;&_max OVR2 ;copy64 JSR2
¬-newmax
DUP2 ;&_min ;geq64 JSR2 ,¬-newmin JCN
;&_min OVR2 ;copy64 JSR2
¬-newmin
&minmax-skip
POP2
LOOP
;&_delta ;&_max ;&_min ;sub64 JSR2
;&_min ;&_max ;&_delta
RTN
[ &_min $8 &_max $8 &_delta $8 ]
&print-result
;&minmax JSR2
SWP2
;print64/no-pad JSR2
LIT '- EMIT
SWP2
;print64/no-pad JSR2
LIT '= EMIT
;print64/no-pad JSR2
RTN
@pair-counts
[ &_counts $800 &_counts-tmp $800 ]
( -- )
&init
#00 #0800 ;&_counts ;memset JSR2
;polymer ( s* )
&init-loop
LDA2k DUP #00 EQU ,&init-done JCN
( elt1 elt2 )
;pair-index/make JSR2
;&increment JSR2
INC2
;&init-loop JMP2
&init-done
( s* elt1 00 )
POP2 POP2
RTN
( pair-idx -- )
&increment
;&ptr JSR2
#01 ;add64-byte JSR2
RTN
( pair-idx -- count* )
&ptr
#00 SWP 8** ;&_counts ADD2
RTN
( -- )
&dump
#0000 #0100 DO
( 00 pair-idx )
DUP ;&ptr JSR2
( 00 pair-idx count* )
DUP2 ;is-non-zero64 JSR2 NOT ,&skip JCN
OVR2 NIP ;pair-index/print JSR2
LIT ': EMIT
DUP2 ;print64/no-pad JSR2 SP
&skip
POP2
LOOP
RTN
( -- )
&clear-tmp
#00 #0800 ;&_counts-tmp ;memset JSR2
RTN
( -- )
&apply-tmp
;&_counts-tmp ;&_counts #0800 ;memcpy JSR2
RTN
( dst-pair-idx src-pair-idx -- )
&add-tmp
;&ptr JSR2 STH2
;&ptr-tmp JSR2 STH2r
( dst-count* src-count* )
;add64 JSR2
RTN
( pair-idx -- count* )
&ptr-tmp
#00 SWP 8** ;&_counts-tmp ADD2
RTN
~library/console.lib.tal
~library/string.tal
~library/math.tal
@polymer $20
@rules $100
( -- )
&reset
#00 #0100 ;rules ;memset JSR2
RTN
( pair-idx out-idx -- )
&add
SWP #00 SWP ;rules ADD2 STA
RTN
( -- )
&dump
;&dump/visitor ;&foreach JSR2
RTN
( pair-idx out-idx -- pair-idx out-idx )
&dump/visitor
OVR ;pair-index/print JSR2
LIT '> EMIT
DUP ;letter-map/print JSR2 SP
RTN
( pair-idx -- out-idx )
&lookup
#00 SWP ;rules ADD2 LDA
RTN
( visitor[ pair-idx out-idx ] )
&foreach
#0000 #0100 DO
( visitor 00 pair-idx )
DUP2 ;rules ADD2 LDA
( visitor 00 pair-idx out-idx )
DUP #00 EQU ,&foreach-skip JCN
STH OVR2 STHr ROT ROT
( visitor 00 pair-idx out-idx visitor )
JSR2
( visitor 00 pair-idx out-idx )
&foreach-skip
POP
LOOP
( visitor )
POP2
RTN