picolisp

commit 62cf9e7781068febe0f5bc6f9802af42a52e668d
parent 8615df6582adb8abdc9861022d449a5e7e12b148
Author: Alexander Burger <abu@software-lab.de>
Date:   Mon, 21 Mar 2011 16:36:36 +0100

Generalized SUBR handling
Diffstat:
M
doc64/asm
 | 
3
++-
M
src64/apply.l
 | 
6
+++---
M
src64/arch/x86-64.l
 | 
10
++++++----
M
src64/lib/asm.l
 | 
13
+++++++++----
M
src64/main.l
 | 
8
++++----

5 files changed, 24 insertions(+), 16 deletions(-)
diff --git a/doc64/asm b/doc64/asm
@@ -1,4 +1,4 @@
-# 05mar11abu
+# 21mar11abu
 # (c) Software Lab. Alexander Burger
 
 
@@ -72,6 +72,7 @@
       jmp 1234             # Absolute
       jmp Label
       jmp (R)              # Indexed
+      jmp (R T)            # Indexed SUBR
       jmp (Global)         # Indirect
 
 ========================================================================
diff --git a/src64/apply.l b/src64/apply.l
@@ -1,4 +1,4 @@
-# 03feb11abu
+# 21mar11abu
 # (c) Software Lab. Alexander Burger
 
 (code 'applyXYZ_E 0)
@@ -31,7 +31,7 @@
          ld E S  # Set 'exe'
          link
          ld (EnvApply) L  # Close apply frame
-         call (C)  # Eval SUBR
+         call (C T)  # Eval SUBR
          drop
          pop (EnvApply)
          ret
@@ -385,7 +385,7 @@
          ld E S  # Set 'exe'
          link
          ld (EnvApply) L  # Close apply frame
-         call (C)  # Eval SUBR
+         call (C T)  # Eval SUBR
          drop
          pop (EnvApply)
          ret
diff --git a/src64/arch/x86-64.l b/src64/arch/x86-64.l
@@ -1,4 +1,4 @@
-# 03mar11abu
+# 21mar11abu
 # (c) Software Lab. Alexander Burger
 
 # Byte order
@@ -508,7 +508,8 @@
 (asm call (Adr A)
    (nond
       (A (prinst "call" (target Adr)))
-      ((=T A) (prinst "call" (pack "*" Adr)))
+      ((=T A)  # Ignore SUBR
+         (prinst "call" (pack "*" Adr)) )
       (NIL
          (prinst "mov" (target Adr T) "%r10")
          (prinst "call" "*%r10") ) ) )
@@ -516,7 +517,8 @@
 (asm jmp (Adr A)
    (nond
       (A (prinst "jmp" (target Adr)))
-      ((=T A) (prinst "jmp" (pack "*" Adr)))
+      ((=T A)  # Ignore SUBR
+         (prinst "jmp" (pack "*" Adr)) )
       (NIL
          (prinst "mov" (target Adr T) "%r10")
          (prinst "jmp" "*%r10") ) ) )
@@ -525,7 +527,7 @@
    (ifn A
       (prinst Opc (target Adr))
       (prinst Opc2 "1f")
-      (ifn (=T A)
+      (ifn (=T A)  # Ignore SUBR
          (prinst "jmp" (pack "*" Adr))
          (prinst "mov" (target Adr T) "%r10")
          (prinst "jmp" "*%r10") )
diff --git a/src64/lib/asm.l b/src64/lib/asm.l
@@ -1,4 +1,4 @@
-# 03mar11abu
+# 21mar11abu
 # (c) Software Lab. Alexander Burger
 
 # *LittleEndian *Registers optimize
@@ -232,6 +232,7 @@
 #  0    -> Immediate
 #  NIL  -> Register
 #  T    -> Direct
+# (..)  -> Combined
 (de "source" (X F)
    (setq X (operand X))
    (cond
@@ -298,9 +299,10 @@
 
 
 # Target addressing mode:
-#  NIL -> Absolute
-#  0   -> Indexed
-#  T   -> Indirect
+#  NIL  -> Absolute
+#  0    -> Indexed
+# (0)   -> SUBR
+#  T    -> Indirect
 (de address ()
    (let X (read)
       (off "*Mode")
@@ -308,6 +310,9 @@
          ((num? X) (pack *Label "_" X))            # Label
          ((reg X) (quit "Bad address" X))          # Register
          ((atom X) X)                              # Absolute
+         ((and (=T (cadr X)) (reg (car X)))        # SUBR
+            (setq "*Mode" (0))
+            @ )
          ((cdr X) (quit "Bad address" X))
          ((reg (car X)) (zero "*Mode") @)          # Register indirect
          (T (on "*Mode") (car X)) ) ) )            # Indirect
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 03mar11abu
+# 21mar11abu
 # (c) Software Lab. Alexander Burger
 
 ### Global return labels ###
@@ -1273,7 +1273,7 @@
          end
          ld A (C)  # Get VAL
          cnt A  # Short number?
-         jnz (A)  # Yes: Eval SUBR
+         jnz (A T)  # Yes: Eval SUBR
          big A  # Undefined if bignum
          jnz undefinedCE
          cmp A (A)  # Auto-symbol?
@@ -1283,7 +1283,7 @@
             jz evExprCE_E  # No: Apply EXPR
          else
             call sharedLibC_FA  # Try dynamic load
-            jnz (A)  # Eval SUBR
+            jnz (A T)  # Eval SUBR
             jmp undefinedCE
          end
       loop
@@ -1296,7 +1296,7 @@
    ld C E
    pop E
    cnt C  # Short number?
-   jnz (C)  # Yes: Eval SUBR
+   jnz (C T)  # Yes: Eval SUBR
    big C  # Undefined if bignum
    jnz undefinedCE
    link