Fixes 1/2 of bug 176207: identifier-syntax second case broken

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)

scheme/last-revision

@@ -1 +1 @@
-1239
+1240

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

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)))