vm.stanza

defpackage stz/vm :
  import core
  import collections
  import stz/vm-ir
  import stz/vm-load-unit
  import stz/typeset
  import stz/vm-table
  import stz/vm-ids
  import stz/dl-ir
  import stz/basic-ops
  import stz/stable-arrays
  import stz/branch-table
  import stz/backend
  import stz/utils
  import stz/extern-intrinsics
  import stz/code-table
  import stz/cvm-code-table
  import stz/jit-code-table
  import stz/vm-structures
  import stz/params
  import stz/timing-log-api
  import stz/verbose
  import stz/loaded-dynamic-libraries
  import stz/extern-defn-table
  import stz/code-template-table
  import stz/absolute-info
  import stz/trace-info
  import core/stack-trace

;<doc>=======================================================
;================= Virtual Machine Interface ================
;============================================================

# Create a virtual machine #

  val vm = VirtualMachine()

# Load new packages into the virtual machine #

  load (vm:VirtualMachine, pkgs:Collection<VMPackage>, keep-globals?:True|False) -> False

If keep-globals? is false, then new loaded globals are bound to
uninitialized variables. If keep-globals? is true, then the globals
are not changed, and retain their current value. In this case, the
globals *must* have the same type as it did previously.

# Unload the given packages from the virtual machine #

  unload (vm:VirtualMachine, pkgs:Collection<Symbol>) -> False

Unloads the given packages from the virtual machine.

# Run top-level initializers for a package #

  init-package (vm:VirtualMachine, package:Symbol)

Executes the top-level expressions in the given package.

Examples:

  init-package(vm, `core)
  init-package(vm, `repl27)

# Compute the current live records #

  compute-live (vm:VirtualMachine, exclude:Seqable<Symbol>) -> Tuple<Rec>

Example: Suppose the user wishes to reload packages stz/algorithms and
stz/parser. This means that all the global variables in these two
packages will be reset to uninitialized, and we will rerun the
top-level expressions in stz/algorithms and stz/parser.

However, there may currently exist live objects that depend upon
certain definitions in stz/algorithms and stz/parser, and we have to
be careful not to change the signatures of these definitions.

The following call will temporarily set the global variables in
stz/algorithms and stz/parser to uninitialized and then retrieve the
records depended upon by all the currently live objects in the heap.

  compute-live(vm, [`stz/algorithms, `stz/parser])

# Clear all the global variables #

  clear-globals (vm:VirtualMachine) -> False

Reset all global variables in the virtual machine to uninitialized.
This is typically used before re-executing the top-level expressions
in all packages.

;============================================================
;=======================================================<doc>

;============================================================
;======================== Timers ============================
;============================================================

val EXEC-PACKAGE = TimerLabel("VM Execute Package")
val LOAD-VM-PACKAGES = TimerLabel("VM Load Packages")
val COMPUTE-LOAD-UNIT = TimerLabel(LOAD-VM-PACKAGES, suffix("Compute Load Unit"))
val LOAD-GLOBALS = TimerLabel(LOAD-VM-PACKAGES, suffix("Load Globals"))
val LOAD-METHODS = TimerLabel(LOAD-VM-PACKAGES, suffix("Load Methods"))
val LOAD-CLASSES = TimerLabel(LOAD-VM-PACKAGES, suffix("Load Classes"))
val LOAD-FUNCTIONS = TimerLabel(LOAD-VM-PACKAGES, suffix("Load Functions"))
val LOAD-DATAS = TimerLabel(LOAD-VM-PACKAGES, suffix("Load Datas"))
val LOAD-CONSTS = TimerLabel(LOAD-VM-PACKAGES, suffix("Load Consts"))
val LOAD-CALLBACKS = TimerLabel(LOAD-VM-PACKAGES, suffix("Load Callbacks"))
val UPDATE-BRANCH-TABLE = TimerLabel(LOAD-VM-PACKAGES, suffix("Update Branch Table"))
val UPDATE-VMSTATE = TimerLabel(LOAD-VM-PACKAGES, suffix("Update VMState"))
val EXECUTE-INIT-CONSTS = TimerLabel(LOAD-VM-PACKAGES, suffix("Executing Init Consts"))

;============================================================
;======================= Linker =============================
;============================================================

deftype Linker
defmulti live-map-table (l:Linker) -> LiveMapTable
defn Linker (branch-table:BranchTable) :
  val live-map-table = LiveMapTable()
  new Linker :
    defmethod live-map-table (this) : live-map-table

;============================================================
;================= Live Map Analysis ========================
;============================================================
deftype LiveMapTable
defmulti map-index (t:LiveMapTable, slots:Seqable<Int>, num-slots:Int) -> Int
defmulti get (t:LiveMapTable, i:Int) -> LivenessMap
defmulti key? (t:LiveMapTable, i:Int) -> True|False

public defstruct LivenessMap <: Hashable&Equalable :
  live-slots: Tuple<Int>
  num-slots: Int
with:
  printer => true

defmethod hash (m:LivenessMap) :
  num-slots(m) + 7 * hash(live-slots(m))

defmethod equal? (a:LivenessMap, b:LivenessMap) :
  live-slots(a) == live-slots(b) and
  num-slots(a) == num-slots(b)

public defn LiveMapTable () :

  ;Create a canonicalized LivenessMap object.
  val sort-buffer = Vector<Int>()
  defn make-liveness-map (slots:Seqable<Int>, num-slots:Int) -> LivenessMap :
    clear(sort-buffer)
    add-all(sort-buffer, slots)
    if empty?(sort-buffer) :
      LivenessMap([], num-slots)
    else :
      qsort!(sort-buffer)
      LivenessMap(to-tuple(sort-buffer), num-slots)

  ;Accumulate all liveness maps here.
  val maps = Vector<LivenessMap>()

  ;Associate liveness maps with the index in 'maps' where they are stored.
  val table = HashTable<LivenessMap,Int>()

  ;Add a map to 'maps' and 'table'.
  defn add-map (m:LivenessMap) -> Int :
    table[m] = length(maps)
    add(maps, m)
    length(maps) - 1

  ;Add the default trivial liveness map at the first position.
  add-map(LivenessMap([], 0))

  ;Return the liven
  new LiveMapTable :
    defmethod map-index (this, slots:Seqable<Int>, num-slots:Int) :
      val map = make-liveness-map(slots, num-slots)
      match(get?(table,map)) :
        (i:Int) : i
        (f:False) : add-map(map)

    defmethod get (this, i:Int) :
      maps[i]

    defmethod key? (this, i:Int) :
      i >= 0 and i < length(maps)



;============================================================
;===================== Format Table =========================
;============================================================

public defstruct CallFormat <: Hashable&Equalable :
  xs: Tuple<VMType>
  ys: Tuple<VMType>
with :
  printer => true

defmethod hash (f:CallFormat) :
  hash(xs(f)) + 7 * hash(ys(f))
defmethod equal? (a:CallFormat, b:CallFormat) :
  xs(a) == xs(b) and ys(a) == ys(b)

public deftype FormatTable
public defmulti index (t:FormatTable, f:CallFormat) -> Int
public defmulti address (t:FormatTable, index:Int) -> Long
public defmulti get (t:FormatTable, f:CallFormat) -> Long
public defmulti set (t:FormatTable, f:CallFormat, l:Long) -> False

defn FormatTable () :
  val table = HashTable<CallFormat,Int>()
  val addresses = Vector<Long>()
  new FormatTable :
    defmethod index (this, f:CallFormat) : table[f]
    defmethod address (this, index:Int) : addresses[index]
    defmethod get (this, f:CallFormat) : addresses[table[f]]
    defmethod set (this, f:CallFormat, l:Long) :
      add(addresses, l)
      table[f] = length(addresses) - 1

public val FORMAT-TABLE = FormatTable()

;============================================================
;=================== Format Coalescing ======================
;============================================================

defn exemplar-type (t:VMType) :
  match(t:VMRef) : VMLong()
  else : t

public defn coalesce (f:CallFormat) :
  ;New return result
  val x* =
    if empty?(xs(f)) :
      VMLong()
    else :
      match(exemplar-type(xs(f)[0])) :
        (t:VMByte|VMInt) : VMLong()
        (t) : t

  ;New arguments
  val ys* = for y in ys(f) map :
    match(exemplar-type(y)) :
      (y:VMByte|VMInt) : VMLong()
      (y) : y

  ;Return coalesced call format
  CallFormat([x*], ys*)

;============================================================
;==================== Tag Bits ==============================
;============================================================

public lostanza val INT-TAG-BITS:long = 0L
public lostanza val REF-TAG-BITS:long = 1L
public lostanza val MARKER-TAG-BITS:long = 2L
public lostanza val BYTE-TAG-BITS:long = 3L
public lostanza val CHAR-TAG-BITS:long = 4L
public lostanza val FLOAT-TAG-BITS:long = 5L

public lostanza val INT-TAG-INT:ref<Int> = new Int{INT-TAG-BITS as int}
public lostanza val REF-TAG-INT:ref<Int> = new Int{REF-TAG-BITS as int}
public lostanza val MARKER-TAG-INT:ref<Int> = new Int{MARKER-TAG-BITS as int}
public lostanza val BYTE-TAG-INT:ref<Int> = new Int{BYTE-TAG-BITS as int}
public lostanza val CHAR-TAG-INT:ref<Int> = new Int{CHAR-TAG-BITS as int}
public lostanza val FLOAT-TAG-INT:ref<Int> = new Int{FLOAT-TAG-BITS as int}

;============================================================
;==================== VM Constants ==========================
;============================================================

lostanza defn untag (x:long) -> ptr<?> :
  val tagbits = x & 7L
  if tagbits != REF-TAG-BITS : fatal("Not a heap-allocated object!")
  return (x - REF-TAG-BITS + 8) as ptr<?>

lostanza defn tag (x:ptr<?>) -> long :
  return (x + REF-TAG-BITS) as long

public lostanza defn void-marker () -> long :
  return (-1L << 3L) + MARKER-TAG-BITS

public lostanza defn false-marker () -> long :
  return (FALSE-TYPE.value << 3L) + MARKER-TAG-BITS

public lostanza defn true-marker () -> long :
  return (TRUE-TYPE.value << 3L) + MARKER-TAG-BITS

public defn void-marker-int () :
  marker-int(-1)

public defn marker-int (t:Int) :
  (t << 3) + MARKER-TAG-INT

;============================================================
;=================== VM Structures ==========================
;============================================================

