* Cogen no longer generates (int x) where x is a fixnum.

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 (lambda (x) (car x)) bind*)]
+            (let ([lhs* (map car bind*)]
                   [rhs* (map cadr bind*)])
               (let ([nlhs* (gen-fml* lhs*)])
                 (let ([expr (make-recbind nlhs* (map E rhs*) (E body ))])
@@ -3093,11 +3093,9 @@
       [(fixnum? off) (list 'disp (int off) val)]
       [(register? off) (list 'disp off val)]
       [else (error 'mem "invalid disp ~s" off)]))
-  (define (int x) 
+  (define-syntax int
-    (cond
+    (syntax-rules ()
-      [(fixnum? x) x]
+      [(_ 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))
@@ -3184,15 +3182,6 @@
         (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)

src/libintelasm.ss

@@ -38,13 +38,6 @@
 
 
 (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)
@@ -194,22 +187,16 @@
               (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 (int-val n)])
+       (list* (byte n)
-         (list* (byte n)
+         (byte (fxsra n  8))
-           (byte (fxsra n  8))
+         (byte (fxsra n 16))
-           (byte (fxsra n 16))
+         (byte (fxsra n 24))
-           (byte (fxsra n 24))
+         ac)]
-           ac))]
       [(obj? n)
        (let ([v (cadr n)])
          (if (immediate? v)
@@ -229,8 +216,7 @@
   (lambda (n ac)
     (cond
       [(int? n) 
-       (let ([n (int-val n)])
+       (list* (byte n) ac)]
-         (list* (byte n) ac))]
       [else (error 'IMM8 "invalid ~s" n)])))
 
 
@@ -249,7 +235,7 @@
 
 (define imm8?
   (lambda (x)
-    (and (int? x) (byte? (int-val x)))))
+    (and (int? x) (byte? x))))
 
 (define label?
   (lambda (x)
@@ -277,11 +263,7 @@
 (define label-name
   (lambda (x) (cadr x)))
 
-(define int?
+(define int? fixnum?)
-  (lambda (x)
-    (or 
-      (fixnum? x)
-      (and (pair? x) (eq? (car x) 'int)))))
 
 (define obj?
   (lambda (x)
@@ -335,7 +317,7 @@
   (lambda (i1 i2 ac)
     (cond
       [(and (int? i1) (obj? i2))
-       (let ([d (int-val i1)] [v (cadr i2)])
+       (let ([d i1] [v (cadr i2)])
          (cons (reloc-word+ v d) ac))]
       [else (error 'assemble "IMM32*2 ~s ~s" i1 i2)])))
 
@@ -512,7 +494,7 @@
       [else (error who "invalid ~s" instr)])]
    [(sall src dst)
     (cond
-      [(and (equal? '(int 1) src) (reg? dst))
+      [(and (equal? 1 src) (reg? dst))
        (CODE #xD1 (ModRM 3 '/4 dst ac))]
       [(and (imm8? src) (reg? dst))
        (CODE #xC1 (ModRM 3 '/4 dst (IMM8 src ac)))]
@@ -521,7 +503,7 @@
       [else (error who "invalid ~s" instr)])]
    [(shrl src dst)
     (cond
-      [(and (equal? '(int 1) src) (reg? dst))
+      [(and (equal? 1 src) (reg? dst))
        (CODE #xD1 (ModRM 3 '/5 dst ac))]
       [(and (imm8? src) (reg? dst))
        (CODE #xC1 (ModRM 3 '/5 dst (IMM8 src ac)))]
@@ -530,7 +512,7 @@
       [else (error who "invalid ~s" instr)])]
    [(sarl src dst)
     (cond
-      [(and (equal? '(int 1) src) (reg? dst))
+      [(and (equal? 1 src) (reg? dst))
        (CODE #xD1 (ModRM 3 '/7 dst ac))]
       [(and (imm8? src) (reg? dst))
        (CODE #xC1 (ModRM 3 '/7 dst (IMM8 src ac)))]
@@ -701,7 +683,7 @@
     (unless (byte? x) (error who "~s is not a byte" x))
     (cons (byte x) ac)]
    [(byte-vector x) (append (map (lambda (x) (byte x)) (vector->list x)) ac)]
-   [(int a) (IMM32 instr ac)]
+   [(int a) (IMM32 a ac)]
    [(label L)
     (unless (symbol? L) (error who "label ~s is not a symbol" L))
     (cons (cons 'label L) ac)]
@@ -908,7 +890,7 @@
 
 (define list*->code*
   (lambda (thunk?-label ls*)
-    (let ([closure-size* (map (lambda (x) (car x)) ls*)]
+    (let ([closure-size* (map car ls*)]
           [ls* (map cdr ls*)])
       (let* ([ls* (map convert-instructions ls*)]
              [ls* (map optimize-local-jumps ls*)])

src/makefile.ss

@@ -259,14 +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)
+ ; (define (time x) x)
   (fork
     (lambda (pid) 
       (time (compile-all 'p1))
@@ -276,7 +276,7 @@
       (time (compile-all 'p0))
       (exit))))
 
-(for-each 
+#;(for-each 
   (lambda (x)
     (when (cadr x)
       (compile-library (car x) (cadr x))))