From fba6ddbc22fb5c40ba6fd35437f5d9e0be9482cc Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 5 Nov 2009 01:36:14 -0600 Subject: [PATCH] Move platform-specific c-type initialization out of cpu.* vocabularies and into alien.c-types so that the vm vocabulary, which is loaded before cpu.*, will have correct struct offsets --- basis/alien/c-types/c-types.factor | 52 ++++++++++++++++++++--------- basis/alien/data/data.factor | 6 ---- basis/cpu/ppc/ppc.factor | 11 ------ basis/cpu/x86/32/32.factor | 6 ---- basis/cpu/x86/64/winnt/winnt.factor | 6 ---- 5 files changed, 37 insertions(+), 44 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index e06c543b54..cfbed5378d 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -230,6 +230,10 @@ M: byte-array byte-length length ; inline M: f byte-length drop 0 ; inline +: >c-bool ( ? -- int ) 1 0 ? ; inline + +: c-bool> ( int -- ? ) 0 = not ; inline + MIXIN: value-type : c-getter ( name -- quot ) @@ -256,6 +260,7 @@ PREDICATE: typedef-word < c-type-word "c-type" word-prop c-type-name? ; M: string typedef ( old new -- ) c-types get set-at ; + M: word typedef ( old new -- ) { [ nip define-symbol ] @@ -338,7 +343,7 @@ SYMBOLS: [ alien-signed-8 ] >>getter [ set-alien-signed-8 ] >>setter 8 >>size - 8 >>align + cpu x86.32? os windows? not and 4 8 ? >>align "box_signed_8" >>boxer "to_signed_8" >>unboxer \ longlong define-primitive-type @@ -349,7 +354,7 @@ SYMBOLS: [ alien-unsigned-8 ] >>getter [ set-alien-unsigned-8 ] >>setter 8 >>size - 8 >>align + cpu x86.32? os windows? not and 4 8 ? >>align "box_unsigned_8" >>boxer "to_unsigned_8" >>unboxer \ ulonglong define-primitive-type @@ -442,14 +447,24 @@ SYMBOLS: "to_cell" >>unboxer \ uchar define-primitive-type - - [ alien-unsigned-1 0 = not ] >>getter - [ [ 1 0 ? ] 2dip set-alien-unsigned-1 ] >>setter - 1 >>size - 1 >>align - "box_boolean" >>boxer - "to_boolean" >>unboxer - \ bool define-primitive-type + cpu ppc? [ + + [ alien-unsigned-4 c-bool> ] >>getter + [ [ >c-bool ] 2dip set-alien-unsigned-4 ] >>setter + 4 >>size + 4 >>align + "box_boolean" >>boxer + "to_boolean" >>unboxer + ] [ + + [ alien-unsigned-1 c-bool> ] >>getter + [ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter + 1 >>size + 1 >>align + "box_boolean" >>boxer + "to_boolean" >>unboxer + \ bool define-primitive-type + ] if math:float >>class @@ -470,17 +485,24 @@ SYMBOLS: [ alien-double ] >>getter [ [ >float ] 2dip set-alien-double ] >>setter 8 >>size - 8 >>align + cpu x86.32? os windows? not and 4 8 ? >>align "box_double" >>boxer "to_double" >>unboxer double-rep >>rep [ >float ] >>unboxer-quot \ double define-primitive-type - \ long c-type \ ptrdiff_t typedef - \ long c-type \ intptr_t typedef - \ ulong c-type \ uintptr_t typedef - \ ulong c-type \ size_t typedef + cpu x86.64? os windows? and [ + \ longlong c-type \ ptrdiff_t typedef + \ longlong c-type \ intptr_t typedef + \ ulonglong c-type \ uintptr_t typedef + \ ulonglong c-type \ size_t typedef + ] [ + \ long c-type \ ptrdiff_t typedef + \ long c-type \ intptr_t typedef + \ ulong c-type \ uintptr_t typedef + \ ulong c-type \ size_t typedef + ] if ] 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 fc18921ef1..93b1afd436 100644 --- a/basis/alien/data/data.factor +++ b/basis/alien/data/data.factor @@ -65,10 +65,6 @@ M: memory-stream stream-read : byte-array>memory ( byte-array base -- ) swap dup byte-length memcpy ; inline -: >c-bool ( ? -- int ) 1 0 ? ; inline - -: c-bool> ( int -- ? ) 0 = not ; inline - M: value-type c-type-rep drop int-rep ; M: value-type c-type-getter @@ -77,5 +73,3 @@ M: value-type c-type-getter M: value-type c-type-setter ( type -- quot ) [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri '[ @ swap @ _ memcpy ] ; - - diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 92cea0d82f..0f33df8df7 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -737,14 +737,3 @@ USE: vocabs.loader } cond "complex-double" c-type t >>return-in-registers? drop - -[ - - [ alien-unsigned-4 c-bool> ] >>getter - [ [ >c-bool ] 2dip set-alien-unsigned-4 ] >>setter - 4 >>size - 4 >>align - "box_boolean" >>boxer - "to_boolean" >>unboxer - bool define-primitive-type -] with-compilation-unit diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 8a29c82dad..8867ca6597 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -324,10 +324,4 @@ M: x86.32 dummy-fp-params? f ; ! Dreadful M: object flatten-value-type (flatten-int-type) ; -os windows? [ - cell longlong c-type (>>align) - cell ulonglong c-type (>>align) - 4 double c-type (>>align) -] unless - check-sse diff --git a/basis/cpu/x86/64/winnt/winnt.factor b/basis/cpu/x86/64/winnt/winnt.factor index 3ecd56bdd1..a398c6565c 100644 --- a/basis/cpu/x86/64/winnt/winnt.factor +++ b/basis/cpu/x86/64/winnt/winnt.factor @@ -24,9 +24,3 @@ M: x86.64 dummy-fp-params? t ; M: x86.64 temp-reg RAX ; -<< -longlong ptrdiff_t typedef -longlong intptr_t typedef -int c-type long define-primitive-type -uint c-type ulong define-primitive-type ->>