Fix make-array transforms.
[sbcl.git] / tools-for-build / ldso-stubs.lisp
index 66e883b..e125e9f 100644 (file)
@@ -1,16 +1,16 @@
-;;;; Generate stubs for C-linkage library functions which we need to refer to 
+;;;; Generate stubs for C-linkage library functions which we need to refer to
 ;;;; from Lisp.
 ;;;;
 ;;;; (But note this is only the Linux version, as per the FIXME
 ;;;; note in the BSD version in undefineds.h.)
 ;;;;
-;;;; These stubs exist for the benefit of Lisp code that needs to refer 
+;;;; These stubs exist for the benefit of Lisp code that needs to refer
 ;;;; to foreign symbols when dlsym() is not available (i.e. when dumping
 ;;;; cold-sbcl.core, when we may be running in a host that's not SBCL,
 ;;;; or on platforms that don't have it at all). If the runtime is
 ;;;; dynamically linked, library functions won't be linked into it, so
 ;;;; the map file won't show them. So, we need a bunch of stubs that
-;;;; nm(1) _can_ see.  
+;;;; nm(1) _can_ see.
 ;;;;
 ;;;; This software is part of the SBCL system. See the README file for
 ;;;; more information.
 ;;;; files for more information.
 
 #!-sparc
-(defun ldso-stubify (fct str)
-  (format str "LDSO_STUBIFY(~A)~%" fct))
+(defun ldso-stubify (fct stream)
+  (format stream "LDSO_STUBIFY(~A)~%" fct))
 
 ;;; This is an attempt to follow DB's hint of sbcl-devel
 ;;; 2001-09-18. -- CSR
 ;;;
 ;;; And an attempt to work around the Sun toolchain... --ns
-#!+sparc 
-(defun ldso-stubify (fct str)
-  (apply #'format str "
+#!+sparc
+(defun ldso-stubify (fct stream)
+  (apply #'format stream "
 .globl ldso_stub__~A ;                          \\
-       FUNCDEF(ldso_stub__~A) ;                \\
+        FUNCDEF(ldso_stub__~A) ;                \\
 ldso_stub__~A: ;                                \\
-       sethi %hi(~A),%g1       ;               \\
-       jmpl %g1+%lo(~A),%g0    ;               \\
-       nop /* delay slot*/     ;               \\
+        sethi %hi(~A),%g1       ;               \\
+        jmpl %g1+%lo(~A),%g0    ;               \\
+        nop /* delay slot*/     ;               \\
 .L~Ae1: ;                                       \\
-       .size    ldso_stub__~A,.L~Ae1-ldso_stub__~A ;~%"
+        .size    ldso_stub__~A,.L~Ae1-ldso_stub__~A ;~%"
           (make-list 9 :initial-element fct)))
 
+#!+hppa
+(defun ldso-stubify (fct stream)
+  (let ((stub (format nil "ldso_stub__~a" fct)))
+    (apply #'format stream (list
+"    .export ~A
+~A:
+    .proc
+    .callinfo
+    b,n ~a
+    .procend
+    .import ~a,code~%" stub stub fct fct))))
+
 (defvar *preludes* '("
 /* This is an automatically generated file, please do not hand-edit it.
  * See the program tools-for-build/ldso-stubs.lisp. */
 
+#ifndef LANGUAGE_ASSEMBLY
 #define LANGUAGE_ASSEMBLY
+#endif
 #include \"sbcl.h\""
 
 #!+sparc "
@@ -55,88 +69,130 @@ ldso_stub__~A: ;                                \\
 #endif
         .text"
 
-#!+(or x86 x86-64) "
+#!+(and (or x86 x86-64) (not darwin)) "
 #define LDSO_STUBIFY(fct)                       \\
-       .align 16 ;                             \\
+        .align 16 ;                             \\
 .globl ldso_stub__ ## fct ;                     \\
-       .type    ldso_stub__ ## fct,@function ; \\
+        .type    ldso_stub__ ## fct,@function ; \\
 ldso_stub__ ## fct: ;                           \\
-       jmp fct ;                               \\
+        jmp fct ;                               \\
 .L ## fct ## e1: ;                              \\
-       .size    ldso_stub__ ## fct,.L ## fct ## e1-ldso_stub__ ## fct ;"
+        .size    ldso_stub__ ## fct,.L ## fct ## e1-ldso_stub__ ## fct ;"
 
 ;;; osf1 has ancient cpp that doesn't do ##
 #!+(and osf1 alpha) "
 #define LDSO_STUBIFY(fct)                       \\
 .globl ldso_stub__/**/fct ;                     \\
 ldso_stub__/**/fct: ;                           \\
-       jmp fct ;                               \\
+        jmp fct ;                               \\
 .L/**/fct/**/e1: ;"
 
 ;;; but there's no reason we need to put up with that on modern (Linux) OSes
 #!+(and linux alpha) "
 #define LDSO_STUBIFY(fct)                       \\
 .globl ldso_stub__ ## fct ;                     \\
-       .type    ldso_stub__ ## fct,@function ; \\
+        .type    ldso_stub__ ## fct,@function ; \\
 ldso_stub__ ## fct: ;                           \\
-       jmp fct ;                               \\
+        jmp fct ;                               \\
 .L ## fct ## e1: ;                              \\
-       .size    ldso_stub__ ## fct,.L ## fct ## e1-ldso_stub__ ## fct ;"
+        .size    ldso_stub__ ## fct,.L ## fct ## e1-ldso_stub__ ## fct ;"
 
-#!+(and linux ppc) "
+#!+hppa "
+        .level  2.0
+        .text"
+
+#!+(and (not darwin) ppc) "
 #define LDSO_STUBIFY(fct)                       \\
 .globl ldso_stub__ ## fct ;                     \\
-       .type    ldso_stub__ ## fct,@function ; \\
+        .type    ldso_stub__ ## fct,@function ; \\
 ldso_stub__ ## fct: ;                           \\
         b fct ;                                 \\
 .L ## fct ## e1: ;                              \\
         .size    ldso_stub__ ## fct,.L ## fct ## e1-ldso_stub__ ## fct ;"
 
 #!+(and darwin ppc) "
-#define LDSO_STUBIFY(fct)                      @\\
+#define LDSO_STUBIFY(fct)                       @\\
 .text                                           @\\
-.globl  ldso_stub___ ## fct                    @\\
-ldso_stub___ ## fct:                           @\\
-       b ldso_stub__ ## fct ## stub            @\\
-.symbol_stub ldso_stub__ ## fct ## stub:       @\\
-.indirect_symbol _ ## fct                      @\\
-       lis     r11,ha16(ldso_stub__ ## fct ## $lazy_ptr)       @\\
-       lwz     r12,lo16(ldso_stub__ ## fct ## $lazy_ptr)(r11)  @\\
-       mtctr   r12                             @\\
-       addi    r11,r11,lo16(ldso_stub__ ## fct ## $lazy_ptr)   @\\
-       bctr                                    @\\
-.lazy_symbol_pointer                           @\\
-ldso_stub__ ## fct ## $lazy_ptr:               @\\
-       .indirect_symbol _ ## fct               @\\
-       .long dyld_stub_binding_helper"
-       
-;;; KLUDGE: set up the vital fifth argument, passed on the 
+.globl  _ldso_stub__ ## fct                      @\\
+_ldso_stub__ ## fct:                             @\\
+        b _ldso_stub__ ## fct ## stub            @\\
+.symbol_stub _ldso_stub__ ## fct ## stub:        @\\
+.indirect_symbol _ ## fct                       @\\
+        lis     r11,ha16(_ldso_stub__ ## fct ## $lazy_ptr)       @\\
+        lwz     r12,lo16(_ldso_stub__ ## fct ## $lazy_ptr)(r11)  @\\
+        mtctr   r12                             @\\
+        addi    r11,r11,lo16(_ldso_stub__ ## fct ## $lazy_ptr)   @\\
+        bctr                                    @\\
+.lazy_symbol_pointer                            @\\
+_ldso_stub__ ## fct ## $lazy_ptr:                @\\
+        .indirect_symbol _ ## fct               @\\
+        .long dyld_stub_binding_helper"
+
+;;; darwin x86 assembler is weird and follows the ppc assembler syntax
+#!+(and darwin x86) "
+#define LDSO_STUBIFY(fct)                       \\
+.text                           ;               \\
+        .align 4 ;                              \\
+.globl _ldso_stub__ ## fct ;                    \\
+_ldso_stub__ ## fct: ;                          \\
+        jmp L ## fct ## $stub ;                 \\
+        .section __IMPORT,__jump_table,symbol_stubs,self_modifying_code+pure_instructions,5 ;   \\
+L ## fct ## $stub: ;                    \\
+        .indirect_symbol _ ## fct ;     \\
+        hlt                       ;     \\
+        hlt                       ;     \\
+        hlt                       ;     \\
+        hlt                       ;     \\
+        hlt                       ;     \\
+        .subsections_via_symbols  ;    "
+
+;;; darwin x86-64
+#!+(and darwin x86-64) "
+#define LDSO_STUBIFY(fct)                       \\
+        .align 4 ;                              \\
+.globl _ldso_stub__ ## fct ;                    \\
+_ldso_stub__ ## fct: ;                          \\
+        jmp _ ## fct ;                          \\
+.L ## fct ## e1: ;                            "
+
+;;; KLUDGE: set up the vital fifth argument, passed on the
 ;;; stack.  Do this unconditionally, even if the stub is for a
 ;;; function with few arguments: it can't hurt.  We only do this for
 ;;; the fifth argument, as the first four are passed in registers
 ;;; and we apparently don't ever need to pass six arguments to a
 ;;; libc function.  -- CSR, 2003-10-29
+;;; Expanded to 8 arguments regardless.  -- ths, 2005-03-24
 #!+mips "
-#define LDSO_STUBIFY(fct)                       \\
-.globl ldso_stub__ ## fct ;                     \\
-       .type    ldso_stub__ ## fct,@function ; \\
-ldso_stub__ ## fct: ;                           \\
-       addiu $29,-48           ; \\
-       sw $28,40($29)          ; \\
-       sw $31,44($29)          ; \\
-       lw $25,64($29)          ; \\
-       sw $25,16($29)          ; \\
-       la $25, fct     ;               \\
-       jalr $25        ;                               \\
-       lw $31,44($29)          ; \\
-       lw $28,40($29)          ; \\
-       addiu $29,48            ; \\
-       jr $31                  ; \\
-.L ## fct ## e1: ;                              \\
-       .size    ldso_stub__ ## fct,.L ## fct ## e1-ldso_stub__ ## fct ;"))
+#define LDSO_STUBIFY(fct)                      \\
+        .globl  ldso_stub__ ## fct ;           \\
+        .type   ldso_stub__ ## fct,@function ; \\
+        .ent    ldso_stub__ ## fct ;           \\
+ldso_stub__ ## fct: ;                  \\
+        .set noat ;                    \\
+        addiu $29,-48 ;                \\
+        sw $28,40($29) ;               \\
+        sw $31,44($29) ;               \\
+        lw $25,64($29) ;               \\
+        lw  $1,68($29) ;               \\
+        sw $25,16($29) ;               \\
+        sw  $1,20($29) ;               \\
+        lw $25,72($29) ;               \\
+        lw  $1,76($29) ;               \\
+        sw $25,24($29) ;               \\
+        sw  $1,28($29) ;               \\
+        .set at ;                      \\
+        la $25, fct ;                  \\
+        jalr $25 ;                     \\
+        lw $31,44($29) ;               \\
+        lw $28,40($29) ;               \\
+        addiu $29,48 ;                 \\
+        jr $31 ;                       \\
+        .end    ldso_stub__ ## fct ;   \\
+        .size   ldso_stub__ ## fct,.-ldso_stub__ ## fct ;"))
 
 (defvar *stubs* (append
-                 '("accept"
+                 '("_exit"
+                   "accept"
                    "access"
                    "acos"
                    "acosh"
@@ -165,6 +221,7 @@ ldso_stub__ ## fct: ;                           \\
                    "fork"
                    "free"
                    "fstat"
+                   #!+inode64 "fstat$INODE64"
                    "fsync"
                    "ftruncate"
                    "getcwd"
@@ -195,17 +252,21 @@ ldso_stub__ ## fct: ;                           \\
                    "log1p"
                    "lseek"
                    "lstat"
+                   #!+inode64 "lstat$INODE64"
                    "malloc"
                    "memmove"
                    "mkdir"
+                   "nanosleep"
                    "nl_langinfo"
                    "open"
                    "opendir"
                    "pipe"
+                   "poll"
                    "pow"
                    "read"
                    "readdir"
                    "readlink"
+                   "realpath"
                    "recv"
                    "rename"
                    "rmdir"
@@ -217,6 +278,7 @@ ldso_stub__ ## fct: ;                           \\
                    "sinh"
                    "socket"
                    "stat"
+                   #!+inode64 "stat$INODE64"
                    "strerror"
                    "strlen"
                    "symlink"
@@ -230,10 +292,11 @@ ldso_stub__ ## fct: ;                           \\
                    "tcsetattr"
                    "truncate"
                    "ttyname"
-                   "tzname"
+                   #!-hpux "tzname"
                    "unlink"
                    "utimes"
-                   "wait3"     
+                   "wait3"
+                   "waitpid"
                    "write")
                  ;; These aren't needed on the X86 because they're microcoded into the
                  ;; FPU, so the Lisp VOPs can implement them directly without having to
@@ -241,27 +304,40 @@ ldso_stub__ ## fct: ;                           \\
                  ;;
                  ;; Note: There might be some other functions in this category as well.
                  ;; E.g. I notice tanh() and acos() in the list above.. -- WHN 2001-06-07
-                 #!-x86 
+                 #!-x86
                  '("sin"
-                   "cos" 
-                   "tan"      
-                   "atan" 
-                   "atan2" 
-                   "exp"      
-                   "log" 
-                   "log10" 
+                   "cos"
+                   "tan"
+                   "atan"
+                   "atan2"
+                   "exp"
+                   "log"
+                   "log10"
                    "sqrt")
                  #!+alpha
                  '("ieee_get_fp_control"
                    "ieee_set_fp_control")
-                 #!-darwin
+                 ;; FIXME: After 1.0 this should be made
+                 ;; #!-linkage-table, as we only need these stubs if
+                 ;; we don't have linkage-table. Done this way now to
+                 ;; cut down on the number of ports affected.
+                 #!-(or win32 darwin freebsd netbsd openbsd)
+                 '("ptsname"
+                   "grantpt"
+                   "unlockpt")
+                 #!+openbsd
+                 '("openpty")
                  '("dlclose"
                    "dlerror"
                    "dlopen"
                    "dlsym")
-                #!+os-provides-dladdr 
-                '("dladdr")
-                 #!-(and sparc sunos) ;; !defined(SVR4)
+                 #!+bsd
+                 '("sysctl")
+                 #!+darwin
+                 '("sysctlbyname")
+                 #!+os-provides-dladdr
+                 '("dladdr")
+                 #!-sunos ;; !defined(SVR4)
                  '("sigsetmask")))
 
 (with-open-file (f "src/runtime/ldso-stubs.S" :direction :output :if-exists :supersede)