SilverSight/fortran/AVMIsa/avm.f90

! AVM ISA v1 — Fortran Port (Strict Functional Execution)
module avm
  implicit none

  integer, parameter :: Q16_SCALE = 65536
  integer, parameter :: MAX_STACK = 1024
  integer, parameter :: MAX_LOCALS = 16
  integer, parameter :: MAX_PROG = 256

  ! Value type codes
  integer, parameter :: VAL_Q16 = 0, VAL_BOOL = 1

  type :: AvmVal
    integer :: ty = VAL_Q16
    integer :: val = 0
  end type

  ! Primitive codes
  integer, parameter :: PRIM_ADD = 0, PRIM_SUB = 1, PRIM_MUL = 2, PRIM_DIV = 3
  integer, parameter :: PRIM_LT = 4, PRIM_EQ = 5, PRIM_AND = 6, PRIM_OR = 7, PRIM_NOT = 8

  ! Instruction opcodes
  integer, parameter :: I_PUSH_Q16 = 0, I_PUSH_BOOL = 1, I_POP = 2, I_DUP = 3
  integer, parameter :: I_SWAP = 4, I_LOAD = 5, I_STORE = 6, I_JUMP = 7
  integer, parameter :: I_JUMP_IF = 8, I_PRIM = 9, I_HALT = 10

  type :: Instr
    integer :: op = 0
    integer :: arg = 0
  end type

  type :: State
    integer :: pc = 0
    type(AvmVal) :: stack(MAX_STACK)
    integer :: sp = 0  ! stack pointer
    type(AvmVal) :: locals(MAX_LOCALS)
    logical :: halted = .false.
  end type

contains

  function q16_mul(a, b) result(r)
    integer, intent(in) :: a, b
    integer :: r
    r = int((int(a, 8) * int(b, 8)) / Q16_SCALE)
  end function

  function q16_div(a, b) result(r)
    integer, intent(in) :: a, b
    integer :: r
    if (b == 0) then
      r = 2147483647
      return
    end if
    r = int((int(a, 8) * Q16_SCALE) / int(b, 8))
  end function

  function make_q16(x) result(v)
    integer, intent(in) :: x
    type(AvmVal) :: v
    v%ty = VAL_Q16; v%val = x
  end function

  function make_bool(x) result(v)
    logical, intent(in) :: x
    type(AvmVal) :: v
    v%ty = VAL_BOOL
    if (x) then; v%val = 1; else; v%val = 0; end if
  end function

  function make_instr(op, arg) result(i)
    integer, intent(in) :: op, arg
    type(Instr) :: i
    i%op = op; i%arg = arg
  end function

  subroutine push(s, v)
    type(State), intent(inout) :: s
    type(AvmVal), intent(in) :: v
    s%sp = s%sp + 1
    s%stack(s%sp) = v
  end subroutine

  function pop(s) result(v)
    type(State), intent(inout) :: s
    type(AvmVal) :: v
    v = s%stack(s%sp)
    s%sp = s%sp - 1
  end function

  function step(state, prog, prog_len) result(ns)
    type(State), intent(in) :: state
    type(Instr), intent(in) :: prog(MAX_PROG)
    integer, intent(in) :: prog_len
    type(State) :: ns
    type(AvmVal) :: a, b, result
    integer :: arity

    ns = state
    if (ns%halted) return
    if (ns%pc < 0 .or. ns%pc >= prog_len) then
      ns%halted = .true.; return
    end if

    select case (prog(ns%pc + 1)%op)  ! +1 for 1-indexed
    case (I_PUSH_Q16)
      call push(ns, make_q16(prog(ns%pc + 1)%arg))
    case (I_PUSH_BOOL)
      call push(ns, make_bool(prog(ns%pc + 1)%arg /= 0))
    case (I_POP)
      a = pop(ns)
    case (I_DUP)
      a = ns%stack(ns%sp)
      call push(ns, a)
    case (I_SWAP)
      a = pop(ns); b = pop(ns)
      call push(ns, a); call push(ns, b)
    case (I_LOAD)
      call push(ns, ns%locals(prog(ns%pc + 1)%arg + 1))
    case (I_STORE)
      ns%locals(prog(ns%pc + 1)%arg + 1) = pop(ns)
    case (I_JUMP)
      ns%pc = prog(ns%pc + 1)%arg - 1; return
    case (I_JUMP_IF)
      a = pop(ns)
      if (a%val /= 0) ns%pc = prog(ns%pc + 1)%arg - 1
    case (I_PRIM)
      arity = 2
      if (prog(ns%pc + 1)%arg == PRIM_NOT) arity = 1
      if (arity == 2) b = pop(ns)
      a = pop(ns)
      select case (prog(ns%pc + 1)%arg)
      case (PRIM_ADD); result = make_q16(a%val + b%val)
      case (PRIM_SUB); result = make_q16(a%val - b%val)
      case (PRIM_MUL); result = make_q16(q16_mul(a%val, b%val))
      case (PRIM_DIV); result = make_q16(q16_div(a%val, b%val))
      case (PRIM_LT);  result = make_bool(a%val < b%val)
      case (PRIM_EQ);  result = make_bool(a%val == b%val)
      case (PRIM_AND); result = make_bool(a%val /= 0 .and. b%val /= 0)
      case (PRIM_OR);  result = make_bool(a%val /= 0 .or. b%val /= 0)
      case (PRIM_NOT); result = make_bool(a%val == 0)
      end select
      call push(ns, result)
    case (I_HALT)
      ns%halted = .true.
    end select
    ns%pc = ns%pc + 1
  end function

  subroutine run(init, prog, prog_len, fuel, out_state)
    type(State), intent(in) :: init
    type(Instr), intent(in) :: prog(MAX_PROG)
    integer, intent(in) :: prog_len, fuel
    type(State), intent(out) :: out_state
    type(State) :: s
    integer :: i

    s = init
    do i = 1, fuel
      if (s%halted) exit
      s = step(s, prog, prog_len)
    end do
    out_state = s
  end subroutine

end module