Possibilité d'avoir plusieurs VM qui s'exécutent tour à tour + nettoyage.
This commit is contained in:
Georges Dupéron
parent
be4c1636b7
commit
6e55560dfd
|
|
@ -1,128 +1,118 @@
|
||||||
|
;; "objet" VM.
|
||||||
|
;; Instanciation :
|
||||||
|
;; (defvar vm (make-vm 100))
|
||||||
|
;; Appels de méthode :
|
||||||
|
;; (send vm get-memory 42)
|
||||||
|
;; (send vm set-memory 42 5)
|
||||||
|
;; (send vm get-register R1)
|
||||||
|
;; (send vm set-register R2 (send vm get-register 42))
|
||||||
|
(defun make-vm (size)
|
||||||
|
(let* ((memory (make-array size :initial-element 0))
|
||||||
|
(registres `(;; Registres généraux.
|
||||||
|
(R0 . 0)
|
||||||
|
(R1 . 0)
|
||||||
|
(R2 . 0)
|
||||||
|
;; Base de la pile.
|
||||||
|
(BP . 0)
|
||||||
|
;; Sommet de la pile.
|
||||||
|
(SP . 0)
|
||||||
|
;; Pointeur de code : fin de la mémoire.
|
||||||
|
(PC . ,(- size 1))
|
||||||
|
;; registres booléens = faux (nil).
|
||||||
|
(PP . nil)
|
||||||
|
(EQ . nil)
|
||||||
|
(PG . nil)
|
||||||
|
;; Quand HALT passe à t, on arrête la machine.
|
||||||
|
(HALT . nil)))
|
||||||
|
(actions `((get-memory . ,(lambda (index) (aref memory index)))
|
||||||
|
(set-memory . ,(lambda (index value) (setf (aref memeory index) value)))
|
||||||
|
(get-register . ,(lambda (reg) (cdr (assoc reg registres))))
|
||||||
|
(set-register . ,(lambda (reg) (setf (cdr (get-register reg))))))))
|
||||||
|
(lambda (message &rest params)
|
||||||
|
(apply (assoc message actions) params))))
|
||||||
|
|
||||||
;; TODO : Penser a cree une fonction qui initialise un tableau en fonction d'un parametre.
|
(defun send (obj &rest params)
|
||||||
(setq memory (make-array 100))
|
(apply obj params))
|
||||||
|
|
||||||
(defun getValueInMemory (index)
|
(defun get-memory (vm index) (send vm get-memory index))
|
||||||
(aref memory index))
|
(defun set-memory (vm index value) (send vm get-memory index value))
|
||||||
|
(defun get-register (vm register) (send vm get-register register))
|
||||||
|
(defun set-register (vm register value) (send vm set-register register value))
|
||||||
|
|
||||||
(defun setValueInMemory (index value)
|
(defun LOAD (vm address register)
|
||||||
(setf (aref memory index) value))
|
(set-register vm register (get-memory vm address)))
|
||||||
|
|
||||||
|
(defun STORE (vm register address)
|
||||||
|
(set-memory vm address (get-register vm register)))
|
||||||
|
|
||||||
;;On initialise les registres a rien (peut etre faut il mettre 0 ?)
|
(defun MOVE (vm reg1 reg2)
|
||||||
(setf R0 nil)
|
(set-register vm reg2 (get-register vm reg1)))
|
||||||
(setf R1 nil)
|
|
||||||
(setf R2 nil)
|
|
||||||
|
|
||||||
;; On initialise le registre de pointeur de base a l'indice 0 du tableau memory
|
(defun _OP_ (vm op reg1 reg2)
|
||||||
(setf BP 0)
|
(set-register vm reg2 (funcall op
|
||||||
;; On initialise le registre de pointeur de pile a la valeur du pointeur de base
|
(get-register vm reg2)
|
||||||
(setf SP BP)
|
(get-register vm reg1))))
|
||||||
;; On initialise le registre du compteur ordinale a la taille du tableau - 1
|
|
||||||
;; TODO : Recupere la taille du tableau dynamiquement.
|
|
||||||
(setf PC 99)
|
|
||||||
|
|
||||||
;; On initialise les registres booleen a faux (nil)
|
(defun ADD (vm reg1 reg2) (_OP_ vm #'+ reg1 reg2))
|
||||||
(setf PP nil)
|
(defun SUB (vm reg1 reg2) (_OP_ vm #'- reg1 reg2))
|
||||||
(setf EQ nil)
|
(defun MULT (vm reg1 reg2) (_OP_ vm #'* reg1 reg2))
|
||||||
(setf PG nil)
|
(defun DIV (vm reg1 reg2) (_OP_ vm #'/ reg1 reg2))
|
||||||
|
|
||||||
(defun LOAD (address register)
|
(defun INCR (vm register)
|
||||||
(setf register (getValueInMemory address)))
|
(set-register vm register (+ (get-register vm register) 1)))
|
||||||
|
|
||||||
(defun STORE (register address)
|
(defun DECR (vm register)
|
||||||
(setValueInMemory address register))
|
(set-register vm register (- (get-register vm register) 1)))
|
||||||
|
|
||||||
;; TODO : Remplir la fonction MOVE
|
(defun PUSH (vm register)
|
||||||
(defun MOVE (reg1 reg2)
|
(INCR vm 'SP)
|
||||||
)
|
(STORE vm register (get-register vm 'SP)))
|
||||||
|
|
||||||
(defun ADD (reg1 reg2)
|
(defun POP (vm register)
|
||||||
(setf reg2 (+ reg2 reg1)))
|
(LOAD vm (get-register vm 'SP) register)
|
||||||
|
(DECR vm 'SP))
|
||||||
|
|
||||||
(defun SUB (reg1 reg2)
|
(defun JMP (vm dst)
|
||||||
(setf reg2 (- reg2 reg1)))
|
(set-register vm 'PC dst))
|
||||||
|
|
||||||
(defun MULT (reg1 reg2)
|
(defun JSR (vm dst)
|
||||||
(setf reg2 (* reg2 reg1)))
|
(PUSH vm 'PC)
|
||||||
|
(JMP vm dst))
|
||||||
(defun DIV (reg1 reg2)
|
|
||||||
(setf reg2 (/ reg2 reg1)))
|
|
||||||
|
|
||||||
(defun INCR (register)
|
|
||||||
(setf register (+ register 1)))
|
|
||||||
|
|
||||||
(defun DECR (register)
|
|
||||||
(setf register (- register 1)))
|
|
||||||
|
|
||||||
(defun PUSH (register)
|
|
||||||
(progn (INCR SP)
|
|
||||||
(STORE register SP)))
|
|
||||||
|
|
||||||
(defun POP (register)
|
|
||||||
(progn (LOAD SP register)
|
|
||||||
(DECR SP)))
|
|
||||||
|
|
||||||
;; TODO : Remplir la fonction JMP
|
|
||||||
(defun JMP (dst)
|
|
||||||
)
|
|
||||||
|
|
||||||
;; TODO : Remplir la fonction JSR
|
|
||||||
(defun JSR (dst)
|
|
||||||
)
|
|
||||||
|
|
||||||
;; TODO : Remplir la fonction RTN
|
;; TODO : Remplir la fonction RTN
|
||||||
(defun RTN ()
|
(defun RTN (vm)
|
||||||
)
|
(POP vm 'PC))
|
||||||
|
|
||||||
(defun CMP (reg1 reg2)
|
(defun CMP (vm reg1 reg2)
|
||||||
(cond ((= (getValueInMemory reg1) (getValueInMemory reg2))
|
(set-register vm 'EQ (= (get-register vm reg1) (get-register vm reg2)))
|
||||||
(progn (setf EQ T)
|
(set-register vm 'PP (< (get-register vm reg1) (get-register vm reg2)))
|
||||||
(setf PP nil)
|
(set-register vm 'PG (> (get-register vm reg1) (get-register vm reg2))))
|
||||||
(setf PG nil)))
|
|
||||||
((< (getValueInMemory reg1) (getValueInMemory reg2))
|
|
||||||
(progn (setf EQ nil)
|
|
||||||
(setf PP T)
|
|
||||||
(setf PG nil)))
|
|
||||||
(T
|
|
||||||
(progn (setf EQ nil)
|
|
||||||
(setf PP nil)
|
|
||||||
(setf PG T)))))
|
|
||||||
|
|
||||||
(defun JEQ (label)
|
(defun _JCOND_ (vm pp eq pg vm dst)
|
||||||
(if EQ
|
(if (or (and eq (get-register vm 'EQ))
|
||||||
(JMP label))
|
(and pg (get-register vm 'PG))
|
||||||
)
|
(and pp (get-register vm 'PP)))
|
||||||
|
(JMP vm dst)))
|
||||||
|
|
||||||
(defun JPG (label)
|
(defun JEQ (vm dst)
|
||||||
(if PG
|
(_JCOND_ vm nil t nil vm dst))
|
||||||
(JMP label))
|
|
||||||
)
|
|
||||||
|
|
||||||
(defun JPP (label)
|
(defun JPG (vm dst)
|
||||||
(if PP
|
(_JCOND_ vm nil nil t vm dst))
|
||||||
(JMP label))
|
|
||||||
)
|
|
||||||
|
|
||||||
(defun JPE (label)
|
(defun JPP (vm dst)
|
||||||
(if (or PP EQ)
|
(_JCOND_ vm t nil nil vm dst))
|
||||||
(JMP label))
|
|
||||||
)
|
|
||||||
|
|
||||||
(defun JGE (label)
|
(defun JPE (vm dst)
|
||||||
(if (or PG EQ)
|
(_JCOND_ vm t t nil vm dst))
|
||||||
(JMP label))
|
|
||||||
)
|
|
||||||
|
|
||||||
(defun JNE (label)
|
(defun JPE (vm dst)
|
||||||
(if (not EQ)
|
(_JCOND_ vm nil t t vm dst))
|
||||||
(JMP label))
|
|
||||||
)
|
|
||||||
|
|
||||||
;; TODO : Remplir la fonction NOP
|
(defun JNE (vm dst)
|
||||||
(defun NOP ()
|
(_JCOND_ vm t nil t vm dst))
|
||||||
)
|
|
||||||
|
|
||||||
;; TODO : Remplir la fonction HALT
|
(defun NOP (vm))
|
||||||
(defun HALT ()
|
|
||||||
)
|
(defun HALT (vm)
|
||||||
|
(set-register vm 'HALT t))
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user