From fa27b7e9cd2192cf4095f4ad71a72dc0e2834f23 Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Fri, 14 Dec 2007 01:58:55 -0500
Subject: [PATCH] Fixes 1/2 of bug 176207: identifier-syntax second case broken

---
 scheme/ikarus.io.ss                | 12 +++++++-----
 scheme/last-revision               |  2 +-
 scheme/pass-specify-rep-primops.ss |  7 ++++++-
 scheme/psyntax.expander.ss         | 11 -----------
 4 files changed, 14 insertions(+), 18 deletions(-)

diff --git a/scheme/ikarus.io.ss b/scheme/ikarus.io.ss
index fa78c9d..0d7edb2 100644
--- a/scheme/ikarus.io.ss
+++ b/scheme/ikarus.io.ss
@@ -125,11 +125,13 @@
       port-id
       ))
 
-  (module UNSAFE (fx< fx<= fx> fx>= fx= fx+ fx-
-                  fxior fxand fxsra fxsll
-                  integer->char char->integer
-                  string-ref string-set! string-length
-                  bytevector-u8-ref bytevector-u8-set!)
+  (module UNSAFE  
+    (fx< fx<= fx> fx>= fx= fx+ fx-
+     fxior fxand fxsra fxsll
+     integer->char char->integer
+     string-ref string-set! string-length
+     bytevector-u8-ref bytevector-u8-set!)
+
     (import 
       (rename (ikarus system $strings)
         ($string-length string-length)
diff --git a/scheme/last-revision b/scheme/last-revision
index 4b5d879..39ccce4 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1239
+1240
diff --git a/scheme/pass-specify-rep-primops.ss b/scheme/pass-specify-rep-primops.ss
index 2c07218..69d2452 100644
--- a/scheme/pass-specify-rep-primops.ss
+++ b/scheme/pass-specify-rep-primops.ss
@@ -1804,7 +1804,12 @@
   [(V x)
    (make-conditional 
      (tag-test (T x) vector-mask vector-tag)
-     (cogen-value-$port-attrs x)
+     (with-tmp ([tag 
+                 (prm 'mref (T x) (K (- disp-port-attrs vector-tag)))])
+       (make-conditional 
+         (tag-test tag port-mask port-tag)
+         (prm 'sra tag (K port-attrs-shift))
+         (K 0)))
      (K 0))])
 
 (define-primop $set-port-index! unsafe
diff --git a/scheme/psyntax.expander.ss b/scheme/psyntax.expander.ss
index 69a78ba..98f4f12 100644
--- a/scheme/psyntax.expander.ss
+++ b/scheme/psyntax.expander.ss
@@ -2830,14 +2830,6 @@
                     (stx-error ctxt "cannot modify imported binding"))))))
             (else (stx-error ctxt "cannot modify binding in")))))))
   
-  (define chi-top-set!
-    (lambda (e)
-      (syntax-match e ()
-        ((_ id rhs) (id? id)
-         (let ((loc (gen-global-var-binding id e)))
-           (let ((rhs (chi-expr rhs '() '())))
-             (values loc rhs)))))))
-  
   (define chi-top*
     (lambda (e* init*)
       (cond
@@ -2851,9 +2843,6 @@
                   (let ((loc (gen-global-var-binding id e)))
                     (let ((rhs (chi-rhs rhs '() '())))
                       (chi-top* (cdr e*) (cons (cons loc rhs) init*))))))
-               ((set!)
-                (let-values (((loc rhs) (chi-top-set! e)))
-                  (chi-top* (cdr e*) (cons (cons loc rhs) init*))))
                ((define-syntax)
                 (let-values (((id rhs) (parse-define-syntax e)))
                   (let ((loc (gen-global-macro-binding id e)))