;;; -*- Lisp -*-
;;;
;;; Instruction definitions for Spice Lisp.
;;; Written by Skef Wholey.
;;;
;;; This file contains information about the instruction set and is
;;; used by the microassembler, the compiler, the error system, and the
;;; disassembler.
;;;

(defvar *1byte-instruction-table*
  (make-array 256)
  "Table used to find the name of a 1 byte long instruction given its
   opcode.")

(defvar *2byte-instruction-table*
  (make-array 256)
  "Table used to find the name of a 2 byte long instruction given the second
  byte of its opcode.")

(defvar *instruction-list* () "List of the instruction names.")

;;; We do this random setq so that the right thing happens when a new
;;; definition file is loaded.

(setq *instruction-list* ())

(defun definstruction (name opcode
		       &optional (type 'read) (operand 'stack) offset)
  "Defines an instruction with the given Name (a symbol) and Opcode.
  Opcode may be either a single integer or a list of integers.  Type
  should be one of Read, Write, Read-Modify-Write, Long-Branch, or
  Short-Branch.  Operand defaults to Stack.  Instructions which don't
  really have operands are considered to be Read Stack operations.
  Operand should be one of Stack, PSIC, NSIC, AL, Long-AL, Constant,
  Long-Constant, Symbol, Long-Symbol, or Ignore.  If the instruction has an
  implied offset, that should be specified with the Offset."
  (if (fixnump opcode)
      (setq opcode (list opcode)))
  (if (not (listp opcode))
      (error "The opcode for ~S must be either an integer or a list." name))
  (setf (get name '%instruction-opcode) opcode)
  (setf (get name '%instruction-length)
	(+ (length opcode)
	   (cond ((memq type '(read write read-modify-write))
		  (cond (offset 0)
			((memq operand '(stack ignore))
			 0)
			((memq operand '(psic nsic al constant symbol))
			 1)
			((memq operand '(long-al long-constant long-symbol))
			 2)
			(t
			 (error "~S is a losing operand." operand))))
		 ((memq type '(long-branch-forward long-branch-backward)) 2)
		 ((memq type '(short-branch-forward short-branch-backward)) 1)
		 ((eq type 'long-dispatch) 3)
		 ((eq type 'short-dispatch) 4)
		 (t (error "~S is a losing type." type)))))
  (setf (get name '%instruction-type) type)
  (setf (get name '%instruction-operand) operand)
  (setf (get name '%instruction-offset) offset)
  (push name *instruction-list*)
  (if (= (car opcode) 254)
      (setf (aref *2byte-instruction-table* (cadr opcode)) name)
      (setf (aref *1byte-instruction-table* (car opcode)) name)))

;;; Definstructionclass is used to define a class of instructions, i.e. a
;;; set of instructions that perform the same operation on operands in
;;; different places.  Each instruction in the class has its %Instruction-Group
;;; property set to the Stack-Form.

(defun definstructionclass (stack-form &rest other-forms)
  (setf (get stack-form '%instruction-class) other-forms)
  (do ((forms other-forms (cdr forms)))
      ((null forms))
    (let ((glob (cdar forms)))
      (if (listp glob)
	  (do ((subforms glob (cdr subforms)))
	      ((null subforms))
	    (setf (get (cdar subforms) '%instruction-group) stack-form))
	  (setf (get glob '%instruction-group) stack-form)))))

;;; 1Byte generates a definstruction for a one-byte instruction.

(defvar *1byte-instruction-counter* nil
  "Counter used to generate unique 1 byte long instructions.")

(defmacro 1byte (name . other-stuff)
  "Generates a Definstruction for the Name and Other-Stuff with a unique
  one-byte opcode."
  `(definstruction ,name ',(prog1 *1byte-instruction-counter*
				  (incf *1byte-instruction-counter*))
     . ,other-stuff))

;;; 2Byte generates a definstruction for a two-byte instruction.

(defvar *2byte-instruction-counter* nil
  "Counter used to generate unique 2 byte long instructions.")

(defmacro 2byte (name . other-stuff)
  "Generates a Definstruction for the Name and Other-Stuff with a unique
  one-byte opcode."
  `(definstruction ,name '(254 ,(prog1 *2byte-instruction-counter*
				       (incf *2byte-instruction-counter*)))
     . ,other-stuff))

;;; Set the counts:

(eval-when (compile)
  (setq *1byte-instruction-counter* 1)
  (setq *2byte-instruction-counter* 0))

;;; InstrSynonym defines a synonym for an instruction.

(defmacro instrsynonym (for is &optional type)
  `(progn (setf (get ,is '%instruction-offset)
		(get ,for '%instruction-offset))
	  (setf (get ,is '%instruction-destination)
		(get ,for '%instruction-destination))
	  (setf (get ,is '%instruction-type)
		,(or type
		     `(get ,for '%instruction-type)))
	  (setf (get ,is '%instruction-length)
		(get ,for '%instruction-length))
	  (setf (get ,is '%instruction-opcode)
		(get ,for '%instruction-opcode))))

;;; Allocation:

(2byte 'get-allocation-space)
(2byte 'set-allocation-space)
(2byte 'alloc-bit-vector)
(2byte 'alloc-i-vector)
(2byte 'alloc-string)
(2byte 'alloc-bignum)
(2byte 'float-long)
(2byte 'make-complex)
(2byte 'make-ratio)
(2byte 'alloc-g-vector)
(definstructionclass 'vector
  '(psic . vector-psic))
(2byte 'vector)
(2byte 'vector-psic 'read 'psic)
(2byte 'alloc-function)
(2byte 'alloc-array)
(2byte 'alloc-symbol)
(definstructionclass 'cons
  '(al . cons-al))
(1byte 'cons)
(1byte 'cons-al 'read 'al)
(definstructionclass 'list
  '(psic . ((psic . list-psic)
	    (1 . list-psic1)
	    (2 . list-psic2)
	    (3 . list-psic3))))
(2byte 'list)
(1byte 'list-psic)
(1byte 'list-psic1 'read 'psic 1)
(1byte 'list-psic2 'read 'psic 2)
(1byte 'list-psic3 'read 'psic 3)
(definstructionclass 'list*
  '(psic . list*-psic))
(2byte 'list*)
(2byte 'list*-psic 'read 'psic)

;;; Stack manipulation:

(definstructionclass 'push
  '(psic . ((psic . push-psic)
	    (0 . push-psic0)
	    (1 . push-psic1)
	    (2 . push-psic2)
	    (3 . push-psic3)
	    (4 . push-psic4)
	    (5 . push-psic5)
	    (6 . push-psic6)
	    (7 . push-psic7)
	    (8 . push-psic8)))
  '(nsic . push-nsic)
  '(al . ((al . push-al)
	  (0 . push-al0)
	  (1 . push-al1)
	  (2 . push-al2)
	  (3 . push-al3)
	  (4 . push-al4)
	  (5 . push-al5)
	  (6 . push-al6)
	  (7 . push-al7)
	  (8 . push-al8)
	  (9 . push-al9)
	  (10 . push-al10)
	  (11 . push-al11)
	  (12 . push-al12)
	  (13 . push-al13)))
  '(longal . push-longal)
  '(c . ((c . push-c)
	 (1 . push-c1)
	 (2 . push-c2)
	 (3 . push-c3)
	 (4 . push-c4)
	 (5 . push-c5)
	 (6 . push-c6)
	 (7 . push-c7)
	 (8 . push-c8)
	 (9 . push-c9)
	 (10 . push-c10)
	 (11 . push-c11)))
  '(longc . push-longc)
  '(s . push-s)
  '(longs . push-longs))
(1byte 'push-psic 'read 'psic)
(1byte 'push-psic0 'read 'psic 0)
(1byte 'push-psic1 'read 'psic 1)
(1byte 'push-psic2 'read 'psic 2)
(1byte 'push-psic3 'read 'psic 3)
(1byte 'push-psic4 'read 'psic 4)
(1byte 'push-psic5 'read 'psic 5)
(1byte 'push-psic6 'read 'psic 6)
(1byte 'push-psic7 'read 'psic 7)
(1byte 'push-psic8 'read 'psic 8)
(1byte 'push-nsic 'read 'nsic)
(1byte 'push-al 'read 'al)
(1byte 'push-al0 'read 'al 0)
(1byte 'push-al1 'read 'al 1)
(1byte 'push-al2 'read 'al 2)
(1byte 'push-al3 'read 'al 3)
(1byte 'push-al4 'read 'al 4)
(1byte 'push-al5 'read 'al 5)
(1byte 'push-al6 'read 'al 6)
(1byte 'push-al7 'read 'al 7)
(1byte 'push-al8 'read 'al 8)
(1byte 'push-al9 'read 'al 9)
(1byte 'push-al10 'read 'al 10)
(1byte 'push-al11 'read 'al 11)
(1byte 'push-al12 'read 'al 12)
(1byte 'push-al13 'read 'al 13)
(2byte 'push-longal 'read 'long-al)
(1byte 'push-c 'read 'constant)
(1byte 'push-c1 'read 'constant 1)
(1byte 'push-c2 'read 'constant 2)
(1byte 'push-c3 'read 'constant 3)
(1byte 'push-c4 'read 'constant 4)
(1byte 'push-c5 'read 'constant 5)
(1byte 'push-c6 'read 'constant 6)
(1byte 'push-c7 'read 'constant 7)
(1byte 'push-c8 'read 'constant 8)
(1byte 'push-c9 'read 'constant 9)
(1byte 'push-c10 'read 'constant 10)
(1byte 'push-c11 'read 'constant 11)
(2byte 'push-longc 'read 'long-constant)
(1byte 'push-s 'read 'symbol)
(2byte 'push-longs 'read 'long-symbol)
(definstructionclass 'pop
  '(al . ((al . pop-al)
	  (0 . pop-al0)
	  (1 . pop-al1)
	  (2 . pop-al2)
	  (3 . pop-al3)
	  (4 . pop-al4)
	  (5 . pop-al5)
	  (6 . pop-al6)
	  (7 . pop-al7)
	  (8 . pop-al8)
	  (9 . pop-al9)))
  '(longal . pop-longal)
  '(s . pop-s)
  '(longs . pop-longs)
  '(ignore . pop-ignore))
(1byte 'pop-al 'write 'al)
(1byte 'pop-al0 'write 'al 0)
(1byte 'pop-al1 'write 'al 1)
(1byte 'pop-al2 'write 'al 2)
(1byte 'pop-al3 'write 'al 3)
(1byte 'pop-al4 'write 'al 4)
(1byte 'pop-al5 'write 'al 5)
(1byte 'pop-al6 'write 'al 6)
(1byte 'pop-al7 'write 'al 7)
(1byte 'pop-al8 'write 'al 8)
(1byte 'pop-al9 'write 'al 9)
(2byte 'pop-longal 'write 'long-al)
(1byte 'pop-s 'write 'symbol)
(2byte 'pop-longs 'write 'long-symbol)
(1byte 'pop-ignore 'write 'ignore)
(2byte 'exchange)
(definstructionclass 'copy
  '(al . ((al . copy-al)
	  (1 . copy-al1)
	  (2 . copy-al2)
	  (3 . copy-al3)))
  '(s . copy-s))
(2byte 'copy 'write)
(1byte 'copy-al 'write 'al)
(1byte 'copy-al1 'write 'al 1)
(1byte 'copy-al2 'write 'al 2)
(1byte 'copy-al3 'write 'al 3)
(1byte 'copy-s 'write 'symbol)
(definstructionclass 'npop
  '(nsic . npop-nsic))
(1byte 'npop)
(1byte 'npop-nsic 'write 'nsic)
(definstructionclass 'bind-null
  '(c . bind-null-c))
(2byte 'bind-null)
(2byte 'bind-null-c 'read 'constant)
(definstructionclass 'bind
  '(c . bind-c))
(2byte 'bind)
(1byte 'bind-c 'read 'constant)
(definstructionclass 'unbind
  '(psic . ((psic . unbind-psic)
	    (1 . unbind-psic1))))
(2byte 'unbind)
(1byte 'unbind-psic 'read 'psic)
(1byte 'unbind-psic1 'read 'psic 1)

;;; List manipulation:

(definstructionclass 'car
  '(al . ((al . car-al)
	  (0 . car-al0)
	  (1 . car-al1)
	  (2 . car-al2)
	  (3 . car-al3)))
  '(s . car-s))
(1byte 'car)
(1byte 'car-al 'read 'al)
(1byte 'car-al0 'read 'al 0)
(1byte 'car-al1 'read 'al 1)
(1byte 'car-al2 'read 'al 2)
(1byte 'car-al3 'read 'al 3)
(1byte 'car-s 'read 'symbol)
(definstructionclass 'cdr
  '(al . ((al . cdr-al)
	  (0 . cdr-al0))))
(1byte 'cdr)
(1byte 'cdr-al 'read 'al)
(1byte 'cdr-al0 'read 'al 0)
(definstructionclass 'cadr
  '(al . ((al . cadr-al)
	  (0 . cadr-al0)))
  '(s . cadr-s))
(1byte 'cadr)
(1byte 'cadr-al 'read 'al)
(1byte 'cadr-al0 'read 'al 0)
(1byte 'cadr-s 'read 'symbol)
(definstructionclass 'cddr
  '(al . cddr-al))
(2byte 'cddr)
(2byte 'cddr-al 'read 'al)
(definstructionclass 'cdar
  '(al . cdar-al))
(1byte 'cdar)
(1byte 'cdar-al 'read 'al)
(definstructionclass 'caar
  '(al . caar-al))
(1byte 'caar)
(1byte 'caar-al 'read 'al)
(definstructionclass 'set-cdr
  '(al . set-cdr-al)
  '(s . set-cdr-s))
(1byte 'set-cdr-al 'read-modify-write 'al)
(1byte 'set-cdr-s 'read-modify-write 'symbol)
(definstructionclass 'set-cddr
  '(al . set-cddr-al)
  '(s . set-cddr-s))
(2byte 'set-cddr-al 'read-modify-write 'al)
(2byte 'set-cddr-s 'read-modify-write 'symbol)
(definstructionclass 'spread
  '(al . spread-al))
(2byte 'spread)
(2byte 'spread-al 'read 'al)
(definstructionclass 'replace-car
  '(al . replace-car-al))
(1byte 'replace-car)
(1byte 'replace-car-al 'read 'al)
(definstructionclass 'replace-cdr
  '(al . replace-cdr-al))
(1byte 'replace-cdr)
(1byte 'replace-cdr-al 'read 'al)
(2byte 'assoc)
(2byte 'assq)
(2byte 'member)
(2byte 'memq)
(definstructionclass 'endp
  '(al . endp-al))
(2byte 'endp)
(1byte 'endp-al 'read 'al)
(2byte 'getf)
(2byte 'putf)

;;; Symbol manipulation:

(1byte 'get-value)
(1byte 'set-value)
(1byte 'get-definition)
(2byte 'set-definition)
(2byte 'get-plist)
(2byte 'set-plist)
(2byte 'get-pname)
(2byte 'get-package)
(2byte 'set-package)
(2byte 'boundp)
(2byte 'fboundp)
(2byte 'get)
(2byte 'put)

;;; Array manipulation:

(2byte 'vector-length)
(2byte 'g-vector-length)
(2byte 'simple-string-length)
(2byte 'simple-bit-vector-length)
(2byte 'get-vector-subtype)
(2byte 'set-vector-subtype)
(2byte 'get-vector-access-code)
(2byte 'shrink-vector)
(1byte 'typed-vref)
(1byte 'typed-vset)
(2byte 'header-length)
(2byte 'header-ref)
(2byte 'header-set)
(1byte 'aref1)
(definstructionclass 'svref
  '(psic . svref-psic))
(1byte 'svref-psic 'read 'psic)
(1byte 'svref)
(1byte 'schar)
(1byte 'sbit)
(2byte 'aset1)
(1byte 'svset)
(1byte 'scharset)
(1byte 'sbitset)
(2byte 'bit-bash)
(2byte 'byte-blt)
(2byte 'find-character)
(2byte 'find-character-with-attribute)
(2byte 'sxhash-simple-string)

;;; Type predicates:

(2byte 'get-type)
(2byte 'get-space)
(2byte 'bit-vector-p)
(2byte 'simple-bit-vector-p)
(2byte 'simple-integer-vector-p)
(1byte 'stringp)
(1byte 'simple-string-p)
(2byte 'bignump)
(2byte 'long-float-p)
(2byte 'complexp)
(2byte 'ratiop)
(2byte 'integerp)
(2byte 'rationalp)
(2byte 'floatp)
(2byte 'numberp)
(2byte 'general-vector-p)
(1byte 'simple-vector-p)
(2byte 'compiled-function-p)
(2byte 'arrayp)
(2byte 'vectorp)
(1byte 'complex-array-p)
(1byte 'symbolp)
(1byte 'listp)
(1byte 'atom)
(1byte 'consp)
(1byte 'fixnump)
(2byte 'short-float-p)
(2byte 'characterp)

;;; Arithmetic and Logic:

(2byte 'integer-length)
(2byte 'float-short)
(2byte 'realpart)
(2byte 'imagpart)
(2byte 'numerator)
(2byte 'denominator)
(2byte 'decode-float)
(2byte 'scale-float)
(definstructionclass '=
  '(al . =-al)
  '(psic . ((psic . =-psic)
	    (0 . =-psic0)
	    (1 . =-psic1))))
(1byte '=)
(1byte '=-al 'read 'al)
(1byte '=-psic 'read 'psic)
(1byte '=-psic0 'read 'psic 0)
(1byte '=-psic1 'read 'psic 1)
(definstructionclass '<
  '(al . <-al)
  '(psic . <-psic))
(1byte '<)
(1byte '<-al 'read 'al)
(1byte '<-psic 'read 'psic)
(definstructionclass '>
  '(al . >-al)
  '(psic . >-psic))
(1byte '>)
(1byte '>-al 'read 'al)
(1byte '>-psic 'read 'psic)
(2byte 'truncate)
(definstructionclass '+
  '(al . +-al)
  '(psic . ((psic . +-psic)
	    (1 . +-psic1))))
(1byte '+)
(1byte '+-psic 'read 'psic)
(1byte '+-psic1 'read-modify-write 'psic 1)
(1byte '+-al 'read 'al)
(definstructionclass '-
  '(al . --al)
  '(psic . ((psic . --psic)
	    (1 . --psic1))))
(1byte '-)
(1byte '--psic 'read 'psic)
(1byte '--psic1 'read-modify-write 'psic 1)
(1byte '--al 'read 'al)
(2byte '*)
#+Common
(2byte '/ )
#-Common
(2byte '//)
(instrsynonym '+-psic1 '1+)
(1byte 'fixnum-1+-al 'read-modify-write 'al)
(instrsynonym '--psic1 '1-)
(1byte 'fixnum-1--al 'read-modify-write 'al)
(1byte 'negate)
(2byte 'abs)
(2byte 'logand)
(2byte 'logior)
(2byte 'logxor)
(2byte 'lognot)
(2byte 'boole)
(2byte 'ash)
(2byte 'ldb)
(2byte 'mask-field)
(2byte 'dpb)
(2byte 'deposit-field)
(2byte 'lsh)
(2byte 'logldb)
(2byte 'logdpb)

;;; Branching and dispatching:

(1byte 'branch-forward 'short-branch-forward)
(2byte 'long-branch-forward 'long-branch-forward)
(1byte 'branch-backward 'short-branch-backward)
(2byte 'long-branch-backward 'long-branch-backward)
(1byte 'branch-null-forward 'short-branch-forward)
(2byte 'long-branch-null-forward 'long-branch-forward)
(1byte 'branch-not-null-forward 'short-branch-forward)
(2byte 'long-branch-not-null-forward 'long-branch-forward)
(1byte 'branch-null-backward 'short-branch-backward)
(2byte 'long-branch-null-backward 'long-branch-backward)
(1byte 'branch-not-null-backward 'short-branch-backward)
(2byte 'long-branch-not-null-backward 'long-branch-backward)
(1byte 'branch-save-not-null-forward 'short-branch-forward)
(2byte 'long-branch-save-not-null-forward 'long-branch-forward)
(1byte 'branch-save-not-null-backward 'short-branch-backward)
(2byte 'long-branch-save-not-null-backward 'long-branch-backward)
(2byte 'dispatch 'short-dispatch)
(2byte 'long-dispatch 'long-dispatch)

;;; Function call and return:

(definstructionclass 'call
  '(al . call-al)
  '(c . ((c . call-c)
	 (1 . call-c1)
	 (2 . call-c2)
	 (3 . call-c3)
	 (4 . call-c4)
	 (5 . call-c5)
	 (6 . call-c6)
	 (7 . call-c7)
	 (8 . call-c8))))
(2byte 'call)
(1byte 'call-al 'read 'al)
(1byte 'call-c 'read 'constant)
(1byte 'call-c1 'read 'constant 1)
(1byte 'call-c2 'read 'constant 2)
(1byte 'call-c3 'read 'constant 3)
(1byte 'call-c4 'read 'constant 4)
(1byte 'call-c5 'read 'constant 5)
(1byte 'call-c6 'read 'constant 6)
(1byte 'call-c7 'read 'constant 7)
(1byte 'call-c8 'read 'constant 8)
(definstructionclass 'call-0
  '(c . call-0-c))
(2byte 'call-0)
(1byte 'call-0-c 'read 'constant)
(definstructionclass 'call-multiple
  '(c . ((c . call-multiple-c)
	 (1 . call-multiple-c1)
	 (2 . call-multiple-c2)
	 (3 . call-multiple-c3)
	 (4 . call-multiple-c4))))
(2byte 'call-multiple)
(1byte 'call-multiple-c 'read 'constant)
(1byte 'call-multiple-c1 'read 'constant 1)
(1byte 'call-multiple-c2 'read 'constant 2)
(1byte 'call-multiple-c3 'read 'constant 3)
(1byte 'call-multiple-c4 'read 'constant 4)
(1byte 'start-call)
(definstructionclass 'push-last
  '(al . ((al . push-last-al)
	  (0 . push-last-al0)
	  (1 . push-last-al1)
	  (2 . push-last-al2)
	  (3 . push-last-al3)))
  '(c . push-last-c)
  '(s . push-last-s))
(instrsynonym 'start-call 'push-last)
(1byte 'push-last-al 'read 'al)
(1byte 'push-last-al0 'read 'al 0)
(1byte 'push-last-al1 'read 'al 1)
(1byte 'push-last-al2 'read 'al 2)
(1byte 'push-last-al3 'read 'al 3)
(1byte 'push-last-c 'read 'constant)
(1byte 'push-last-s 'read 'symbol)
(definstructionclass 'return
  '(al . return-al)
  '(c . return-c))
(1byte 'return)
(1byte 'return-al 'read 'al)
(1byte 'return-c 'read 'constant)
(2byte 'escape-return)
(2byte 'break-return)
(2byte 'catch)
(2byte 'catch-multiple)
(2byte 'catch-all)
(2byte 'throw)

;;; Miscellaneous:

(definstructionclass 'eq
  '(al . eq-al)
  '(c . ((c . eq-c)
	 (1 . eq-c1)
	 (2 . eq-c2)
	 (3 . eq-c3))))
(1byte 'eq)
(1byte 'eq-al 'read 'al)
(1byte 'eq-c 'read 'constant)
(1byte 'eq-c1 'read 'constant 1)
(1byte 'eq-c2 'read 'constant 2)
(1byte 'eq-c3 'read 'constant 3)
(2byte 'eql)
(definstructionclass 'set-null
  '(al . set-null-al))
(1byte 'set-null-al 'write 'al)
(1byte 'set-null 'write)
(1byte 'set-t)
(instrsynonym 'push-psic0 'set-0 'write)
(1byte 'make-predicate)
(1byte 'not-predicate)
(1byte 'values-to-n)
(1byte 'n-to-values)
(1byte 'force-values)
(2byte 'flush-values)

;;; System hacking:

(1byte 'make-immediate-type)
(2byte '8bit-system-ref)
(2byte '8bit-system-set)
(2byte '16bit-system-ref)
(2byte '16bit-system-set)
(2byte 'collect-garbage)
(2byte 'newspace-bit)
(2byte 'kernel-trap)
(2byte 'halt)
(2byte 'arg-in-frame)
(2byte 'active-call-frame)
(2byte 'set-call-frame)
(2byte 'current-open-frame)
(2byte 'set-open-frame)
(2byte 'current-stack-pointer)
(2byte 'current-binding-pointer)
(2byte 'read-control-stack)
(2byte 'write-control-stack)
(2byte 'read-binding-stack)
(2byte 'write-binding-stack)

;;; %%% Things at the end just for now: %%%

(2byte 'long-float-ref)
(2byte 'long-float-set)
(2byte 'active-catch-frame)
(2byte 'set-catch-frame)
(2byte 'io-get-time)

(2byte 'sap-system-ref)
(2byte 'pointer-system-set)
(2byte 'signed-16bit-system-ref)
(2byte 'signed-32bit-system-ref)
(2byte 'signed-32bit-system-set)
(2byte 'check-<=)

(2byte 'sxhash-simple-substring)

(2byte 'profile-return)

(setq *1byte-instruction-counter* #.*1byte-instruction-counter*)
(setq *2byte-instruction-counter* #.*2byte-instruction-counter*)

;(format t "[~3D 1-byte instructions have been defined.]"
;	(1- #.*1byte-instruction-counter*))
;(terpri)
;(format t "[~3D 2-byte instructions have been defined.]"
;	#.*2byte-instruction-counter*)