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