From 35b76b83afd7f353d22a9ac7dcbe86caca9e276f Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 15 Sep 2009 16:08:42 -0500 Subject: [PATCH] convert compiler cpu backends to use c-type words --- basis/alien/c-types/c-types.factor | 34 ++++++++++++---------- basis/alien/prettyprint/prettyprint.factor | 12 ++++++-- basis/cpu/ppc/ppc.factor | 2 +- basis/cpu/x86/64/unix/unix.factor | 9 +++--- basis/cpu/x86/64/winnt/winnt.factor | 8 ++--- basis/cpu/x86/x86.factor | 1 + 6 files changed, 38 insertions(+), 28 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 2d53e01f0f..553ff26443 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -5,9 +5,19 @@ namespaces make parser sequences strings words splitting math.parser cpu.architecture alien alien.accessors alien.strings quotations layouts system compiler.units io io.files io.encodings.binary io.streams.memory accessors combinators effects continuations fry -classes vocabs vocabs.loader vocabs.parser ; +classes vocabs vocabs.loader vocabs.parser words.symbol ; +QUALIFIED: math IN: alien.c-types +SYMBOLS: + char uchar + short ushort + int uint + long ulong + longlong ulonglong + float double + void* bool ; + DEFER: DEFER: *char @@ -78,7 +88,7 @@ M: string resolve-pointer-type { { [ CHAR: ] over member? ] [ parse-array-type ] } { [ dup search c-type-word? ] [ parse-c-type-name resolve-typedef ] } - { [ dup c-types get at ] [ dup c-types get at resolve-typedef ] } + { [ dup c-types get at ] [ c-types get at resolve-typedef ] } { [ "*" ?tail ] [ parse-c-type-name resolve-pointer-type ] } [ no-c-type ] } cond ; @@ -294,8 +304,9 @@ PREDICATE: typedef-word < c-type-word M: string typedef ( old new -- ) c-types get set-at ; M: word typedef ( old new -- ) + [ nip define-symbol ] [ name>> typedef ] - [ swap "c-type" set-word-prop ] 2bi ; + [ swap "c-type" set-word-prop ] 2tri ; TUPLE: long-long-type < c-type ; @@ -339,15 +350,6 @@ M: long-long-type box-return ( type -- ) : if-void ( type true false -- ) pick "void" = [ drop nip call ] [ nip call ] if ; inline -SYMBOLS: - char uchar - short ushort - int uint - long ulong - longlong ulonglong - float double - void* bool ; - CONSTANT: primitive-types { char uchar @@ -496,8 +498,8 @@ SYMBOLS: \ bool define-primitive-type - float >>class - float >>boxed-class + math:float >>class + math:float >>boxed-class [ alien-float ] >>getter [ [ >float ] 2dip set-alien-float ] >>setter 4 >>size @@ -509,8 +511,8 @@ SYMBOLS: \ float define-primitive-type - float >>class - float >>boxed-class + math:float >>class + math:float >>boxed-class [ alien-double ] >>getter [ [ >float ] 2dip set-alien-double ] >>setter 8 >>size diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor index 6201f1e245..54bb3812a4 100644 --- a/basis/alien/prettyprint/prettyprint.factor +++ b/basis/alien/prettyprint/prettyprint.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel combinators alien alien.strings alien.c-types -alien.syntax math.parser prettyprint.backend prettyprint.custom -prettyprint.sections definitions see see.private ; +alien.syntax arrays math.parser prettyprint.backend +prettyprint.custom prettyprint.sections definitions see see.private +strings words ; IN: alien.prettyprint M: alien pprint* @@ -17,9 +18,14 @@ M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ; M: c-type-word definer drop \ C-TYPE: f ; M: c-type-word definition drop f ; +GENERIC: pprint-c-type ( c-type -- ) +M: word pprint-c-type pprint-word ; +M: string pprint-c-type text ; +M: array pprint-c-type pprint* ; + M: typedef-word see-class* ; diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 9c829bc390..f881ff5f91 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -770,5 +770,5 @@ USE: vocabs.loader 4 >>align "box_boolean" >>boxer "to_boolean" >>unboxer - "bool" define-primitive-type + bool define-primitive-type ] with-compilation-unit diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor index e06c026d39..1088f20175 100644 --- a/basis/cpu/x86/64/unix/unix.factor +++ b/basis/cpu/x86/64/unix/unix.factor @@ -14,9 +14,10 @@ M: float-regs param-regs M: x86.64 reserved-area-size 0 ; -! The ABI for passing structs by value is pretty messed up -<< "void*" c-type clone "__stack_value" define-primitive-type -stack-params "__stack_value" c-type (>>rep) >> +SYMBOL: (stack-value) +! The ABI for passing structs by value is pretty great +<< void* c-type clone \ (stack-value) define-primitive-type +stack-params \ (stack-value) c-type (>>rep) >> : struct-types&offset ( struct-type -- pairs ) fields>> [ @@ -36,7 +37,7 @@ stack-params "__stack_value" c-type (>>rep) >> : flatten-large-struct ( c-type -- seq ) heap-size cell align - cell /i "__stack_value" c-type ; + cell /i \ (stack-value) c-type ; M: struct-type flatten-value-type ( type -- seq ) dup heap-size 16 > [ diff --git a/basis/cpu/x86/64/winnt/winnt.factor b/basis/cpu/x86/64/winnt/winnt.factor index d9f83612e6..bbe943e06b 100644 --- a/basis/cpu/x86/64/winnt/winnt.factor +++ b/basis/cpu/x86/64/winnt/winnt.factor @@ -25,8 +25,8 @@ 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 +longlong ptrdiff_t typedef +longlong intptr_t typedef +int c-type long define-primitive-type +uint c-type ulong define-primitive-type >> diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 27b6667c05..04b5308836 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -12,6 +12,7 @@ compiler.cfg.comparisons compiler.cfg.stack-frame compiler.codegen compiler.codegen.fixup ; +FROM: math => float ; IN: cpu.x86 << enable-fixnum-log2 >>