]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' into abi-symbols
authorJoe Groff <arcata@gmail.com>
Thu, 1 Apr 2010 22:28:36 +0000 (15:28 -0700)
committerJoe Groff <arcata@gmail.com>
Thu, 1 Apr 2010 22:28:36 +0000 (15:28 -0700)
1  2 
basis/cpu/ppc/ppc.factor
basis/openssl/libssl/libssl.factor
basis/ui/backend/windows/windows.factor

diff --combined basis/cpu/ppc/ppc.factor
index e72171315408dd89c5ecb5b267d7b9185f5ef19c,dbc313052f6e9c1d8127a79f9785fa0a7671c191..f81d8705bf649207829c16cf5c95b25e5eba4cc5
@@@ -237,7 -237,7 +237,7 @@@ M: spill-slot float-function-param* [ 
  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 ;
@@@ -587,7 -587,7 +587,7 @@@ M: ppc %reload ( dst rep src -- 
  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 -- )
@@@ -647,7 -647,7 +647,7 @@@ M:: ppc %box ( n rep func -- 
      ! 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 ;
  
@@@ -678,8 -678,6 +678,6 @@@ M: ppc %box-large-struct ( n c-type -- 
  
  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 ;
  
@@@ -692,14 -690,6 +690,6 @@@ M:: ppc %save-context ( temp1 temp2 -- 
  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? ;
@@@ -757,14 -735,31 +735,31 @@@ M: ppc %box-small-struct ( c-type -- 
      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 ] }
index 341b35eb15d9773c4e9e40faa4311c7fbee38d8c,96d235d271fc5c98f8842f900b72a98067747e45..272b1bb17ebaef2819a6f255c8d03a5aecc9d174
@@@ -3,16 -3,16 +3,16 @@@
  ! 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
@@@ -258,15 -258,14 +258,14 @@@ CONSTANT: SSL_SESS_CACHE_OFF    HEX: 00
  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
index 626faf4274eba544ceb29c00e25efae72c437a0f,c0829e5c8dada706571cf4c3e319899aedfcc526..e0be2e7c9971ccc2f7f836a3a1fe17ea6608ebe8
@@@ -609,7 -609,7 +609,7 @@@ SYMBOL: trace-messages
  
  ! 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
@@@ -628,7 -628,7 +628,7 @@@ M: windows-ui-backend do-event
      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
@@@ -811,8 -811,7 +811,7 @@@ M: windows-ui-backend (ungrab-input) ( 
      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 ]