moved %(un)nest-stacks out to cpu specific files to eliminate %vm-invoke from compiler.codegen
							parent
							
								
									28420c587a
								
							
						
					
					
						commit
						d457df1fbf
					
				| 
						 | 
				
			
			@ -447,7 +447,7 @@ M: ##alien-indirect generate-insn
 | 
			
		|||
    ! Generate code for boxing input parameters in a callback.
 | 
			
		||||
    [
 | 
			
		||||
        dup \ %save-param-reg move-parameters
 | 
			
		||||
        "nest_stacks" %vm-invoke-1st-arg
 | 
			
		||||
        %nest-stacks
 | 
			
		||||
        box-parameters
 | 
			
		||||
    ] with-param-regs ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -485,8 +485,6 @@ TUPLE: callback-context ;
 | 
			
		|||
        [ callback-context new do-callback ] %
 | 
			
		||||
    ] [ ] make ;
 | 
			
		||||
 | 
			
		||||
: %unnest-stacks ( -- ) "unnest_stacks" %vm-invoke-1st-arg ;
 | 
			
		||||
 | 
			
		||||
M: ##callback-return generate-insn
 | 
			
		||||
    #! All the extra book-keeping for %unwind is only for x86.
 | 
			
		||||
    #! On other platforms its an alias for %return.
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -395,6 +395,10 @@ HOOK: %alien-callback cpu ( quot -- )
 | 
			
		|||
 | 
			
		||||
HOOK: %callback-value cpu ( ctype -- )
 | 
			
		||||
 | 
			
		||||
HOOK: %nest-stacks cpu ( -- )
 | 
			
		||||
 | 
			
		||||
HOOK: %unnest-stacks cpu ( -- )
 | 
			
		||||
 | 
			
		||||
! Return to caller with stdcall unwinding (only for x86)
 | 
			
		||||
HOOK: %callback-return cpu ( params -- )
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -778,6 +778,12 @@ M: ppc %box-small-struct ( c-type -- )
 | 
			
		|||
    4 3 4 LWZ
 | 
			
		||||
    3 3 0 LWZ ;
 | 
			
		||||
 | 
			
		||||
M: ppc %nest-stacks ( -- )
 | 
			
		||||
    "nest_stacks" f %alien-invoke ;
 | 
			
		||||
 | 
			
		||||
M: ppc %unnest-stacks ( -- )
 | 
			
		||||
    "unnest_stacks" f %alien-invoke ;
 | 
			
		||||
 | 
			
		||||
M: ppc %unbox-small-struct ( size -- )
 | 
			
		||||
    #! Alien must be in EAX.
 | 
			
		||||
    heap-size cell align cell /i {
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -48,8 +48,7 @@ M: x86.32 reserved-area-size 0 ;
 | 
			
		|||
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
 | 
			
		||||
 | 
			
		||||
: push-vm-ptr ( -- )
 | 
			
		||||
    temp-reg 0 MOV rc-absolute-cell rt-vm rel-fixup ! push the vm ptr as an argument
 | 
			
		||||
    temp-reg PUSH ;
 | 
			
		||||
    0 PUSH rc-absolute-cell rt-vm rel-fixup ; ! push the vm ptr as an argument
 | 
			
		||||
 | 
			
		||||
M: x86.32 return-struct-in-registers? ( c-type -- ? )
 | 
			
		||||
    c-type
 | 
			
		||||
| 
						 | 
				
			
			@ -238,6 +237,18 @@ M:: x86.32 %unbox-large-struct ( n c-type -- )
 | 
			
		|||
        "to_value_struct" f %alien-invoke
 | 
			
		||||
    ] with-aligned-stack ;
 | 
			
		||||
 | 
			
		||||
M: x86.32 %nest-stacks ( -- )
 | 
			
		||||
    4 [
 | 
			
		||||
        push-vm-ptr
 | 
			
		||||
        "nest_stacks" f %alien-invoke
 | 
			
		||||
    ] with-aligned-stack ;
 | 
			
		||||
 | 
			
		||||
M: x86.32 %unnest-stacks ( -- )
 | 
			
		||||
    4 [
 | 
			
		||||
        push-vm-ptr
 | 
			
		||||
        "unnest_stacks" f %alien-invoke
 | 
			
		||||
    ] with-aligned-stack ;
 | 
			
		||||
 | 
			
		||||
M: x86.32 %prepare-alien-indirect ( -- )
 | 
			
		||||
    push-vm-ptr "unbox_alien" f %alien-invoke
 | 
			
		||||
    temp-reg POP
 | 
			
		||||
| 
						 | 
				
			
			@ -271,6 +282,7 @@ M: x86.32 %callback-value ( ctype -- )
 | 
			
		|||
    ! Unbox EAX
 | 
			
		||||
    unbox-return ;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
M: x86.32 %cleanup ( params -- )
 | 
			
		||||
    #! a) If we just called an stdcall function in Windows, it
 | 
			
		||||
    #! cleaned up the stack frame for us. But we don't want that
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -190,6 +190,13 @@ M: x86.64 %alien-invoke
 | 
			
		|||
    rc-absolute-cell rel-dlsym
 | 
			
		||||
    R11 CALL ;
 | 
			
		||||
 | 
			
		||||
M: x86.64 %nest-stacks ( -- )
 | 
			
		||||
    param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup
 | 
			
		||||
    "nest_stacks" f %alien-invoke ;
 | 
			
		||||
 | 
			
		||||
M: x86.64 %unnest-stacks ( -- )
 | 
			
		||||
    param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup
 | 
			
		||||
    "unnest_stacks" f %alien-invoke ;
 | 
			
		||||
 | 
			
		||||
M: x86.64 %prepare-alien-indirect ( -- )
 | 
			
		||||
    "unbox_alien" %vm-invoke-1st-arg
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue