module:      access-path-implementation
synopsis:    Experimenting with a more complex simulated runtime.
author:      Paul Howard
Copyright:    Original Code is Copyright (c) 1995-2004 Functional Objects, Inc.
              All rights reserved.
License:      Functional Objects Library Public License Version 1.0
Dual-license: GNU Lesser General Public License
Warranty:     Distributed WITHOUT WARRANTY OF ANY KIND


///// THE INSTRUCTION SET

define constant $CALL = 1000; // <addr>
define constant $RET = 1001;
define constant $LINK = 1002;
define constant $SPAWN = 1003; // <addr>
define constant $END = 1004;
define constant $NOP = 1005;
define constant $STOPCODE = 1006; // <integer code>
define constant $LOCALASSIGN = 1008; // <frame offset> <value>
define constant $GLOBALASSIGN = 1009; // <addr> <value>
define constant $LDA = 1010;
define constant $JREL = 1011;
define constant $JRELNZ = 1012;
define constant $DECA = 1013;
define constant $INCA = 1014;
define constant $PUSHA = 1015;
define constant $POPA = 1016;

define method I(x) (x * 4) + 1 end method;
define method C(x) (as(<integer>, x) * 4) + 2 end method;

///// <SIMULATION-MEMORY>
//    The memory, innit!

define constant $memory-size = 2000;
define constant $stack-size = 50;

define class <simulation-memory> (<object>)

  slot contents :: <vector> 
    = make(<vector>, size: $memory-size, fill: $NOP);

  slot breakpointed? :: <vector>
    = #[];

  slot code-segment-start :: <integer> = 0;

  slot data-segment-start :: <integer> = 0;

  slot next-stack-position :: <integer> = $memory-size - 1;

  slot stack-size :: <integer> = $stack-size;

  slot dump-pointer :: <integer> = 0;

end class;


///// <SIMULATION-THREAD>
//    Models the context of a running thread.

define class <simulation-thread> (<object>)

  slot eip :: <remote-value>,
    required-init-keyword: start-routine:;

  slot name :: <string>,
    init-value: "Un-named Thread",
    init-keyword: name:;

  slot still-alive? :: <boolean> = #t;
  slot zero-flag :: <boolean> = #f;

  slot esp :: <remote-value> = 0;
  slot ebp :: <remote-value> = 0;
  slot eax :: <remote-value> = 0;
  slot ebx :: <remote-value> = 0;

  slot current-unwind-protect :: <remote-value> = 0;

  slot suspend-count :: <integer> = 0;
end class;


///// <NAME-OFFSET-PAIR>
//    Describes lexical/argument variables.

define class <name-offset-pair> (<object>)

  slot name :: <string>,
    required-init-keyword: name:;

  slot offset :: <integer>,
    required-init-keyword: offset:;

end class;


///// <SIMULATION-STOP-REASON>
//    Is pushed onto a queue when generated by the application. The
//    access-path function "wait-for-stop-reason" pops this queue.

define class <simulation-stop-reason> (<object>)

  slot stop-reason-code :: <integer>,
    required-init-keyword: code:;

  slot related-simulation-object,
    init-value: #f,
    init-keyword: simulated-object:;

  slot signalling-thread :: <simulation-thread>,
    required-init-keyword: thread:;

  slot address :: <integer>,
    init-value: 0,
    init-keyword: address:;

end class;


///// <SIMULATION-FUNCTION-DESCRIPTION>
//    Provides enough information to "call" a function, and set
//    up its stack frame.

define class <simulation-function-description> (<object>)

  slot symbolic-name :: <string>,
    required-init-keyword: name:;

  slot compiled-address :: <remote-value> = 0; // Needs fixup

  // The first instruction in most functions will be $LINK,
  // a one "byte" instruction, but we might as well allow it
  // to be different.

  slot debug-start-offset :: <remote-value>,
       init-value: 1,
       init-keyword: debug-start-offset:;

  slot debug-end-offset :: <remote-value> = 0; // Needs fixup

  slot code-vector :: <vector>,
    required-init-keyword: code-vector:;

  slot arguments :: <vector>,
    required-init-keyword: arguments:;

  slot lexicals :: <vector>,
    required-init-keyword: lexicals:;

  slot line-offset-pairs :: <vector>,
    init-value: #[],
    init-keyword: known-locations:;

  slot source-filename :: <string> = "UNKNOWN",
    init-keyword: file:;

  slot source-linenumber :: <integer> = 0,
    init-keyword: line:;

end class;


///// <SIMULATION-VARIABLE-DESCRIPTION>
//    Models a variable.

define class <simulation-variable-description> (<object>)

  slot symbolic-name :: <string>,
    required-init-keyword: name:;

  slot dumped-address :: <remote-value> = 0;

  slot mode :: <symbol>,
    init-value: #"static",
    init-keyword: mode:;

  slot representation :: <vector>,
    init-value: #[],
    init-keyword: representation:;

end class;


///// <SOURCE-FILE-MAP>
//    A mapping for code/source locators within a file.

define class <source-file-map> (<object>)

  slot filename :: <string>,
    required-init-keyword: filename:;

  slot line-address-pairs :: <stretchy-vector>
    = make(<stretchy-vector>);

end class;


///// <SIMULATION-SOURCE-MAP>
//    A mapping for code/source locators in the simulated runtime.

define class <simulation-source-map> (<object>)

  slot number-of-files :: <integer>,
    init-value: 0,
    init-keyword: file-count:;

  slot file-information :: <stretchy-vector>
    = make(<stretchy-vector>, size: 0);

end class;


///// <SIMULATION>
//    The simulated runtime.

define class <simulation> (<object>)

  slot memory :: <simulation-memory>
    = make(<simulation-memory>);

  slot debug-info :: <vector>,
    init-value: #[];

  slot source-map :: <simulation-source-map>;

  slot threads :: <stretchy-vector>
    = make(<stretchy-vector>, size: 0);

  slot new-threads :: <stretchy-vector>
    = make(<stretchy-vector>, size: 0);

  slot stop-reason-queue :: <deque>
    = make(<deque>);

end class;


// ************************************************************************
// ******************************* RUNTIME ********************************
// ************************************************************************


///// MACHINE-CYCLE
//    Steps all threads through one instruction.

define method machine-cycle (sim :: <simulation>) => ()
  let threads-stepped = 0;
  for (thread in sim.threads)
    if (thread.still-alive?)
      unless (thread.suspend-count < 0)
        fetch-execute(sim, thread);
      end unless;
      threads-stepped := threads-stepped + 1;
    end if;
  end for;
  if (size(sim.new-threads) > 0)
    sim.threads := concatenate!(sim.threads, sim.new-threads);
    sim.new-threads := make(<stretchy-vector>, size: 0);
  end if;
  /*
  if (threads-stepped == 0)
    push(sim.stop-reason-queue,
         make(<simulation-stop-reason>,
              code: $exit-process,
              thread: sim.threads[0],
              address: sim.threads[0].eip))
  end if;
  */
end method;


///// FETCH-EXECUTE
//    Steps the thread through one instruction, queueing a stop-reason
//    if necessary.

