;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE:               microcode.lisp
;;;;LANGUAGE:           Common-Lisp
;;;;SYSTEM:             Common-Lisp
;;;;USER-INTERFACE:     NONE
;;;;DESCRIPTION
;;;;
;;;;    Implements a microcoded microprocessor virtual machine.
;;;;
;;;;AUTHORS
;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;;    2015-02-09 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;;    AGPL3
;;;;
;;;;    Copyright Pascal J. Bourguignon 2015 - 2015
;;;;
;;;;    This program is free software: you can redistribute it and/or modify
;;;;    it under the terms of the GNU Affero General Public License as published by
;;;;    the Free Software Foundation, either version 3 of the License, or
;;;;    (at your option) any later version.
;;;;
;;;;    This program is distributed in the hope that it will be useful,
;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;;    GNU Affero General Public License for more details.
;;;;
;;;;    You should have received a copy of the GNU Affero General Public License
;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************
(defpackage "MICROPROCESSOR"
  (:use "COMMON-LISP")
  (:export "ENCODE-MICROPROGRAM" "PRINT-MICROPROGRAM"
           "RUN" "LAP" "DIS"
           "STORE" "LOAD" "ADD" "SUB" "JMP" "JEQ" "JLT" "HALT"
           "A.ADD" "A.READ" "A.SUB" "A.WRITE1" "A.WRITE2" "I.READ"
           "I.READA" "I.WRITE" "M.READ" "M.WRITE" "P.INCR" "P.READA"
           "P.WRITE" "R.READ" "R.WRITE" "DECODE" "CYCLE" "GROUND" "S.HALT")
  (:documentation "
This package implements a simple microprogrammed microprocessor.

The processor has:
- a memory of 32 8-bit bytes,
- a program counter register,
- an accumulator register, with two flags: zero and minus (two-complement),
- an ALU able to add and subtract bytes,
- a microprogram, with a decoder and the signals to drive the various
  registers, buses and flags.

The instructions consist of single bytes with 3-bit operation code,
and 5-bit addresses.

    000 = store
    001 = load
    010 = add
    011 = sub
    100 = jmp
    101 = jeq
    110 = jlt
    111 = halt

The microcode instructions consist of 13 bits:
- 5-bit signal number,
- 1-bit state,
- 7-bit next microcode address.



License: AGPL3

Copyright Pascal J. Bourguignon 2015 - 2015

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU Affero General Public License for more details.

You should have received a copy of the GNU Affero General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
"))
(in-package "MICROPROCESSOR")

(defun encode-signal (signal-name)
  "Gives the signal number from the signal name."
  (case signal-name
    (a.add    #b00000)
    (a.read   #b00001)
    (a.sub    #b00010)
    (a.write1 #b00011)
    (a.write2 #b00100)
    (i.read   #b00101)
    (i.reada  #b00110)
    (i.write  #b00111)
    (m.read   #b01000)
    (m.write  #b01001)
    (p.incr   #b01010)
    (p.reada  #b01011)
    (p.write  #b01100)
    (r.read   #b01101)
    (r.write  #b01110)
    (decode   #b01111)
    (cycle    #b10000)
    (s.halt   #b11111)))


(defun encode-microprogram (pgm)
  "Encode a microprogram PGM.
Returns: the list of microcode, an a-list of labels with their
addresses, and the length of the microcode.
"
  (multiple-value-bind (labels size)
      (loop
        :with addr = 0
        :with labels = '()
        :for i :in pgm
        :do (if (symbolp i)
                (push (cons i addr) labels)
                (incf addr))
        :finally (return (values (nreverse labels) addr)))
    (loop
      :with addr = 0
      :with code = '()
      :for i :in pgm
      :do (unless (symbolp i)
            (destructuring-bind (signal &optional - (state 0)) i
              (push (dpb (encode-signal signal) (byte 5 8)
                         (dpb state (byte 1 7)
                              (1+ addr)))
                    code)
              (incf addr)))
      :finally (return (values (nreverse code) labels size)))))

(defun print-microprogram (code labels size)
  "Disassemble the microprogram given in the list CODE, with the
symbol table LABELS."
  (declare (ignore size))
  (loop
    :for a   :from 0
    :for mci :in code
    :for l = (rassoc a labels)
    :do (when l
          (format t "~A:~%" (car l)))
        (format t "~3D: ~5,'0B ~B ~7,'0B~%" a
                (ldb (byte 5 8) mci)
                (ldb (byte 1 7) mci)
                (ldb (byte 7 0) mci))))

(defparameter *simple-microprocessor*
  '(
    cycle
    (cycle <- 0)
    (p.reada <- 1) ;; puts the PC onto the address bus
    (m.read <- 1)  ;; read the memory
    (i.write <- 1) ;; store it in the instruction register
    (i.write <- 0) ;; release the bus
    (p.incr <- 1)  ;; increment pc
    (m.read <- 0)  ;; release the bus
    (p.reada <- 0)
    (p.incr <- 0)
    (decode <- 1)

    store
    (decode <- 0)
    (i.reada <- 1) ;; puts the address on the address bus.
    (r.read <- 1) ;; puts the value from the accumulator on the data bus.
    (m.write <- 1) ;; stores the value on the data bus into the memory at the address on the address bus.
    (m.write <- 0) ;; release the buses.
    (r.read <- 0)
    (i.reada <- 0)
    (cycle <- 1)

    load
    (decode <- 0)
    (i.reada <- 1) ;; puts the address on the address bus.
    (m.read <- 1) ;; puts the value from the memory at the address on the address bus, onto the data bus.
    (r.write <- 1) ;; stores the value on the data bus into the accumulator.
    (r.write <- 0) ;; release the buses.
    (m.read <- 0)
    (i.reada <- 0)
    (cycle <- 1)

    add
    (decode <- 0)
    (i.reada <- 1) ;; puts the address on the address bus.
    (m.read <- 1) ;; puts the value from the memory at the address on the address bus, onto the data bus.
    (a.write2 <- 1) ;; stores the value on the data bus into the second argument of the ALU
    (a.write2 <- 0) ;; release the buses.
    (m.read <- 0)
    (i.reada <- 0)
    (r.read <- 1) ;; puts the value from the accumulator on the data bus
    (a.write1 <- 1) ;; stores the value on the data bus into the first argument of the ALU
    (a.write2 <- 0) ;; release the buses.
    (r.read <- 0)
    (a.add <- 1) ;; adds
    (a.read <- 1) ;; puts the result on the data bus
    (r.write <- 1) ;; store the value on the data bus into the accumulator
    (r.write <- 0) ;; release the buses
    (a.add <- 0)
    (a.read <- 0)
    (cycle <- 1)

    sub ;; is similar to add addr, with a.sub instead of a.add.
    (decode <- 0)
    (i.reada <- 1) ;; puts the address on the address bus.
    (m.read <- 1) ;; puts the value from the memory at the address on the address bus, onto the data bus.
    (a.write2 <- 1) ;; stores the value on the data bus into the second argument of the ALU
    (a.write2 <- 0) ;; release the buses.
    (m.read <- 0)
    (i.reada <- 0)
    (r.read <- 1) ;; puts the value from the accumulator on the data bus
    (a.write1 <- 1) ;; stores the value on the data bus into the first argument of the ALU
    (a.write2 <- 0) ;; release the buses.
    (r.read <- 0)
    (a.sub <- 1) ;; subtracts
    (a.read <- 1) ;; puts the result on the data bus
    (r.write <- 1) ;; store the value on the data bus into the accumulator
    (r.write <- 0) ;; release the buses
    (a.sub <- 0)
    (a.read <- 0)
    (cycle <- 1)

    jmp
    (decode <- 0)
    (i.read <- 1) ;; puts the address in the instruction onto the data bus
    (p.write <- 1) ;; store the address in the pc register
    (p.write <- 0) ;; release the buses
    (i.read <- 0)
    (cycle <- 1)

    halt
    (decode <- 0)
    (s.halt <- 1)
    (cycle <- 1))

  "This microprogram implements our microprocessor instructions:
store, load, add, sub, jmp and halt.  jeq and jlt are implemented as
jmp when the right conditions are detected by the decoder.")



(defstruct (memory (:constructor %make-memory))
  "A memory."
  data)

(defun make-memory (address-bus-width data-bus-width)
  "Creates a memory containing 2^address-bus-width words of data-bus-width bits."
  (%make-memory :data (make-array (expt 2 address-bus-width)
                                  :element-type `(unsigned-byte ,data-bus-width)
                                  :initial-element 0)))

(defstruct register
  "A register."
  (value 0))

(defstruct bus
  "A bus."
  (value 0))

(defmacro define-register (name)
  "Defines a named register."
  `(defparameter ,name (make-register)))

(defmacro define-bus (name)
  "Defines a named bus."
  `(defparameter ,name (make-bus)))

(defmacro define-memory (name address-bus-width data-bus-width)
  "Defines a named memory."
  `(defparameter ,name (make-memory ,address-bus-width ,data-bus-width)))

(defmacro define-signal (name on &optional off)
  "Defines a signal.  The signal can be set on or reset off.
On each occurences, the ON or OFF expressions are evaluated,
thus implementing the specific signal."
  (let ((state (gensym "state")))
    `(defun ,name (,state)
       (if (zerop ,state)
           ,off
           ,on))))

(defmacro define-flag (name &body body)
  "Defines a flags.  The BODY computes the current value of the flag."
  `(defun ,name ()
     ,@body))


;; The buses:
(define-bus *data*)
(define-bus *address*)

;; The main memory:
(defparameter *address-width* 5)
(defparameter *data-width*    8)
(define-memory *mem* *address-width* *data-width*)
(define-signal m.read     (setf (bus-value *data*) (aref (memory-data *mem*) (bus-value *address*))))
(define-signal m.write
  (progn
    (format *trace-output* "[~D]<-~D~%" (bus-value *address*) (bus-value *data*))
    (setf (aref (memory-data *mem*) (bus-value *address*)) (bus-value *data*))))
(defun load-memory (data) (replace (memory-data *mem*) data))

;; The instruction register:
(define-register *instruction*)
(define-signal i.reada  (setf (bus-value *address*) (ldb (byte 5 0) (register-value *instruction*))))
(define-signal i.read   (setf (bus-value *data*)    (ldb (byte 5 0) (register-value *instruction*))))
(define-signal i.write  (setf (register-value *instruction*) (bus-value *data*)))

(define-flag op2        (ldb (byte 1 7) (register-value *instruction*)))
(define-flag op1        (ldb (byte 1 6) (register-value *instruction*)))
(define-flag op0        (ldb (byte 1 5) (register-value *instruction*)))

;; The Program counter register:
(define-register *pc*)
(define-signal p.reada  (setf (bus-value *address*) (register-value *pc*)))
(define-signal p.read   (setf (bus-value *data*) (register-value *pc*)))
(define-signal p.incr
  (progn
    (setf (register-value *pc*) (mod (+ (register-value *pc*) 1) (expt 2 *address-width*)))
    (format *trace-output* "PC=~D~%"  (register-value *pc*))))
(define-signal p.write  (setf (register-value *pc*) (bus-value *data*)))

;; The accumulator register:
(define-register *acc*)
(define-signal r.read   (setf (bus-value *data*) (register-value *acc*)))
(define-signal r.write
  (progn
    (setf (register-value *acc*) (bus-value *data*))
    (format *trace-output* "AC=~D~%" (register-value *acc*))))
(define-flag zero       (if (zerop (register-value *acc*))  1 0))
(define-flag minus      (if (<= 128 (register-value *acc*)) 1 0))

;; The ALU:
(define-register *arg1*)
(define-register *arg2*)
(define-register *result*)
(define-signal a.write2 (setf (register-value *arg2*) (bus-value *data*)))
(define-signal a.write1 (setf (register-value *arg1*) (bus-value *data*)))
(define-signal a.add    (setf (register-value *result*) (logand #xff (+ (register-value *arg1*) (register-value *arg2*)))))
(define-signal a.sub    (setf (register-value *result*) (logand #xff (- (register-value *arg1*) (register-value *arg2*)))))
(define-signal a.read   (setf (bus-value *data*)  (register-value *result*)))

;; The microcode memory
(define-bus      *mcbus*)
(define-register *mcaddr*)
(define-register *signal*)
(define-register *state*)
(define-memory *microcode* 7 13)


(define-signal c.read
  ;; The c.read signal is used to read the microcode from the microcode memory.
  (let ((mci (aref (memory-data *microcode*) (bus-value *mcbus*))))
    (setf (register-value *signal*) (ldb (byte 5 8) mci)
          (register-value *state*)  (ldb (byte 1 7) mci)
          (register-value *mcaddr*) (ldb (byte 7 0) mci)
          (bus-value *mcbus*) (register-value *mcaddr*))))

;; The decoder/sequencer
(define-signal cycle
  ;; The cycle signal is used to complete the processing of a processor instruction.
  (setf (bus-value *mcbus*) cycle)
  (setf (bus-value *mcbus*) (register-value *mcaddr*)))

;; microcode subroutines addresses:
;; they are filled by the microcode loader,
;; and used by the decoder to jump to the right microcode.
(defvar cycle)
(defvar store)
(defvar load)
(defvar add)
(defvar sub)
(defvar jmp)
(defvar halt)

(defun load-microcode (microcode labels)
  (loop :for (label . addr) :in labels
        :do (setf (symbol-value label) addr))
  (replace (memory-data *microcode*) microcode))


;; The halt signal sets the halt register, which is used to stop the machine.
(define-register *halt*)
(define-signal s.halt
  (setf (register-value *halt*) 1)
  (setf (register-value *halt*) 0))



(define-signal decode
  ;; The decode signal dispatches the microcode,
  ;; according to the opcode bits and status flags,
  ;; or writing the next microcode address to the microcode bus when
  ;; reset.
  ;;
  ;; !cycle & decode & !op2 & !op1 &  !op0                store
  ;; !cycle & decode & !op2 & !op1 &   op0                load
  ;; !cycle & decode & !op2 &  op1 &  !op0                add
  ;; !cycle & decode & !op2 &  op1 &   op0                sub
  ;; !cycle & decode &  op2 & !op1 &  !op0                jmp
  ;; !cycle & decode &  op2 & !op1 & ( op0 & zero)        jmp (jeq)
  ;; !cycle & decode &  op2 &  op1 & (!op0 & minus)       jmp (jlt)
  ;; !cycle & decode &  op2 &  op1 &   op0                halt
  (setf (bus-value *mcbus*) (if (zerop (op2))
                                (if (zerop (op1))
                                    (if (zerop (op0))
                                        store
                                        load)
                                    (if (zerop (op0))
                                        add
                                        sub))
                                (if (zerop (op1))
                                    (if (zerop (op0))
                                        jmp
                                        (if (zerop (zero))
                                            cycle
                                            jmp))
                                    (if (zerop (op0))
                                        (if (zerop (minus))
                                            cycle
                                            jmp)
                                        halt))))
  ;; !cycle & !decode                                 --> mcaddr
  (setf (bus-value *mcbus*) (register-value *mcaddr*)))

;; The ground signal is a dummy used by invalid signal codes in the microcode.
(define-signal ground
  (values))


(defun signal/demux ()
  "
The signal/demux implements the heart-beat of the processor,
fetching the next micro-code, and demultiplexing the signal number,
setting the corresponding signal to the specified state.
It loops until the halt register is set.
"
  (loop
    :for addr = (bus-value *mcbus*)
    :while (zerop (register-value *halt*))
    :do (c.read 1)
        (let ((signal (aref #(a.add a.read a.sub a.write1 a.write2 i.read i.reada i.write
                              m.read m.write p.incr p.reada p.write r.read r.write decode
                              cycle ground ground ground ground ground ground ground
                              ground ground ground ground ground ground ground s.halt)
                            (register-value *signal*)))
              (state-val (register-value *state*)))
          (format *trace-output* "ยต-code ~3D: ~8S <- ~A, next: ~D~%" addr signal state-val (bus-value *mcbus*))
          (funcall signal state-val))
        (c.read 0)))


(defun run (pgm &key print-microprogram trace)
  "
Initialize the *SIMPLE-MICROPROCESSOR* microprocessor with the program
PGM, and start it.  It runs until the HALT instruction  is executed.
Return: The vector of bytes in the memory.
"
  (setf (register-value *acc*)           0
        (register-value *pc*)            0
        (register-value *instruction*)   0
        (register-value *mcaddr*)        0
        (register-value *state*)         0
        (register-value *signal*)        0
        (register-value *arg1*)          0
        (register-value *arg2*)          0
        (register-value *result*)        0
        (bus-value *address*)            0
        (bus-value *data*)               0
        (bus-value *mcbus*)              0)
  (fill (memory-data *microcode*) 0)
  (multiple-value-bind (microcode labels size) (encode-microprogram *simple-microprocessor*)
    (load-microcode microcode labels)
    (when print-microprogram
      (print-microprogram microcode labels size)))
  (fill (memory-data *mem*) 0)
  (load-memory pgm)
  (let ((*trace-output* (if trace *trace-output* (make-broadcast-stream))))
    (s.halt 0)
    (decode 0)
    (cycle 1)
    (signal/demux))
  (memory-data *mem*))



;;; The processor Assembler.

(defparameter *codops* #(store load add sub jmp jeq jlt halt))

(defun codop (instruction)
  "Encode the operation code INSTRUCTION."
  (or (position instruction *codops*)
      (error "Invalid instruction ~A" *instruction*)))

(defun dis (code)
  "Disassemble the list CODE."
  (loop
        :for a :from 0
        :for i :in code
        :for op = (aref *codops* (ldb (byte 3 5) i))
        :for ad = (ldb (byte 5 0) i)
        :collect (list op ad)))

(defun lap (pgm)
  "Assemble the program PGM.
Returns the list of code bytes, the symbol table a-list and the length of code."
  (multiple-value-bind (labels size)
      (loop
        :with addr = 0
        :with labels = '()
        :for i :in pgm
        :do (cond
              ((symbolp i)         (push (cons i addr) labels))
              ((eql 'data (car i)) (incf addr (length (cdr i))))
              (t                   (incf addr)))
        :finally (return (values (nreverse labels) addr)))
    (loop
      :with addr = 0
      :with code = '()
      :for i :in pgm
      :do (unless (symbolp i)
            (if (eql 'data (car i))
                (loop :for byte :in (cdr i)
                      :do (push byte code)
                          (incf addr))
                (destructuring-bind (instruction argument) i
                  (let ((argval (or (if (integerp argument)
                                        argument
                                        (cdr (assoc argument labels)))
                                    (error "Invalid argument ~A in ~S at address ~A"
                                           argument i addr)))
                        (opcode (codop instruction)))
                    (push (dpb opcode (byte 3 5) argval) code)
                    (incf addr)))))
      :finally (return (values (nreverse code) labels size)))))


#-(and)
(progn

  (run (lap '(gcd ;; compute the gcd of a and b; result in a and in b
              (jmp start)
              a (data 70)
              b (data 77)
              start
              (load a)
              (sub b)
              (jeq end)
              (jlt suba) ;; a<b
              ;; a>b a:=a-b
              (store a)
              (jmp start)
              suba
              ;; a<b b:=b-a
              (load b)
              (sub a)
              (store b)
              (jmp start)
              end
              (halt 0)))
       :print-microprogram t
       :trace t)
  ;; The result should be:
  ;; #(131 7 7 33 98 173 201 1 131 34 97 2 131 224 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)

  (run (lap '((jmp start) ;; test subtraction.
              a (data 10)
              b (data 20)
              c (data 0)
              start
              (load a)
              (sub b)
              (store c)
              (halt 0))))
  ;; The result should be:
  ;; #(132 10 20 246 33 98 3 224 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)

  );;progn

;;;; THE END ;;;;
ViewGit