diff --git a/code/exports.lisp b/code/exports.lisp index 4b6cff14d5cab7e0024e15fb15bdeafa0d28615d..4d22e6d814edca8d87e4c930ef0b1d0ebbb59653 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 40f084d4cc62847edeabb4e990d2fad27ce5f525..b09d667f42ace4eb645cb8f5a95a544ee20928a8 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 36b2a1f173b8f25e6189899f43e2fe604cc23233..0473d50b53f27429494d2873e764e5819065c98a 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 40a4736a9e7a1be8b5660b7bb1f3432af75402ce..dceb6176592ae89ffd7f3960a773f0248d62b6a4 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 9db1e04f507c04ab4bf154c8f4f71f4b0fa07bdc..49eae548fe2dbd58a4e922250b39e09480729635 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 fffd0c880d6419dcd0aabb44c41b867311341e80..35e031089d08341e4128ca443fe6966f297c2c27 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 2efe17f6f64866875eea6bc320491f87af243aaf..abf2888d9deb712aba8e51734063825cea9c2cfd 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 64bfbc60fafbc9dfec092fedcf365a457474bec8..a13893ef4e79004f80bbc9dc3f01bb5062cff995 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 d930ae9f4042f5a614d3601940838930f89530ec..416140dac30d913a7ac123d0b87177ea1e58cd29 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 42a290761a804691d8685d19b1af7e48819d8553..ac6aff16584d7ddf7dd9c81e9553a1c6924bcf00 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 bd280abd2487c9b303b1f30c2cf8ab8b3561803c..f7215ec7739ec0ec0a18a2cfc57f43479f8e62db 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 4e4e3c3c2ec2d34af363e7ac6422fa2982843c6c..c2a16d0d1be73448feb0925721481a5c978dd431 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 0000000000000000000000000000000000000000..c58cc4d08769543179b513ad9c59bbf003d2a0a0 --- /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 bcc22d46a866eb6a8b5a84908d25e340ecfe554e..a1bcabfcc79d200e4075489b692ac0087d2b0555 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 5b482c1d2fe54d491153bead19eefd4955cb7b21..89dc6d7e90eaa684b5c639f85d1c3783a696b495 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 ecd37773f37ad9ccf7579f605d8eca2e78804da7..1b78b1eeb964ee3d2abba2bf803f56f875d95bdc 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 88e8b9403656c6faf45ddd6860479993d01ddc7d..a377fabc46dd7b3079d350b3de415b48b76ad324 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 0b8e2a014fc651598d1f630378a81f5e78243420..3bd7e9c9db3d64b809598fe1ca32ec1afbec692d 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 5f14692e196b5bf8d7005a8e4f6603ee950eb450..4fad28f438ab45c873c88379de76f4325467bcc1 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