diff --git a/implementation/mini-meval.lisp b/implementation/mini-meval.lisp index 7263bda..3f90ab9 100644 --- a/implementation/mini-meval.lisp +++ b/implementation/mini-meval.lisp @@ -555,4 +555,4 @@ Mini-meval sera appellé sur des morceaux spécifiques du fichier source. Il fau (mini-meval '(block foo 1 2)) 2) -(provide 'mini-meval) \ No newline at end of file +(provide 'mini-meval) diff --git a/instructions.lisp b/instructions.lisp index 558f583..c04a6d1 100644 --- a/instructions.lisp +++ b/instructions.lisp @@ -6,7 +6,7 @@ ;; (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) +(defun make-vm (size &optional (debug nil)) (let* ((memory (make-array size :initial-element 0)) (registers `(;; Registres généraux. (R0 . 0) @@ -25,13 +25,16 @@ (EQ . nil) (PG . nil) ;; Quand HALT passe à t, on arrête la machine. - (HALT . nil))) + (HALT . nil) + ;; Sert uniquement pour le debug + (DEBUG . debug))) (actions `((get-memory . ,(lambda (index) (aref memory index))) (set-memory . ,(lambda (index value) (setf (aref memory index) value))) (get-register-list . ,(lambda () (mapcar #'car registers))) (get-register . ,(lambda (reg) (cdr (assoc reg registers)))) (set-register . ,(lambda (reg value) (setf (cdr (assoc reg registers)) value))) - (size-memory . ,(lambda () (length memory)))))) + (size-memory . ,(lambda () (length memory))) + (get-debug-mode . ,(lambda () (cdr (assoc 'DEBUG registers))))))) (lambda (message &rest params) (apply (cdr (assoc message actions)) params)))) @@ -44,6 +47,19 @@ (defun get-register (vm register) (send vm 'get-register register)) (defun set-register (vm register value) (send vm 'set-register register value)) (defun size-memory (vm) (send vm 'size-memory)) +(defun get-debug-mode (vm) (send vm 'get-debug-mode)) + + +;; TODO : Reste a ajouter la resolution d'etiquette +(defun load-asm (asm &optional (stack-size 100) (debug nil)) + (let ((vm (make-vm (+ (length asm) stack-size) debug)) + (size-vm (+ (length asm) stack-size))) + (labels ((load-asm-rec (vm index asm debug) + (if (endp asm) + vm + (progn (set-memory vm index (car asm)) + (load-asm-rec vm (- index 1) (cdr asm) debug))))) + (load-asm-rec vm (- size-vm 1) asm debug)))) ;;TODO : Rajouter une fonction resolve pour resoudre les differents modes d'adresssage. ;; TODO : Penser a ajouter une table des opcodes @@ -105,7 +121,6 @@ (position1 valeur-2 (get-register-list (make-vm 1))) valeur-2)))) -;;TODO : Faire les registres (defun dump-vm (vm) (dotimes (i (size-memory vm)) (let ((val (get-memory vm i))) @@ -267,4 +282,4 @@ (get-memory vm (get-register vm 'SP))) t-r1-value) -(provide 'instructions) \ No newline at end of file +(provide 'instructions) diff --git a/test-unitaire.lisp b/test-unitaire.lisp index 8a65e4c..5f435ed 100644 --- a/test-unitaire.lisp +++ b/test-unitaire.lisp @@ -188,4 +188,4 @@ ;; (run-tests t) ;; (run-tests) -(provide 'test-unitaire) \ No newline at end of file +(provide 'test-unitaire)