convert compiler cpu backends to use c-type words

diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 2d53e01f0f2a493fdeb3e7554890721eb3526b9d..553ff264431bc30ed8a4a1df1cd8f6334c3fe085 100755 (executable)
--- 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: <int>
 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
 
     <c-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
 
     <c-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 6201f1e24544b3b5b8d755adc1b606a6156becfa..54bb3812a40b167f2d2d0a1d409c3a6c4cfcc5a4 100644 (file)
--- 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*
     <colon
     \ TYPEDEF: pprint-word
-    dup "typedef" word-prop pprint-word
+    dup "c-type" word-prop pprint-c-type
     pprint-word
     block> ;

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 9c829bc390023b8e88ddcb01c734f8f837107b28..f881ff5f9131448fd2a18724147128f9e7eee0d6 100644 (file)
--- 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 e06c026d39702bfa562f9526f12fa21cdd2acb1e..1088f2017591bc749da829dbe8155e36373e6c89 100644 (file)
--- 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 <repetition> ;
+    cell /i \ (stack-value) c-type <repetition> ;
 
 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 d9f83612e60394729cc9bda88fc8701fb21de26d..bbe943e06ba2419b26cfa8ac34933c9e4ba78ce0 100644 (file)
--- 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 27b6667c050858949c5d6a41e380a77bc71fce3d..04b530883653533837fb34b40a7c7ad7368a5a67 100644 (file)
--- 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 >>