diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index ff3c9b8dde..6ded9f4e0d 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -164,17 +164,12 @@ M: c-type stack-size size>> cell align ; MIXIN: value-type : c-getter ( name -- quot ) - c-type-getter [ - [ "Cannot read struct fields with this type" throw ] - ] unless* ; - -: c-type-getter-boxer ( name -- quot ) - [ c-getter ] [ c-type-boxer-quot ] bi append ; + [ c-type-getter ] [ c-type-boxer-quot ] bi append ; : c-setter ( name -- quot ) - c-type-setter [ - [ "Cannot write struct fields with this type" throw ] - ] unless* ; + [ c-type-unboxer-quot [ [ ] ] [ '[ _ 2dip ] ] if-empty ] + [ c-type-setter ] + bi append ; : array-accessor ( c-type quot -- def ) [ @@ -295,7 +290,7 @@ M: pointer c-type c-ptr >>class c-ptr >>boxed-class [ alien-cell ] >>getter - [ [ >c-ptr ] 2dip set-alien-cell ] >>setter + [ set-alien-cell ] >>setter bootstrap-cell >>size bootstrap-cell >>align bootstrap-cell >>align-first @@ -304,30 +299,6 @@ M: pointer c-type "alien_offset" >>unboxer \ void* define-primitive-type - - integer >>class - integer >>boxed-class - [ alien-signed-4 ] >>getter - [ set-alien-signed-4 ] >>setter - 4 >>size - 4 >>align - 4 >>align-first - "from_signed_4" >>boxer - "to_fixnum" >>unboxer - \ int define-primitive-type - - - integer >>class - integer >>boxed-class - [ alien-unsigned-4 ] >>getter - [ set-alien-unsigned-4 ] >>setter - 4 >>size - 4 >>align - 4 >>align-first - "from_unsigned_4" >>boxer - "to_cell" >>unboxer - \ uint define-primitive-type - fixnum >>class fixnum >>boxed-class @@ -338,6 +309,7 @@ M: pointer c-type 2 >>align-first "from_signed_2" >>boxer "to_fixnum" >>unboxer + [ >fixnum ] >>unboxer-quot \ short define-primitive-type @@ -350,6 +322,7 @@ M: pointer c-type 2 >>align-first "from_unsigned_2" >>boxer "to_cell" >>unboxer + [ >fixnum ] >>unboxer-quot \ ushort define-primitive-type @@ -362,6 +335,7 @@ M: pointer c-type 1 >>align-first "from_signed_1" >>boxer "to_fixnum" >>unboxer + [ >fixnum ] >>unboxer-quot \ char define-primitive-type @@ -374,34 +348,14 @@ M: pointer c-type 1 >>align-first "from_unsigned_1" >>boxer "to_cell" >>unboxer + [ >fixnum ] >>unboxer-quot \ uchar define-primitive-type - cpu ppc? [ - - [ alien-unsigned-4 c-bool> ] >>getter - [ [ >c-bool ] 2dip set-alien-unsigned-4 ] >>setter - 4 >>size - 4 >>align - 4 >>align-first - "from_boolean" >>boxer - "to_boolean" >>unboxer - ] [ - - [ alien-unsigned-1 c-bool> ] >>getter - [ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter - 1 >>size - 1 >>align - 1 >>align-first - "from_boolean" >>boxer - "to_boolean" >>unboxer - ] if - \ bool define-primitive-type - math:float >>class math:float >>boxed-class [ alien-float ] >>getter - [ [ >float ] 2dip set-alien-float ] >>setter + [ set-alien-float ] >>setter 4 >>size 4 >>align 4 >>align-first @@ -415,7 +369,7 @@ M: pointer c-type math:float >>class math:float >>boxed-class [ alien-double ] >>getter - [ [ >float ] 2dip set-alien-double ] >>setter + [ set-alien-double ] >>setter 8 >>size 8-byte-alignment "from_double" >>boxer @@ -425,14 +379,40 @@ M: pointer c-type \ double define-primitive-type cell 8 = [ + + fixnum >>class + fixnum >>boxed-class + [ alien-signed-4 ] >>getter + [ set-alien-signed-4 ] >>setter + 4 >>size + 4 >>align + 4 >>align-first + "from_signed_4" >>boxer + "to_fixnum" >>unboxer + [ >fixnum ] >>unboxer-quot + \ int define-primitive-type + + + fixnum >>class + fixnum >>boxed-class + [ alien-unsigned-4 ] >>getter + [ set-alien-unsigned-4 ] >>setter + 4 >>size + 4 >>align + 4 >>align-first + "from_unsigned_4" >>boxer + "to_cell" >>unboxer + [ >fixnum ] >>unboxer-quot + \ uint define-primitive-type + integer >>class integer >>boxed-class [ alien-signed-cell ] >>getter [ set-alien-signed-cell ] >>setter - bootstrap-cell >>size - bootstrap-cell >>align - bootstrap-cell >>align-first + 8 >>size + 8 >>align + 8 >>align-first "from_signed_cell" >>boxer "to_fixnum" >>unboxer \ longlong define-primitive-type @@ -442,9 +422,9 @@ M: pointer c-type integer >>boxed-class [ alien-unsigned-cell ] >>getter [ set-alien-unsigned-cell ] >>setter - bootstrap-cell >>size - bootstrap-cell >>align - bootstrap-cell >>align-first + 8 >>size + 8 >>align + 8 >>align-first "from_unsigned_cell" >>boxer "to_cell" >>unboxer \ ulonglong define-primitive-type @@ -463,6 +443,30 @@ M: pointer c-type \ ulonglong c-type \ uintptr_t typedef \ ulonglong c-type \ size_t typedef ] [ + + integer >>class + integer >>boxed-class + [ alien-signed-cell ] >>getter + [ set-alien-signed-cell ] >>setter + 4 >>size + 4 >>align + 4 >>align-first + "from_signed_cell" >>boxer + "to_fixnum" >>unboxer + \ int define-primitive-type + + + integer >>class + integer >>boxed-class + [ alien-unsigned-cell ] >>getter + [ set-alien-unsigned-cell ] >>setter + 4 >>size + 4 >>align + 4 >>align-first + "from_unsigned_cell" >>boxer + "to_cell" >>unboxer + \ uint define-primitive-type + integer >>class integer >>boxed-class @@ -495,6 +499,12 @@ M: pointer c-type \ uint c-type \ size_t typedef ] if + cpu ppc? \ uint \ uchar ? c-type clone + [ >c-bool ] >>unboxer-quot + [ c-bool> ] >>boxer-quot + object >>boxed-class + \ bool define-primitive-type + ] with-compilation-unit M: char-16-rep rep-component-type drop char ; diff --git a/basis/alien/data/data.factor b/basis/alien/data/data.factor index af1ed24663..9922463b33 100644 --- a/basis/alien/data/data.factor +++ b/basis/alien/data/data.factor @@ -68,8 +68,7 @@ M: value-type c-type-getter drop [ swap ] ; M: value-type c-type-setter ( type -- quot ) - [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri - '[ @ swap @ _ memcpy ] ; + [ c-type-getter ] [ heap-size ] bi '[ @ swap _ memcpy ] ; M: array c-type-boxer-quot unclip [ array-length ] dip [ ] 2curry ; diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index 166c29bef5..dea9627970 100755 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -169,7 +169,7 @@ PREDICATE: alien-callback-type-word < typedef-word : global-quot ( type word -- quot ) name>> current-library get '[ _ _ address-of 0 ] - swap c-type-getter-boxer append ; + swap c-getter append ; : define-global ( type word -- ) [ nip ] [ global-quot ] 2bi (( -- value )) define-declared ; diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index 13088e1469..e841881d28 100644 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -211,7 +211,7 @@ UNION-STRUCT: struct-test-float-and-bits { name "y" } { offset 4 } { initial 123 } - { class integer } + { class $[ cell 4 = integer fixnum ? ] } { type int } } T{ struct-slot-spec @@ -235,7 +235,7 @@ UNION-STRUCT: struct-test-float-and-bits { name "bits" } { offset 0 } { type uint } - { class integer } + { class $[ cell 4 = integer fixnum ? ] } { initial 0 } } } ] [ struct-test-float-and-bits c-type fields>> ] unit-test diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 605ee573f5..60ef793063 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -101,7 +101,7 @@ MACRO: ( class -- quot: ( ... -- struct ) ) GENERIC: (reader-quot) ( slot -- quot ) M: struct-slot-spec (reader-quot) - [ type>> c-type-getter-boxer ] + [ type>> c-getter ] [ offset>> [ >c-ptr ] swap suffix ] bi prepend ; M: struct-bit-slot-spec (reader-quot) diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index 38f97303ba..35448a501c 100644 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -45,7 +45,7 @@ byte-array>A DEFINES byte-array>${A} A{ DEFINES ${A}{ A@ DEFINES ${A}@ -NTH [ T dup c-type-getter-boxer array-accessor ] +NTH [ T dup c-getter array-accessor ] SET-NTH [ T dup c-setter array-accessor ] WHERE