allocation overflow check sequence is a little tighter now.

scheme/ikarus.compiler.altcogen.ss

@@ -406,15 +406,15 @@
             (do-bind (list t) (list x)
               (k t)))]
          [else (error who "invalid S" x)])]))
-  ;(define (Mem x k) 
+  (define (Mem x k) 
-  ;  (struct-case x 
+    (struct-case x 
-  ;    [(primcall op arg*) 
+      [(primcall op arg*) 
-  ;     (if (eq? op 'mref)
+       (if (eq? op 'mref)
-  ;         (S* arg*
+           (S* arg*
-  ;            (lambda (arg*)
+              (lambda (arg*)
-  ;               (make-disp (car arg*) (cadr arg*))))
+                 (k (make-disp (car arg*) (cadr arg*)))))
-  ;         (S x k))]
+           (S x k))]
-  ;    [else (S x k)]))
+      [else (S x k)]))
   ;;;
   (define (do-bind lhs* rhs* body)
     (cond
@@ -485,15 +485,25 @@
   ;;;              (make-constant (- disp-symbol-record-proc symbol-ptag))))
   ;;;          (list size)))))
   (define (alloc-check size)
+    (define (test size)
+      (if (struct-case size 
+             [(constant i) (<= i 4096)]
+             [else #f])
+          (make-primcall '<= 
+             (list 
+               apr
+               (make-primcall 'mref 
+                 (list pcr (make-constant pcb-allocation-redline)))))
+          (make-primcall '>= 
+            (list (make-primcall 'int- 
+                     (list 
+                       (make-primcall 'mref 
+                         (list pcr (make-constant pcb-allocation-redline))) 
+                       apr))
+                  size))))
     (E (make-shortcut
          (make-conditional ;;; PCB ALLOC-REDLINE
-           (make-primcall '>= 
+           (test size)
-             (list (make-primcall 'int- 
-                      (list 
-                        (make-primcall 'mref 
-                          (list pcr (make-constant pcb-allocation-redline))) 
-                        apr))
-                   size))
            (make-primcall 'nop '())
            (make-primcall 'interrupt '()))
          (make-funcall 
@@ -666,15 +676,26 @@
             (let ([t (unique-var 'tmp)])
               (P (make-bind (list t) (list a)
                     (make-primcall op (list t b)))))]
-           ;[(constant? a) 
-           ; (Mem b (lambda (b) (make-asm-instr op a b)))]
-           ;[(constant? b)
-           ; (Mem a (lambda (a) (make-asm-instr op a b)))]
            [else
-            (S* rands
+            (Mem a
-                (lambda (rands)
+              (lambda (a)
-                  (let ([a (car rands)] [b (cadr rands)])
+                (Mem b 
-                    (make-asm-instr op a b))))]))]
+                  (lambda (b)
+                    (make-asm-instr op a b)))))]))]
+         ;(cond
+         ;  [(and (constant? a) (constant? b))
+         ;   (let ([t (unique-var 'tmp)])
+         ;     (P (make-bind (list t) (list a)
+         ;           (make-primcall op (list t b)))))]
+         ;  [(constant? a)
+         ;   (Mem b (lambda (b) (make-asm-instr op a b)))]
+         ;  [(constant? b)
+         ;   (Mem a (lambda (a) (make-asm-instr op a b)))]
+         ;  [else
+         ;   (S* rands
+         ;       (lambda (rands)
+         ;         (let ([a (car rands)] [b (cadr rands)])
+         ;           (make-asm-instr op a b))))]))]
         [(shortcut body handler)
          (make-shortcut (P body) (P handler))]
       [else (error who "invalid pred" x)]))
@@ -2396,7 +2417,7 @@
               (make-seq
                 (E (make-asm-instr 'move u b))
                 (P (make-asm-instr op a u))))]
-           [(and (mem? a) (mem? b)) 
+           [(and (mem? a) (mem? b))
             (let ([u (mku)])
               (make-seq
                 (E (make-asm-instr 'move u b))

scheme/ikarus.intel-assembler.ss

@@ -663,7 +663,7 @@
       [(and (reg? src) (reg? dst))    (CR*  #x39 src dst ac)]
       [(and (mem? src) (reg? dst))      (CR*  #x3B dst src ac)]
       [(and (imm8? src) (mem? dst))       (CR*  #x83 '/7 dst (IMM8 src ac))]
-      [(and (imm32? src) (mem? dst))        (CR*  #x81 '/8 dst (IMM32 src ac))]
+      [(and (imm32? src) (mem? dst))        (CR*  #x81 '/7 dst (IMM32 src ac))]
       [else (die who "invalid" instr)])]
    [(imull src dst)
     (cond

scheme/last-revision

@@ -1 +1 @@
-1512
+1513