Cache Source

A fragment of the LRU (least recently used) cache implementation.

val W = 32

fun mask b = (1 << b) - 1

fun load_sample (p, b) = let wa = p / W let ba = p % W let w0 = (load_word_cached wa) let s0 = (mask b) & (w0 >> ba) if ((ba + b) > W) (let ub = W - ba let w1 = load_word_cached ((p+ub) / W) let s1 = (w1 & (mask (b - ub))) s0 | (s1 << ub)) s0

fun flush_line line = let (addr, clean, mask, v) = line if clean line let v2 = (if (0 = mask) v (v | (mask & (load_word addr)))) let line2 = (addr, true, 0, v2) store_word(addr, v2)

fun load_word_cached(addr) = let (effects,cache) = get_store if (is_pair(cache)) (lw_loop(cache, (), addr)) (load_word(addr))

fun lw_loop(cache, prev_cache, addr) = if (is_pair cache) (let (line, rest) = cache let (addr2, clean, mask, v) = line if (aliases(addr2,addr)) (if (clean or (mask = 0)) (cache_done(prev_cache, rest, addr, true, 0, v)) (error cannot_cross_streams2)) (lw_loop (rest, (line, prev_cache), addr))) ((flush_line(left prev_cache)); (let w = (load_word(addr)) (cache_done ((right prev_cache), (), addr, true, 0, w))))

Signal Source

A fragment of the Simple implementation of the signal library:

fun memory_empty  (start, stop, size, stride) = 
    (start = stop)
fun memory_next (start, stop, size, stride) =
    (v_memory, ((start+stride), stop, size, stride))
fun memory_get (start, stop, size, stride) = 
    load_sample(start, size)
fun memory_put ((start, stop, size, stride), v) =
    store_sample(start, size, v)

fun constant_empty k = true fun constant_next k = (v_constant, k) fun constant_get k = k fun constant_put (k, v) = (error)

fun noise_empty (state, ia, ic, im) = true fun noise_next (state, ia, ic, im) = (v_noise, (((lift (ia*state + ic)) % im), ia, ic, im)) fun noise_get (state, ia, ic, im) = state fun noise_put (state, ia, ic, im) = (error)

fun bin_empty (op, v, w) = ((vec_empty v) and (vec_empty w)) fun bin_next (op, v, w) = (v_bin, (op, (vec_next v), (vec_next w))) fun bin_get (op, v, w) = (do_op (op, (vec_get v), (vec_get w))) fun bin_put ((op, v, w), q) = (error)

fun delay1_empty (h, v) = (vec_empty v) fun delay1_next (h, v) = (v_delay1, ((vec_get v), (vec_next v))) fun delay1_get (h, v) = h fun delay1_put ((h, v), q) = (error)

fun scan_empty (op, h, v) = (vec_empty v) fun scan_next (op, h, v) = (v_scan, (op, (do_op (h, (vec_get v))), (vec_next v))) fun scan_get (op, h, v) = h fun scan_put ((op, h, v), q) = (error)

fun lut_empty (m, v) = (vec_empty v) fun lut_next (m, v) = (v_lut, (m, (vec_next v))) fun lut_get (m, v) = (load_word (m + ((vec_get v)))) fun lut_put ((m, v), w) = (error)

fun sum_tile_empty (v, max, in) = (vec_empty in) fun sum_tile_next (v, max, in) = let next = ((v + (vec_get in)) & (max-1)) (v_sum_tile, (next, max, (vec_next in))) fun sum_tile_get (v, max, in) = v fun sum_tile_put (v, max, in) = (error)

fun reduce (op, init, vec) = loop (v, vec) ((lift init), vec) (vec_empty vec) ((do_op(op, v, (vec_get vec))), (vec_next vec)) v

fun copy (a, b) = loop (a, b) (a, b) ((vec_empty a) and (vec_empty b)) ((vec_put (b, (vec_get a))); ((vec_next a), (vec_next b))) ()

fun filter (i, k, pre) = if (is_pair k) (v_binop, (op_plus, (v_map, (op_times, (left k), i)), (filter ((v_delay1, ((left pre)), i), (right k), (right pre))))) i

fun fm_osc (mod_freq, c, wav, size, base_freq, init_phase) = let prec = 8 (v_lut, (wav, (v_map, (op_shift_right, prec, (v_sum_tile, (init_phase, (size * (1<<prec)), (v_bin, (op_plus, base_freq, (v_map, (op_shift_right, prec, (v_map, (op_times, c, mod_freq))))))))))))

fun rgb2m (r, g, b, m) = ((v_map, (op_div, 64, (v_bin, (op_plus, (v_bin, (op_plus, (v_map, (op_times, 30, r)), (v_map, (op_times, 25, g)))), (v_map, (op_times, 9, b)))))), m)

Signal Examples

Programs implemented with the signal library.

val add = (op_plus, sig16, sig16_1, sig16_2)

val inc = (op_plus, sig16, (v_constant, 10), sig16_1)

val filter2 = ((v_bin, (op_plus, (v_delay1, (('first), sig16)), sig16)), sig16_2)

val kernel = (1, 2, 4, 2, 1, ()) val prefix = (('a), ('b), ('c), ('d), ('e), ()) val filter5 = ((filter (sig16, kernel, prefix)), sig16_1)

val lut1 = ((v_lut, (('buf), sig8)), sig16)

val wavtab1 = ((v_lut_feedback, (('buf), 1024, 1, 32, ('prev), sig16)), sig16_1)

val fm1 = ((fm_osc ((v_constant, 0), 0, ('buf), 1024, (v_constant, 256), ('init_phase))), sig16)

val fm2 = ((fm_osc ((osc (('buf), 1024, (v_constant, 256), ('phase0))), 1, ('buf), 1024, (v_constant, 256), ('phase1))), sig16)

val rgb2m_1 = rgb2m (rgba_r, rgba_g, rgba_b, mono8) val rgb2m_2 = rgb2m (rgb_r, rgb_g, rgb_b, mono8)

val base64_encode = (aligned_6s, aligned_bytes) val base64_decode = (aligned_bytes, aligned_6s)

Manual Code

Baseline C code.

int
sum16(short *start, short *stop,
      int sum) {
  while (start != stop) {
    sum += *start++;
  }
  return sum;
}

void filter2(short *start, short *stop, short *start1, short *stop1) { while (start != stop) { *start1 = start[0] + start[1]; start++; start1++; } }

void filter5(short *start, short *stop, short *start1, short *stop1) { int i, t; while (start != stop) { t = 0; for (i = 0; i < 5; i++) t += start[i]; *start1 = t; start++; start1++; } }

int sum8(int *start, int *stop, int sum) { int v; while(start != stop) { v = *start; sum += (((v>>0)&255) + ((v>>8)&255) + ((v>>16)&255) + ((v>>24)&255)); start += 1; } return sum; }

void iota(int *start, int *stop) { int i = 0; while(start != stop) { *start++ = i | ((i+1)<<8) | ((i+2)<<16) | ((i+3)<<24); i+=4; } }

void copy(int *start0, int* stop0, int *start1, int* stop1) { while (start0 != stop0) *start0++ = *start1++; }

void gaps(int *start0, int* stop0, int *start1, int* stop1) { while (start0 != stop0) { int v = *start0; int b0 = (v>>0)&255; int b1 = (v>>8)&255; int b2 = (v>>16)&255; int b3 = (v>>24)&255; int mask = 0xff00ff00; start1[0] = (start1[0] & mask) | b0 | (b1 << 16); start1[1] = (start1[1] & mask) | b2 | (b3 << 16); start0++; start1+=2; } }

int sum12(int *start, int *stop) { int sum = 0; while (start != stop) { int w0 = start[0]; int w1 = start[1]; int w2 = start[2]; sum += ((w0 & 0xfff) + ((w0 >> 12) & 0xfff) + (((w0 >> 24) & 0xff) | ((w1 & 0xf) << 8)) + ((w1 >> 4) & 0xfff) + ((w1 >> 16) & 0xfff) + (((w1 >> 28) & 0xf) | ((w2 & 0xff) << 4)) + ((w2 >> 8) & 0xfff) + ((w2 >> 20) & 0xfff)); start += 3; } return sum; }

void fm1(int *lut, int phase, short *start, short *stop) { while (start != stop) { *start++ = lut[phase>>8]; phase += 256; phase = phase & ((1024*256)-1); } }