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