public lostanza deftype VirtualMachine :
  dylibs: ref<LoadedDynamicLibraries>
  extern-defns: ref<ExternDefnTable>
  backend: ref<Backend>
  vmtable: ref<VMTable>
  vm-ids: ref<VMIds>
  linker: ref<Linker>
  vmstate: ptr<VMState>
  var core-loaded?: ref<True|False>

lostanza defn linker (vm:ref<VirtualMachine>) -> ref<Linker> :
  return vm.linker

lostanza defn vm-ids (vm:ref<VirtualMachine>) -> ref<VMIds> :
  return vm.vm-ids

lostanza defn vmtable (vm:ref<VirtualMachine>) -> ref<VMTable> :
  return vm.vmtable

lostanza defn class-table (vm:ref<VirtualMachine>) -> ref<ClassTable> :
  return vmtable(vm).class-table

lostanza defn backend (vm:ref<VirtualMachine>) -> ref<Backend> :
  return vm.backend

lostanza defn live-map-table (vm:ref<VirtualMachine>) -> ref<LiveMapTable> :
  return live-map-table(linker(vm))

lostanza defn dynamic-libraries (vm:ref<VirtualMachine>) -> ref<LoadedDynamicLibraries> :
  return vm.dylibs

lostanza defn extern-defns (vm:ref<VirtualMachine>) -> ref<ExternDefnTable> :
  return vm.extern-defns

lostanza defn update-vmstate (vm:ref<VirtualMachine>) -> ref<False> :
  val vms = vm.vmstate
  val vmt = vmtable(vm)
  vms.instructions = instructions(vmt.code-table).value as ptr<byte>
  vms.global-offsets = vmt.global-offsets.data
  vms.global-mem = vmt.globals.mem
  vms.const-table = vmt.consts.mem
  vms.const-mem = vmt.consts-data.mem
  vms.data-offsets = vmt.data-positions.data
  vms.data-mem = vmt.data.mem
  vms.code-offsets = vmt.function-addresses.data
  vms.trie-table = trie-table-data(branch-table(vm))
  vms.class-table = packed-class-table(vmt.class-table)
  return false

;============================================================
;==================== VM Implementation =====================
;============================================================

public defn VirtualMachine (dylibs:LoadedDynamicLibraries) :
  #if-defined(PLATFORM-WINDOWS) :
    VirtualMachine(dylibs, W64Backend())
  #else :
    #if-defined(PLATFORM-LINUX) :
      VirtualMachine(dylibs, L64Backend())
    #else :
      VirtualMachine(dylibs, X64Backend())

public lostanza defn VirtualMachine (dylibs:ref<LoadedDynamicLibraries>, backend:ref<Backend>) -> ref<VirtualMachine> :
  val vmstate:ptr<VMState> = call-c clib/malloc(sizeof(VMState))
  vmstate.registers = call-c clib/malloc(8 * 256)
  vmstate.system-registers = call-c clib/malloc(8 * 256)
  ;Initialize heap
  val initial-heap-size = 8 * 1024L * 1024L
  val heap = addr(vmstate.heap)
  initialize-heap(heap, initial-heap-size, MAXIMUM-HEAP-SIZE)
  heap.iterate-roots = addr(vm-iterate-roots)
  heap.iterate-references-in-stack-frames = addr(vm-iterate-references-in-stack-frames)

  ;Initialize sighandler to false to indicate no handler on initialization.
  vmstate.sig-handler = false-marker()

  ;Initialize extern trampoline
  initialize-extern-trampoline(addr(call_extern), vmstate.registers)

  vmstate.trie-table = null
  vmstate.class-table = null
  val extern-defns = ExternDefnTable(backend)
  val vm-ids = VMIds(dylibs, extern-defns)
  val class-table = ClassTable()
  val branch-table = BranchTable(class-table)
  val linker = Linker(branch-table)
  val resolver = EncodingResolver(class-table, branch-table, live-map-table(linker), dylibs, extern-defns)
  val code-table = make-code-table(resolver, backend)
  val vmtable = VMTable(class-table, branch-table, code-table)
  val vm = new VirtualMachine{dylibs, extern-defns, backend, vmtable, vm-ids, linker, vmstate, false}
  update-vmstate(vm)
  return vm

