convert compiler cpu backends to use c-type words
							parent
							
								
									95ba6a4c05
								
							
						
					
					
						commit
						35b76b83af
					
				| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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> ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 > [
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
>>
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 >>
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue