LARA

// Simple malloc and free, fragmentation possible
class Heap(size : Int) {
  private var mem = new Array[Int](size)   // OS would provide this memory
  private var nextAvailable : Int = 1 // where to allocate next
 
  val nextOffset = 0 // offset of 'next' field in free list
  val sizeOffset = 1 // offset of 'size' field in free list
  val minFreeListBlockSize = 2 // each free list block must have size at least 2 words
 
  // initially, free list contains one block whose size is memory size
  def initFreeList = {
    nextAvailable = 1
    mem(nextAvailable + nextOffset) = 0
    mem(nextAvailable + sizeOffset) = size - 1
  }
 
  def malloc(blockSize : Int) : Int = {
    var prev = 0
    var current = nextAvailable
    while ((current != 0) &&
	   (current < size) &&
	   load(current, sizeOffset) < blockSize) {
      prev = current
      current = load(current, nextOffset)
    }
 
    def setPrev(v : Int) = {
      if (prev==0) 
	nextAvailable = v
      else
	mem(prev + nextOffset) = v
    }
 
    // current is the block we would like to return
    if (current==0) {
      error("Out of useful memory")
    } else {
      // found block of the right size
      val restSize = mem(current + sizeOffset) - blockSize
      if (restSize >= minFreeListBlockSize) {
	// replace original block with remaining block
	val restAddr = current + blockSize
	mem(restAddr + sizeOffset) = restSize
	mem(restAddr + nextOffset) = mem(current + nextOffset)
	setPrev(restAddr)
      } else {// remove entire block from free list
	setPrev(mem(current + nextOffset))
      }
      initMem(current, current + blockSize)
    }
    current
  }
 
  def initMem(from : Int, to : Int) = {
    var i = from
    while (i < to) { 
      mem(i) = 0;
      i = i + 1;
    }
  }
 
  // Find where to put the block
  def free(ptr : Int, blockSize : Int) = {
    var prev = 0
    var current = nextAvailable
 
    def setPrev(v : Int) = {
      if (prev==0) 
	nextAvailable = v
      else
	mem(prev + nextOffset) = v
    }
 
    while ((current != 0) && (current < ptr)) {
      prev = current
      current = mem(current + nextOffset)
    }
    // insert the freed block
    mem(ptr + nextOffset) = current
    mem(ptr + sizeOffset) = blockSize
    setPrev(ptr)
    // to reduce fragmentation we should merge here
  }
 
  val nullPtr = 0
 
  // x.f
  def load(x : Int, f : Int) = {
    if (x==0) error("Null dereference!")
    else mem(x + f)
  }
 
  // x.f = y
  def store(x : Int, f : Int, y : Int) = {
    if (x==0) error("Null dereference!")
    else { mem(x + f) = y }
  }
 
  override def toString() : String = {
    var res = "nextAvailable:" + nextAvailable + "\n"
    var i : Int = 0
    while (i < size) {
      res += (i + "->" + mem(i) + "  ")
      i = i + 1
    }
    res
  }
 
  initFreeList
}
 
// source code example
object TestSourceCode {
  class Node {
    var next : Node = null
    var data : Int = 0
  }
  def main(args : Array[String]) = {
    var x : Node = new Node()
    var y : Node = new Node()
    x.next = y
    x.data = 42
    var z : Node = x.next
    z.data = 9
  }
}
 
// object code for the above example
object TestObjectCode {
  val typeTagOffset  = 0 // implicit, first, field
  val nextOffset     = 1 // second field
  val dataOffset     = 2 // third field
  val nodeSize = 3 // three 1-word fields total
 
  val nodeTypeTag = 555 // index of type 'Node'
 
  def main(args : Array[String]) = {
    var h : Heap = new Heap(64)
    println(h)
    var x : Int = h.malloc(nodeSize)
    h.store(x, typeTagOffset, nodeTypeTag)
    println(h)
 
    var y : Int = h.malloc(nodeSize)
    h.store(y, typeTagOffset, nodeTypeTag)
    println(h)
 
    h.store(x, nextOffset, y)
    h.store(x, dataOffset, 42)
    var z : Int = h.load(x, nextOffset)
    h.store(z, dataOffset, 9)
    println(h)
    println("About to free")
    h.free(z, nodeSize)
    println(h)
  }
}