From efd9aa3bc7ea4b3aec98f522bedcb9656f4973f5 Mon Sep 17 00:00:00 2001 From: pw <pw> Date: Sat, 23 Aug 1997 16:00:23 +0000 Subject: [PATCH] I just finished making load-foreign work on SGIs, along with fixing calling of foreign functions taking floating-point arguments after integer arguments but before the fourth argument (more or less; mips has unusual C calling conventions), and making cmucl work on IRIX 6.2 on the Onyx (where the system page size has changed). I've included the patches below, along with some discussion of the changes and a couple of problems with cmucl's interaction with dynamic loading. Also, there's a misc change to make ioctls work (I'm not sure for what version the released code worked, but it doesn't work on anything I have). The patches do not fix the R10000; cmucl continues to not work on it (O2 and Octane). The fixes make cmucl on the sgi use shared libraries so it can use dlopen et al in load-foreign; this is based on the solaris implementation. The problem with this is that the addresses of foreign variables are included directly in the dumped lisp image (without relocation on loading), which might result in a problem if cmucl is run with newer shared libraries than those it was compiled and dumped with. As far as I can tell, for the SGI at least, this does not affect function calls because the addresses used (and included in the dumped image) are those of stub routines that jump to the actual routines, thus are located in the executable proper rather than in the shared libraries, and so shouldn't be changed by a new version of the shared library. Unfortunately, this is not the case for global variables. Fortunately, there appear to only be two foreign variables used by cmucl in any of its system code winding up in the dumped image: errno and tzname. Apparently, Solaris relocates data references in dsos to match the program, while IRIX relocates data references in the program to match the dso. Thus, on Solaris, you don't need to do anything special for cmucl to work with a newer runtime libc, but on IRIX it gets the wrong value of errno and tzname. Unfortunately, the address of errno is different between irix 6.2, 6.3, and 6.4 (all of which we have to have because SGI doesn't have a single cross-platform OS version yet), which would require a different lisp.core for each machine (you just need to run mk-lisp, not recompile) if it weren't for the hack below. But fortunately again, a lisp compiled for one version seems to be able to run on another version well enough to generate the new lisp.core (presumably the worst that would happen is that error messages could be confusing). It would be really nice to avoid this problem. Perhaps some kind of relocation table could be added to the dumped image format? I don't know enough about the system to know how possible or ridiculous that suggestion is, unfortunately. Is the Solaris behavior guaranteed to be the same in future releases? If not, or if any other platforms have the irix behavior, this might become a more general problem. In the meantime, we use a hack: we *define* errno in undefineds.c rather than just referencing it; this results in warnings from the linker, but it resolves the conflict in favor of the definition in the program, relocating libc to match, thus fixing this problem for errno. The other global variables, tzname et al, can't be fixed this way as easily because they're listed as weak symbols, essentially aliases for the real symbol, so redefining them wouldn't cause libc to reference the new version. Thus, as long as you don't use tzname, there's no problem right now (although there may be if any other library global variables are used in cmucl in the future). The definition of tzname is in a progn preceeded by a comment which says not to use it, so hopefully it's not in fact used and therefore not a problem. These patches have been tested on an R5000 O2 running irix 6.3 and a dual R4400 Onyx running irix 6.2. A previous version of these patches (for 17f) was tested on the onyx when it was running 5.3 (I think, maybe 5.2). The patches here are from the main branch of the CVS tar as of August 13. Incidentally, it was quite painful figuring out how to compile and bootstrap the current sources under the distributed irix 18a binary, even without trying :new-random or :signed-array (which I haven't tried to do yet); it might be nice to put a newer binary up... --- code/exports.lisp | 4 +- code/foreign.lisp | 40 ++-- code/load.lisp | 7 +- code/unix.lisp | 14 +- compiler/generic/core.lisp | 9 +- compiler/generic/new-genesis.lisp | 7 +- compiler/mips/c-call.lisp | 10 +- compiler/mips/float.lisp | 62 +++++- compiler/mips/insts.lisp | 32 ++- compiler/mips/parms.lisp | 4 +- compiler/mips/vm.lisp | 16 +- lisp/Config.sgi_52 | 18 +- lisp/irix-asm-munge.c | 100 +++++++++ lisp/irix-nm | 7 +- lisp/irix-os.h | 6 +- lisp/lisp.h | 4 +- lisp/mips-assem.S | 26 ++- lisp/undefineds.c | 49 ++++- lisp/undefineds.h | 338 +++++++++++++++--------------- 19 files changed, 527 insertions(+), 226 deletions(-) create mode 100644 lisp/irix-asm-munge.c diff --git a/code/exports.lisp b/code/exports.lisp index 4b6cff14d..4d22e6d81 100644 --- a/code/exports.lisp +++ b/code/exports.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.120 1997/06/11 18:32:18 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.121 1997/08/23 15:59:56 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -642,6 +642,7 @@ "DOUBLE-FLOAT-NORMAL-EXPONENT-MIN" "DOUBLE-FLOAT-SIGNIFICAND-BYTE" "DOUBLE-FLOAT-SIZE" "DOUBLE-FLOAT-TRAPPING-NAN-BIT" "DOUBLE-FLOAT-TYPE" "DOUBLE-FLOAT-VALUE-SLOT" + #+SGI "DOUBLE-INT-CARG-REG-SC-NUMBER" "DOUBLE-REG-SC-NUMBER" "DOUBLE-STACK-SC-NUMBER" "ERROR-TRAP" "EVEN-FIXNUM-TYPE" "EXPORTED-STATIC-SYMBOLS" "FIND-HOLES" "FIXNUM" "FIXUP-CODE-OBJECT" "FLOAT-DIVIDE-BY-ZERO-TRAP-BIT" @@ -692,6 +693,7 @@ "SINGLE-FLOAT-NORMAL-EXPONENT-MIN" "SINGLE-FLOAT-SIGNIFICAND-BYTE" "SINGLE-FLOAT-SIZE" "SINGLE-FLOAT-TRAPPING-NAN-BIT" "SINGLE-FLOAT-TYPE" "SINGLE-FLOAT-VALUE-SLOT" + #+SGI "SINGLE-INT-CARG-REG-SC-NUMBER" "SINGLE-REG-SC-NUMBER" "SINGLE-STACK-SC-NUMBER" "SLOT-DOCS" "SLOT-LENGTH" "SLOT-NAME" "SLOT-OFFSET" "SLOT-OPTIONS" "SLOT-REST-P" "STATIC-SYMBOL-OFFSET" "STATIC-SYMBOL-P" diff --git a/code/foreign.lisp b/code/foreign.lisp index 40f084d4c..b09d667f4 100644 --- a/code/foreign.lisp +++ b/code/foreign.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/foreign.lisp,v 1.23 1997/08/05 20:41:12 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/foreign.lisp,v 1.24 1997/08/23 15:59:59 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -241,7 +241,11 @@ #+hppa (defconstant reloc-magic #x106) #+hppa +(defconstant cpu-pa-risc1-0 #x20b) +#+hppa (defconstant cpu-pa-risc1-1 #x210) +#+hppa +(defconstant cpu-pa-risc-max #x2ff) #+hppa (defun load-object-file (name) @@ -284,7 +288,7 @@ )) (unix:unix-close fd)))) -#-(or linux solaris) +#-(or linux solaris irix) (defun parse-symbol-table (name) (format t ";;; Parsing symbol table...~%") (let ((symbol-table (make-hash-table :test #'equal))) @@ -332,7 +336,10 @@ #+hpux (dolist (f files) (with-open-file (stream f :element-type '(unsigned-byte 16)) - (unless (eql (read-byte stream) cpu-pa-risc1-1) + (unless (let ((sysid (read-byte stream))) + (or (eql sysid cpu-pa-risc1-0) + (and (>= sysid cpu-pa-risc1-1) + (<= sysid cpu-pa-risc-max)))) (error "Object file is wrong format, so can't load-foreign:~ ~% ~S" f)) @@ -375,19 +382,22 @@ (export '(alternate-get-global-address)) -#-(or freebsd solaris linux) +#-(or freebsd solaris linux irix) (defun alternate-get-global-address (symbol) (declare (type simple-string symbol) (ignore symbol)) 0) -#+(or linux solaris) +#+(or linux solaris irix) (progn (defconstant rtld-lazy 1) (defconstant rtld-now 2) -(defconstant rtld-global #o400) +(defconstant rtld-global #-irix #o400 #+irix 4) (defvar *global-table* NIL) +(defvar *dso-linker* + #+solaris "/usr/ccs/bin/ld" + #+(or linux irix) "/usr/bin/ld") (alien:def-alien-routine dlopen system-area-pointer (str c-call:c-string) (i c-call:int)) @@ -403,7 +413,7 @@ (let ((sap (dlopen file (logior rtld-now rtld-global)))) (if (zerop (sap-int sap)) (error "Can't open object ~S: ~S" file (dlerror)) - (pushnew sap *global-table*)))) + (pushnew sap *global-table* :test #'sap=)))) (defun alternate-get-global-address (symbol) (unless *global-table* @@ -441,15 +451,13 @@ (let ((output-file (pick-temporary-file-name (concatenate 'string "/tmp/~D~C" (string (gensym))))) (error-output (make-string-output-stream))) - - #-linux (format t ";;; Running /usr/ccs/bin/ld...~%") - #+linux (format t ";;; Running /usr/bin/ld...~%") + + (format t ";;; Running ~A...~%" *dso-linker*) (force-output) (let ((proc (ext:run-program - #-linux "/usr/ccs/bin/ld" - #+linux "/usr/bin/ld" + *dso-linker* (list* - "-G" + #+(or solaris linux) "-G" #+irix "-shared" "-o" output-file (append (mapcar #'(lambda (name) @@ -463,12 +471,10 @@ :output error-output :error :output))) (unless proc - (error #+linux "Could not run /usr/bin/ld" - #-linux "Could not run /usr/ccs/bin/ld")) + (error "Could not run ~A" *dso-linker*)) (unless (zerop (ext:process-exit-code proc)) (system:serve-all-events 0) - (error #-linux "/usr/ccs/bin/ld failed:~%~A" - #+linux "/usr/bin/ld failed:~%~A" + (error "~A failed:~%~A" *dso-linker* (get-output-stream-string error-output))) (load-object-file output-file) (unix:unix-unlink output-file) diff --git a/code/load.lisp b/code/load.lisp index 36b2a1f17..0473d50b5 100644 --- a/code/load.lisp +++ b/code/load.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.63 1997/06/11 18:22:02 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.64 1997/08/23 16:00:01 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1270,7 +1270,10 @@ (multiple-value-bind (value found) (gethash symbol *foreign-symbols* 0) - (if found + ;; can't make irix linker give values in the symbol table to global vars + ;;from dsos, so we have to resolve at runtime (and handle symbols being + ;;defined with null values) + (if #-irix found #+irix (and found (not (zerop value))) value (let ((value (system:alternate-get-global-address symbol))) (when (zerop value) diff --git a/code/unix.lisp b/code/unix.lisp index 40a4736a9..dceb61765 100644 --- a/code/unix.lisp +++ b/code/unix.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix.lisp,v 1.49 1997/06/15 21:27:31 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix.lisp,v 1.50 1997/08/23 16:00:04 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -731,14 +731,8 @@ ;;; And now for something completely different ... (emit-unix-errors) -#-irix (def-alien-variable ("errno" unix-errno) int) -#+irix -(setf (alien::heap-alien-info-sap-form - (info variable alien::alien-info 'unix-errno)) - (int-sap (alien-funcall (extern-alien "__oserror" (function int))))) - ;;; GET-UNIX-ERROR-MSG -- public. ;;; (defun get-unix-error-msg (&optional (error-number unix-errno)) @@ -1422,7 +1416,7 @@ (eval-when (compile load eval) -#-(or svr4 linux) +#-(or (and svr4 (not irix)) linux) (progn (defconstant iocparm-mask #x7f) ; Freebsd: #x1fff ? (defconstant ioc_void #x20000000) @@ -1430,7 +1424,7 @@ (defconstant ioc_in #x80000000) (defconstant ioc_inout (logior ioc_in ioc_out))) -#-(or linux svr4) +#-(or linux (and svr4 (not irix))) (defmacro define-ioctl-command (name dev cmd arg &optional (parm-type :void)) (let* ((ptype (ecase parm-type (:void ioc_void) @@ -1447,7 +1441,7 @@ `(eval-when (eval load compile) (defconstant ,name ,code)))) -#+(or linux svr4) +#+(or linux (and svr4 (not irix))) (defmacro define-ioctl-command (name dev cmd arg &optional (parm-type :void)) (declare (ignore dev arg parm-type)) `(eval-when (eval load compile) diff --git a/compiler/generic/core.lisp b/compiler/generic/core.lisp index 9db1e04f5..49eae548f 100644 --- a/compiler/generic/core.lisp +++ b/compiler/generic/core.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/core.lisp,v 1.34 1997/04/02 20:53:35 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/core.lisp,v 1.35 1997/08/23 16:00:06 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -95,8 +95,13 @@ (gethash name lisp::*assembler-routines*)) (:foreign (assert (stringp name)) + ;; XXX perhaps we should use foreign-symbol-address-aux on linux + ;;too? #-linux - (gethash name lisp::*foreign-symbols*) + (let ((val (lisp::foreign-symbol-address-aux name))) + ;; lisp::foreign-symbol-address-aux always signals exactly the + ;; same error we would if the symbol isn't found + (values val t)) #+linux (multiple-value-bind (value found) diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp index fffd0c880..35e031089 100644 --- a/compiler/generic/new-genesis.lisp +++ b/compiler/generic/new-genesis.lisp @@ -4,7 +4,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.23 1997/03/15 19:54:24 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.24 1997/08/23 16:00:08 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1638,7 +1638,10 @@ ((and is-linux (gethash (concatenate 'string "PVE_stub_" name) *cold-foreign-symbol-table* nil))) ;; Non-linux case - ((gethash name *cold-foreign-symbol-table* nil)) + ((let ((value (gethash name *cold-foreign-symbol-table* nil))) + #+irix (when (and (numberp value) (zerop value)) + (warn "Not-really-defined foreign symbol: ~S" name)) + value)) ((and is-linux (gethash (concatenate 'string "__libc_" name) *cold-foreign-symbol-table* nil))) ((and is-linux (gethash (concatenate 'string "__" name) diff --git a/compiler/mips/c-call.lisp b/compiler/mips/c-call.lisp index 2efe17f6f..abf2888d9 100644 --- a/compiler/mips/c-call.lisp +++ b/compiler/mips/c-call.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/c-call.lisp,v 1.13 1994/10/31 04:44:16 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/c-call.lisp,v 1.14 1997/08/23 16:00:11 pw Rel $") ;;; ;;; ********************************************************************** ;;; @@ -70,7 +70,9 @@ 'double-reg (+ (* float-args 2) 12))) (t - (error "Can't put floats in int regs yet."))))) + (my-make-wired-tn 'double-float + 'double-int-carg-reg + (+ stack-frame-size 4)))))) (def-alien-type-method (single-float :arg-tn) (type state) (declare (ignore type)) @@ -88,7 +90,9 @@ 'single-reg (+ (* float-args 2) 12))) (t - (error "Can't put floats in int regs yet."))))) + (my-make-wired-tn 'single-float + 'single-int-carg-reg + (+ stack-frame-size 4)))))) (defstruct result-state diff --git a/compiler/mips/float.lisp b/compiler/mips/float.lisp index 64bfbc60f..a13893ef4 100644 --- a/compiler/mips/float.lisp +++ b/compiler/mips/float.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/float.lisp,v 1.20 1994/10/31 04:44:16 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/float.lisp,v 1.21 1997/08/23 16:00:12 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -178,6 +178,66 @@ (define-move-vop move-argument :move-argument (single-reg double-reg) (descriptor-reg)) +;; stuff for c-call float-in-int-register arguments + +(define-vop (move-to-single-int-reg) + (:args (x :scs (single-reg descriptor-reg))) + (:results (y :scs (single-int-carg-reg) :load-if nil)) + (:note "pointer to float-in-int coercion") + (:generator 1 + (sc-case x + (single-reg + (inst mfc1 y x)) + (descriptor-reg + (inst lw y x (- (* single-float-value-slot word-bytes) + other-pointer-type)))) + (inst nop))) ;nop needed here? +(define-move-vop move-to-single-int-reg + :move (single-reg descriptor-reg) (single-int-carg-reg)) + +(define-vop (move-single-int-reg) + (:args (x :target y :scs (single-int-carg-reg) :load-if nil) + (fp :scs (any-reg) :load-if (not (sc-is y single-int-carg-reg)))) + (:results (y :scs (single-int-carg-reg) :load-if nil)) + (:generator 1 + (unless (location= x y) + (error "Huh? why did it do that?")))) +(define-move-vop move-single-int-reg :move-argument + (single-int-carg-reg) (single-int-carg-reg)) + +(define-vop (move-to-double-int-reg) + (:args (x :scs (double-reg descriptor-reg))) + (:results (y :scs (double-int-carg-reg) :load-if nil)) + (:note "pointer to float-in-int coercion") + (:generator 2 + (sc-case x + (double-reg + (ecase (backend-byte-order *backend*) + (:big-endian + (inst mfc1-odd2 y x) + (inst mfc1-odd y x)) + (:little-endian + (inst mfc1 y x) + (inst mfc1-odd3 y x)))) + (descriptor-reg + (inst lw y x (- (* double-float-value-slot word-bytes) + other-pointer-type)) + (inst lw-odd y x (- (* (1+ double-float-value-slot) word-bytes) + other-pointer-type)))) + (inst nop))) ;nop needed here? +(define-move-vop move-to-double-int-reg + :move (double-reg descriptor-reg) (double-int-carg-reg)) + +(define-vop (move-double-int-reg) + (:args (x :target y :scs (double-int-carg-reg) :load-if nil) + (fp :scs (any-reg) :load-if (not (sc-is y double-int-carg-reg)))) + (:results (y :scs (double-int-carg-reg) :load-if nil)) + (:generator 2 + (unless (location= x y) + (error "Huh? why did it do that?")))) +(define-move-vop move-double-int-reg :move-argument + (double-int-carg-reg) (double-int-carg-reg)) + ;;;; Arithmetic VOPs: diff --git a/compiler/mips/insts.lisp b/compiler/mips/insts.lisp index d930ae9f4..416140dac 100644 --- a/compiler/mips/insts.lisp +++ b/compiler/mips/insts.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/insts.lisp,v 1.50 1994/10/31 04:44:16 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/insts.lisp,v 1.51 1997/08/23 16:00:13 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -927,6 +927,22 @@ (emit-register-inst segment cop1-op #b00000 (reg-tn-encoding to) (1+ (fp-reg-tn-encoding from)) 0 0))) +(define-instruction mfc1-odd2 (segment to from) + (:declare (type tn to from)) + (:dependencies (reads from) (writes to)) + (:delay 1) + (:emitter + (emit-register-inst segment cop1-op #b00000 (1+ (reg-tn-encoding to)) + (fp-reg-tn-encoding from) 0 0))) + +(define-instruction mfc1-odd3 (segment to from) + (:declare (type tn to from)) + (:dependencies (reads from) (writes to)) + (:delay 1) + (:emitter + (emit-register-inst segment cop1-op #b00000 (1+ (reg-tn-encoding to)) + (1+ (fp-reg-tn-encoding from)) 0 0))) + (define-instruction cfc1 (segment reg cr) (:declare (type tn reg) (type (unsigned-byte 5) cr)) (:printer register ((op cop1-op) (rs #b00010) (rd nil :type 'control-reg) @@ -1186,12 +1202,13 @@ ;;;; Loads and Stores -(defun emit-load/store-inst (segment opcode reg base index) +(defun emit-load/store-inst (segment opcode reg base index + &optional (oddhack 0)) (when (fixup-p index) (note-fixup segment :addi index) (setf index 0)) (emit-immediate-inst segment opcode (reg-tn-encoding reg) - (reg-tn-encoding base) index)) + (+ (reg-tn-encoding base) oddhack) index)) (defconstant load-store-printer '(:name :tab @@ -1235,6 +1252,15 @@ (:emitter (emit-load/store-inst segment #b100011 base reg index))) +;; next is just for ease of coding double-in-int c-call convention +(define-instruction lw-odd (segment reg base &optional (index 0)) + (:declare (type tn reg base) + (type (or (signed-byte 16) fixup) index)) + (:dependencies (reads base) (reads :memory) (writes reg)) + (:delay 1) + (:emitter + (emit-load/store-inst segment #b100011 base reg index 1))) + (define-instruction lbu (segment reg base &optional (index 0)) (:declare (type tn reg base) (type (or (signed-byte 16) fixup) index)) diff --git a/compiler/mips/parms.lisp b/compiler/mips/parms.lisp index 42a290761..ac6aff165 100644 --- a/compiler/mips/parms.lisp +++ b/compiler/mips/parms.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/parms.lisp,v 1.111 1994/10/31 04:44:16 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/parms.lisp,v 1.112 1997/08/23 16:00:15 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -41,7 +41,7 @@ (setf (backend-register-save-penalty *target-backend*) 3) (setf (backend-byte-order *target-backend*) #+pmax :little-endian #+sgi :big-endian) -(setf (backend-page-size *target-backend*) 4096) +(setf (backend-page-size *target-backend*) 16384) ); eval-when diff --git a/compiler/mips/vm.lisp b/compiler/mips/vm.lisp index bd280abd2..f7215ec77 100644 --- a/compiler/mips/vm.lisp +++ b/compiler/mips/vm.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/vm.lisp,v 1.49 1994/10/31 04:44:16 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/vm.lisp,v 1.50 1997/08/23 16:00:17 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -228,7 +228,19 @@ :alternate-scs (double-stack)) ;; A catch or unwind block. - (catch-block control-stack :element-size vm:catch-block-size)) + (catch-block control-stack :element-size vm:catch-block-size) + + ;; floating point numbers temporarily stuck in integer registers for c-call + (single-int-carg-reg registers + :locations (4 5 6 7) + :alternate-scs () + :constant-scs ()) + (double-int-carg-reg registers + :locations (4 6) + :constant-scs () + :alternate-scs () + :alignment 2 ;is this needed? + :element-size 2)) diff --git a/lisp/Config.sgi_52 b/lisp/Config.sgi_52 index 4e4e3c3c2..c2a16d0d1 100644 --- a/lisp/Config.sgi_52 +++ b/lisp/Config.sgi_52 @@ -3,18 +3,28 @@ CPPFLAGS = -I. -Dirix -DSVR4 CC = cc # -Wall -Wstrict-prototypes -Wmissing-prototypes CPP = cpp -CFLAGS = -Dirix -DSVR4 -D_BSD_SIGNALS -non_shared -g +CFLAGS = -Dirix -DSVR4 -D_BSD_SIGNALS -g # For some reason mips-assem.S and mips-assem.s must both be linked to the # mips-assem.S source file. It seems that .S means something wierd on this # platform. Also, make sure that "as" is /usr/bin/as, not the # gnu assembler. -ASFLAGS = -g -Dirix -non_shared +ASFLAGS = -g -Dirix -NM = irix-nm +NM = ./irix-nm UNDEFSYMPATTERN=-Xlinker -u -Xlinker & ASSEM_SRC = mips-assem.S ARCH_SRC = mips-arch.c OS_SRC = irix-os.c os-common.c undefineds.c -OS_LINK_FLAGS= -non_shared +OS_LINK_FLAGS= OS_LIBS= + +# special rules for working around sgi compiler bug, see comments at start +# of irix-asm-munge.c + +irix-asm-munge: irix-asm-munge.c internals.h + cc -g -o $@ irix-asm-munge.c -lelf + +mips-assem.o: mips-assem.S irix-asm-munge + as $(ASFLAGS) -o $@ mips-assem.S + ./irix-asm-munge $@ diff --git a/lisp/irix-asm-munge.c b/lisp/irix-asm-munge.c new file mode 100644 index 000000000..c58cc4d08 --- /dev/null +++ b/lisp/irix-asm-munge.c @@ -0,0 +1,100 @@ +/* This program takes an object file assumed to be the output of assembling + mips-assem.s and munges certain locations to have the right values, in + order to work around a bug (SGI may disagree) in SGI's assembler that + disallows .word, .byte, etc in .text sections in PIC code (but not in + non_shared). + + Specifically, we stuck "break 11" where we need to munge afterwards, and + put global labels beforehand. "break 11" is 0x000B000D + + mipsmungelra points to one break which should have been + .word type_ReturnPcHeader, so we replace it with that value as an int + undefined_tramp points 4 bytes before two breaks which should be replaced + by 0x0417FECC and 0x01000000 respectively (they were magic numbers in the + original code too) + function_end_breakpoint_guts points to a break that should have been + .word type_ReturnPcHeader, so replace it too. + + The file is written in place. + */ +#include <stdio.h> +#include <unistd.h> +#include <libelf.h> +#include <sys/types.h> +#include <sys/stat.h> +#include <fcntl.h> +#include <assert.h> +#include <nlist.h> +#include "lisp.h" +#include "internals.h" + +struct nlist nl[] = { + {"mipsmungelra", 0, 0}, + {"undefined_tramp", 0, 0}, + {"function_end_breakpoint_guts", 0, 0}, + {NULL, 0, 0}}; + +main(int argc, char **argv) +{ + int fd; + Elf *elf; + Elf32_Ehdr *ehdr; + Elf_Scn *scn; + Elf_Data *data; + Elf32_Half ndx; + Elf32_Shdr *shdr; + unsigned int *textdata; + + if(argc != 2) exit(2); + + assert(!nlist(argv[1], nl)); + assert(nl[0].n_value && !(nl[0].n_value&0x3)); + assert(nl[1].n_value && !(nl[1].n_value&0x3)); + assert(nl[2].n_value && !(nl[2].n_value&0x3)); + + if(elf_version(EV_CURRENT) == EV_NONE) { + fprintf(stderr, "ELF punted! Recompile %s\n", argv[0]); + exit(1); + } + + fd = open(argv[1], O_RDWR); + if(fd < 0) { + perror("open"); + exit(1); + } + + elf = elf_begin(fd, ELF_C_RDWR, NULL); + + ehdr = elf32_getehdr(elf); + assert(ehdr); + /* want SHT_PROGBITS section named .text */ + ndx = ehdr->e_shstrndx; + scn = NULL; + while((scn = elf_nextscn(elf, scn))) { + char *name = NULL; + if((shdr = elf32_getshdr(scn))) + name = elf_strptr(elf, ndx, (size_t)shdr->sh_name); + if(!strcmp(name, ".text")) break; + } + + data = elf_getdata(scn, NULL); + assert(data && data->d_size && !data->d_off); + textdata = (unsigned int*)data->d_buf; + + /* process */ + assert(textdata[nl[0].n_value/4] == 0x000B000D); + textdata[nl[0].n_value/4] = type_ReturnPcHeader; + + assert(textdata[nl[1].n_value/4] == 0x000A000D); + assert(textdata[nl[1].n_value/4+1] == 0x000B000D); + assert(textdata[nl[1].n_value/4+2] == 0x000B000D); + textdata[nl[1].n_value/4+1] = 0x0417FECC; + textdata[nl[1].n_value/4+2] = 0x01000000; + + assert(textdata[nl[2].n_value/4] == 0x000B000D); + textdata[nl[2].n_value/4] = type_ReturnPcHeader; + + elf_flagdata(data, ELF_C_SET, ELF_F_DIRTY); + elf_update(elf, ELF_C_WRITE); + elf_end(elf); + } diff --git a/lisp/irix-nm b/lisp/irix-nm index bcc22d46a..a1bcabfcc 100755 --- a/lisp/irix-nm +++ b/lisp/irix-nm @@ -1,5 +1,8 @@ -#!/bin/csh -f +#!/bin/sh -/bin/nm -Bgv $argv | sed -e 's/ (weak)//' +#errnoaddr=`/bin/nm -Bg /usr/lib/libc.so|fgrep ' D errno'|sed -e 's/ .*//'` +tznameaddr=`/bin/nm -Bg /usr/lib/libc.so|fgrep ' D tzname'|sed -e 's/ .*//'` + +/bin/nm -Bgv $* | sed -e 's/ (weak)//' -e "/ U errno/ s/00000000 /$errnoaddr /" -e "/ U tzname/ s/00000000 /$tznameaddr /"|sort -k1,1 exit 0 diff --git a/lisp/irix-os.h b/lisp/irix-os.h index 5b482c1d2..89dc6d7e9 100644 --- a/lisp/irix-os.h +++ b/lisp/irix-os.h @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/irix-os.h,v 1.2 1994/10/27 17:13:54 ram Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/irix-os.h,v 1.3 1997/08/23 16:00:20 pw Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -19,4 +19,6 @@ typedef int os_vm_prot_t; #define OS_VM_PROT_WRITE PROT_WRITE #define OS_VM_PROT_EXECUTE PROT_EXECUTE -#define OS_VM_DEFAULT_PAGESIZE 4096 +/* formerly 4096, on irix 6.2 on an R4400 Onyx, and irix 6.4 on an Octane, + pagesize is 16384 */ +#define OS_VM_DEFAULT_PAGESIZE 16384 diff --git a/lisp/lisp.h b/lisp/lisp.h index ecd37773f..1b78b1eeb 100644 --- a/lisp/lisp.h +++ b/lisp/lisp.h @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.h,v 1.3 1997/01/21 00:28:13 ram Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.h,v 1.4 1997/08/23 16:00:21 pw Exp $ */ #ifndef _LISP_H_ #define _LISP_H_ @@ -52,4 +52,4 @@ typedef u32 lispobj; #define SymbolFunction(sym) \ (((struct fdefn *)(SymbolValue(sym)-type_OtherPointer))->function) -#endif _LISP_H_ +#endif /* _LISP_H_ */ diff --git a/lisp/mips-assem.S b/lisp/mips-assem.S index 88e8b9403..a377fabc4 100644 --- a/lisp/mips-assem.S +++ b/lisp/mips-assem.S @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/mips-assem.S,v 1.6 1994/07/20 16:52:41 hallgren Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/mips-assem.S,v 1.7 1997/08/23 16:00:22 pw Exp $ */ #ifdef mach #include <machine/regdef.h> #else @@ -102,8 +102,16 @@ call_into_lisp: .set noreorder .align 3 +#ifdef irix +.globl mipsmungelra /* for our munging afterwards in irix-asm-munge */ +mipsmungelra: +#endif lra: +#ifndef irix .word type_ReturnPcHeader +#else + break 11 +#endif /* Multiple value return spot, clear stack */ move reg_CSP, reg_OCFP @@ -168,6 +176,9 @@ call_into_c: addu reg_NL4, type_OtherPointer sw reg_NL4, 4(reg_CFP) sw reg_CODE, 8(reg_CFP) +#ifdef irix + sw gp, 12(reg_CFP) +#endif /* Note: the C stack is already set up. */ @@ -197,6 +208,10 @@ call_into_c: move t9, reg_CFUNC #endif jal reg_CFUNC +#ifdef irix + /* we rely on assembler to insert a nop between the jal and this */ + lw gp, 12(reg_CFP) +#endif /* Clear unsaved descriptor regs */ move t0, zero @@ -259,12 +274,17 @@ start_of_tramps: .ent undefined_tramp undefined_tramp: break 10 +#ifdef irix + break 11 + break 11 +#else .byte 4 .byte 23 .byte 254 .byte 204 .byte 1 .align 2 +#endif .end undefined_tramp /* @@ -294,7 +314,11 @@ end_of_tramps: .set noreorder .globl function_end_breakpoint_guts function_end_breakpoint_guts: +#ifndef irix .word type_ReturnPcHeader +#else + break 11 +#endif beq zero, zero, 1f nop move reg_OCFP, reg_CSP diff --git a/lisp/undefineds.c b/lisp/undefineds.c index 0b8e2a014..3bd7e9c9d 100644 --- a/lisp/undefineds.c +++ b/lisp/undefineds.c @@ -1,5 +1,5 @@ /* Routines that must be linked into the core for lisp to work. */ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/undefineds.c,v 1.4 1997/06/18 08:57:22 dtc Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/undefineds.c,v 1.5 1997/08/23 16:00:23 pw Exp $ */ #ifdef sun #ifndef MACH @@ -12,17 +12,54 @@ typedef int func(); extern func +#define F(x) x, +#if !(defined(irix) || defined(SOLARIS)) +/* XXXfixme next line probably wrong; was previous behavior */ +#define D(x) x, +#else +#define D(x) +#endif #include "undefineds.h" -; +#undef F +#undef D +exit; /* just a random function known to exist */ + +#if defined(SOLARIS) || defined(irix) -#ifdef SOLARIS -void reference_random_symbols_fun(void) { +#ifdef irix +int errno; /* hack to be sure works with newer libc without having to redump */ + /* causes libc to be relocated to match cmucl rather than vice + versa */ #endif +extern int +#define F(x) +#define D(x) x, +#include "undefineds.h" +#undef F +#undef D +errno; /* a random variable known to exist */ + +int reference_random_symbols(void) { + int a; +#define F(x) x(); +#define D(x) a+=x; +#include "undefineds.h" +#undef F +#undef D + return a; + } + +#else + func *reference_random_symbols[] = { +#define F(x) x, + /* XXXfixme next line is probably wrong but was previous behavior */ +#define D(x) x, #include "undefineds.h" +#undef F +#undef D + exit /* a random function known to exist */ }; -#ifdef SOLARIS -} #endif diff --git a/lisp/undefineds.h b/lisp/undefineds.h index 5f14692e1..4fad28f43 100644 --- a/lisp/undefineds.h +++ b/lisp/undefineds.h @@ -1,231 +1,241 @@ /* Routines that must be linked into the core for lisp to work. */ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/undefineds.h,v 1.18 1997/06/07 15:25:41 pw Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/undefineds.h,v 1.19 1997/08/23 16:00:23 pw Exp $ */ /* Pick up all the syscalls. */ -accept, -access, -acct, +F(accept) +F(access) +F(acct) #ifndef hpux -adjtime, -#endif -bind, -brk, -chdir, -chmod, -chown, -chroot, -close, -connect, -creat, -dup, -dup2, -execve, -exit, -fchmod, -fchown, -fcntl, +F(adjtime) +#endif +F(bind) +F(brk) +#if defined(hpux) || defined(SVR4) || defined(__FreeBSD__) +F(cfgetospeed) +F(cfsetospeed) +F(cfgetispeed) +F(cfsetispeed) +#endif +F(chdir) +F(chmod) +F(chown) +F(chroot) +F(close) +F(connect) +F(creat) +F(dup) +F(dup2) +F(execve) +F(exit) +F(fchmod) +F(fchown) +F(fcntl) #if !defined(hpux) && !defined(SVR4) -flock, -#endif -fork, -fstat, -fsync, -ftruncate, -#if !defined(hpux) && !defined(SVR4) || defined(SOLARIS25) -getdtablesize, -#endif -getegid, -geteuid, -getgid, -getgroups, +F(flock) +#endif +F(fork) +F(fstat) +F(fsync) +F(ftruncate) +#if !defined(hpux) && !defined(SVR4) || defined(SOLARIS25) || defined(irix) +F(getdtablesize) +#endif +F(getegid) +F(geteuid) +F(getgid) +F(getgroups) #if !defined (SOLARIS) || defined(SOLARIS25) -gethostid, +F(gethostid) #endif -gethostname, -getitimer, +F(gethostname) +F(getitimer) #if !defined(hpux) && !defined(SVR4) || defined(SOLARIS25) -getpagesize, +F(getpagesize) #endif -getpeername, -getpgrp, -getpid, -getppid, +F(getpeername) +F(getpgrp) +F(getpid) +F(getppid) #if !defined(SVR4) || defined(SOLARIS25) -getpriority, +F(getpriority) #endif -getrlimit, +F(getrlimit) #if !defined(SOLARIS) || defined(SOLARIS25) -getrusage, -#endif -getsockname, -getsockopt, -gettimeofday, -getuid, -ioctl, -kill, +F(getrusage) +#endif +F(getsockname) +F(getsockopt) +F(gettimeofday) +F(getuid) +F(ioctl) +F(kill) #if !defined(SOLARIS) || defined(SOLARIS25) -killpg, -#endif -link, -listen, -lseek, -lstat, -mkdir, -mknod, -mount, -open, -pipe, -profil, -ptrace, +F(killpg) +#endif +F(link) +F(listen) +F(lseek) +F(lstat) +F(mkdir) +F(mknod) +F(mount) +F(open) +F(pipe) +F(profil) +F(ptrace) #ifdef mach -quota, +F(quota) #endif -read, -readlink, -readv, +F(read) +F(readlink) +F(readv) #ifndef SVR4 -reboot, -#endif -recv, -recvfrom, -recvmsg, -rename, -rmdir, -sbrk, -select, -send, -sendmsg, -sendto, -setgroups, +F(reboot) +#endif +F(recv) +F(recvfrom) +F(recvmsg) +F(rename) +F(rmdir) +F(sbrk) +F(select) +F(send) +F(sendmsg) +F(sendto) +F(setgroups) #if !defined(SUNOS) && !(defined(SOLARIS) || defined(SOLARIS25)) -sethostid, +F(sethostid) #endif #if !defined(SVR4) || defined(SOLARIS25) -sethostname, +F(sethostname) #endif -setitimer, -setpgrp, +F(setitimer) +F(setpgrp) #if !defined(SVR4) || defined(SOLARIS25) -setpriority, +F(setpriority) #endif #if !defined(mach) && !defined(SOLARIS) && !defined(__FreeBSD__) && !defined(SUNOS) && !defined(osf1) && !defined(irix) -setquota, +F(setquota) #endif #if !defined(hpux) && !defined(SVR4) || defined(SOLARIS25) -setregid, -setreuid, +F(setregid) +F(setreuid) #endif -setrlimit, -setsockopt, -settimeofday, -shutdown, +F(setrlimit) +F(setsockopt) +F(settimeofday) +F(shutdown) #ifndef SVR4 -sigblock, +F(sigblock) #endif -sigpause, +F(sigpause) #if !defined(ibmrt) && !defined(hpux) && !defined(SVR4) && !defined(i386) -sigreturn, +F(sigreturn) #endif #if !defined(SVR4) && !defined(__FreeBSD__) -sigsetmask, -sigstack, -sigvec, +F(sigsetmask) +F(sigstack) +F(sigvec) #endif -socket, -socketpair, -stat, +F(socket) +F(socketpair) +F(stat) #ifndef SVR4 -swapon, +F(swapon) #endif -symlink, -sync, -syscall, +F(symlink) +F(sync) +F(syscall) #if defined(hpux) || defined(SVR4) -closedir, -opendir, -readdir, -tcgetattr, -tcsetattr, -#endif -truncate, -umask, +F(closedir) +F(opendir) +F(readdir) +#endif +#if defined(hpux) || defined(SVR4) || defined(__FreeBSD__) || defined(__linux__) +F(tcgetattr) +F(tcsetattr) +F(tcsendbreak) +F(tcdrain) +F(tcflush) +F(tcflow) +#endif +F(truncate) +F(umask) #if !defined(SUNOS) && !defined(parisc) && !defined(SOLARIS) \ && !defined(__FreeBSD__) -umount, +F(umount) #endif -unlink, +F(unlink) #ifndef hpux -utimes, +F(utimes) #endif #ifndef irix -vfork, +F(vfork) #endif #if !defined(osf1) && !defined(__FreeBSD__) -vhangup, +F(vhangup) #endif -wait, +F(wait) #if !defined(SOLARIS) || defined(SOLARIS25) -wait3, +F(wait3) #endif -write, -writev, +F(write) +F(writev) /* Math routines. */ -cos, -sin, -tan, -acos, -asin, -atan, -atan2, -sinh, -cosh, -tanh, -asinh, -acosh, -atanh, -exp, +F(cos) +F(sin) +F(tan) +F(acos) +F(asin) +F(atan) +F(atan2) +F(sinh) +F(cosh) +F(tanh) +F(asinh) +F(acosh) +F(atanh) +F(exp) #ifndef hpux -expm1, +F(expm1) #endif -log, -log10, +F(log) +F(log10) #ifndef hpux -log1p, +F(log1p) #endif -pow, +F(pow) #ifndef hpux -cbrt, +F(cbrt) #endif #ifndef i386 -sqrt, +F(sqrt) #endif -hypot, +F(hypot) /* Network support. */ -gethostbyname, -gethostbyaddr, +F(gethostbyname) +F(gethostbyaddr) /* Other random things. */ #if defined(SVR4) -setpgid, -getpgid, -timezone, -altzone, -daylight, -tzname, -#if !defined (irix) -dlopen, -dlsym, -dlclose, -dlerror, -#endif +F(setpgid) +F(getpgid) +D(timezone) +D(altzone) +D(daylight) +D(tzname) +F(dlopen) +F(dlsym) +F(dlclose) +F(dlerror) #endif #if !defined (SOLARIS) || defined(SOLARIS25) -getwd, +F(getwd) #endif -ttyname +F(ttyname) #ifdef irix -,_getpty +F(_getpty) #endif -- GitLab