;Make an appropriate CodeTable depending on whether the user has
;enabled the JIT.
defn make-code-table (resolver:EncodingResolver, backend:Backend) -> CodeTable :
  if contains?(EXPERIMENTAL-FEATURES, `jit) : JITCodeTable(resolver, backend)
  else : CVMCodeTable()

lostanza defn vm-iterate-roots (f:ptr<((ptr<long>, ptr<core/VMState>) -> ref<False>)>,
                                vms:ptr<core/VMState>) -> ref<False> :
  val vmtable = vmtable(current-vm())
  ;Scan globals
  val globals:ptr<long> = vmtable.globals.mem
  val roots = to-seq(roots(vmtable.global-table))
  while empty?(roots) == false :
    val r = next(roots).value
    [f](addr(globals[r]), vms)
  ;Scan const roots
  val consts:ptr<long> = vmtable.consts.mem
  val nconsts = vmtable.consts.size / 8
  for (var i:int = 0, i < nconsts, i = i + 1) :
    [f](addr(consts[i]), vms)
  ;No meaningful return value
  return false

lostanza defn vm-iterate-references-in-stack-frames (stack:ptr<Stack>,
                                                     f:ptr<((ptr<long>, ptr<core/VMState>) -> ref<False>)>,
                                                     vms:ptr<core/VMState>) -> ref<False> :
  val live-maps = live-map-table(current-vm())
  ;Precondition: stack.frames != null
  var frame:ptr<StackFrame> = stack.frames
  val end-frame:ptr<StackFrame> = stack.stack-pointer
  while frame <= end-frame :
    val map = get(live-maps, new Int{frame.liveness-map as int})
    val live-slots = live-slots(map)
    val num-live = length(live-slots).value
    for (var i:int = 0, i < num-live, i = i + 1) :
      val r = get(live-slots, new Int{i}).value
      [f](addr(frame.slots[r]), vms)
    frame = addr(frame.slots[num-slots(map).value]) as ptr<StackFrame>
  ;No meaningful return value
  return false

;============================================================
;================= Bytecode Loop ============================
;============================================================

protected extern defn call_garbage_collector (vms:ptr<VMState>, size:long) -> long :
  return extend-heap(current-vm(), size)

protected extern defn call_print_stack_trace (vms:ptr<VMState>, stack:long) -> int :
  val vm = current-vm()
  val stk:ptr<Stack> = untag(stack)
  print-stack-trace(stk, vmtable(vm), live-map-table(vm))
  return 0

protected extern defn call_collect_stack_trace (vms:ptr<VMState>, stack:long) -> ptr<PackedStackTrace> :
  val vm = current-vm()
  val stk:ptr<Stack> = untag(stack)
  return collect-stack-trace(stk, vmtable(vm), live-map-table(vm))

;Run the given virtual machine starting from the given starting function.
var VIRTUAL-MACHINE : VirtualMachine|False = false
protected lostanza var register-array:ptr<long>

lostanza defn current-vm () -> ref<VirtualMachine> :
  return VIRTUAL-MACHINE as ref<VirtualMachine>

lostanza defn heap (vm:ref<VirtualMachine>) -> ptr<core/Heap> :
  return addr!(vm.vmstate.heap)

lostanza defn current-stack (vm:ref<VirtualMachine>) -> ptr<Stack> :
  return untag(heap(vm).current-stack)

public lostanza defn run-bytecode (vm:ref<VirtualMachine>, start-func:ref<Int>) -> ref<False> :
  VIRTUAL-MACHINE = vm
  register-array = vm.vmstate.registers
  initialize-stack-pointer(vm)
  launch(new Long{vm.vmstate as long}, vm.vmtable.code-table, start-func)
  null-stack-pointer(vm)
  VIRTUAL-MACHINE = false
  return false

;Called by the extern defn callbacks defined in the generated bindings
extern defn call_extern (func-id:int) -> int :
  ;Retrieve the currently active virtual machine
  val vm = current-vm()
  ;Set the returnpc to -1, so that execution will return here.
  var saved-ret:long
  let :
    val stk:ptr<Stack> = current-stack(vm)
    val sp = stk.stack-pointer
    saved-ret = sp.return
    sp.return = -1
  ;Execute from startin function
  launch(new Long{vm.vmstate as long}, vm.vmtable.code-table, new Int{func-id})
  ;Restore the returnpc and return
  let :
    val stk:ptr<Stack> = current-stack(vm)
    val sp = stk.stack-pointer
    sp.return = saved-ret
    return 0

;Called by the extern defn callbacks. Retrieve the registers array
;from the currently active virtual machine.
public lostanza defn vm-registers () -> ptr<long> :
  return current-vm().vmstate.registers

;Set the stack pointer of the stack to point to the beginning
;of its frames. (I.e. It is no longer null.)
lostanza defn initialize-stack-pointer (vm:ref<VirtualMachine>) -> ref<False> :
  val stk:ptr<Stack> = current-stack(vm)
  stk.stack-pointer = stk.frames
  return false

;Set the stack pointer of the stack to null. (I.e. It is no longer active.)
lostanza defn null-stack-pointer (vm:ref<VirtualMachine>) -> ref<False> :
  val stk:ptr<Stack> = current-stack(vm)
  stk.stack-pointer = null
  return false

;============================================================
;==================== Dispatch ==============================
;============================================================

lostanza defn branch-table (vm:ref<VirtualMachine>) -> ref<BranchTable> :
  return vmtable(vm).branch-table

;============================================================
;===================== Stack Traces =========================
;============================================================

;------------------------------------------------------------
;---------------------- Printing ----------------------------
;------------------------------------------------------------

lostanza defn print-stack-trace (stack:ptr<Stack>, vmtable:ref<VMTable>, livemap:ref<LiveMapTable>) -> ref<False> :
  ;Collect entries
  val buffer = collect-stack-trace-entries(stack, vmtable, livemap)

  ;Print out the entries
  print-stack-buffer(buffer)

  ;Return false
  return false

;Print the stack buffer
defn print-stack-buffer (buffer:Vector<StackTraceEntry>) -> False :
  do(print-stack-entry, buffer)

;Print a single stack trace entry.
defn print-stack-entry (e:StackTraceEntry) -> False :
  ;Print package and signature
  match(signature(e)) :
    (sig:String) : println(STANDARD-ERROR-STREAM, "  in %_/%_" % [package(e), sig])
    (sig:False) : println(STANDARD-ERROR-STREAM, "  in %_" % [package(e)])
  ;Print file information
  match(info(e)) :
    (info:AbsoluteFileInfo) : println(STANDARD-ERROR-STREAM, "    at %_" % [/info(info)])
    (f:False) : false

;------------------------------------------------------------
;---------------------- Collecting --------------------------
;------------------------------------------------------------


lostanza defn collect-stack-trace (stack:ptr<Stack>, vmtable:ref<VMTable>, livemap:ref<LiveMapTable>) -> ptr<PackedStackTrace> :
  val buffer = collect-stack-trace-entries(stack, vmtable, livemap)

  ;Pack items into stable memory.
  val builder = StackTraceBuilder()
  add-entries(builder, buffer)
  return pack(builder)

defn add-entries (b:StackTraceBuilder, es:Seqable<StackTraceEntry>) :
  for e in es do :
    add-entry(b, e)

;------------------------------------------------------------
;-------------------- Common Utilities ----------------------
;------------------------------------------------------------

defn make-entry (ip:Long, sp:Long, st-info:StackTraceInfo) :
  StackTraceEntry(ip, sp, package(st-info), signature(st-info), info(st-info))

lostanza defn collect-stack-trace-entries (stack:ptr<Stack>,
                                           vmtable:ref<VMTable>,
                                           livemap:ref<LiveMapTable>) -> ref<Vector<StackTraceEntry>> :
  ;Accumulate all entries into a buffer.
  val buffer = Vector<StackTraceEntry>()

  ;Discover return addresses
  val end-sp = stack.stack-pointer
  labels :
    begin : goto loop(stack.frames)
    loop (sp:ptr<StackFrame>) :
      ;Store in return buffer
      ;if it exists in the file info table
      val ret = new Long{sp.return}
      match(get?(vmtable.trace-table, ret)) :
        (info:ref<StackTraceInfo>) : add(buffer, make-entry(ret, new Long{sp as long}, info))
        (info) : ()

      ;Continue if we're not at the end of the stack
      if sp < end-sp :
        val map-index = sp.liveness-map as int
        val stackmap = get(livemap, new Int{map-index})
        val num-slots = num-slots(stackmap).value
        val next-frame = addr(sp.slots[num-slots]) as ptr<StackFrame>
        goto loop(next-frame)

  ;Return the vector of entries in reverse order
  reverse!(buffer)
  return buffer


;============================================================
;==================== Heap/Stack Extension ==================
;============================================================

;This function is called by the C virtual machine when interpreting
;a GC_OPCODE instruction. It returns the new number of remaining bytes
;on the heap.
lostanza defn extend-heap (vm:ref<VirtualMachine>, size:long) -> long :
  val saved-vm = VIRTUAL-MACHINE
  VIRTUAL-MACHINE = vm
  val available-bytes = collect-garbage(size, vm.vmstate as ptr<core/VMState>)
  VIRTUAL-MACHINE = saved-vm
  return available-bytes

lostanza defn ensure-heap-space (vm:ref<VirtualMachine>, size:long) -> ref<False> :
  val saved-vm = VIRTUAL-MACHINE
  VIRTUAL-MACHINE = vm
  ensure-heap-space(size + sizeof(long), vm.vmstate as ptr<core/VMState>)
  VIRTUAL-MACHINE = saved-vm
  return false

lostanza defn object-size-on-heap (sz:ref<Int>) -> ref<Int> :
  return new Int{object-size-on-heap(sz.value) as int}

lostanza defn num-slots (f:ptr<StackFrame>, vm:ref<VirtualMachine>) -> int :
  val map = get(live-map-table(vm), new Int{f.liveness-map as int})
  return num-slots(map).value

;============================================================
;==================== Liveness Detector =====================
;============================================================

val EMPTY-TUPLE = []
public lostanza defn compute-live (vm:ref<VirtualMachine>, exclude:ref<Seqable<Symbol>>) -> ref<Tuple<Rec>> :
  ;If virtual machine is not yet initialized, then return empty tuple.
  if vm.core-loaded? == false : return EMPTY-TUPLE

  ;Save VIRTUAL-MACHINE and set it to given vm. It is necessary for GC functions.
  val saved-vm = VIRTUAL-MACHINE
  VIRTUAL-MACHINE = vm

  ;Perform full GC to get rid of unreachable stacks and liveness-tracked objects
  val vms = vm.vmstate as ptr<core/VMState>
  val heap = addr(vms.heap)
  full-heap-collection(vms)

  ;Scan global roots
  val vmtable = vmtable(vm)
  val globals:ptr<long> = vmtable.globals.mem
  val roots = to-seq(roots(vmtable.global-table, exclude))
  while empty?(roots) == false :
    val i = next(roots).value
    mark-from-root(addr(globals[i]), vms)
  ;Const roots do not affect liveness

  ;Scan stack roots assuming all heap's stacks are live. It may be too conservative.
  ;Superfluous dependencies can be added to the set. In this case, consider performing full GC
  ;first to get rid of dead stacks.
  for (var stack:ptr<Stack> = heap.stacks, stack != null, stack = stack.tail) :
    val stack-obj = stack as ptr<?> - sizeof(long)
    set-mark(stack-obj, heap)
    iterate-references-in-stack-frames(stack, addr(mark-from-root), vms)

  ;Scan liveness trackers assuming all heap's liveness-tracked objects are live.
  ;Superfluous dependencies can be added to the set. In this case, consider performing full GC
  ;first to get rid of dead stacks.
  for (var tracker:ptr<LivenessTracker> = heap.liveness-trackers, tracker != null, tracker = tracker.tail) :
    val tracker-obj = tracker as ptr<?> - sizeof(long)
    set-mark(tracker-obj, heap)
    val value-obj = (tracker.value - 1) as ptr<?>
    set-mark(value-obj, heap)

  complete-marking(vms)

  ;Get live set
  val live-recs = RecSet()
  val vm-ids = vm-ids(vm)
  val heap-top = heap.top
  for (var p:ptr<long> = heap.start, p < heap.old-objects-end, p = p + allocation-size(p, vms)) :
    if test-and-clear-mark(p, heap) != 0 :
      val tag = [p] as int
      if tag == FN-TYPE.value :
        val f = (p + sizeof(long)) as ptr<Function>
        val code = new Int{f.code as int}
        add-all(live-recs, function-dependencies(vm-ids, code))
      else :
        add-all(live-recs, class-dependencies(vm-ids, new Int{tag}))
  ;Restore VIRTUAL-MACHINE
  VIRTUAL-MACHINE = saved-vm
  ;Return ids
  return to-tuple(live-recs)

defn RecSet () :
  HashSet<Rec>(hash{id(_)}, {id(_) == id(_)})

;============================================================
;===================== Debugging ============================
;============================================================

lostanza defn dump-heap (vm:ref<VirtualMachine>) -> ref<False> :
  val heap = heap(vm)
  call-c clib/printf("Heap[%p to %p]:\n", heap.start, heap.old-objects-end)
  dump-heap(heap.start, heap.old-objects-end, vm)
  call-c clib/printf("Nursery[%p to %p]:\n", core/nursery-start(heap), heap.top)
  dump-heap(core/nursery-start(heap), heap.top, vm)
  return false

lostanza defn dump-heap (pstart:ptr<long>, pend:ptr<long>, vm:ref<VirtualMachine>) -> int :
  val stackrefs = Vector<Long>()
  call-c clib/printf("Heap:\n")
  val class-table = class-table(vm)
  var p:ptr<long> = pstart
  while p < pend :
    val tag = [p] as int
    if tag == STACK-TYPE.value :
      add(stackrefs, new Long{/tag(p)})
    val class = get(class-table, new Int{tag})
    match(class) :
      (class:ref<VMLeafClass>) :
        val obj = p as ptr<ObjectLayout>
        val size = size(class).value
        call-c clib/printf("  %p: [Object %d, size = %d]", /tag(p), tag, size)
        for (var i:long = 0, i < size, i = i + 8) :
          call-c clib/printf("  %lx", [p + 8 + i])
        call-c clib/printf("\n")
        ;Advance to next object
        p = p + object-size-on-heap(size)
      (class:ref<VMArrayClass>) :
        val array = p as ptr<ObjectLayout>
        val len = array.slots[0]
        val base-size = base-size(class).value
        val item-size = item-size(class).value
        val size = base-size + item-size * len
        call-c clib/printf("  %p: [Array %d, length = %ld, base-size = %d, item-size = %d]",
                           /tag(p), tag, len, base-size, item-size)
        for (var i:long = 0, i < size, i = i + 8) :
          call-c clib/printf("  %lx", [p + 8 + i])
        call-c clib/printf("\n")
        ;Advance to next object
        p = p + object-size-on-heap(size)
  ;Dump stacks
  val stackrefs-length = length(stackrefs).value
  for (var i:int = 0, i < stackrefs-length, i = i + 1) :
    val s = get(stackrefs, new Int{i})
    dump-stack(s.value, vm)
  return 0

lostanza defn dump-stack (stackref:long, vm:ref<VirtualMachine>) -> int :
  val stk:ptr<Stack> = untag(stackref)
  var f:ptr<StackFrame> = stk.frames
  val f-end = stk.stack-pointer
  call-c clib/printf("Stack %p:\n", stackref)
  if f != null :
    val live-map-table = live-map-table(vm)
    while f <= f-end :
      ;Get frame properties
      val map-index = new Int{f.liveness-map as int}
      if key?(live-map-table, map-index) == true :
        val map = get(live-map-table, map-index)
        val live-slots = live-slots(map)
        val num-slots = num-slots(map).value
        ;Print properties
        val num-live = length(live-slots).value
        var slot-i:int = 0
        call-c clib/printf("  %p: [StackFrame %ld, num-slots = %d]\n", f, f.liveness-map, num-slots)
        for (var i:int = 0, i < num-slots, i = i + 1) :
          if slot-i < num-live and live-slots.items[slot-i].value == i :
            call-c clib/printf("    %d: [%lx]\n", i, f.slots[i])
            slot-i = slot-i + 1
          else :
            call-c clib/printf("    %d: %lx\n", i, f.slots[i])
        ;Advance to next frame
        f = addr(f.slots[num-slots]) as ptr<StackFrame>
      else :
        call-c clib/printf("  %p: [BAD FRAME %x]\n", f, f.liveness-map)
        return 0
  return 0

lostanza defn print-tag (ref:long) -> int :
  call-c clib/printf("inspect tag of %p\n", ref)
  val tagbits = ref & 7L
  if tagbits == REF-TAG-BITS :
    val tag = [(ref - REF-TAG-BITS) as ptr<long>]
    if tag == FN-TYPE.value or tag == TYPE-TYPE.value :
      val f:ptr<Function> = untag(ref)
      call-c clib/printf("tagbits = %ld (REF), tag = %ld (FN/TYPE), code = %ld\n", tagbits, tag, f.code)
    else :
      call-c clib/printf("tagbits = %ld (REF), tag = %ld\n", tagbits, tag)
  else if tagbits == MARKER-TAG-BITS :
    val tag = ref >> 3L
    call-c clib/printf("tagbits = %ld (MARKER), tag = %ld\n", tagbits, tag)
  else if tagbits == INT-TAG-BITS :
    call-c clib/printf("tagbits = %ld (INT)\n", tagbits)
  else if tagbits == BYTE-TAG-BITS :
    call-c clib/printf("tagbits = %ld (BYTE)\n", tagbits)
  else if tagbits == CHAR-TAG-BITS :
    call-c clib/printf("tagbits = %ld (CHAR)\n", tagbits)
  else if tagbits == FLOAT-TAG-BITS :
    call-c clib/printf("tagbits = %ld (FLOAT)\n", tagbits)
  else :
    call-c clib/printf("Unrecognized tag bits.\n")
  return 0

lostanza defn function-addresses (vmt:ref<VMTable>) -> ref<StableLongArray> :
  return vmt.function-addresses

;============================================================
;================= Instruction Encoding =====================
;============================================================

defn EncodingResolver (class-table:ClassTable,
                       branch-table:BranchTable,
                       live-map-table:LiveMapTable,
                       dylibs:LoadedDynamicLibraries,
                       extern-defns:ExternDefnTable) :
  new EncodingResolver :
    defmethod liveness-map (this, live:Seqable<Int>, num-locals:Int) :
      map-index(live-map-table, live, num-locals)
    defmethod object-header-size (this) :
      8
    defmethod object-size-on-heap (this, sz:Int) :
      object-size-on-heap(sz) - 8
    defmethod dispatch-format (this, branches:Tuple<Tuple<TypeSet>>) :
      add(branch-table, DispatchFormat(branches))
    defmethod match-format (this, branches:Tuple<Tuple<TypeSet>>) :
      add(branch-table, MatchFormat(branches))
    defmethod method-format (this, multi:Int, num-header-args:Int, num-args:Int) :
      add(branch-table, MultiFormat(multi, num-header-args, num-args))
    defmethod marker (this, type:Int) : marker-int(type)
    defmethod void-marker (this) : void-marker-int()
    defmethod ref-offset (this) : REF-TAG-INT
    defmethod type-is-final? (this, n:Int) :
      val c = loaded-class(class-table, n)
      match(class(c)) :
        (class:VMArrayClass|VMLeafClass) : package(c) == `core
        (class) : false
    defmethod marker? (this, n:Int) :
      match(class-table[n]) :
        (c:VMLeafClass) : size(c) == 0 and not unique?(class-table,n)
        (c) : false
    defmethod tagbits (this, n:Int) :
      switch(n) :
        BYTE-TYPE : BYTE-TAG-INT
        CHAR-TYPE : CHAR-TAG-INT
        INT-TYPE : INT-TAG-INT
        FLOAT-TYPE : FLOAT-TAG-INT
    defmethod extern-address (this, id:Int) :
      extern-address(dylibs, id)
    defmethod extern-defn-address (this, id:Int) :
      address-as-long(extern-defns, id)

;============================================================
;====================== Loading =============================
;============================================================

public defn load (vm:VirtualMachine, vmps:Collection<VMPackage>, keep-existing-globals?:True|False) -> False :
  if not empty?(to-seq(vmps)) :
    vprintln("VM: Load packages %," % [seq(name, vmps)])
    val package-names = to-string("%," % [seq(name, vmps)])
    within log-time(LOAD-VM-PACKAGES, suffix(package-names)) :
      ;Precondition
      ensure-core-loaded-first!(vm, vmps)

      ;Retrieve tables
      vprintln("VM: Computing load unit.")
      val vmt = vmtable(vm)
      val vm-ids = vm-ids(vm)
      val load-unit = within log-time(COMPUTE-LOAD-UNIT) :
        load-packages(vm-ids, vmps)

      ;Load all packages
      vprintln("VM: Loading packages")
      for p in packages(load-unit) do :
        vprintln("VM: Loading package %_" % [name(p)])
        within log-time(LOAD-GLOBALS) :
          load-globals(vmt, globals(p), name(p), keep-existing-globals?)
        within log-time(LOAD-METHODS) :
          load-package-methods(branch-table(vm), name(p), methods(p))

      ;Load all classes into table
      vprintln("VM: Loading classes")
      within log-time(LOAD-CLASSES) :
        load-classes(vmt, classes(load-unit))

      ;Load callbacks
      ;This has to be done before loading functions so that ExternDefnId
      ;can be resolved to the right addresses.
      vprintln("VM: Loading callbacks")
      within log-time(LOAD-CALLBACKS) :
        for c in callbacks(load-unit) do :
          set-signature(extern-defns(vm), index(c), function-id(c), a1(c), a2(c))

      ;Load functions
      vprintln("VM: Encoding functions")
      within log-time(LOAD-FUNCTIONS) :
        ;Compute the functions that are exposed externally via callbacks.
        val callback-set = to-intset(seq(function-id, callbacks(load-unit)))
        ;Create the encoding resolver for compiling the function.
        val encoding-resolver = EncodingResolver(class-table(vm), branch-table(vm), live-map-table(linker(vm)),
                                                 dynamic-libraries(vm), extern-defns(vm))
        ;Load each of the functions.
        for f in funcs(load-unit) do :
          load-function(vmt, f, callback-set[id(f)], encoding-resolver, backend(vm))

      ;Load datas and consts
      vprintln("VM: Loading datas and constants")
      within log-time(LOAD-DATAS) :
        load-datas(vmt, datas(load-unit))
      within log-time(LOAD-CONSTS) :
        load-consts(vmt, consts(load-unit))

      ;Update the virtual machine state
      vprintln("VM: Updating branch table")
      within log-time(UPDATE-BRANCH-TABLE) :
        update(branch-table(vm))
      vprintln("VM: Updating VMState")
      within log-time(UPDATE-VMSTATE) :
        update-vmstate(vm)

      ;If core has been loaded, then initialize the constants by running
      ;the initialize-constants function.
      if core-loaded?(vm) :
        vprintln("VM: Run constant initializer.")
        within log-time(EXECUTE-INIT-CONSTS) :
          run-bytecode(vm, INIT-CONSTS-FN)
        vprintln("VM: Finished running constant initializer.")

public defn unload (vm:VirtualMachine, ps:Collection<Symbol>) :
  val vmps = to-tuple $ for p in ps seq :
    val io = PackageIO(p, [], [], [], [], [], false)
    VMPackage(io, false, [], [], [], [], [], [], [], [], , VMDebugNameTable([]), VMDebugInfoTable([]), VMSafepointTable([]))
  load(vm, vmps, false)

defn ensure-core-loaded-first! (vm:VirtualMachine, vmps:Collection<VMPackage>) :
  if not core-loaded?(vm) :
    val package-names = to-tuple(seq(name, vmps))
    if not contains?(package-names, `core) :
      fatal("Cannot load packages %, before loading core." % [package-names])
lostanza defn core-loaded? (vm:ref<VirtualMachine>) -> ref<True|False> :
  return vm.core-loaded?
lostanza defn set-core-loaded? (vm:ref<VirtualMachine>, v:ref<True|False>) -> ref<False> :
  vm.core-loaded? = v
  return false

public defn init-package (vm:VirtualMachine, package:Symbol) -> True|False :
  vprintln("VM: Initializating package %_" % [package])
  val f = package-init(vm-ids(vm), package)
  match(f:Int) :
    vprintln("VM: Running package %_" % [package])
    within log-time(EXEC-PACKAGE, suffix(package)) :
      val run-result =
        if package == `core :
          run-bytecode(vm, f)
          set-core-loaded?(vm, true)
          true
        else :
          launch-init(vm, f)
      vprintln("VM: Finished running package %_" % [package])
      run-result
  else :
    vprintln("VM: Package %_ contains no top-level code." % [package])
    true

public lostanza defn clear-globals (vm:ref<VirtualMachine>) -> ref<False> :
  ;Scan global roots
  val vmtable = vmtable(vm)
  val globals:ptr<long> = vmtable.globals.mem
  val roots = to-seq(roots(vmtable.global-table))
  while empty?(roots) == false :
    val i = next(roots).value
    globals[i] = void-marker()
  return false

;============================================================
;========= Launching the Initialization Function ============
;============================================================
;This function is the standard way of launching some code to execute
;in the JIT. It calls `core/execute-toplevel-command()` with the given
;function passed as a closure. All fatals/exceptions are intercepted
;by execute-toplevel-command, and thus it is guaranteed to return
;normally. launch-init() returns the boolean that is returned by
;execute-toplevel-command().
;- fid: The identifier of the VMFunction to execute.

lostanza defn launch-init (vm:ref<VirtualMachine>, fid:ref<Int>) -> ref<True|False> :
  ;Create the closure representing the initialization function
  val closure-size = 8 + 8
  ensure-heap-space(vm, closure-size)
  val closure:ptr<Function> = allocate-initial(heap(vm), FN-TYPE.value, closure-size)
  closure.num-slots = 0L
  closure.code = fid.value
  ;Call closure using the launcher function
  val vms = vm.vmstate
  vms.registers[0] = false-marker()
  vms.registers[1] = 1L
  vms.registers[2] = tag-as-ref(closure)
  run-bytecode(vm, EXECUTE-TOPLEVEL-COMMAND-FN)
  ;Return whether successful or not
  val ret = vms.registers[0]
  if ret == false-marker() : return false
  else if ret == true-marker() : return true
  else : return fatal("Invalid return value from execute-toplevel-command.")

;============================================================
;================= Releasing Resources ======================
;============================================================

public defn shutdown (vm:VirtualMachine) :
  free-code-table(vm)

lostanza defn free-code-table (vm:ref<VirtualMachine>) -> ref<False> :
  free(vm.vmtable.code-table)
  return false

;============================================================
;==================== Utilities =============================
;============================================================

var delay : (() -> ?) -> False =
  fn (f) : fatal("Not within delay-actions block.")
defn delay-actions<?T> (f:() -> ?T) :
  val delays = Vector<(() -> ?)>()
  defn delay-action (action:() -> ?)  : add(delays, action)
  val result = let-var delay = delay-action : f()
  for d in delays do : d()
  clear(delays)
  result