picolisp

commit 359fdb518a25418f6f795f3f12dbaeb13afac2a9
parent 9bf80eaef1de2067e4f10228d659a1a1ebca9c61
Author: Alexander Burger <abu@software-lab.de>
Date:   Thu, 19 Jan 2012 15:56:31 +0100

Generalized condition code optimizations
Diffstat:
M
src64/arch/ppc64.l
 | 
49
+------------------------------------------------
M
src64/lib/asm.l
 | 
52
++++++++++++++++++++++++++++++++++++++++++++++++++--

2 files changed, 51 insertions(+), 50 deletions(-)
diff --git a/src64/arch/ppc64.l b/src64/arch/ppc64.l
@@ -1,4 +1,4 @@
-# 29apr11abu
+# 19jan12abu
 # (c) Software Lab. Alexander Burger
 
 # Byte order
@@ -121,20 +121,6 @@
       (prinst "bl" "callRel")
       (prinst ".int" (pack Sym "-.")) ) )
 
-# Optimize
-(de asmNoCC Args
-   (let Sym (intern (pack (car Args) "-"))
-      (put (car Args) 'noCC Sym)
-      (def Sym 'asm (cdr Args)) ) )
-
-(de useCC Lst
-   (for Sym Lst
-      (put Sym 'useCC T) ) )
-
-(de chgCC Lst
-   (for Sym Lst
-      (put Sym 'chgCC T) ) )
-
 # Addressing modes
 (de checkOp (Fun)
    (unless (Fun Op)
@@ -1568,42 +1554,9 @@
    (prinst "add" 18 4 3) )
 
 ### Optimizer ###
-(useCC
-   ldc ldnc ldz ldnz
-   addc subc rcl rcr
-   jz jeq jnz jne js jns jsz jnsz jc jlt jnc jge jcz jle jncz jgt )
-
-(chgCC
-   movn mset movm save load
-   add sub inc dec not neg and or xor off test shl shr rol ror
-   mul div zxt setz clrz
-   cmp cmp4 cmpn slen memb null nul4 nul cnt big num sym atom
-   call cc return
-   eval eval+ eval/ret exec prog )
-
-
 # Replace the the next 'cnt' elements with 'lst'
 (de optimize (Lst)  #> (cnt . lst)
    (when (noCC L)
       (cons 1 (cons (cons @ (cdar L)))) ) )
 
-(de noCC (Lst)
-   (with (caar Lst)
-      (and
-         (: noCC)
-         (loop
-            (NIL (setq Lst (cdr Lst)))
-            (T (get Lst 1 1 'useCC))
-            (T (get Lst 1 1 'chgCC) T)
-            (T (= '(push T NIL) (car Lst)))
-            (T (= '(pop T NIL) (car Lst)) T)
-            (T (== 'ret (caar Lst))
-               (use (@A @B @Z)
-                  (not (match '(@A "_" @B "F" @Z) (chop *Label))) ) )
-            (T
-               (and
-                  (== 'jmp (caar Lst))
-                  (not (setq Lst (member (cons ': (cadar Lst)) *Program))) ) ) )
-         (: noCC) ) ) )
-
 # vi:et:ts=3:sw=3
diff --git a/src64/lib/asm.l b/src64/lib/asm.l
@@ -1,4 +1,4 @@
-# 27dec11abu
+# 19jan12abu
 # (c) Software Lab. Alexander Burger
 
 # *LittleEndian *AlignedCode *Registers optimize
@@ -214,7 +214,6 @@
                               (cdr *Conditions) ) )
                         (cadr (pop '*Program)) ) ) ) ) ) ) ) )
 
-
 # Print instruction
 (de prinst (Name . @)
    (if (rest)
@@ -582,6 +581,55 @@
    (while Name
       (prinst ".byte" (glue ", " (cut 8 'Name))) ) )
 
+
+# Condition code optimizations
+(de asmNoCC Args
+   (let Sym (intern (pack (car Args) "-"))
+      (put (car Args) 'noCC Sym)
+      (def Sym 'asm (cdr Args)) ) )
+
+(de useCC Lst
+   (for Sym Lst
+      (put Sym 'useCC T) ) )
+
+(de chgCC Lst
+   (for Sym Lst
+      (put Sym 'chgCC T) ) )
+
+(useCC
+   ldc ldnc ldz ldnz
+   addc subc rcl rcr
+   jz jeq jnz jne js jns jsz jnsz jc jlt jnc jge jcz jle jncz jgt )
+
+(chgCC
+   movn mset movm save load
+   add sub inc dec not neg and or xor off test shl shr rol ror
+   mul div zxt setz clrz
+   cmp cmp4 cmpn slen memb null nul4 nul cnt big num sym atom
+   call cc return
+   eval eval+ eval/ret exec prog )
+
+(de noCC (Lst)
+   (with (caar Lst)
+      (and
+         (: noCC)
+         (loop
+            (NIL (setq Lst (cdr Lst)))
+            (T (get Lst 1 1 'useCC))
+            (T (get Lst 1 1 'chgCC) T)
+            (T (= '(push T NIL) (car Lst)))
+            (T (= '(pop T NIL) (car Lst)) T)
+            (T (== 'ret (caar Lst))
+               (use (@A @B @Z)
+                  (not (match '(@A "_" @B "F" @Z) (chop *Label))) ) )
+            (T
+               (and
+                  (== 'jmp (caar Lst))
+                  (not (setq Lst (member (cons ': (cadar Lst)) *Program))) ) ) )
+         (: noCC) ) ) )
+
+
+# Warning message
 (de warn (Msg)
    (out 2
       (printsp *Label *Statement)