Move non-parsing words out of alien.syntax, and use a symbol instead of a string variable to store the current library in alien.parser
parent
2712496880
commit
becb7c78b7
|
@ -434,15 +434,15 @@ MACRO: fortran-invoke ( return library function parameters -- )
|
||||||
[ \ fortran-invoke 5 [ ] nsequence ] dip define-declared ;
|
[ \ fortran-invoke 5 [ ] nsequence ] dip define-declared ;
|
||||||
|
|
||||||
SYNTAX: SUBROUTINE:
|
SYNTAX: SUBROUTINE:
|
||||||
f "c-library" get scan ";" parse-tokens
|
f current-library get scan ";" parse-tokens
|
||||||
[ "()" subseq? not ] filter define-fortran-function ;
|
[ "()" subseq? not ] filter define-fortran-function ;
|
||||||
|
|
||||||
SYNTAX: FUNCTION:
|
SYNTAX: FUNCTION:
|
||||||
scan "c-library" get scan ";" parse-tokens
|
scan current-library get scan ";" parse-tokens
|
||||||
[ "()" subseq? not ] filter define-fortran-function ;
|
[ "()" subseq? not ] filter define-fortran-function ;
|
||||||
|
|
||||||
SYNTAX: LIBRARY:
|
SYNTAX: LIBRARY:
|
||||||
scan
|
scan
|
||||||
[ "c-library" set ]
|
[ current-library set ]
|
||||||
[ set-fortran-abi ] bi ;
|
[ set-fortran-abi ] bi ;
|
||||||
|
|
||||||
|
|
|
@ -38,6 +38,11 @@ M: library dispose dll>> [ dispose ] when* ;
|
||||||
: library-abi ( library -- abi )
|
: library-abi ( library -- abi )
|
||||||
library [ abi>> ] [ cdecl ] if* ;
|
library [ abi>> ] [ cdecl ] if* ;
|
||||||
|
|
||||||
|
ERROR: no-such-symbol name library ;
|
||||||
|
|
||||||
|
: address-of ( name library -- value )
|
||||||
|
2dup load-library dlsym [ 2nip ] [ no-such-symbol ] if* ;
|
||||||
|
|
||||||
SYMBOL: deploy-libraries
|
SYMBOL: deploy-libraries
|
||||||
|
|
||||||
deploy-libraries [ V{ } clone ] initialize
|
deploy-libraries [ V{ } clone ] initialize
|
||||||
|
|
|
@ -7,6 +7,8 @@ splitting words fry locals lexer namespaces summary math
|
||||||
vocabs.parser words.constant ;
|
vocabs.parser words.constant ;
|
||||||
IN: alien.parser
|
IN: alien.parser
|
||||||
|
|
||||||
|
SYMBOL: current-library
|
||||||
|
|
||||||
: parse-c-type-name ( name -- word )
|
: parse-c-type-name ( name -- word )
|
||||||
dup search [ ] [ no-word ] ?if ;
|
dup search [ ] [ no-word ] ?if ;
|
||||||
|
|
||||||
|
@ -117,7 +119,7 @@ PRIVATE>
|
||||||
names return function-effect ;
|
names return function-effect ;
|
||||||
|
|
||||||
: (FUNCTION:) ( -- word quot effect )
|
: (FUNCTION:) ( -- word quot effect )
|
||||||
scan-function-name "c-library" get ";" scan-c-args make-function ;
|
scan-function-name current-library get ";" scan-c-args make-function ;
|
||||||
|
|
||||||
: callback-quot ( return types abi -- quot )
|
: callback-quot ( return types abi -- quot )
|
||||||
'[ [ _ _ _ ] dip alien-callback ] ;
|
'[ [ _ _ _ ] dip alien-callback ] ;
|
||||||
|
@ -131,7 +133,7 @@ PRIVATE>
|
||||||
type-word return types lib library-abi callback-quot (( quot -- alien )) ;
|
type-word return types lib library-abi callback-quot (( quot -- alien )) ;
|
||||||
|
|
||||||
: (CALLBACK:) ( -- word quot effect )
|
: (CALLBACK:) ( -- word quot effect )
|
||||||
"c-library" get
|
current-library get
|
||||||
scan-function-name ";" scan-c-args make-callback-type ;
|
scan-function-name ";" scan-c-args make-callback-type ;
|
||||||
|
|
||||||
PREDICATE: alien-function-word < word
|
PREDICATE: alien-function-word < word
|
||||||
|
@ -142,3 +144,10 @@ PREDICATE: alien-function-word < word
|
||||||
|
|
||||||
PREDICATE: alien-callback-type-word < typedef-word
|
PREDICATE: alien-callback-type-word < typedef-word
|
||||||
"callback-effect" word-prop ;
|
"callback-effect" word-prop ;
|
||||||
|
|
||||||
|
: global-quot ( type word -- quot )
|
||||||
|
name>> current-library get '[ _ _ address-of 0 ]
|
||||||
|
swap c-type-getter-boxer append ;
|
||||||
|
|
||||||
|
: define-global ( type word -- )
|
||||||
|
[ nip ] [ global-quot ] 2bi (( -- value )) define-declared ;
|
||||||
|
|
|
@ -1,10 +1,10 @@
|
||||||
! Copyright (C) 2005, 2010 Slava Pestov, Alex Chapman.
|
! Copyright (C) 2005, 2010 Slava Pestov, Alex Chapman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors arrays alien alien.c-types
|
USING: accessors arrays alien alien.c-types alien.arrays
|
||||||
alien.arrays alien.strings kernel math namespaces parser
|
alien.strings kernel math namespaces parser sequences words
|
||||||
sequences words quotations math.parser splitting grouping
|
quotations math.parser splitting grouping effects assocs
|
||||||
effects assocs combinators lexer strings.parser alien.parser
|
combinators lexer strings.parser alien.parser fry vocabs.parser
|
||||||
fry vocabs.parser words.constant alien.libraries ;
|
words.constant alien.libraries ;
|
||||||
IN: alien.syntax
|
IN: alien.syntax
|
||||||
|
|
||||||
SYNTAX: DLL" lexer get skip-blank parse-string dlopen suffix! ;
|
SYNTAX: DLL" lexer get skip-blank parse-string dlopen suffix! ;
|
||||||
|
@ -13,7 +13,7 @@ SYNTAX: ALIEN: 16 scan-base <alien> suffix! ;
|
||||||
|
|
||||||
SYNTAX: BAD-ALIEN <bad-alien> suffix! ;
|
SYNTAX: BAD-ALIEN <bad-alien> suffix! ;
|
||||||
|
|
||||||
SYNTAX: LIBRARY: scan "c-library" set ;
|
SYNTAX: LIBRARY: scan current-library set ;
|
||||||
|
|
||||||
SYNTAX: FUNCTION:
|
SYNTAX: FUNCTION:
|
||||||
(FUNCTION:) define-declared ;
|
(FUNCTION:) define-declared ;
|
||||||
|
@ -33,20 +33,8 @@ SYNTAX: C-ENUM:
|
||||||
SYNTAX: C-TYPE:
|
SYNTAX: C-TYPE:
|
||||||
void CREATE-C-TYPE typedef ;
|
void CREATE-C-TYPE typedef ;
|
||||||
|
|
||||||
ERROR: no-such-symbol name library ;
|
|
||||||
|
|
||||||
: address-of ( name library -- value )
|
|
||||||
2dup load-library dlsym [ 2nip ] [ no-such-symbol ] if* ;
|
|
||||||
|
|
||||||
SYNTAX: &:
|
SYNTAX: &:
|
||||||
scan "c-library" get '[ _ _ address-of ] append! ;
|
scan current-library get '[ _ _ address-of ] append! ;
|
||||||
|
|
||||||
: global-quot ( type word -- quot )
|
|
||||||
name>> "c-library" get '[ _ _ address-of 0 ]
|
|
||||||
swap c-type-getter-boxer append ;
|
|
||||||
|
|
||||||
: define-global ( type word -- )
|
|
||||||
[ nip ] [ global-quot ] 2bi (( -- value )) define-declared ;
|
|
||||||
|
|
||||||
SYNTAX: C-GLOBAL: scan-c-type CREATE-WORD define-global ;
|
SYNTAX: C-GLOBAL: scan-c-type CREATE-WORD define-global ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue