commit 6e55560dfd25a8c113e940044b55d51cc473b3b8
parent be4c1636b7998ebbabf5f5876065e5c8013baf77
Author: Georges Dupéron <jahvascriptmaniac+github@free.fr>
Date: Fri, 15 Oct 2010 22:22:50 +0200
Possibilité d'avoir plusieurs VM qui s'exécutent tour à tour + nettoyage.
Diffstat:
| M | VM/instruction.lisp | | | 224 | ++++++++++++++++++++++++++++++++++++++----------------------------------------- |
1 file changed, 107 insertions(+), 117 deletions(-)
diff --git a/VM/instruction.lisp b/VM/instruction.lisp
@@ -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))))
+
+(defun send (obj &rest params)
+ (apply obj params))
+
+(defun get-memory (vm index) (send vm get-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 LOAD (vm address register)
+ (set-register vm register (get-memory vm address)))
+
+(defun STORE (vm register address)
+ (set-memory vm address (get-register vm register)))
+
+(defun MOVE (vm reg1 reg2)
+ (set-register vm reg2 (get-register vm reg1)))
+
+(defun _OP_ (vm op reg1 reg2)
+ (set-register vm reg2 (funcall op
+ (get-register vm reg2)
+ (get-register vm reg1))))
+
+(defun ADD (vm reg1 reg2) (_OP_ vm #'+ reg1 reg2))
+(defun SUB (vm reg1 reg2) (_OP_ vm #'- reg1 reg2))
+(defun MULT (vm reg1 reg2) (_OP_ vm #'* reg1 reg2))
+(defun DIV (vm reg1 reg2) (_OP_ vm #'/ reg1 reg2))
+
+(defun INCR (vm register)
+ (set-register vm register (+ (get-register vm register) 1)))
+
+(defun DECR (vm register)
+ (set-register vm register (- (get-register vm register) 1)))
+
+(defun PUSH (vm register)
+ (INCR vm 'SP)
+ (STORE vm register (get-register vm 'SP)))
+
+(defun POP (vm register)
+ (LOAD vm (get-register vm 'SP) register)
+ (DECR vm 'SP))
+
+(defun JMP (vm dst)
+ (set-register vm 'PC dst))
+
+(defun JSR (vm dst)
+ (PUSH vm 'PC)
+ (JMP vm dst))
-;; TODO : Penser a cree une fonction qui initialise un tableau en fonction d'un parametre.
-(setq memory (make-array 100))
-
-(defun getValueInMemory (index)
- (aref memory index))
-
-(defun setValueInMemory (index value)
- (setf (aref memory index) value))
-
-
-;;On initialise les registres a rien (peut etre faut il mettre 0 ?)
-(setf R0 nil)
-(setf R1 nil)
-(setf R2 nil)
-
-;; On initialise le registre de pointeur de base a l'indice 0 du tableau memory
-(setf BP 0)
-;; On initialise le registre de pointeur de pile a la valeur du pointeur de base
-(setf SP BP)
-;; 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)
-(setf PP nil)
-(setf EQ nil)
-(setf PG nil)
-
-(defun LOAD (address register)
- (setf register (getValueInMemory address)))
-
-(defun STORE (register address)
- (setValueInMemory address register))
-
-;; TODO : Remplir la fonction MOVE
-(defun MOVE (reg1 reg2)
- )
-
-(defun ADD (reg1 reg2)
- (setf reg2 (+ reg2 reg1)))
+;; TODO : Remplir la fonction RTN
+(defun RTN (vm)
+ (POP vm 'PC))
-(defun SUB (reg1 reg2)
- (setf reg2 (- reg2 reg1)))
+(defun CMP (vm reg1 reg2)
+ (set-register vm 'EQ (= (get-register vm reg1) (get-register vm reg2)))
+ (set-register vm 'PP (< (get-register vm reg1) (get-register vm reg2)))
+ (set-register vm 'PG (> (get-register vm reg1) (get-register vm reg2))))
-(defun MULT (reg1 reg2)
- (setf reg2 (* reg2 reg1)))
+(defun _JCOND_ (vm pp eq pg vm dst)
+ (if (or (and eq (get-register vm 'EQ))
+ (and pg (get-register vm 'PG))
+ (and pp (get-register vm 'PP)))
+ (JMP vm dst)))
-(defun DIV (reg1 reg2)
- (setf reg2 (/ reg2 reg1)))
+(defun JEQ (vm dst)
+ (_JCOND_ vm nil t nil vm dst))
-(defun INCR (register)
- (setf register (+ register 1)))
+(defun JPG (vm dst)
+ (_JCOND_ vm nil nil t vm dst))
-(defun DECR (register)
- (setf register (- register 1)))
+(defun JPP (vm dst)
+ (_JCOND_ vm t nil nil vm dst))
-(defun PUSH (register)
- (progn (INCR SP)
- (STORE register SP)))
+(defun JPE (vm dst)
+ (_JCOND_ vm t t nil vm dst))
-(defun POP (register)
- (progn (LOAD SP register)
- (DECR SP)))
+(defun JPE (vm dst)
+ (_JCOND_ vm nil t t vm dst))
-;; TODO : Remplir la fonction JMP
-(defun JMP (dst)
- )
+(defun JNE (vm dst)
+ (_JCOND_ vm t nil t vm dst))
-;; TODO : Remplir la fonction JSR
-(defun JSR (dst)
- )
+(defun NOP (vm))
-;; TODO : Remplir la fonction RTN
-(defun RTN ()
- )
-
-(defun CMP (reg1 reg2)
- (cond ((= (getValueInMemory reg1) (getValueInMemory reg2))
- (progn (setf EQ T)
- (setf PP nil)
- (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)
- (if EQ
- (JMP label))
- )
-
-(defun JPG (label)
- (if PG
- (JMP label))
- )
-
-(defun JPP (label)
- (if PP
- (JMP label))
- )
-
-(defun JPE (label)
- (if (or PP EQ)
- (JMP label))
- )
-
-(defun JGE (label)
- (if (or PG EQ)
- (JMP label))
- )
-
-(defun JNE (label)
- (if (not EQ)
- (JMP label))
- )
-
-;; TODO : Remplir la fonction NOP
-(defun NOP ()
- )
-
-;; TODO : Remplir la fonction HALT
-(defun HALT ()
- )
+(defun HALT (vm)
+ (set-register vm 'HALT t))
