diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm index 0034cc199..f14f48f43 100644 --- a/module/language/cps/compile-bytecode.scm +++ b/module/language/cps/compile-bytecode.scm @@ -172,24 +172,8 @@ (emit-word-ref/immediate asm (from-sp dst) (from-sp (slot obj)) idx)) (($ $primcall 'pointer-ref/immediate (annotation . idx) (obj)) (emit-pointer-ref/immediate asm (from-sp dst) (from-sp (slot obj)) idx)) - (($ $primcall 'struct-ref/immediate idx (struct)) - (emit-struct-ref/immediate asm (from-sp dst) (from-sp (slot struct)) - idx)) (($ $primcall 'free-ref idx (closure)) (emit-free-ref asm (from-sp dst) (from-sp (slot closure)) idx)) - (($ $primcall 'allocate-struct #f (vtable nfields)) - (emit-allocate-struct asm (from-sp dst) (from-sp (slot vtable)) - (from-sp (slot nfields)))) - (($ $primcall 'allocate-struct/immediate nfields (vtable)) - (emit-allocate-struct/immediate asm (from-sp dst) - (from-sp (slot vtable)) - nfields)) - (($ $primcall 'struct-ref #f (struct n)) - (emit-struct-ref asm (from-sp dst) (from-sp (slot struct)) - (from-sp (slot n)))) - (($ $primcall 'struct-ref/immediate idx (struct)) - (emit-struct-ref/immediate asm (from-sp dst) (from-sp (slot struct)) - idx)) (($ $primcall 'char->integer #f (src)) (emit-char->integer asm (from-sp dst) (from-sp (slot src)))) (($ $primcall 'integer->char #f (src)) @@ -321,12 +305,6 @@ (($ $primcall 'free-set! idx (closure value)) (emit-free-set! asm (from-sp (slot closure)) (from-sp (slot value)) idx)) - (($ $primcall 'struct-set! #f (struct index value)) - (emit-struct-set! asm (from-sp (slot struct)) (from-sp (slot index)) - (from-sp (slot value)))) - (($ $primcall 'struct-set!/immediate idx (struct value)) - (emit-struct-set!/immediate asm (from-sp (slot struct)) idx - (from-sp (slot value)))) (($ $primcall 'string-set! #f (string index char)) (emit-string-set! asm (from-sp (slot string)) (from-sp (slot index)) (from-sp (slot char)))) diff --git a/module/language/cps/cse.scm b/module/language/cps/cse.scm index 95d9c07d1..d4a294c47 100644 --- a/module/language/cps/cse.scm +++ b/module/language/cps/cse.scm @@ -258,10 +258,6 @@ false. It could be that both true and false proofs are available." ((word-set!/immediate p s x) (x <- word-ref/immediate p s)) ((pointer-set!/immediate p s x) (x <- pointer-ref/immediate p s)) - ((s <- allocate-struct #f v n) (v <- struct-vtable #f s)) - ((s <- allocate-struct/immediate n v) (v <- struct-vtable #f s)) - ((struct-set! #f s i x) (x <- struct-ref #f s i)) - ((struct-set!/immediate i s x) (x <- struct-ref/immediate i s)) ((u <- scm->f64 #f s) (s <- f64->scm #f u)) ((s <- f64->scm #f u) (u <- scm->f64 #f s)) ((u <- scm->u64 #f s) (s <- u64->scm #f u)) diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm index f2066f46e..aea0d5803 100644 --- a/module/language/cps/effects-analysis.scm +++ b/module/language/cps/effects-analysis.scm @@ -396,17 +396,6 @@ the LABELS that are clobbered by the effects of LABEL." (&write-field (annotation->memory-kind ann) idx))))) -;; Structs. -(define-primitive-effects* param - ((allocate-struct vt n) (&allocate &struct) &type-check) - ((allocate-struct/immediate vt) (&allocate &struct) &type-check) - ((make-struct/no-tail vt . _) (&allocate &struct) &type-check) - ((struct-ref s n) (&read-object &struct) &type-check) - ((struct-ref/immediate s) (&read-field &struct param) &type-check) - ((struct-set! s n x) (&write-object &struct) &type-check) - ((struct-set!/immediate s x) (&write-field &struct param) &type-check) - ((struct-vtable s) &type-check)) - ;; Strings. (define-primitive-effects ((string-ref s n) (&read-object &string) &type-check) diff --git a/module/language/cps/reify-primitives.scm b/module/language/cps/reify-primitives.scm index 327700de4..7436422fc 100644 --- a/module/language/cps/reify-primitives.scm +++ b/module/language/cps/reify-primitives.scm @@ -316,9 +316,6 @@ ((sub/immediate (u8? y) x) (sub x y)) (_ (reify-u64-constants - ((allocate-struct/immediate (u8? size) vt) (allocate-struct vt size)) - ((struct-ref/immediate (u8? idx) s) (struct-ref s idx)) - ((struct-set!/immediate (u8? idx) s val) (struct-set! s idx val)) ((uadd/immediate (u8? y) x) (uadd x y)) ((usub/immediate (u8? y) x) (usub x y)) ((umul/immediate (u8? y) x) (umul x y)) diff --git a/module/language/cps/specialize-primcalls.scm b/module/language/cps/specialize-primcalls.scm index 81692de0d..96d7e118a 100644 --- a/module/language/cps/specialize-primcalls.scm +++ b/module/language/cps/specialize-primcalls.scm @@ -121,9 +121,6 @@ ... (_ #f))) (specialize-case - (('allocate-struct v (? uint? n)) (allocate-struct/immediate n (v))) - (('struct-ref s (? uint? n)) (struct-ref/immediate n (s))) - (('struct-set! s (? uint? n) x) (struct-set!/immediate n (s x))) (('allocate-words (? uint? n)) (allocate-words/immediate n ())) (('scm-ref o (? uint? i)) (scm-ref/immediate i (o))) (('scm-set! o (? uint? i) x) (scm-set!/immediate i (o x))) diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm index d3d738d6f..225b99c67 100644 --- a/module/language/cps/types.scm +++ b/module/language/cps/types.scm @@ -823,59 +823,6 @@ minimum, and maximum." ((current-thread) &all-types)) - - -;;; -;;; Structs. -;;; - -;; No type-checker for allocate-struct, as we can't currently check that -;; vt is actually a vtable. -(define-type-inferrer (allocate-struct vt size result) - (restrict! vt &struct vtable-offset-user (target-max-size-t/scm)) - (restrict! size &u64 0 (target-max-size-t/scm)) - (define! result &struct (&min/0 size) (&max/scm-size size))) - -(define-type-checker (struct-ref s idx) - (and (check-type s &struct 0 (target-max-size-t/scm)) - (check-type idx &u64 0 (target-max-size-t/scm)) - ;; FIXME: is the field boxed? - (< (&max idx) (&min s)))) -(define-type-inferrer (struct-ref s idx result) - (restrict! s &struct (1+ (&min/0 idx)) (target-max-size-t/scm)) - (restrict! idx &u64 0 (1- (&max/scm-size s))) - (define! result &all-types -inf.0 +inf.0)) - -(define-type-checker (struct-set! s idx val) - (and (check-type s &struct 0 (target-max-size-t/scm)) - (check-type idx &u64 0 (target-max-size-t/scm)) - ;; FIXME: is the field boxed? - (< (&max idx) (&min s)))) -(define-type-inferrer (struct-set! s idx val) - (restrict! s &struct (1+ (&min/0 idx)) (target-max-size-t/scm)) - (restrict! idx &u64 0 (1- (&max/scm-size s)))) - -(define-type-inferrer/param (allocate-struct/immediate size vt result) - (restrict! vt &struct vtable-offset-user (target-max-size-t/scm)) - (define! result &struct size size)) - -(define-type-checker/param (struct-ref/immediate idx s) - ;; FIXME: is the field boxed? - (and (check-type s &struct 0 (target-max-size-t/scm)) (< idx (&min s)))) -(define-type-inferrer/param (struct-ref/immediate idx s result) - (restrict! s &struct (1+ idx) (target-max-size-t/scm)) - (define! result &all-types -inf.0 +inf.0)) - -(define-type-checker/param (struct-set!/immediate idx s val) - ;; FIXME: is the field boxed? - (and (check-type s &struct 0 (target-max-size-t/scm)) (< idx (&min s)))) -(define-type-inferrer/param (struct-set!/immediate idx s val) - (restrict! s &struct (1+ idx) (target-max-size-t/scm))) - -(define-simple-type (struct-vtable (&struct 0 (target-max-size-t/scm))) - (&struct vtable-offset-user (target-max-size-t/scm))) - - ;;; diff --git a/module/language/tree-il/cps-primitives.scm b/module/language/tree-il/cps-primitives.scm index 2d14f2edb..b9f2fe95b 100644 --- a/module/language/tree-il/cps-primitives.scm +++ b/module/language/tree-il/cps-primitives.scm @@ -104,7 +104,6 @@ (define-cps-primitive struct-vtable 1 1) (define-cps-primitive allocate-struct 2 1) (define-cps-primitive struct-ref 2 1) - ;; Unhappily, and undocumentedly, struct-set! returns the value that was ;; set. There is code that relies on this. The struct-set! lowering ;; routines ensure this return arity. diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index cf64ef076..da125119d 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -260,13 +260,6 @@ emit-ulsh/immediate emit-char->integer emit-integer->char - emit-struct-vtable - emit-allocate-struct/immediate - emit-struct-ref/immediate - emit-struct-set!/immediate - emit-allocate-struct - emit-struct-ref - emit-struct-set! emit-class-of emit-make-array emit-scm->f64