ghc/rts/universal_call_c.S

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