From cab9589f06a4bf012c056c52d630787ff641d030 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Sat, 4 Dec 2010 13:00:52 +0100 Subject: [PATCH] Travail avec Yoann : Corrections dans squash et ajout de la compilation du if. --- implementation/compilation.lisp | 15 +++++++++ implementation/squash-lisp.lisp | 54 ++++++++++++++++++--------------- 2 files changed, 45 insertions(+), 24 deletions(-) diff --git a/implementation/compilation.lisp b/implementation/compilation.lisp index 3f8fa82..8a80732 100644 --- a/implementation/compilation.lisp +++ b/implementation/compilation.lisp @@ -101,6 +101,21 @@ (asm-once 'code "main" (mapcar #'my-compile-1 body))) + +;; if +((if :condition _ :si-vrai _ :si-faux _) + (let ((else-label (gen-label "else")) + (end-if-label (gen-label "end-if"))) + (compile condition) + (fasm "cmp r0 @nil") + (fasm "jeq @~a" else-label) + (compile si-vrai) + (fasm "jmp @~a" end-if-label) + (fasm "label @~a" else-label) + (compile si-faux) + (fasm "label @~a" end-if-label))) + + ;;; Exemples (my-compile '(1 2 3)) diff --git a/implementation/squash-lisp.lisp b/implementation/squash-lisp.lisp index 0b70973..b226407 100644 --- a/implementation/squash-lisp.lisp +++ b/implementation/squash-lisp.lisp @@ -1,5 +1,7 @@ (require 'mini-meval "implementation/mini-meval") +;; TODO : emballer le résultat de squash-lisp dans un (macrolet ...) pour les "special-operator" qu'on rajoute. + ;; TODO !!! ;; TODO !!! Utiliser une pile descendante (donc adapter les calculs pour unwind), sinon on n'aura pas la compatibilité x86 ;; TODO !!! @@ -57,8 +59,11 @@ push @catch-code push r0 push @marker-unwind-destination [compile body] -jmp @after-catch-code ;; seulement si catch-code est présent -@catch-code ;; seulement si catch-code est présent +pop r2 +pop r2 +pop r2 +jmp @after-catch-code +@catch-code [compile catch-code] ;; seulement si catch-code est présent @after-catch-code ;; seulement si catch-code est présent @@ -66,6 +71,8 @@ De plus, un (unwind-protect body protect-code) est compilé ainsi : push @protect-code push @marker-unwind-protect [compile body] +pop r2 +pop r2 jmp @after-protect-code @protect-code [compile protect-code] @@ -74,8 +81,8 @@ jmp @start-unwind (half-unwind object post-unwind-code) est compilé ainsi : jsr @find-unwind-destination -push @post-unwind-code ;; On "push" after-unwind-code comme cible au lieu de l'ancienne. -add 2 sp ;; On "re-push" l'objet et le marqueur, mettre 1 si on n'a pas de marqueur. +mov [immediate]@post-unwind-code @singleton-post-unwind-code +add 3 sp ;; On "re-push" l'adresse de la cible, l'objet et le marqueur, mettre 2 au lieu de 3 si on n'a pas de marqueur. mov sp @singleton-unwind-destination mov r1 sp ;; On remonte en haut de la pile jmp @start-unwind @@ -85,7 +92,6 @@ halt ;; Sinon, on quite "brutalement" Et enfin, (unwind object) est compilé ainsi : [compile object] -push r0 jsr @find-unwind-destination mov sp @singleton-unwind-destination mov r1 sp ;; On remonte en haut de la pile @@ -95,39 +101,42 @@ Et une fonction (lambda nb-let-vars body) est compilée ainsi => push ip; jmp @function @function -mov sp r0 ;; begin-frame : Va avec le marker-end-frame +mov sp, r0 ;; begin-frame : Va avec le marker-end-frame push bp mov sp, bp ;; sp -> bp -add sp, [nb-let-vars] +add [nb-let-vars], sp push r0 ;; Permet à unwind de sauter directement jusqu'au begin-frame. push @marker-end-frame ;; On peut l'ommetre pour accélérer les appels de fonction et/ou ;; quand il n'y a pas de marker-unwind-* à la suite. ;; IMPORTANT : effacer tout le segment de pile _SI_ on n'utilise pas begin/end-frame ;; (car sinon il peut y avoir des destinations / protect d'unwind qui traînent encore). [body] -sub sp, [nb-let-vars] +sub sp, [nb-let-vars + 2] ;; ERREUR ! pop bp Les "fonctions" find-unwind-destination et start-unwind : +db 0 ;; 0 = (type-number placeholder) ;; devrait être autre chose, pointeur par ex @singleton-unwind-destination -db 0 ;; 0 = (type-number placeholder) -db 0 ;; Toujours au moins deux octets. +db4 0 +db 0 ;; 0 = (type-number placeholder) ;; devrait être autre chose, pointeur par ex +@singleton-post-unwind-code +db4 0 @marker-unwind-destination db 0 -db 0 +db 0 ;; Toujours au moins deux octets (ou au moins 5 ? j'ai oublié…). @marker-unwind-protect db 0 -db 0 +db 0 ;; Toujours au moins deux octets (ou au moins 5 ? j'ai oublié…). @marker-end-frame db 0 -db 0 +db 0 ;; Toujours au moins deux octets (ou au moins 5 ? j'ai oublié…). ;; fud == find-unwind-destination @find-unwind-destination mov sp r1 @fud-loop -cmp sp 3 ;; Ne pas passer en-dessous de 0. +cmp sp 2 ;; ??? ;; Ne pas passer en-dessous de 0. jpe @unwind-not-found-error ;; Ne pas passer en-dessous de 0. pop r2 cmp r2 @marker-end-frame @@ -142,6 +151,7 @@ jne @fud-loop ;; fud-found cmp r2 @nil ;; Cible désactivée ? jeq @fud-loop +mov r2 @singleton-post-unwind-code ret @fud-skip-frame @@ -151,31 +161,27 @@ jmp @fud-loop @unwind-not-found-error ;; error : cant unwind to this object, the return point doesn't exist anymore. +;; TODO : mettre un code d'erreur dans r2 halt @start-unwind -;; TODO ;; su == start-unwind @su-loop -cmp sp @singleton-unwind-destination -jeq @su-stop +cmp sp *@singleton-unwind-destination +jeq *@singleton-post-unwind-code ;; Fin de l'unwind, tout le monde descend ! pop r0 cmp r0 @marker-end-frame -jeq @fud-skip-frame +jeq @su-skip-frame cmp r0 @marker-unwind-protect jne @su-loop pop r0 -jmp *r0 +jmp r0 @su-skip-frame pop r0 mov r0 sp jmp @su-loop -@su-stop -pop r0 -jmp *r0 - On a donc une pile de cette forme (les vieilles données sont en haut) : ** [old bp] ;; adresse = 987 == BP == @@ -193,8 +199,8 @@ On a donc une pile de cette forme (les vieilles données sont en haut) : ** [unwind-protect] [protect-code à l'adresse 3333] ** [unwind-protect] - [objet] [code unwind-catch à l'adresse 4444] + [objet] ** [unwind-catch] [protect-code à l'adresse 5555] ** [unwind-protect]