X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2Funiversal_call_c.S;h=5860ef5f42aee6692e65b6874ea1a8e34b45ea46;hb=24d0875225a9e155906a2058b9d10b5ad6205164;hp=3f03ff31885a6e42345be39a648416ce4a6254d1;hpb=dee29ec187607a1ae30959b9b45b9ddcd23356ea;p=ghc-hetmet.git

diff --git a/ghc/rts/universal_call_c.S b/ghc/rts/universal_call_c.S
index 3f03ff3..5860ef5 100644
--- a/ghc/rts/universal_call_c.S
+++ b/ghc/rts/universal_call_c.S
@@ -5,8 +5,8 @@
  * Copyright (c) 1994-1999.
  *
  * $RCSfile: universal_call_c.S,v $
- * $Revision: 1.3 $
- * $Date: 1999/10/22 15:58:26 $
+ * $Revision: 1.9 $
+ * $Date: 1999/11/17 13:19:36 $
  * ------------------------------------------------------------------------*/
 	
 #include "config.h"
@@ -64,10 +64,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_ccall
-universal_call_c_x86_ccall:
+
+/*
+ * 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 +89,140 @@ universal_call_c_x86_ccall:
 	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 /* INTERPRETER */