Make alien.c-types reloadable
Slava Pestov
parent
4373cb1630
commit
cece726e54
|
|
@ -3,7 +3,7 @@
|
||||||
USING: byte-arrays arrays generator.registers assocs
|
USING: byte-arrays arrays generator.registers assocs
|
||||||
kernel kernel.private libc math namespaces parser sequences
|
kernel kernel.private libc math namespaces parser sequences
|
||||||
strings words assocs splitting math.parser cpu.architecture
|
strings words assocs splitting math.parser cpu.architecture
|
||||||
alien quotations system ;
|
alien quotations system compiler.units ;
|
||||||
IN: alien.c-types
|
IN: alien.c-types
|
||||||
|
|
||||||
TUPLE: c-type
|
TUPLE: c-type
|
||||||
|
|
@ -227,130 +227,135 @@ M: long-long-type box-return ( type -- )
|
||||||
define-out ;
|
define-out ;
|
||||||
|
|
||||||
: expand-constants ( c-type -- c-type' )
|
: expand-constants ( c-type -- c-type' )
|
||||||
|
#! We use word-def call instead of execute to get around
|
||||||
|
#! staging violations
|
||||||
dup array? [
|
dup array? [
|
||||||
unclip >r [ dup word? [ execute ] when ] map r> add*
|
unclip >r [ dup word? [ word-def call ] when ] map
|
||||||
|
r> add*
|
||||||
] when ;
|
] when ;
|
||||||
|
|
||||||
[ alien-cell ]
|
[
|
||||||
[ set-alien-cell ]
|
[ alien-cell ]
|
||||||
bootstrap-cell
|
[ set-alien-cell ]
|
||||||
"box_alien"
|
bootstrap-cell
|
||||||
"alien_offset" <primitive-type>
|
"box_alien"
|
||||||
"void*" define-primitive-type
|
"alien_offset" <primitive-type>
|
||||||
|
"void*" define-primitive-type
|
||||||
|
|
||||||
[ alien-signed-8 ]
|
[ alien-signed-8 ]
|
||||||
[ set-alien-signed-8 ]
|
[ set-alien-signed-8 ]
|
||||||
8
|
8
|
||||||
"box_signed_8"
|
"box_signed_8"
|
||||||
"to_signed_8" <primitive-type> <long-long-type>
|
"to_signed_8" <primitive-type> <long-long-type>
|
||||||
"longlong" define-primitive-type
|
"longlong" define-primitive-type
|
||||||
|
|
||||||
[ alien-unsigned-8 ]
|
[ alien-unsigned-8 ]
|
||||||
[ set-alien-unsigned-8 ]
|
[ set-alien-unsigned-8 ]
|
||||||
8
|
8
|
||||||
"box_unsigned_8"
|
"box_unsigned_8"
|
||||||
"to_unsigned_8" <primitive-type> <long-long-type>
|
"to_unsigned_8" <primitive-type> <long-long-type>
|
||||||
"ulonglong" define-primitive-type
|
"ulonglong" define-primitive-type
|
||||||
|
|
||||||
[ alien-signed-cell ]
|
[ alien-signed-cell ]
|
||||||
[ set-alien-signed-cell ]
|
[ set-alien-signed-cell ]
|
||||||
bootstrap-cell
|
bootstrap-cell
|
||||||
"box_signed_cell"
|
"box_signed_cell"
|
||||||
"to_fixnum" <primitive-type>
|
"to_fixnum" <primitive-type>
|
||||||
"long" define-primitive-type
|
"long" define-primitive-type
|
||||||
|
|
||||||
[ alien-unsigned-cell ]
|
[ alien-unsigned-cell ]
|
||||||
[ set-alien-unsigned-cell ]
|
[ set-alien-unsigned-cell ]
|
||||||
bootstrap-cell
|
bootstrap-cell
|
||||||
"box_unsigned_cell"
|
"box_unsigned_cell"
|
||||||
"to_cell" <primitive-type>
|
"to_cell" <primitive-type>
|
||||||
"ulong" define-primitive-type
|
"ulong" define-primitive-type
|
||||||
|
|
||||||
[ alien-signed-4 ]
|
[ alien-signed-4 ]
|
||||||
[ set-alien-signed-4 ]
|
[ set-alien-signed-4 ]
|
||||||
4
|
4
|
||||||
"box_signed_4"
|
"box_signed_4"
|
||||||
"to_fixnum" <primitive-type>
|
"to_fixnum" <primitive-type>
|
||||||
"int" define-primitive-type
|
"int" define-primitive-type
|
||||||
|
|
||||||
[ alien-unsigned-4 ]
|
[ alien-unsigned-4 ]
|
||||||
[ set-alien-unsigned-4 ]
|
[ set-alien-unsigned-4 ]
|
||||||
4
|
4
|
||||||
"box_unsigned_4"
|
"box_unsigned_4"
|
||||||
"to_cell" <primitive-type>
|
"to_cell" <primitive-type>
|
||||||
"uint" define-primitive-type
|
"uint" define-primitive-type
|
||||||
|
|
||||||
[ alien-signed-2 ]
|
[ alien-signed-2 ]
|
||||||
[ set-alien-signed-2 ]
|
[ set-alien-signed-2 ]
|
||||||
2
|
2
|
||||||
"box_signed_2"
|
"box_signed_2"
|
||||||
"to_fixnum" <primitive-type>
|
"to_fixnum" <primitive-type>
|
||||||
"short" define-primitive-type
|
"short" define-primitive-type
|
||||||
|
|
||||||
[ alien-unsigned-2 ]
|
[ alien-unsigned-2 ]
|
||||||
[ set-alien-unsigned-2 ]
|
[ set-alien-unsigned-2 ]
|
||||||
2
|
2
|
||||||
"box_unsigned_2"
|
"box_unsigned_2"
|
||||||
"to_cell" <primitive-type>
|
"to_cell" <primitive-type>
|
||||||
"ushort" define-primitive-type
|
"ushort" define-primitive-type
|
||||||
|
|
||||||
[ alien-signed-1 ]
|
[ alien-signed-1 ]
|
||||||
[ set-alien-signed-1 ]
|
[ set-alien-signed-1 ]
|
||||||
1
|
1
|
||||||
"box_signed_1"
|
"box_signed_1"
|
||||||
"to_fixnum" <primitive-type>
|
"to_fixnum" <primitive-type>
|
||||||
"char" define-primitive-type
|
"char" define-primitive-type
|
||||||
|
|
||||||
[ alien-unsigned-1 ]
|
[ alien-unsigned-1 ]
|
||||||
[ set-alien-unsigned-1 ]
|
[ set-alien-unsigned-1 ]
|
||||||
1
|
1
|
||||||
"box_unsigned_1"
|
"box_unsigned_1"
|
||||||
"to_cell" <primitive-type>
|
"to_cell" <primitive-type>
|
||||||
"uchar" define-primitive-type
|
"uchar" define-primitive-type
|
||||||
|
|
||||||
[ alien-unsigned-4 zero? not ]
|
[ alien-unsigned-4 zero? not ]
|
||||||
[ 1 0 ? set-alien-unsigned-4 ]
|
[ 1 0 ? set-alien-unsigned-4 ]
|
||||||
4
|
4
|
||||||
"box_boolean"
|
"box_boolean"
|
||||||
"to_boolean" <primitive-type>
|
"to_boolean" <primitive-type>
|
||||||
"bool" define-primitive-type
|
"bool" define-primitive-type
|
||||||
|
|
||||||
[ alien-float ]
|
[ alien-float ]
|
||||||
[ >r >r >float r> r> set-alien-float ]
|
[ >r >r >float r> r> set-alien-float ]
|
||||||
4
|
4
|
||||||
"box_float"
|
"box_float"
|
||||||
"to_float" <primitive-type>
|
"to_float" <primitive-type>
|
||||||
"float" define-primitive-type
|
"float" define-primitive-type
|
||||||
|
|
||||||
T{ float-regs f 4 } "float" c-type set-c-type-reg-class
|
T{ float-regs f 4 } "float" c-type set-c-type-reg-class
|
||||||
[ >float ] "float" c-type set-c-type-prep
|
[ >float ] "float" c-type set-c-type-prep
|
||||||
|
|
||||||
[ alien-double ]
|
[ alien-double ]
|
||||||
[ >r >r >float r> r> set-alien-double ]
|
[ >r >r >float r> r> set-alien-double ]
|
||||||
8
|
8
|
||||||
"box_double"
|
"box_double"
|
||||||
"to_double" <primitive-type>
|
"to_double" <primitive-type>
|
||||||
"double" define-primitive-type
|
"double" define-primitive-type
|
||||||
|
|
||||||
T{ float-regs f 8 } "double" c-type set-c-type-reg-class
|
T{ float-regs f 8 } "double" c-type set-c-type-reg-class
|
||||||
[ >float ] "double" c-type set-c-type-prep
|
[ >float ] "double" c-type set-c-type-prep
|
||||||
|
|
||||||
[ alien-cell alien>char-string ]
|
[ alien-cell alien>char-string ]
|
||||||
[ set-alien-cell ]
|
[ set-alien-cell ]
|
||||||
bootstrap-cell
|
bootstrap-cell
|
||||||
"box_char_string"
|
"box_char_string"
|
||||||
"alien_offset" <primitive-type>
|
"alien_offset" <primitive-type>
|
||||||
"char*" define-primitive-type
|
"char*" define-primitive-type
|
||||||
|
|
||||||
"char*" "uchar*" typedef
|
"char*" "uchar*" typedef
|
||||||
|
|
||||||
[ string>char-alien ] "char*" c-type set-c-type-prep
|
[ string>char-alien ] "char*" c-type set-c-type-prep
|
||||||
|
|
||||||
[ alien-cell alien>u16-string ]
|
[ alien-cell alien>u16-string ]
|
||||||
[ set-alien-cell ]
|
[ set-alien-cell ]
|
||||||
4
|
4
|
||||||
"box_u16_string"
|
"box_u16_string"
|
||||||
"alien_offset" <primitive-type>
|
"alien_offset" <primitive-type>
|
||||||
"ushort*" define-primitive-type
|
"ushort*" define-primitive-type
|
||||||
|
|
||||||
[ string>u16-alien ] "ushort*" c-type set-c-type-prep
|
[ string>u16-alien ] "ushort*" c-type set-c-type-prep
|
||||||
|
] with-compilation-unit
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue