M: integer float-function-param* FMR ;
: float-function-param ( i src -- )
- [ float-regs param-regs nth ] dip float-function-param* ;
+ [ float-regs cdecl param-regs nth ] dip float-function-param* ;
: float-function-return ( reg -- )
float-regs return-reg double-rep %copy ;
M: ppc %loop-entry ;
M: int-regs return-reg drop 3 ;
-M: int-regs param-regs drop { 3 4 5 6 7 8 9 10 } ;
+M: int-regs param-regs 2drop { 3 4 5 6 7 8 9 10 } ;
M: float-regs return-reg drop 1 ;
M:: ppc %save-param-reg ( stack reg rep -- )
! If the source is a stack location, load it into freg #0.
! If the source is f, then we assume the value is already in
! freg #0.
- n [ 0 rep reg-class-of param-reg rep %load-param-reg ] when*
+ n [ 0 rep reg-class-of cdecl param-reg rep %load-param-reg ] when*
rep double-rep? 5 4 ? %load-vm-addr
func f %alien-invoke ;
M:: ppc %restore-context ( temp1 temp2 -- )
temp1 "ctx" %vm-field
- temp2 1 stack-frame get total-size>> ADDI
- temp2 temp1 "callstack-bottom" context-field-offset STW
ds-reg temp1 "datastack" context-field-offset LWZ
rs-reg temp1 "retainstack" context-field-offset LWZ ;
M: ppc %alien-invoke ( symbol dll -- )
[ 11 ] 2dip %alien-global 11 MTLR BLRL ;
- M: ppc %alien-callback ( quot -- )
- 3 4 %restore-context
- 3 swap %load-reference
- 4 3 quot-entry-point-offset LWZ
- 4 MTLR
- BLRL
- 3 4 %save-context ;
-
M: ppc %prepare-alien-indirect ( -- )
3 ds-reg 0 LWZ
ds-reg ds-reg 4 SUBI
M: ppc %alien-indirect ( -- )
16 MTLR BLRL ;
- M: ppc %callback-value ( ctype -- )
- ! Save top of data stack
- 3 ds-reg 0 LWZ
- 3 1 0 local@ STW
- 3 %load-vm-addr
- ! Restore data/call/retain stacks
- "unnest_context" f %alien-invoke
- ! Restore top of data stack
- 3 1 0 local@ LWZ
- ! Unbox former top of data stack to return registers
- unbox-return ;
-
M: ppc immediate-arithmetic? ( n -- ? ) -32768 32767 between? ;
M: ppc immediate-bitwise? ( n -- ? ) 0 65535 between? ;
4 3 4 LWZ
3 3 0 LWZ ;
- M: ppc %nest-context ( -- )
+ M: ppc %begin-callback ( -- )
3 %load-vm-addr
- "nest_context" f %alien-invoke ;
+ "begin_callback" f %alien-invoke ;
+
+ M: ppc %alien-callback ( quot -- )
+ 3 4 %restore-context
+ 3 swap %load-reference
+ 4 3 quot-entry-point-offset LWZ
+ 4 MTLR
+ BLRL
+ 3 4 %save-context ;
- M: ppc %unnest-context ( -- )
+ M: ppc %end-callback ( -- )
3 %load-vm-addr
"unnest_context" f %alien-invoke ;
+ M: ppc %end-callback-value ( ctype -- )
+ ! Save top of data stack
+ 12 ds-reg 0 LWZ
+ %end-callback
+ ! Restore top of data stack
+ 3 12 MR
+ ! Unbox former top of data stack to return registers
+ unbox-return ;
+
M: ppc %unbox-small-struct ( size -- )
heap-size cell align cell /i {
{ 1 [ %unbox-struct-1 ] }
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax combinators kernel
system namespaces assocs parser lexer sequences words
- quotations math.bitwise alien.libraries ;
+ quotations math.bitwise alien.libraries literals ;
IN: openssl.libssl
<< {
{ [ os openbsd? ] [ ] } ! VM is linked with it
{ [ os netbsd? ] [ ] }
- { [ os winnt? ] [ "libssl" "ssleay32.dll" "cdecl" add-library ] }
- { [ os macosx? ] [ "libssl" "libssl.dylib" "cdecl" add-library ] }
- { [ os unix? ] [ "libssl" "libssl.so" "cdecl" add-library ] }
+ { [ os winnt? ] [ "libssl" "ssleay32.dll" cdecl add-library ] }
+ { [ os macosx? ] [ "libssl" "libssl.dylib" cdecl add-library ] }
+ { [ os unix? ] [ "libssl" "libssl.so" cdecl add-library ] }
} cond >>
CONSTANT: X509_FILETYPE_PEM 1
CONSTANT: SSL_SESS_CACHE_CLIENT HEX: 0001
CONSTANT: SSL_SESS_CACHE_SERVER HEX: 0002
- : SSL_SESS_CACHE_BOTH ( -- n )
- { SSL_SESS_CACHE_CLIENT SSL_SESS_CACHE_SERVER } flags ; inline
+ CONSTANT: SSL_SESS_CACHE_BOTH flags{ SSL_SESS_CACHE_CLIENT SSL_SESS_CACHE_SERVER }
CONSTANT: SSL_SESS_CACHE_NO_AUTO_CLEAR HEX: 0080
CONSTANT: SSL_SESS_CACHE_NO_INTERNAL_LOOKUP HEX: 0100
CONSTANT: SSL_SESS_CACHE_NO_INTERNAL_STORE HEX: 0200
- : SSL_SESS_CACHE_NO_INTERNAL ( -- n )
- { SSL_SESS_CACHE_NO_INTERNAL_LOOKUP SSL_SESS_CACHE_NO_INTERNAL_STORE } flags ; inline
+ CONSTANT: SSL_SESS_CACHE_NO_INTERNAL
+ flags{ SSL_SESS_CACHE_NO_INTERNAL_LOOKUP SSL_SESS_CACHE_NO_INTERNAL_STORE }
! ===============================================
! x509_vfy.h
! return 0 if you handle the message, else just let DefWindowProc return its val
: ui-wndproc ( -- object )
- uint { void* uint long long } "stdcall" [
+ uint { void* uint long long } stdcall [
pick
trace-messages? get-global [ dup windows-message-name name>> print flush ] when
wm-handlers get-global at* [ call ] [ drop DefWindowProc ] if
WNDCLASSEX <struct> f GetModuleHandle
class-name-ptr pick GetClassInfoEx 0 = [
WNDCLASSEX heap-size >>cbSize
- { CS_HREDRAW CS_VREDRAW CS_OWNDC } flags >>style
+ flags{ CS_HREDRAW CS_VREDRAW CS_OWNDC } >>style
ui-wndproc >>lpfnWndProc
0 >>cbClsExtra
0 >>cbWndExtra
f ClipCursor drop
1 ShowCursor drop ;
- : fullscreen-flags ( -- n )
- { WS_CAPTION WS_BORDER WS_THICKFRAME } flags ; inline
+ CONSTANT: fullscreen-flags { WS_CAPTION WS_BORDER WS_THICKFRAME }
: enter-fullscreen ( world -- )
handle>> hWnd>>
[
f
over hwnd>RECT get-RECT-dimensions
- { SWP_NOMOVE SWP_NOSIZE SWP_NOZORDER SWP_FRAMECHANGED } flags
+ flags{ SWP_NOMOVE SWP_NOSIZE SWP_NOZORDER SWP_FRAMECHANGED }
SetWindowPos win32-error=0/f
]
[ SW_RESTORE ShowWindow win32-error=0/f ]