X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2Funiversal_call_c.S;h=77f425aff4d37d8dee568c75968a9a8526bf490c;hb=580c816072b2274b6b7f619f8bafcd41661fd4bc;hp=19e425c3de46ec74b514da4e2cd11b40a9d8c123;hpb=0600f5d1cf4882ba6292ea5382e695270b1a6ba1;p=ghc-hetmet.git

diff --git a/ghc/rts/universal_call_c.S b/ghc/rts/universal_call_c.S
index 19e425c..77f425a 100644
--- a/ghc/rts/universal_call_c.S
+++ b/ghc/rts/universal_call_c.S
@@ -1,19 +1,21 @@
-
 /* --------------------------------------------------------------------------
  * Assembly code to call C and Haskell functions 
  *
- * Copyright (c) 1994-1999.
+ * Copyright (c) 1994-2001.
  *
- * $RCSfile: universal_call_c.S,v $
- * $Revision: 1.1 $
- * $Date: 1999/10/19 11:03:39 $
+ * $Id: universal_call_c.S,v 1.11 2001/02/12 12:08:44 sewardj Exp $
  * ------------------------------------------------------------------------*/
 	
 #include "config.h"
-#include "options.h"	
+
+#if sparc_TARGET_ARCH
+	.text
+only_here_to_work_around_a_bug_in_GNU_ld_291_on_sparc:
+#endif
+	
+#if 0 /* later:	 GHCI */
 	
-#ifdef INTERPRETER
-	.file "callfun.S"
+	.file "universal_call_c.S"
 
 #if 0
    Implement this.  See comment in rts/ForeignCall.c for details.
@@ -64,10 +66,22 @@
          }
       }
 #endif
-	
+
+#if LEADING_UNDERSCORE
+#define ADD_UNDERSCORE(sss) _##sss
+#else
+#define ADD_UNDERSCORE(sss) sss
+#endif
+
 #if i386_TARGET_ARCH
-.globl universal_call_c_x86_linux
-universal_call_c_x86_linux:
+
+/*
+ * Tricky!  Calls the specified function using ccall convention,
+ * *and* assumes that I myself was called using ccall.
+ */
+
+.globl ADD_UNDERSCORE(universal_call_c_x86_ccall)
+ADD_UNDERSCORE(universal_call_c_x86_ccall:)
 	pushl %ebp
 	movl %esp,%ebp
 	pushl %edi
@@ -77,61 +91,140 @@ universal_call_c_x86_linux:
 	movl 16(%ebp),%edi
 	movl 8(%ebp),%ebx
 	testl %ebx,%ebx
-	jle docall
+	jle .Lcdocall
 	
-looptop:
+.Lclooptop:
 	cmpb $105,(%ebx,%edi)	# 'i'
-	jne .L6
+	jne .Lc6
 	pushl (%esi,%ebx,8)
-	jmp looptest
-.L6:
+	jmp .Lclooptest
+.Lc6:
 	cmpb $73,(%ebx,%edi)	# 'I'
-	jne .L8
+	jne .Lc8
 	pushl 4(%esi,%ebx,8)
 	pushl (%esi,%ebx,8)
-	jmp looptest
-.L8:
+	jmp .Lclooptest
+.Lc8:
 	cmpb $102,(%ebx,%edi)	# 'f'
-	jne .L10
+	jne .Lc10
 	movl (%esi,%ebx,8),%eax
 	pushl %eax
-	jmp looptest
-.L10:
+	jmp .Lclooptest
+.Lc10:
 	cmpb $70,(%ebx,%edi)	# 'F'
-	jne looptest
+	jne .Lclooptest
 	movl 4(%esi,%ebx,8),%eax
 	movl (%esi,%ebx,8),%edx
 	pushl %eax
 	pushl %edx
-looptest:
+.Lclooptest:
 	decl %ebx
         testl %ebx,%ebx
-	jg looptop
+	jg .Lclooptop
 
-docall:	
+.Lcdocall:	
 	call *20(%ebp)
 	
 	cmpb $102,(%edi)	# 'f'
-	je float32
+	je .Lcfloat32
 	cmpb $70,(%edi)		# 'F'
-	je float64
-iorI:
+	je .Lcfloat64
+.LciorI:
 	movl %eax,0(%esi)
 	movl %edx,4(%esi)
-	jmp bye
-float32:
+	jmp .Lcbye
+.Lcfloat32:
 	fstps 0(%esi)
-	jmp bye
-float64:
+	jmp .Lcbye
+.Lcfloat64:
 	fstpl 0(%esi)
-	jmp bye	
-bye:
+	jmp .Lcbye	
+.Lcbye:
 	leal -12(%ebp),%esp
 	popl %ebx
 	popl %esi
 	popl %edi
 	leave
 	ret
+
+
+	
+# Almost identical to the above piece of code
+# see comments near end for differences 
+
+# Even more tricky!  Calls the specified function using 
+# stdcall convention, *but* assumes that I myself was called 
+# using ccall.
+	
+.globl ADD_UNDERSCORE(universal_call_c_x86_stdcall)
+ADD_UNDERSCORE(universal_call_c_x86_stdcall:)
+	pushl %ebp
+	movl %esp,%ebp
+	pushl %edi
+	pushl %esi
+	pushl %ebx
+	movl 12(%ebp),%esi
+	movl 16(%ebp),%edi
+	movl 8(%ebp),%ebx
+	testl %ebx,%ebx
+	jle .Lsdocall
+	
+.Lslooptop:
+	cmpb $105,(%ebx,%edi)	# 'i'
+	jne .Ls6
+	pushl (%esi,%ebx,8)
+	jmp .Lslooptest
+.Ls6:
+	cmpb $73,(%ebx,%edi)	# 'I'
+	jne .Ls8
+	pushl 4(%esi,%ebx,8)
+	pushl (%esi,%ebx,8)
+	jmp .Lslooptest
+.Ls8:
+	cmpb $102,(%ebx,%edi)	# 'f'
+	jne .Ls10
+	movl (%esi,%ebx,8),%eax
+	pushl %eax
+	jmp .Lslooptest
+.Ls10:
+	cmpb $70,(%ebx,%edi)	# 'F'
+	jne .Lslooptest
+	movl 4(%esi,%ebx,8),%eax
+	movl (%esi,%ebx,8),%edx
+	pushl %eax
+	pushl %edx
+.Lslooptest:
+	decl %ebx
+        testl %ebx,%ebx
+	jg .Lslooptop
+
+.Lsdocall:	
+	call *20(%ebp)
+	
+	cmpb $102,(%edi)	# 'f'
+	je .Lsfloat32
+	cmpb $70,(%edi)		# 'F'
+	je .Lsfloat64
+.LsiorI:
+	movl %eax,0(%esi)
+	movl %edx,4(%esi)
+	jmp .Lsbye
+.Lsfloat32:
+	fstps 0(%esi)
+	jmp .Lsbye
+.Lsfloat64:
+	fstpl 0(%esi)
+	jmp .Lsbye	
+.Lsbye:
+	/* don_t clear the args -- the callee does it */
+	/* leal -12(%ebp),%esp */
+	popl %ebx
+	popl %esi
+	popl %edi
+	leave
+	/* ret $16     # but we have to clear our own! (no! we were ccall_d) */
+	ret
+
 #endif /* i386_TARGET_ARCH */
 	
-#endif /* INTERPRETER */
\ No newline at end of file
+#endif /* GHCI */