Mercurial > repos > icfp2014

comparison code/ghc.lm @ 42:f1453e8970ca

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Added simulator for ghc microcontroller
author Michael Pavone <pavone@retrodev.com>
date Sat, 26 Jul 2014 19:43:27 -0700
parents
children
comparison
equal deleted inserted replaced
41:e1047192610c 42:f1453e8970ca
1 #{
2 import: [
3 length
4 reverse
5 split:at
6 map
7 fold:with
8 filter
9 flatten
10 ] from: (module: "ll.lm")
11
12 import: [
13 makeTree:size
14 makeTree
15 filledTree
16 _filledTree
17 get:fromTree:size
18 get:fromTree
19 treeMap:size
20 treeMap
21 tree:size:update:with
22 tree:update:with
23 tree:set:to
24 ] from: (module: "tree.lm")
25
26 add8 <- :a b {
27 a <- a + b
28 if: a >= 256 {
29 a <- a - 256
30 } else: {}
31 a
32 }
33
34 sub8 <- :a b {
35 a <- a - b
36 if: a < 0 {
37 a <- a + 256
38 } else: {}
39 a
40 }
41
42 mul8 <- :a b {
43 a <- a * b
44 while: { a > 256 } do: {
45 a <- a - 256
46 }
47 a
48 }
49
50 and8 <- :a b {
51 bit <- 128
52 out <- 0
53 while: { bit > 0 } do: {
54 if: a >= bit {
55 a <- a - bit
56 if: b >= bit {
57 b <- b - bit
58 out <- out + bit
59 } else: {}
60 } else: {
61 if: b >= bit {
62 b <- b - bit
63 } else: {}
64 }
65 bit <- bit / 2
66 }
67 out
68 }
69
70 or8 <- :a b {
71 bit <- 128
72 out <- 0
73 while: { bit > 0 } do: {
74 if: a >= bit {
75 a <- a - bit
76 out <- out + bit
77 if: b >= bit {
78 b <- b - bit
79 } else: {}
80 } else: {
81 if: b >= bit {
82 b <- b - bit
83 out <- out + bit
84 } else: {}
85 }
86 bit <- bit / 2
87 }
88 out
89 }
90
91 xor8 <- :a b {
92 bit <- 128
93 out <- 0
94 while: { bit > 0 } do: {
95 if: a >= bit {
96 a <- a - bit
97 if: b >= bit {
98 b <- b - bit
99 } else: {
100 out <- out + bit
101 }
102 } else: {
103 if: b >= bit {
104 b <- b - bit
105 out <- out + bit
106 } else: {}
107 }
108 bit <- bit / 2
109 }
110 out
111 }
112
113 makeCPU <- :code intHandler {
114 a <- 0
115 b <- 0
116 c <- 0
117 d <- 0
118 e <- 0
119 f <- 0
120 g <- 0
121 h <- 0
122
123 dataMem <- filledTree: 0 256
124
125 getRegVal <- :regnum pc {
126 if: regnum >= 4 {
127 if: regnum >= 6 {
128 if: regnum = 6 {
129 regnum <- g
130 } else: {
131 if: regnum = 7 {
132 regnum <- h
133 } else: {
134 regnum <- pc
135 }
136 }
137 } else: {
138 if: regnum = 4 {
139 regnum <- e
140 } else: {
141 regnum <- f
142 }
143 }
144 } else: {
145 if: regnum >= 2 {
146 if: regnum = 2 {
147 regnum <- c
148 } else: {
149 regnum <- d
150 }
151 } else: {
152 if: regnum {
153 regnum <- b
154 } else: {
155 regnum <- a
156 }
157 }
158 }
159 regnum
160 }
161
162 getArg <- :arg pc {
163 type <- arg value
164 param <- arg tail
165 if: type >= 2 {
166 if: type = 3 {
167 param <- get: param fromTree: dataMem
168 } else: {}
169 } else: {
170 param <- getRegVal: param pc
171 if: type {
172 param <- get: param fromTree: dataMem
173 } else: {}
174 }
175 param
176 }
177
178 setReg <- :regnum pc val {
179 if: regnum >= 4 {
180 if: regnum >= 6 {
181 if: regnum = 6 {
182 g <- val
183 } else: {
184 if: regnum = 7 {
185 h <- val
186 } else: {
187 pc <- val
188 }
189 }
190 } else: {
191 if: regnum = 4 {
192 e <- val
193 } else: {
194 f <- val
195 }
196 }
197 } else: {
198 if: regnum >= 2 {
199 if: regnum = 2 {
200 c <- val
201 } else: {
202 d <- val
203 }
204 } else: {
205 if: regnum {
206 b <- val
207 } else: {
208 a <- val
209 }
210 }
211 }
212 pc
213 }
214
215 saveDest <- :arg pc val {
216 type <- arg value
217 param <- arg tail
218 if: type >= 2 {
219 if: type = 3 {
220 dataMem <- tree: dataMem set: param to: val
221 } else: {}
222 } else: {
223 if: type {
224 param <- getRegVal: param pc
225 dataMem <- tree: dataMem set: param to: val
226 } else: {
227 pc <- setReg: param pc val
228 }
229 }
230 pc
231 }
232
233 mov <- :args {
234 dst <- args value
235 src <- (args tail) value
236 :pc {
237 #[1 (saveDest: dst pc (getArg: src pc))]
238 }
239 }
240
241 inc <- :args {
242 dst <- args value
243 :pc {
244 #[1 (saveDest: dst pc (add8: (getArg: dst pc) 1))]
245 }
246 }
247
248 dec <- :args {
249 dst <- args value
250 :pc {
251 #[1 (saveDest: dst pc (sub8: (getArg: dst pc) 1))]
252 }
253 }
254
255 add <- :args {
256 dst <- args value
257 src <- (args tail) value
258 :pc {
259 #[1 (saveDest: dst pc (add8: (getArg: dst pc) (getArg: src pc)))]
260 }
261 }
262
263 sub <- :args {
264 dst <- args value
265 src <- (args tail) value
266 :pc {
267 #[1 (saveDest: dst pc (sub8: (getArg: dst pc) (getArg: src pc)))]
268 }
269 }
270
271 mul <- :args {
272 dst <- args value
273 src <- (args tail) value
274 :pc {
275 #[1 (saveDest: dst pc (mul8: (getArg: dst pc) (getArg: src pc)))]
276 }
277 }
278
279 div <- :args {
280 dst <- args value
281 src <- (args tail) value
282 :pc {
283 srcv <- getArg: src pc
284 if: srcv = 0 {
285 pc <- #[0 pc]
286 } else: {
287 pc <- #[1 (saveDest: dst pc (getArg: dst pc) / srcv)]
288 }
289 pc
290 }
291 }
292
293 and <- :args {
294 dst <- args value
295 src <- (args tail) value
296 :pc {
297 #[1 (saveDest: dst pc (and8: (getArg: dst pc) (getArg: src pc)))]
298 }
299 }
300
301 or <- :args {
302 dst <- args value
303 src <- (args tail) value
304 :pc {
305 #[1 (saveDest: dst pc (or8: (getArg: dst pc) (getArg: src pc)))]
306 }
307 }
308
309 xor <- :args {
310 dst <- args value
311 src <- (args tail) value
312 :pc {
313 #[1 (saveDest: dst pc (xor8: (getArg: dst pc) (getArg: src pc)))]
314 }
315 }
316
317 jlt <- :args {
318 target <- args value
319 x <- (args tail) value
320 y <- ((args tail) tail) value
321 :pc {
322 if: x >= y {
323 } else: {
324 pc <- target
325 }
326 pc
327 }
328 }
329
330 jeq <- :args {
331 target <- args value
332 x <- (args tail) value
333 y <- ((args tail) tail) value
334 :pc {
335 if: x = y {
336 pc <- target
337 } else: {
338 }
339 pc
340 }
341 }
342
343 jgt <- :args {
344 target <- args value
345 x <- (args tail) value
346 y <- ((args tail) tail) value
347 :pc {
348 if: x > y {
349 pc <- target
350 } else: {
351 }
352 pc
353 }
354 }
355
356 int <- :args {
357 num <- args value
358 :pc {
359 iargs <- a
360 if: num = 8 {
361 iargs <- #[a b c d e f g h]
362 } else: {
363 if: num = 7 {
364 iargs <- #[a b]
365 } else: {}
366 }
367 intHandler: num iargs setReg pc
368 }
369 }
370
371
372 hlt <- :pc {
373 #[0 pc]
374 }
375
376 codeMem <- (fold: code #[(filledTree: hlt 256) 0] with: :acc inst {
377 cmem <- acc value
378 pc <- acc tail
379
380 inum <- inst value
381 args <- inst tail
382
383 if: inum >= 7 {
384 if: inum >= 11 {
385 if: inum >= 13 {
386 if: inum = 14 {
387 inst <- hlt
388 } else: {
389 inst <- int: args
390 }
391 } else: {
392 if: inum = 12 {
393 inst <- jgt: args
394 } else: {
395 inst <- jeq: args
396 }
397 }
398 } else: {
399 if: inum >= 9 {
400 if: inum = 10 {
401 inst <- jlt: args
402 } else: {
403 inst <- xor: args
404 }
405 } else: {
406 if: inum = 8 {
407 inst <- or: args
408 } else: {
409 inst <- and: args
410 }
411 }
412 }
413 } else: {
414 if: inum >= 3 {
415 if: inum >= 5 {
416 if: inum = 5 {
417 inst <- mul: args
418 } else: {
419 inst <- div: args
420 }
421 } else: {
422 if: inum = 3 {
423 inst <- add: args
424 } else: {
425 inst <- sub: args
426 }
427 }
428 } else: {
429 if: inum = 2 {
430 inst <- dec: args
431 } else: {
432 if: inum {
433 inst <- inc: args
434 } else: {
435 inst <- mov: args
436 }
437 }
438 }
439 }
440 #[(tree: cmem set: pc to: inst) pc + 1]
441 }) value
442
443 {
444 cycle <- 0
445 pc <- 0
446 ret <- 0
447 run <- 1
448
449 while: { run } do: {
450 ret <- get: pc fromTree: codeMem
451 ret <- ret: pc
452 run <- ret value
453
454 if: (ret tail) = pc {
455 pc <- pc + 1
456 } else: {
457 pc <- ret tail
458 }
459 cycle <- cycle + 1
460 if: cycle >= 1024 {
461 run <- 0
462 } else: {}
463 }
464 cycle
465 }
466 }
467
468 main <- {
469 cpu <- makeCPU: [
470 #[0 [#[0 0] #[2 31]]] //0 a <- 31
471 #[0 [#[0 1] #[2 45]]] //1 b <- 45
472 #[0 [#[0 2] #[2 57]]] //2 c <- 57
473 #[0 [#[0 3] #[2 127]]] //3 d <- 127
474 #[0 [#[0 4] #[2 128]]] //4 e <- 128
475 #[0 [#[0 5] #[2 254]]] //5 f <- 254
476 #[0 [#[0 6] #[2 255]]] //6 g <- 255
477 #[0 [#[0 7] #[2 3]]] //7 h <- 3
478 #[0 [#[3 0] #[2 45]]] //8 [0] <- 45
479 #[1 [#[0 0]]] //9 a <- a + 1 : 32
480 #[2 [#[0 1]]] //10 b <- b - 1 : 44
481 #[3 [#[0 2] #[0 3]]] //11 c <- c + d : 184
482 #[4 [#[0 4] #[0 5]]] //12 e <- e - f : 130
483 #[5 [#[0 6] #[0 7]]] //13 g <- g * h : 253
484 #[6 [#[3 0] #[0 0]]] //14 [0] <- [0] * a : 160
485 #[13 [8]] //15
486 #[14 []] //16
487 ] :num iargs setReg pc {
488 print: #[num pc iargs]
489 #[1 pc]
490 }
491 print: (add8: 2 3)
492 print: (add8: 255 1)
493 print: (add8: 129 128)
494 print: (sub8: 4 2)
495 print: (sub8: 2 4)
496 print: (sub8: 0 255)
497 print: (mul8: 255 255)
498 print: (mul8: 255 2)
499 print: (mul8: 3 5)
500 print: (and8: 127 254)
501 print: (and8: 3 5)
502 print: (or8: 127 254)
503 print: (or8: 3 5)
504 print: (xor8: 127 254)
505 print: (xor8: 3 5)
506 print: (cpu: )
507 }
508 }