diff options
Diffstat (limited to 'module/system')
-rw-r--r-- | module/system/base/types/internal.scm | 35 | ||||
-rw-r--r-- | module/system/vm/assembler.scm | 16 | ||||
-rw-r--r-- | module/system/vm/disassembler.scm | 6 |
3 files changed, 30 insertions, 27 deletions
diff --git a/module/system/base/types/internal.scm b/module/system/base/types/internal.scm index 768deae92..c75ca3bf6 100644 --- a/module/system/base/types/internal.scm +++ b/module/system/base/types/internal.scm @@ -103,13 +103,16 @@ (fixnum fixnum? #b11 #b10) (heap-object heap-object? #b111 #b000) (char char? #b11111111 #b00001100) - (false eq-false? #b111111111111 #b000000000100) - (nil eq-nil? #b111111111111 #b000100000100) - (null eq-null? #b111111111111 #b001100000100) - (true eq-true? #b111111111111 #b010000000100) - (unspecified unspecified? #b111111111111 #b100000000100) (undefined undefined? #b111111111111 #b100100000100) - (eof eof-object? #b111111111111 #b101000000100) + + ;; To check for these values from Scheme, use eq?. From assembler, + ;; use eq-immediate?. + (false #f #b111111111111 #b000000000100) + (nil #f #b111111111111 #b000100000100) + (null #f #b111111111111 #b001100000100) + (true #f #b111111111111 #b010000000100) + (unspecified #f #b111111111111 #b100000000100) + (eof #f #b111111111111 #b101000000100) ;;(nil eq-nil? #b111111111111 #b000100000100) ;;(eol eq-null? #b111111111111 #b001100000100) @@ -200,24 +203,24 @@ may not fit into a word on the target platform." ((eq? x #t) %tc16-true) ((unspecified? x) %tc16-unspecified) ;; FIXME: %tc16-undefined. - ((eof-object? x) %tc16-eof) + ((eof-object? x) %tc16-eof) (else #f))) (define (immediate-bits->scm imm) "Return the SCM object corresponding to the immediate encoding @code{imm}. Note that this value should be sign-extended already." (define-syntax-rule (define-predicate name pred mask tag) - (define (pred) (eqv? (logand imm mask) tag))) + (define (name) (eqv? (logand imm mask) tag))) (visit-immediate-tags define-predicate) (cond - ((fixnum?) (ash imm -2)) - ((char?) (integer->char (ash imm -8))) - ((eq-false?) #f) - ((eq-nil?) #nil) - ((eq-null?) '()) - ((eq-true?) #t) - ((unspecified?) (if #f #f)) - ((eof-object?) the-eof-object) + ((fixnum) (ash imm -2)) + ((char) (integer->char (ash imm -8))) + ((false) #f) + ((nil) #nil) + ((null) '()) + ((true) #t) + ((unspecified) (if #f #f)) + ((eof) the-eof-object) (else (error "invalid immediate" imm))) ) (define (sign-extend x bits) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 8f67cac51..698d44dac 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -95,14 +95,7 @@ emit-fixnum? emit-heap-object? emit-char? - emit-eq-null? - emit-eq-nil? - emit-eq-false? - emit-eq-true? - emit-unspecified? emit-undefined? - emit-eof-object? - emit-null? emit-false? emit-nil? @@ -1390,9 +1383,12 @@ returned instead." (let ((loc (intern-constant asm (make-static-procedure label)))) (emit-make-non-immediate asm dst loc))) -(define-syntax-rule (define-immediate-tag=?-macro-assembler name pred mask tag) - (define-macro-assembler (pred asm slot) - (emit-immediate-tag=? asm slot mask tag))) +(define-syntax define-immediate-tag=?-macro-assembler + (syntax-rules () + ((_ name #f mask tag) #f) + ((_ name pred mask tag) + (define-macro-assembler (pred asm slot) + (emit-immediate-tag=? asm slot mask tag))))) (visit-immediate-tags define-immediate-tag=?-macro-assembler) diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm index 28f4338d6..cc055491d 100644 --- a/module/system/vm/disassembler.scm +++ b/module/system/vm/disassembler.scm @@ -195,7 +195,11 @@ address of that offset." (define immediate-tag-annotations '()) (define-syntax-rule (define-immediate-tag-annotation name pred mask tag) (set! immediate-tag-annotations - (cons `((,mask ,tag) ,(symbol->string 'pred)) immediate-tag-annotations))) + (cons `((,mask ,tag) + ,(cond + ('pred => symbol->string) + (else (string-append "eq-" (symbol->string 'name) "?")))) + immediate-tag-annotations))) (visit-immediate-tags define-immediate-tag-annotation) (define heap-tag-annotations '()) |