define method fetch-execute
  (sim :: <simulation>, thread :: <simulation-thread>) => ()

  let bp-state 
    = element(sim.memory.breakpointed?, thread.eip,
              default: #"clear");

  if (bp-state == #"break")
    push(sim.stop-reason-queue,
         make(<simulation-stop-reason>,
              code: $breakpoint-exception,
              thread: thread,
              address: thread.eip));
    sim.memory.breakpointed?[thread.eip] := #"replace";
  else
    if (bp-state == #"replace")
      sim.memory.breakpointed?[thread.eip] := #"break";
    end if;
    let opcode = sim.memory.contents[thread.eip];
    thread.eip := thread.eip + 1;
    select(opcode)
      $CALL =>
        let addr = sim.memory.contents[thread.eip];
        thread.eip := thread.eip + 1;
        thread.esp := thread.esp - 1;
        sim.memory.contents[thread.esp] := thread.eip;
        thread.eip := addr;
//        format-out ("-- CALL %d\n", addr);

      $RET =>
        // Callee pops args and lexicals
        thread.esp := thread.ebp + 1;
        thread.ebp := sim.memory.contents[thread.ebp];
        let ret-addr = sim.memory.contents[thread.esp];
        thread.esp := thread.esp + 1;
        thread.eip := ret-addr;
//        format-out("-- RET\n");

      $LOCALASSIGN =>
        let offset = sim.memory.contents[thread.eip];
        thread.eip := thread.eip + 1;
        let val = sim.memory.contents[thread.eip];
        thread.eip := thread.eip + 1;
        sim.memory.contents[thread.ebp + offset] := val;
//        format-out("-- LOCALASSIGN %d %d\n", thread.ebp + offset, val);

      $GLOBALASSIGN =>
        let dest = sim.memory.contents[thread.eip];
        thread.eip := thread.eip + 1;
        let val = sim.memory.contents[thread.eip];
        thread.eip := thread.eip + 1;
        sim.memory.contents[dest] := val;
//        format-out("-- GLOBALASSIGN %d %d\n", dest, val);

      $LINK =>
        let function-description
          = map-eip-to-function(sim, thread.eip - 1);
        thread.esp := thread.esp - 1;
        sim.memory.contents[thread.esp] := thread.ebp;
        thread.ebp := thread.esp;
        // Now create enough space for lexicals and args.
        thread.esp := thread.esp - (size(function-description.arguments) +
                                   size(function-description.lexicals));
//        format-out("-- LINK\n");

      $SPAWN =>
        let newthread 
          = make(<simulation-thread>,
                 start-routine: sim.memory.contents[thread.eip]);
        newthread.esp := sim.memory.next-stack-position;
        sim.memory.next-stack-position 
          := sim.memory.next-stack-position - sim.memory.stack-size;
        thread.eip := thread.eip + 1;
        push(sim.stop-reason-queue,
             make(<simulation-stop-reason>,
                  thread: newthread,
                  code: $create-thread,
                  address: thread.eip - 2));
        sim.new-threads := add!(sim.new-threads, newthread);
//        format-out("-- SPAWN %d\n", newthread.eip);

      $END =>
        // Find out if we're the last living thread. If we are, push
        // the exit-process-stop-reason rather than exit-thread-stop-reason

        let live-thread-count = 0;
        for (t in sim.threads)
          if (t.still-alive?)
            live-thread-count := live-thread-count + 1;
          end if
        end for;
        for (t in sim.new-threads)
          if (t.still-alive?)
            live-thread-count := live-thread-count + 1;
          end if
        end for;
        if (live-thread-count < 2)
          push(sim.stop-reason-queue,
               make(<simulation-stop-reason>,
                    thread: thread,
                    code: $exit-process,
                    address: thread.eip - 1));
        else
          push(sim.stop-reason-queue,
               make(<simulation-stop-reason>,
                    thread: thread,
                    code: $exit-thread,
                    address: thread.eip - 1));
        end if;
        thread.still-alive? := #f;
//        format-out("-- END\n");

      $JREL =>
        let offset = sim.memory.contents[thread.eip];
        thread.eip := thread.eip + 1;
        thread.eip := thread.eip + offset;
//        format-out("-- JREL %d\n", offset);

      $JRELNZ =>
        let offset = sim.memory.contents[thread.eip];
        thread.eip := thread.eip + 1;
        if (~thread.zero-flag)
          thread.zero-flag := #f;
          thread.eip := thread.eip + offset;
        end if;
//        format-out("-- JRELNZ %d\n", offset);

      $INCA =>
        thread.eax := thread.eax + 1;
        unless(thread.eax == 0)
          thread.zero-flag := #f
        end unless;
//        format-out("-- INCA\n");

      $PUSHA =>
        thread.esp := thread.esp - 1;
        sim.memory.contents[thread.esp] := thread.eax;
        unless(thread.eax == 0)
          thread.zero-flag := #f
        end unless;
//        format-out("-- PUSHA\n");

      $POPA =>
        thread.eax := sim.memory.contents[thread.esp];
        thread.esp := thread.esp + 1;
        unless(thread.eax == 0)
          thread.zero-flag := #f
        end unless;
//        format-out("-- POPA\n");

      $DECA =>
        thread.eax := thread.eax - 1;
        if (thread.eax == 0)
          thread.zero-flag := #t;
        end if;
//        format-out("-- DECA\n");

      $LDA =>
        thread.eax := sim.memory.contents[thread.eip];
        thread.eip := thread.eip + 1;
        unless(thread.eax == 0)
          thread.zero-flag := #f
        end unless;
//        format-out("-- LDA %d\n", thread.eax);

      $NOP =>
        thread.still-alive? := thread.still-alive?; // Do _something_ !!
//        format-out("-- NOP\n");

      $STOPCODE =>
        let stopcode = sim.memory.contents[thread.eip];
        thread.eip := thread.eip + 1;
        push(sim.stop-reason-queue,
             make(<simulation-stop-reason>,
                  thread: thread,
                  code: stopcode,
                  address: thread.eip - 2));
//        format-out("-- STOPCODE %d\n", stopcode);
    end select
  end if
end method;


// ***********************************************************************
// **************** INJECTING DATA INTO THE SIMULATION *******************
// ***********************************************************************


///// DUMP-VALUE
//    Injects a value into the simulation.

define method dump-value
  (sim :: <simulation>, value) => ()

  sim.memory.contents[sim.memory.dump-pointer] := value;
  sim.memory.dump-pointer := sim.memory.dump-pointer + 1;
end method;


///// ALIGN
//    Aligns the dump address to a 4-byte boundary for the next dump.
//    (Instances of objects must be 4-byte aligned).

define method align (sim :: <simulation>) => ()
  let (div, rem)
    = truncate (sim.memory.dump-pointer, 4);
  if (rem > 0)
    sim.memory.dump-pointer := sim.memory.dump-pointer + (4 - rem);
  end if
end method;


///// BEGIN-CODE-SEGMENT
//    Signals that the code segment starts here.

define method begin-code-segment (sim :: <simulation>) => ()
  sim.memory.code-segment-start := sim.memory.dump-pointer;
end method;


///// BEGIN-DATA-SEGMENT
//    Signals that the data segment starts here.

define method begin-data-segment (sim :: <simulation>) => ()
  sim.memory.data-segment-start := sim.memory.dump-pointer;
end method;


///// END-OF-DUMP
//    Signals that we've finished dumping.

define method end-of-dump (sim :: <simulation>) => ()
end method;


///// START-OF-DUMP
//    Signals that we're starting dumping.

define method start-of-dump (sim :: <simulation>) => ()
end method;


///// RESET-RUNTIME
//    Puts the simulation into a "reset" and ready-to-go state.

define method reset-runtime (sim :: <simulation>) => ()
  sim.memory.next-stack-position := $memory-size - 1;
  sim.memory.breakpointed?
    := make(<vector>, size: sim.memory.data-segment-start, fill: #"clear");
  let primary-thread
    = make(<simulation-thread>,
            start-routine: 0);
  primary-thread.esp := sim.memory.next-stack-position;
  sim.memory.next-stack-position
    := sim.memory.next-stack-position - $stack-size;
  sim.threads := make(<stretchy-vector>, size: 0);
  sim.threads := add!(sim.threads, primary-thread);
  sim.new-threads := make(<stretchy-vector>, size: 0);
  sim.stop-reason-queue := make(<deque>);
  push(sim.stop-reason-queue,
       make(<simulation-stop-reason>,
            code: $create-process,
            thread: primary-thread,
            address: 0));
end method;


///// FIXUP-ADDRESSES
//    Goes through the memory code and data segments, and any
//    entries which aren't integers are assumed to point to
//    <simulation-function-description> or <simulation-variable-description>
//    instances. The memory locations are overwritten with the
//    compiled addresses of these symbols.

define method fixup-addresses (sim :: <simulation>) => ()
  let i = sim.memory.code-segment-start;
  while (i < sim.memory.dump-pointer)
    if (instance?(sim.memory.contents[i], <simulation-function-description>))
      sim.memory.contents[i]
        := sim.memory.contents[i].compiled-address;
    elseif 
       (instance?(sim.memory.contents[i], <simulation-variable-description>))
       sim.memory.contents[i]
         := sim.memory.contents[i].dumped-address;
    end if;
    i := i + 1;
  end while
end method;


///// LINK-SIMULATION
//    Assuming that the vector of debug-info has been installed, builds
//    the runtime simulation

define method link-simulation (sim :: <simulation>) => ()

  let i = 0;

  local method dump-functions ()
          let sym = sim.debug-info[i];
          while (instance?(sym, <simulation-function-description>))
            align(sim);
            sym.compiled-address := sim.memory.dump-pointer;
            for (x in sym.code-vector)
              dump-value(sim, x);
            end for;
            i := i + 1;
            sym := element(sim.debug-info, i, default: #f);
          end while;
        end method,

        method dump-variables ()
          let sym = sim.debug-info[i];
          while (instance?(sym, <simulation-variable-description>))
            align(sim);
            sym.dumped-address := sim.memory.dump-pointer;
            for (x in sym.representation)
              dump-value(sim, x);
            end for;
            i := i + 1;
            sym := element(sim.debug-info, i, default: #f);
          end while;
        end method;

  start-of-dump(sim);
  begin-code-segment(sim);
  dump-functions();
  begin-data-segment(sim);
  dump-variables();
  end-of-dump(sim);
  fixup-addresses(sim);
end method;


///// MAP-EIP-TO-FUNCTION
//    Given a program counter, returns the <simulation-function-description>
//    whose definition straddles that address.

define method map-eip-to-function
  (sim :: <simulation>, addr :: <integer>)
    => (_ :: <simulation-function-description>)
  let i = 0;
  let sz = size(sim.debug-info);
  let found = #f;
  let candidate = sim.debug-info[i];
  while ((~found) & (instance?(candidate, <simulation-function-description>)))
    if ((candidate.compiled-address <= addr) &
        (addr < (candidate.compiled-address + size(candidate.code-vector))))
      found := #t;
    else
      i := i + 1;
      candidate := sim.debug-info[i];
    end if
  end while;
  candidate;
end method;


// ***********************************************************************
// ********************* DESCRIBING THE SIMULATION ***********************
// ***********************************************************************


///// GENERATE-RUNTIME-VECTOR
//    This throws out a vector of debug-info, which is resolved into the
//    the runtime and fixed-up by a fake "linking" process. If I have
//    this right, it should be possible to alter the simulation _just_
//    by altering this function. The one proviso is that certain
//    symbols (eg KLmm_wrapperGYdylanVdylanW) must exist
//    in order for anything sensible to happen.

define method generate-runtime-vector () => (_ :: <vector>)

  let SIMRT!<mm-wrapper>-wrapper
    = make(<simulation-variable-description>,
           name: "KLmm_wrapperGYdylanVdylanW",
           representation: vector(#f));

  SIMRT!<mm-wrapper>-wrapper.representation[0] 
    := SIMRT!<mm-wrapper>-wrapper;

  let SIMRT!<class>-wrapper
    = make(<simulation-variable-description>,
           name: "KLclassGYdylanVdylanW",
           representation: vector(SIMRT!<mm-wrapper>-wrapper,
                                  #f));

  let SIMRT!<class>
    = make(<simulation-variable-description>,
           name: "KLclassGYinternalVdylan",
           representation: vector(SIMRT!<class>-wrapper));

  SIMRT!<class>-wrapper.representation[1] := SIMRT!<class>;

  let SIMRT!<byte-string>
    = make(<simulation-variable-description>,
           name: "KLbyte_stringGYinternalVdylan");

  let SIMRT!<byte-string>-wrapper
    = make(<simulation-variable-description>,
           name: "KLbyte_stringGYdylanVdylanW",
           representation: vector(SIMRT!<mm-wrapper>-wrapper,
                                  SIMRT!<byte-string>));

  let SIMRT!<simple-object-vector>
    = make(<simulation-variable-description>,
           name: "KLsimple_object_vectorGYinternalVdylan");

  let SIMRT!<simple-object-vector>-wrapper
    = make(<simulation-variable-description>,
           name: "KLsimple_object_vectorGYdylanVdylanW",
           representation: vector(SIMRT!<mm-wrapper>-wrapper,
                                  SIMRT!<simple-object-vector>));

  let SIMRT!<pair>
    = make(<simulation-variable-description>,
           name: "KLpairGYinternalVdylan");

  let SIMRT!<pair>-wrapper
    = make(<simulation-variable-description>,
           name: "KLpairGYdylanVdylanW",
           representation: vector(SIMRT!<mm-wrapper>-wrapper,
                                  SIMRT!<pair>));

  let SIMRT!<boolean>
    = make(<simulation-variable-description>,
           name: "KLbooleanGYinternalVdylan");

  let SIMRT!<boolean>-wrapper
    = make(<simulation-variable-description>,
           name: "KLbooleanGYdylanVdylanW",
           representation: vector(SIMRT!<mm-wrapper>-wrapper,
                                  SIMRT!<boolean>));

  let SIMRT!<generic-function>
    = make(<simulation-variable-description>,
           name: "KLgeneric_functionGYinternalVdylan");

  let SIMRT!<generic-function>-wrapper
    = make(<simulation-variable-description>,
           name: "KLgeneric_functionGYdylanVdylanW",
           representation: vector(SIMRT!<mm-wrapper>-wrapper,
                                  SIMRT!<generic-function>));

  let SIMRT!<method>
    = make(<simulation-variable-description>,
           name: "KLmethodGYinternalVdylan");

  let SIMRT!<method>-wrapper
    = make(<simulation-variable-description>,
           name: "KLmethodGYdylanVdylanW",
           representation: vector(SIMRT!<mm-wrapper>-wrapper,
                                  SIMRT!<method>));

  let SIMRT!<slot-method>
    = make(<simulation-variable-description>,
           name: "KLslot_methodGYinternalVdylan");

  let SIMRT!<slot-method>-wrapper
    = make(<simulation-variable-description>,
           name: "KLslot_methodGYdylanVdylanW",
           representation: vector(SIMRT!<mm-wrapper>-wrapper,
                                  SIMRT!<slot-method>));

  let SIMRT!<complex-method>
    = make(<simulation-variable-description>,
           name: "KLcomplex_methodGYinternalVdylan");

  let SIMRT!<complex-method>-wrapper
    = make(<simulation-variable-description>,
           name: "KLcomplex_methodGYdylanVdylanW",
           representation: vector(SIMRT!<mm-wrapper>-wrapper,
                                  SIMRT!<complex-method>));

  let SIMRT!<symbol>
    = make(<simulation-variable-description>,
           name: "KLsymbolGYinternalVdylan");

  let SIMRT!<symbol>-wrapper
    = make(<simulation-variable-description>,
           name: "KLsymbolGYdylanVdylanW",
           representation: vector(SIMRT!<mm-wrapper>-wrapper,
                                  SIMRT!<symbol>));

  let SIMRT!<open-class>
    = make(<simulation-variable-description>,
           name: "KLopen_classGYinternalVdylan");

  let SIMRT!<open-class>-wrapper
    = make(<simulation-variable-description>,
           name: "KLopen_classGYdylanVdylanW",
           representation: vector(SIMRT!<mm-wrapper>-wrapper,
                                  SIMRT!<open-class>));

  let SIMRT!<sealed-class>
    = make(<simulation-variable-description>,
           name: "KLsealed_classGYinternalVdylan");

  let SIMRT!<sealed-class>-wrapper
    = make(<simulation-variable-description>,
           name: "KLsealed_classGYdylanVdylanW",
           representation: vector(SIMRT!<mm-wrapper>-wrapper,
                                  SIMRT!<sealed-class>));

  let SIMRT!<instance-slot-descriptor>
    = make(<simulation-variable-description>,
           name: "KLinstance_slot_descriptorGYinternalVdylan");

  let SIMRT!<instance-slot-descriptor>-wrapper
    = make(<simulation-variable-description>,
           name: "KLinstance_slot_descriptorGYdylanVdylanW",
           representation: vector(SIMRT!<mm-wrapper>-wrapper,
                                  SIMRT!<instance-slot-descriptor>));

  let SIMRT!<repeated-slot-descriptor>
    = make(<simulation-variable-description>,
           name: "KLrepeated_slot_descriptorGYinternalVdylan");

  let SIMRT!<repeated-slot-descriptor>-wrapper
    = make(<simulation-variable-description>,
           name: "KLrepeated_slot_descriptorGYdylanVdylanW",
           representation: vector(SIMRT!<mm-wrapper>-wrapper,
                                  SIMRT!<repeated-slot-descriptor>));

  let SIMRT!<empty-list>
    = make(<simulation-variable-description>,
           name: "KLempty_listGYinternalVdylan");

  let SIMRT!<empty-list>-wrapper
    = make(<simulation-variable-description>,
           name: "KLempty_listGYdylanVdylanW",
           representation: vector(SIMRT!<mm-wrapper>-wrapper,
                                  SIMRT!<empty-list>));

  let SIMRT!%empty-list
    = make(<simulation-variable-description>,
           name: "KPempty_listYinternalVdylan",
           representation: vector(SIMRT!<empty-list>-wrapper));

  let SIMRT!%empty-vector
    = make(<simulation-variable-description>,
           name: "KPempty_vectorYinternalVdylan",
           representation: vector(SIMRT!<simple-object-vector>-wrapper,
                                  I(0)));

  let SIMRT!%true
    = make(<simulation-variable-description>,
           name: "KPtrueYinternalVdylan",
           representation: vector(SIMRT!<boolean>-wrapper));

  let SIMRT!%false
    = make(<simulation-variable-description>,
           name: "KPfalseYinternalVdylan",
           representation: vector(SIMRT!<boolean>-wrapper));

  let poo-slot
    = make(<simulation-variable-description>,
           name: "poo_slotYdummymodVdummylib",
           representation: vector(SIMRT!<generic-function>-wrapper,
                                  SIMRT!%empty-list));

  let pants-slot
    = make(<simulation-variable-description>,
           name: "pants_slotYdummymodVdummylib",
           representation: vector(SIMRT!<generic-function>-wrapper,
                                  SIMRT!%empty-list));

  let poo-descriptor
    = make(<simulation-variable-description>,
           name: "d_poo_slotYdummymodVdummylib",
           representation: vector(SIMRT!<instance-slot-descriptor>-wrapper,
                                  poo-slot));

  let pants-descriptor
    = make(<simulation-variable-description>,
           name: "d_pants_slotYdummymodVdummylib",
           representation: vector(SIMRT!<instance-slot-descriptor>-wrapper,
                                  pants-slot));

  let ph-descriptors
    = make(<simulation-variable-description>,
           name: "dv_ph_classYdummymodVdummylib",
           representation: vector(SIMRT!<simple-object-vector>-wrapper,
                                  I(2),
                                  poo-descriptor,
                                  pants-descriptor));

  let ph-class
    = make(<simulation-variable-description>,
           name: "Lph_classGYdummymodVdummylib",
           representation: vector(SIMRT!<class>-wrapper,
                                  ph-descriptors,
                                  SIMRT!%false));

  let ph-wrapper
    = make(<simulation-variable-description>,
           name: "KLph_classGYdummymodVdummylibW",
           representation: vector(SIMRT!<mm-wrapper>-wrapper,
                                  ph-class));

  let ph1
    = make(<simulation-variable-description>,
           name: "ph1YdummymodVdummylib",
           representation: vector(ph-wrapper, I(5), I(10)));

  let func
    = make(<simulation-function-description>,
           name: "KfuncYdummymodVdummylib",
           arguments: #["x", "y", "z"],
           lexicals: #["pants_M1"],
           file: "dummy-source.pseudodylan",
           line: 15,
           known-locations: vector(pair(0, 0),
                                   pair(1, 1),
                                   pair(3, 4),
                                   pair(4, 7),
                                   pair(5, 10),
                                   pair(6, 14)),
           code-vector:
               vector($LINK,
                      $LOCALASSIGN, -1, I(1),
                      $LOCALASSIGN, -2, ph1,
                      $LOCALASSIGN, -3, I(3),
                      $LOCALASSIGN, -4, I(4),
                      $NOP,
                      $STOPCODE, $access-violation,
                      $RET));

  let second-thread
    = make(<simulation-function-description>,
           name: "Ksecond_threadYdummymodVdummylib",
           arguments: #[],
           lexicals: #[],
           file: "dummy-source.pseudodylan",
           line: 32,
           known-locations: vector(pair(0, 0),
                                   pair(1, 1),
                                   pair(2, 3),
                                   pair(3, 5),
                                   pair(4, 10)),
           code-vector:
             vector($LINK,
                    $CALL, func,
                    $CALL, func,
                    $CALL, func,
                    $NOP,
                    $NOP,
                    $NOP,
                    $END));

  let recursive-function
    = make(<simulation-function-description>,
           name: "Krecursive_functionYdummymodVdummylib",
           arguments: #[],
           lexicals: #["thingy_M1"],
           file: "dummy-source.pseudodylan",
           line: 27,
           known-locations: vector(pair(0, 0),
                                   pair(1, 1),
                                   pair(2, 8),
                                   pair(3, 10)),
           code-vector:
             vector($LINK,
                    $LOCALASSIGN, -1, ph1,
                    $DECA,
                    $JRELNZ, 1,
                    $RET,
                    $CALL, 0, // Needs fixup - position 9 in the vector
                    $RET));

  recursive-function.code-vector[9] := recursive-function;

  let kick-off-recursion
    = make(<simulation-function-description>,
           name: "Kkick_off_recursionYdummymodVdummylib",
           arguments: #[],
           lexicals: #[],
           file: "dummy-source.pseudodylan",
           line: 23,
           known-locations: vector(pair(0, 0),
                                   pair(1, 3),
                                   pair(2, 5)),
           code-vector:
             vector($LINK,
                    $LDA, 5,
                    $CALL, recursive-function,
                    $RET));

  let main
    = make(<simulation-function-description>,
           name: "KmainYdummymodVdummylib",
           arguments: #[],
           lexicals: #[],
           file: "dummy-source.pseudodylan",
           line: 38,
           known-locations: vector(pair(0, 0), 
                                   pair(1, 4),
                                   pair(2, 6),
                                   pair(3, 10),
                                   pair(4, 12)),
           code-vector:
             vector($LINK,
                    $LDA, 3,
                    $PUSHA,
                    $CALL, func,
                    $SPAWN, second-thread,
                    $POPA,
                    $DECA,
                    $JRELNZ, -9,
                    $CALL, kick-off-recursion,
                    $END));

  // ***************************** FIXUPS *******************************

  SIMRT!<byte-string>.representation
    := vector(SIMRT!<class>-wrapper, SIMRT!%empty-vector, SIMRT!%false);

  SIMRT!<simple-object-vector>.representation
    := vector(SIMRT!<class>-wrapper, SIMRT!%empty-vector, SIMRT!%false);

  SIMRT!<pair>.representation
    := vector(SIMRT!<class>-wrapper, SIMRT!%empty-vector, SIMRT!%false);

  SIMRT!<boolean>.representation
    := vector(SIMRT!<class>-wrapper, SIMRT!%empty-vector, SIMRT!%false);

  SIMRT!<generic-function>.representation
    := vector(SIMRT!<class>-wrapper, SIMRT!%empty-vector, SIMRT!%false);

  SIMRT!<method>.representation
    := vector(SIMRT!<class>-wrapper, SIMRT!%empty-vector, SIMRT!%false);

  SIMRT!<slot-method>.representation
    := vector(SIMRT!<class>-wrapper, SIMRT!%empty-vector, SIMRT!%false);

  SIMRT!<complex-method>.representation
    := vector(SIMRT!<class>-wrapper, SIMRT!%empty-vector, SIMRT!%false);

  SIMRT!<symbol>.representation
    := vector(SIMRT!<class>-wrapper, SIMRT!%empty-vector, SIMRT!%false);

  SIMRT!<open-class>.representation
    := vector(SIMRT!<class>-wrapper, SIMRT!%empty-vector, SIMRT!%false);

  SIMRT!<sealed-class>.representation
    := vector(SIMRT!<class>-wrapper, SIMRT!%empty-vector, SIMRT!%false);

  SIMRT!<instance-slot-descriptor>.representation
    := vector(SIMRT!<class>-wrapper, SIMRT!%empty-vector, SIMRT!%false);

  SIMRT!<repeated-slot-descriptor>.representation
    := vector(SIMRT!<class>-wrapper, SIMRT!%empty-vector, SIMRT!%false);

  SIMRT!<empty-list>.representation
    := vector(SIMRT!<class>-wrapper, SIMRT!%empty-vector, SIMRT!%false);

  // ********************************************************************
  // Splurt out a complete list of functions and objects to go into
  // the runtime.
  // All functions must precede all non-functions.
  // The first function in this vector is the entry point.

  vector(main, func, second-thread,
         kick-off-recursion, recursive-function,
         SIMRT!<mm-wrapper>-wrapper,
         SIMRT!<byte-string>-wrapper,
         SIMRT!<class>-wrapper,
         SIMRT!<simple-object-vector>-wrapper,
         SIMRT!<pair>-wrapper,
         SIMRT!<boolean>-wrapper,
         SIMRT!<generic-function>-wrapper,
         SIMRT!<method>-wrapper,
         SIMRT!<slot-method>-wrapper,
         SIMRT!<complex-method>-wrapper,
         SIMRT!<symbol>-wrapper,
         SIMRT!<open-class>-wrapper,
         SIMRT!<sealed-class>-wrapper,
         SIMRT!<instance-slot-descriptor>-wrapper,
         SIMRT!<repeated-slot-descriptor>-wrapper,
         SIMRT!<empty-list>,
         SIMRT!<byte-string>,
         SIMRT!<class>,
         SIMRT!<simple-object-vector>,
         SIMRT!<pair>,
         SIMRT!<boolean>,
         SIMRT!<generic-function>,
         SIMRT!<method>,
         SIMRT!<slot-method>,
         SIMRT!<complex-method>,
         SIMRT!<symbol>,
         SIMRT!<open-class>,
         SIMRT!<sealed-class>,
         SIMRT!<instance-slot-descriptor>,
         SIMRT!<repeated-slot-descriptor>,
         SIMRT!<empty-list>,
         SIMRT!%empty-list,
         SIMRT!%empty-vector,
         SIMRT!%true,
         SIMRT!%false,
         poo-slot, pants-slot,
         poo-descriptor, pants-descriptor,
         ph-descriptors,
         ph-class,
         ph-wrapper,
         ph1);
end method;