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