ghc/rts/universal_call_c.S

   1 /* --------------------------------------------------------------------------
   2  * Assembly code to call C and Haskell functions
   3  *
   4  * Copyright (c) 1994-2001.
   5  *
   6  * $Id: universal_call_c.S,v 1.11 2001/02/12 12:08:44 sewardj Exp $
   7  * ------------------------------------------------------------------------*/
   8
   9 #include "config.h"
  10
  11 #if sparc_TARGET_ARCH
  12         .text
  13 only_here_to_work_around_a_bug_in_GNU_ld_291_on_sparc:
  14 #endif
  15
  16 #if 0 /* later:  GHCI */
  17
  18         .file "universal_call_c.S"
  19
  20 #if 0
  21    Implement this.  See comment in rts/ForeignCall.c for details.
  22
  23    void universal_call_c_ARCHNAME
  24                          ( int   n_args,
  25                            void* args,
  26                            char* argstr,
  27                            void* fun )
  28
  29    You can get a crude approximation to the assembly you need by
  30    compiling the following:
  31
  32       extern void pingi64 ( unsigned long long int );
  33       extern void pingi32 ( unsigned int );
  34       extern void pingf32 ( float f );
  35       extern void pingf64 ( double d );
  36
  37       void universal_call_c_ARCHNAME ( int   n_args,
  38                                        void* args,
  39                                        char* argstr,
  40                                        void* fun )
  41       {
  42          int i;
  43          for (i = 1; i <= n_args; i++) {
  44            if (argstr[i] == 'i') {
  45               unsigned int u1 = ((unsigned int*)args)[2*i];
  46               pingi32(u1);
  47            } else
  48            if (argstr[i] == 'I') {
  49               unsigned long long int uu1 = ((unsigned long long int*)args)[i];
  50               pingi64(uu1);
  51            } else
  52            if (argstr[i] == 'f') {
  53               float u1 = ((float*)args)[2*i];
  54               pingf32(u1);
  55            } else
  56            if (argstr[i] == 'F') {
  57               double u1 = ((double*)args)[i];
  58               pingf64(u1);
  59            }
  60          }
  61
  62          if (argstr[0] == 'f' || argstr[0] == 'F') {
  63             pingi32(987654321);
  64          } else {
  65             pingi32(123456789);
  66          }
  67       }
  68 #endif
  69
  70 #if LEADING_UNDERSCORE
  71 #define ADD_UNDERSCORE(sss) _##sss
  72 #else
  73 #define ADD_UNDERSCORE(sss) sss
  74 #endif
  75
  76 #if i386_TARGET_ARCH
  77
  78 /*
  79  * Tricky!  Calls the specified function using ccall convention,
  80  * *and* assumes that I myself was called using ccall.
  81  */
  82
  83 .globl ADD_UNDERSCORE(universal_call_c_x86_ccall)
  84 ADD_UNDERSCORE(universal_call_c_x86_ccall:)
  85         pushl %ebp
  86         movl %esp,%ebp
  87         pushl %edi
  88         pushl %esi
  89         pushl %ebx
  90         movl 12(%ebp),%esi
  91         movl 16(%ebp),%edi
  92         movl 8(%ebp),%ebx
  93         testl %ebx,%ebx
  94         jle .Lcdocall
  95
  96 .Lclooptop:
  97         cmpb $105,(%ebx,%edi)   # 'i'
  98         jne .Lc6
  99         pushl (%esi,%ebx,8)
 100         jmp .Lclooptest
 101 .Lc6:
 102         cmpb $73,(%ebx,%edi)    # 'I'
 103         jne .Lc8
 104         pushl 4(%esi,%ebx,8)
 105         pushl (%esi,%ebx,8)
 106         jmp .Lclooptest
 107 .Lc8:
 108         cmpb $102,(%ebx,%edi)   # 'f'
 109         jne .Lc10
 110         movl (%esi,%ebx,8),%eax
 111         pushl %eax
 112         jmp .Lclooptest
 113 .Lc10:
 114         cmpb $70,(%ebx,%edi)    # 'F'
 115         jne .Lclooptest
 116         movl 4(%esi,%ebx,8),%eax
 117         movl (%esi,%ebx,8),%edx
 118         pushl %eax
 119         pushl %edx
 120 .Lclooptest:
 121         decl %ebx
 122         testl %ebx,%ebx
 123         jg .Lclooptop
 124
 125 .Lcdocall:
 126         call *20(%ebp)
 127
 128         cmpb $102,(%edi)        # 'f'
 129         je .Lcfloat32
 130         cmpb $70,(%edi)         # 'F'
 131         je .Lcfloat64
 132 .LciorI:
 133         movl %eax,0(%esi)
 134         movl %edx,4(%esi)
 135         jmp .Lcbye
 136 .Lcfloat32:
 137         fstps 0(%esi)
 138         jmp .Lcbye
 139 .Lcfloat64:
 140         fstpl 0(%esi)
 141         jmp .Lcbye
 142 .Lcbye:
 143         leal -12(%ebp),%esp
 144         popl %ebx
 145         popl %esi
 146         popl %edi
 147         leave
 148         ret
 149
 150
 151
 152 # Almost identical to the above piece of code
 153 # see comments near end for differences
 154
 155 # Even more tricky!  Calls the specified function using
 156 # stdcall convention, *but* assumes that I myself was called
 157 # using ccall.
 158
 159 .globl ADD_UNDERSCORE(universal_call_c_x86_stdcall)
 160 ADD_UNDERSCORE(universal_call_c_x86_stdcall:)
 161         pushl %ebp
 162         movl %esp,%ebp
 163         pushl %edi
 164         pushl %esi
 165         pushl %ebx
 166         movl 12(%ebp),%esi
 167         movl 16(%ebp),%edi
 168         movl 8(%ebp),%ebx
 169         testl %ebx,%ebx
 170         jle .Lsdocall
 171
 172 .Lslooptop:
 173         cmpb $105,(%ebx,%edi)   # 'i'
 174         jne .Ls6
 175         pushl (%esi,%ebx,8)
 176         jmp .Lslooptest
 177 .Ls6:
 178         cmpb $73,(%ebx,%edi)    # 'I'
 179         jne .Ls8
 180         pushl 4(%esi,%ebx,8)
 181         pushl (%esi,%ebx,8)
 182         jmp .Lslooptest
 183 .Ls8:
 184         cmpb $102,(%ebx,%edi)   # 'f'
 185         jne .Ls10
 186         movl (%esi,%ebx,8),%eax
 187         pushl %eax
 188         jmp .Lslooptest
 189 .Ls10:
 190         cmpb $70,(%ebx,%edi)    # 'F'
 191         jne .Lslooptest
 192         movl 4(%esi,%ebx,8),%eax
 193         movl (%esi,%ebx,8),%edx
 194         pushl %eax
 195         pushl %edx
 196 .Lslooptest:
 197         decl %ebx
 198         testl %ebx,%ebx
 199         jg .Lslooptop
 200
 201 .Lsdocall:
 202         call *20(%ebp)
 203
 204         cmpb $102,(%edi)        # 'f'
 205         je .Lsfloat32
 206         cmpb $70,(%edi)         # 'F'
 207         je .Lsfloat64
 208 .LsiorI:
 209         movl %eax,0(%esi)
 210         movl %edx,4(%esi)
 211         jmp .Lsbye
 212 .Lsfloat32:
 213         fstps 0(%esi)
 214         jmp .Lsbye
 215 .Lsfloat64:
 216         fstpl 0(%esi)
 217         jmp .Lsbye
 218 .Lsbye:
 219         /* don_t clear the args -- the callee does it */
 220         /* leal -12(%ebp),%esp */
 221         popl %ebx
 222         popl %esi
 223         popl %edi
 224         leave
 225         /* ret $16     # but we have to clear our own! (no! we were ccall_d) */
 226         ret
 227
 228 #endif /* i386_TARGET_ARCH */
 229
 230 #endif /* GHCI */