(int x) is no longer emitted by the cogen.

assembler handles (int x) and fixnums similarly.

src/libcompile.ss

@@ -323,7 +323,7 @@
                (f (make-seq a (E (car d))) (cdr d))]))]
          [(letrec)
           (let ([bind* (cadr x)] [body (caddr x)])
-            (let ([lhs* (map car bind*)]
+            (let ([lhs* (map (lambda (x) (car x)) bind*)]
                   [rhs* (map cadr bind*)])
               (let ([nlhs* (gen-fml* lhs*)])
                 (let ([expr (make-recbind nlhs* (map E rhs*) (E body ))])
@@ -444,7 +444,6 @@
                  [base-idx: ,base-idx]
                  [arg-count: ,arg-count]
                  [live-mask: ,live-mask])]
-
       [(tailcall-cp convention label arg-count)
        `(tailcall-cp ,convention ,label ,arg-count)]
       [(foreign-label x) `(foreign-label ,x)]
@@ -452,6 +451,7 @@
       [else (error 'unparse "invalid record ~s" x)]))
   (E x))
 
+
 (define (optimize-direct-calls x)
   (define who 'optimize-direct-calls)
   (define (make-conses ls)
@@ -3093,7 +3093,11 @@
       [(fixnum? off) (list 'disp (int off) val)]
       [(register? off) (list 'disp off val)]
       [else (error 'mem "invalid disp ~s" off)]))
-  (define (int x) (list 'int x))
+  (define (int x) 
+    (cond
+      [(fixnum? x) x]
+      [else (error 'int "not a fixnum ~s" x)]))
+
   (define (obj x) (list 'obj x))
   (define (byte x) (list 'byte x))
   (define (byte-vector x) (list 'byte-vector x))
@@ -3108,6 +3112,7 @@
   (define (xorl src targ) (list 'xorl src targ))
   (define (andl src targ) (list 'andl src targ))
   (define (movl src targ) (list 'movl src targ))
+  (define (leal src targ) (list 'leal src targ))
   (define (movb src targ) (list 'movb src targ))
   (define (addl src targ) (list 'addl src targ))
   (define (imull src targ) (list 'imull src targ))
@@ -3178,6 +3183,16 @@
   (mem (fx- disp-symbol-system-value symbol-tag)
         (obj op)))
 
+
+(define-syntax car
+  (syntax-rules ()
+    [(_ x)
+     (let ([t x])
+       (if (pair? t)
+           (#%car t)
+           (error '(car x) "~s is not a pair" t)))]))
+
+
 (define (generate-code x)
   (define who 'generate-code)
   (define (rp-label x L_multi)
@@ -3871,9 +3886,8 @@
        (list* (movl (Simple (car arg*)) eax)
               (movl (Simple (cadr arg*)) ebx)
               (movl eax (mem disp-car apr))
-              (movl apr eax)
               (movl ebx (mem disp-cdr apr))
-              (addl (int pair-tag) eax)
+              (leal (mem pair-tag apr) eax)
               (addl (int (align pair-size)) apr)
               ac)]
       [(list)
@@ -4479,60 +4493,6 @@
        (NonTail body ac)]
       [(call-cp)
        (handle-call-cp x ac NonTail)]
-    #;[(call-cp call-convention direct-label save-cp? rp-convention offset size mask)
-       (let ([L_CALL (unique-label)])
-         (case call-convention
-           [(normal)
-            (list* (addl (int (frame-adjustment offset)) fpr)
-                   (movl (int (argc-convention size)) eax)
-                   (jmp L_CALL)
-                   ; NEW FRAME
-                   `(byte-vector ,mask)
-                   `(int ,(fx* offset wordsize))
-                   `(current-frame-offset)
-                   (rp-label rp-convention)
-                   `(byte 0) ; padding for indirect calls only
-                   `(byte 0) ; direct calls are ok
-                   L_CALL
-                   (indirect-cpr-call)
-                   (if save-cp? (movl (mem 0 fpr) cpr) '(nop))
-                   (subl (int (frame-adjustment offset)) fpr)
-                   ac)]
-           [(direct)
-            (list* (addl (int (frame-adjustment offset)) fpr)
-                   ;(movl (int (argc-convention size)) eax)
-                   (jmp L_CALL)
-                   ; NEW FRAME
-                   `(byte-vector ,mask)
-                   `(int ,(fx* offset wordsize))
-                   `(current-frame-offset)
-                   (rp-label rp-convention)
-                   ;;; no padding for direct calls
-                   L_CALL
-                   (call (label direct-label))
-                   (if save-cp? (movl (mem 0 fpr) cpr) '(nop))
-                   (subl (int (frame-adjustment offset)) fpr)
-                   ac)] 
-           [(foreign) 
-            (list* (addl (int (frame-adjustment offset)) fpr)
-                   (movl (int (argc-convention size)) eax)
-                   (movl '(foreign-label "ik_foreign_call") ebx)
-                   (jmp L_CALL)
-                   ; NEW FRAME
-                   (byte-vector mask)
-                   `(int ,(fx* offset wordsize))
-                   `(current-frame-offset)
-                   (rp-label rp-convention) ; should be 0, since C has 1 rv
-                   '(byte 0)
-                   '(byte 0)
-                   '(byte 0)
-                   L_CALL
-                   (call ebx)
-                   (if save-cp? (movl (mem 0 fpr) cpr) '(nop))
-                   (subl (int (frame-adjustment offset)) fpr)
-                   ac)]
-           [else
-            (error who "invalid convention ~s for call-cp" call-convention)]))]
       [else (error 'NonTail "invalid expression ~s" x)]))
   (define (Pred x Lt Lf ac)
     (record-case x
@@ -4791,9 +4751,9 @@
            (movl (primref-loc 'do-vararg-overflow) cpr) ; load handler
            (jmp L_CALL)   ; go to overflow handler
            ; NEW FRAME
-           (int 0)        ; if the framesize=0, then the framesize is dynamic
+           '(int 0)        ; if the framesize=0, then the framesize is dynamic
            '(current-frame-offset)
-           (int 0)        ; multiarg rp
+           '(int 0)        ; multiarg rp
            (byte 0)
            (byte 0)
            L_CALL
@@ -4985,7 +4945,7 @@
               (jmp (label L_cwv_call))
               ; MV NEW FRAME
               (byte-vector '#(#b110))
-              (int (fx* wordsize 3))
+              `(int ,(fx* wordsize 3))
                '(current-frame-offset)
               (label-address L_cwv_multi_rp)
               (byte 0)

src/libintelasm.ss

@@ -38,6 +38,13 @@
 
 
 (let ()
+(define-syntax car
+  (syntax-rules ()
+    [(_ x)
+     (let ([t x])
+       (if (pair? t)
+           (#%car t)
+           (error '(car x) "~s is not a pair" t)))]))
 
 (define fold
   (lambda (f init ls)
@@ -153,13 +160,14 @@
 
 (define mem?
   (lambda (x)
-    (and (list? x)
+    (and (pair? x)
-         (fx= (length x) 3)
+         ;(fx= (length x) 3)
          (eq? (car x) 'disp)
-         (or (imm? (cadr x))
+         ;(or (imm? (cadr x))
-             (reg? (cadr x)))
+         ;    (reg? (cadr x)))
-         (or (imm? (caddr x))
+         ;(or (imm? (caddr x))
-             (reg? (caddr x))))))
+         ;    (reg? (caddr x)))
+         )))
 
 (define small-disp?
   (lambda (x)
@@ -186,11 +194,17 @@
               (cons (byte #x24) ac)
               ac))))
 
+(define (int-val x)
+  (cond
+    [(fixnum? x) x]
+    [(and (pair? x) (eq? (car x) 'int)) (cadr x)]
+    [else (error 'int-val "not a fixnum ~s" x)]))
+
 (define IMM32
   (lambda (n ac)
     (cond
       [(int? n) 
-       (let ([n (cadr n)])
+       (let ([n (int-val n)])
          (list* (byte n)
            (byte (fxsra n  8))
            (byte (fxsra n 16))
@@ -215,7 +229,7 @@
   (lambda (n ac)
     (cond
       [(int? n) 
-       (let ([n (cadr n)])
+       (let ([n (int-val n)])
          (list* (byte n) ac))]
       [else (error 'IMM8 "invalid ~s" n)])))
 
@@ -235,7 +249,7 @@
 
 (define imm8?
   (lambda (x)
-    (and (int? x) (byte? (cadr x)))))
+    (and (int? x) (byte? (int-val x)))))
 
 (define label?
   (lambda (x)
@@ -265,7 +279,9 @@
 
 (define int?
   (lambda (x)
-    (and (pair? x) (eq? (car x) 'int))))
+    (or 
+      (fixnum? x)
+      (and (pair? x) (eq? (car x) 'int)))))
 
 (define obj?
   (lambda (x)
@@ -319,7 +335,7 @@
   (lambda (i1 i2 ac)
     (cond
       [(and (int? i1) (obj? i2))
-       (let ([d (cadr i1)] [v (cadr i2)])
+       (let ([d (int-val i1)] [v (cadr i2)])
          (cons (reloc-word+ v d) ac))]
       [else (error 'assemble "IMM32*2 ~s ~s" i1 i2)])))
 
@@ -554,6 +570,11 @@
       [(and (mem? src) (reg? dst))
        (CODErd #x33 dst src ac)]
       [else (error who "invalid ~s" instr)])]
+   [(leal src dst) 
+    (cond
+      [(and (mem? src) (reg? dst))
+       (CODErd #x8D dst src ac)]
+      [else (error who "invalid ~s" instr)])]
    [(cmpl src dst)
     (cond
       [(and (imm8? src) (reg? dst)) 
@@ -690,6 +711,7 @@
    [(current-frame-offset)
     (cons '(current-frame-offset) ac)]
    [(nop) ac]
+
 ))
 
 
@@ -886,7 +908,7 @@
 
 (define list*->code*
   (lambda (thunk?-label ls*)
-    (let ([closure-size* (map car ls*)]
+    (let ([closure-size* (map (lambda (x) (car x)) ls*)]
           [ls* (map cdr ls*)])
       (let* ([ls* (map convert-instructions ls*)]
              [ls* (map optimize-local-jumps ls*)])

src/makefile.ss

@@ -259,13 +259,14 @@
 
 
 
-(let ()
+#;(let ()
   (define (compile-all who)
     (for-each
       (lambda (x)
         (when (eq? who (caddr x))
           (compile-library (car x) (cadr x))))
       scheme-library-files))
+  (define (time x) x)
   (fork
     (lambda (pid) 
       (time (compile-all 'p1))
@@ -275,11 +276,11 @@
       (time (compile-all 'p0))
       (exit))))
 
-;;; (for-each 
+(for-each 
-;;;   (lambda (x)
+  (lambda (x)
-;;;     (when (cadr x)
+    (when (cadr x)
-;;;       (compile-library (car x) (cadr x))))
+      (compile-library (car x) (cadr x))))
-;;;   scheme-library-files)
+  scheme-library-files)
 
 (define (join s ls)
   (cond