diff --git a/instructions.lisp b/instructions.lisp index 1d6673d..3615a7e 100644 --- a/instructions.lisp +++ b/instructions.lisp @@ -63,14 +63,15 @@ (defun position1 (x l) (+ 1 (position x l))) -(defun split-bytes (n nb-bytes append) - "Découpe N en plusieurs valeurs inférieures à 256, -en renvoyant une liste de longueur NB-BYTES, -et termine par la liste APPEND." - (if (<= nb-bytes 0) - append - (cons (ldb (byte 8 (* 8 (- nb-bytes 1))) n) - (split-bytes n (- nb-bytes 1) append)))) +;; TODO : faire une fonction (append-bits n1 size2 n2 size3 n3 ... sizen nn) + +(defun append-bits (&optional (n1 0) &rest rest) + (if (endp rest) + n1 + (apply #'append-bits + (logior (ash n1 (car rest)) + (cadr rest)) + (cddr rest)))) (defvar nb-operateurs (length table-operateurs)) (defvar nb-modes-adressage (length table-modes-adressage)) @@ -88,25 +89,21 @@ et termine par la liste APPEND." ;; '(operateur mode-adressage-1 valeur-1 mode-adressage-2 valeur-2) ;; Si l'instruction ne prend qu'un (ou zéro) paramètre, les champs ;; correspondants sont mis à nil. -;; TODO : encoder en entier les registres de valeur-1 et valeur-2. + (defun isn-encode (instruction) - (let ((operateur (first instruction)) - (mode-adressage-1 (second instruction)) - (valeur-1 (third instruction)) - (mode-adressage-2 (fourth instruction)) - (valeur-2 (fifth instruction))) - (let* ((opcode (position1 operateur table-operateurs)) - (opcode (ash opcode nb-modes-adressage)) - (opcode (logior opcode (position1 mode-adressage-1 table-modes-adressage))) - (opcode (ash opcode nb-modes-adressage)) - (opcode (logior opcode (position1 mode-adressage-2 table-modes-adressage)))) - (split-bytes opcode nb-opcode-bytes - (list (if (eq mode-adressage-1 'registre) - (position1 valeur-1 (get-register-list (make-vm 1))) - valeur-1) - (if (eq mode-adressage-2 'registre) - (position1 valeur-2 (get-register-list (make-vm 1))) - valeur-2)))))) + (loop + for (operateur mode-adressage-1 valeur-1 mode-adressage-2 valeur-2) = instruction + return (list (append-bits (position1 operateur table-operateurs) + nb-modes-adressage + (position1 mode-adressage-1 table-modes-adressage) + nb-modes-adressage + (position1 mode-adressage-2 table-modes-adressage)) + (if (eq mode-adressage-1 'registre) + (position1 valeur-1 (get-register-list (make-vm 1))) + valeur-1) + (if (eq mode-adressage-2 'registre) + (position1 valeur-2 (get-register-list (make-vm 1))) + valeur-2)))) ;;TODO : Faire les registres (defun dump-vm (vm) diff --git a/lisp2li.lisp b/lisp2li.lisp index 6822aec..b1fa498 100644 --- a/lisp2li.lisp +++ b/lisp2li.lisp @@ -1,4 +1,5 @@ (load "util.lisp") + ;; ` (defvar my-quasiquote (car '`(,a))) diff --git a/util.lisp b/util.lisp index 3b631e1..d1ca2b1 100644 --- a/util.lisp +++ b/util.lisp @@ -76,14 +76,16 @@ (propper-list-p (cdr l))))) (defun m-macroexpand-1 (macro) + ;; TODO : not implemented yet m-macroexpand-1 + macro ;; Pour éviter le unused variable. ()) (defmacro get-defun (symb) `(get ,symb :defun)) (defun set-defun (symb expr) - (setf (get-defun (cdaddr li)) - (cdddr li))) + (setf (get-defun symb) + expr)) (defmacro get-defmacro (symb) `(get ,symb :defmacro))