convert compiler cpu backends to use c-type words

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
+        math:float >>class
-        float >>boxed-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
+        math:float >>class
-        float >>boxed-class
+        math:float >>boxed-class
         [ alien-double ] >>getter
         [ [ >float ] 2dip set-alien-double ] >>setter
         8 >>size

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
+alien.syntax arrays math.parser prettyprint.backend
-prettyprint.sections definitions see see.private ;
+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> ;

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

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
+SYMBOL: (stack-value)
-<< "void*" c-type clone "__stack_value" define-primitive-type
+! The ABI for passing structs by value is pretty great
-stack-params "__stack_value" c-type (>>rep) >>
+<< 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 > [

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 ptrdiff_t typedef
-"longlong" "intptr_t" typedef
+longlong intptr_t  typedef
-"int" c-type "long" define-primitive-type
+int  c-type long  define-primitive-type
-"uint" c-type "ulong" define-primitive-type
+uint c-type ulong define-primitive-type
 >>

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 >>