src/wam/bytecode.lisp @ dc6892a9a406

Stop using the fill pointer for the stack

This is ugly, but it had to be done.  Shit gets too crazy once you introduce
choice points.  We'll just have to manage our own memory.  Ugh.
author Steve Losh <steve@stevelosh.com>
date Wed, 20 Apr 2016 17:13:31 +0000
parents 1ab41e0128dc
children 27f037427ad3
(in-package #:bones.wam)

;;;; Opcodes
(defun* instruction-size ((opcode opcode))
  (:returns (integer 1 3))
  "Return the size of an instruction for the given opcode.

  The size includes one word for the opcode itself and one for each argument.

  "
  (eswitch (opcode)
    (+opcode-noop+ 1)

    (+opcode-get-structure-local+ 3)
    (+opcode-unify-variable-local+ 2)
    (+opcode-unify-variable-stack+ 2)
    (+opcode-unify-value-local+ 2)
    (+opcode-unify-value-stack+ 2)
    (+opcode-get-variable-local+ 3)
    (+opcode-get-variable-stack+ 3)
    (+opcode-get-value-local+ 3)
    (+opcode-get-value-stack+ 3)

    (+opcode-put-structure-local+ 3)
    (+opcode-set-variable-local+ 2)
    (+opcode-set-variable-stack+ 2)
    (+opcode-set-value-local+ 2)
    (+opcode-set-value-stack+ 2)
    (+opcode-put-variable-local+ 3)
    (+opcode-put-variable-stack+ 3)
    (+opcode-put-value-local+ 3)
    (+opcode-put-value-stack+ 3)

    (+opcode-call+ 2)
    (+opcode-proceed+ 1)
    (+opcode-allocate+ 2)
    (+opcode-deallocate+ 1)
    (+opcode-done+ 1)
    (+opcode-try+ 2)
    (+opcode-retry+ 2)
    (+opcode-trust+ 1)))


(defun* opcode-name ((opcode opcode))
  (:returns string)
  (eswitch (opcode)
    (+opcode-noop+ "NOOP")
    (+opcode-get-structure-local+ "GET-STRUCTURE")
    (+opcode-unify-variable-local+ "UNIFY-VARIABLE")
    (+opcode-unify-variable-stack+ "UNIFY-VARIABLE")
    (+opcode-unify-value-local+ "UNIFY-VALUE")
    (+opcode-unify-value-stack+ "UNIFY-VALUE")
    (+opcode-get-variable-local+ "GET-VARIABLE")
    (+opcode-get-variable-stack+ "GET-VARIABLE")
    (+opcode-get-value-local+ "GET-VALUE")
    (+opcode-get-value-stack+ "GET-VALUE")

    (+opcode-put-structure-local+ "PUT-STRUCTURE")
    (+opcode-set-variable-local+ "SET-VARIABLE")
    (+opcode-set-variable-stack+ "SET-VARIABLE")
    (+opcode-set-value-local+ "SET-VALUE")
    (+opcode-set-value-stack+ "SET-VALUE")
    (+opcode-put-variable-local+ "PUT-VARIABLE")
    (+opcode-put-variable-stack+ "PUT-VARIABLE")
    (+opcode-put-value-local+ "PUT-VALUE")
    (+opcode-put-value-stack+ "PUT-VALUE")

    (+opcode-call+ "CALL")
    (+opcode-proceed+ "PROCEED")
    (+opcode-allocate+ "ALLOCATE")
    (+opcode-deallocate+ "DEALLOCATE")
    (+opcode-done+ "DONE")
    (+opcode-try+ "TRY")
    (+opcode-retry+ "RETRY")
    (+opcode-trust+ "TRUST")))

(defun* opcode-short-name ((opcode opcode))
  (:returns string)
  (eswitch (opcode)
    (+opcode-noop+ "NOOP")

    (+opcode-get-structure-local+ "GETS")
    (+opcode-unify-variable-local+ "UVAR")
    (+opcode-unify-variable-stack+ "UVAR")
    (+opcode-unify-value-local+ "UVLU")
    (+opcode-unify-value-stack+ "UVLU")
    (+opcode-get-variable-local+ "GVAR")
    (+opcode-get-variable-stack+ "GVAR")
    (+opcode-get-value-local+ "GVLU")
    (+opcode-get-value-stack+ "GVLU")

    (+opcode-put-structure-local+ "PUTS")
    (+opcode-set-variable-local+ "SVAR")
    (+opcode-set-variable-stack+ "SVAR")
    (+opcode-set-value-local+ "SVLU")
    (+opcode-set-value-stack+ "SVLU")
    (+opcode-put-variable-local+ "PVAR")
    (+opcode-put-variable-stack+ "PVAR")
    (+opcode-put-value-local+ "PVLU")
    (+opcode-put-value-stack+ "PVLU")

    (+opcode-call+ "CALL")
    (+opcode-proceed+ "PROC")
    (+opcode-allocate+ "ALOC")
    (+opcode-deallocate+ "DEAL")
    (+opcode-done+ "DONE")
    (+opcode-try+ "TRYM")
    (+opcode-retry+ "RTRY")
    (+opcode-trust+ "TRST")))