From 26987375eb9dae6e9b15084e317a04a6509dd05f Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sun, 4 Jan 2009 07:35:53 +0000 Subject: [PATCH] 1.0.24.21: call stub needed to switch between hpux heap-spaces * Patch by Larry Valkama. --- src/assembly/hppa/assem-rtns.lisp | 23 +++++++++++++++++++++++ src/code/cold-init.lisp | 2 ++ src/code/early-impl.lisp | 1 + src/code/save.lisp | 1 + src/code/toplevel.lisp | 1 + src/compiler/generic/parms.lisp | 2 ++ src/compiler/hppa/system.lisp | 24 ++++++++++++++++++++++++ src/runtime/hppa-assem.S | 16 ++++++++++------ src/runtime/runtime.c | 8 ++++++++ version.lisp-expr | 2 +- 10 files changed, 73 insertions(+), 7 deletions(-) diff --git a/src/assembly/hppa/assem-rtns.lisp b/src/assembly/hppa/assem-rtns.lisp index 4cae72b..b90b2cb 100644 --- a/src/assembly/hppa/assem-rtns.lisp +++ b/src/assembly/hppa/assem-rtns.lisp @@ -201,3 +201,26 @@ (inst b *unwind-entry-point*) (inst move catch target)) + +#!+hpux +(define-assembly-routine + (return-from-lisp-stub (:return-style :none)) + ((:temp lip interior-reg lip-offset) + (:temp nl0 descriptor-reg nl0-offset) + (:temp nl1 descriptor-reg nl1-offset) + (:temp lra descriptor-reg lra-offset)) + ; before calling into lisp we must save our return address (reg_LRA) + (store-symbol-value lra *c-lra*) + ; note the lra we calculate next must "simulate" an fixnum, + ; because compute-calling-frame will use fixnump on this value. + ; either use 16 or 20, finetune it... + (inst addi 19 nl0 lra) ; then setup the new LRA (rest of this routine after branch) + (inst bv lip :nullify t) + (inst word return-pc-header-widetag) + ; ok, we are back from the lisp-call, lets return to c + ; FIX-lav: steal more stuff from call_into_lisp here, ideally the whole thing + (inst move ocfp-tn csp-tn) ; dont think we should ever get here + (inst nop) + (load-symbol-value nl0 *c-lra*) + (inst addi 1 nl0 nl0) + (inst ble 0 c-text-space nl0 :nullify t)) diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp index 57c5c12..2b26328 100644 --- a/src/code/cold-init.lisp +++ b/src/code/cold-init.lisp @@ -259,6 +259,8 @@ (/show0 "done initializing, setting *COLD-INIT-COMPLETE-P*") (setf *cold-init-complete-p* t) + ; hppa heap is segmented, lisp and c uses a stub to call eachother + #!+hpux (sb!sys:%primitive sb!vm::setup-return-from-lisp-stub) ;; The system is finally ready for GC. (/show0 "enabling GC") (gc-on) diff --git a/src/code/early-impl.lisp b/src/code/early-impl.lisp index 430b1c7..3cd6dc8 100644 --- a/src/code/early-impl.lisp +++ b/src/code/early-impl.lisp @@ -33,6 +33,7 @@ ;; pseudo-atomicity too, but they handle it without ;; messing with special variables.) #!+(or x86 x86-64) *pseudo-atomic-bits* + #!+(or hpux) sb!vm::*c-lra* *allow-with-interrupts* *interrupts-enabled* *interrupt-pending* diff --git a/src/code/save.lisp b/src/code/save.lisp index 486bc97..d4f183e 100644 --- a/src/code/save.lisp +++ b/src/code/save.lisp @@ -125,6 +125,7 @@ sufficiently motivated to do lengthy fixes." (labels ((restart-lisp () (handling-end-of-the-world (reinit) + #!+hpux (sb!sys:%primitive sb!vm::setup-return-from-lisp-stub) (funcall toplevel))) (foreign-bool (value) (if value 1 0)) diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index bc46818..bbebd5b 100644 --- a/src/code/toplevel.lisp +++ b/src/code/toplevel.lisp @@ -20,6 +20,7 @@ (progn (defvar sb!vm::*current-catch-block*) (defvar sb!vm::*current-unwind-protect-block*) + #!+hpux (defvar sb!vm::*c-lra*) (defvar *free-interrupt-context-index*)) ;;; specials initialized by !COLD-INIT diff --git a/src/compiler/generic/parms.lisp b/src/compiler/generic/parms.lisp index c134c87..df1f733 100644 --- a/src/compiler/generic/parms.lisp +++ b/src/compiler/generic/parms.lisp @@ -44,6 +44,8 @@ *current-catch-block* *current-unwind-protect-block* + #!+hpux *c-lra* + ;; stack pointers *binding-stack-start* *control-stack-start* diff --git a/src/compiler/hppa/system.lisp b/src/compiler/hppa/system.lisp index 8246323..9246fae 100644 --- a/src/compiler/hppa/system.lisp +++ b/src/compiler/hppa/system.lisp @@ -199,6 +199,29 @@ (:generator 1 (inst break halt-trap))) +#+hpux +(define-vop (setup-return-from-lisp-stub) + (:results) + (:save-p t) + (:temporary (:sc any-reg :offset nl0-offset) nl0) + (:temporary (:sc any-reg :offset cfunc-offset) cfunc) + (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save) + (:temporary (:scs (non-descriptor-reg)) temp) + (:vop-var vop) + (:generator 100 + (let ((stub (make-fixup 'return-from-lisp-stub :assembly-routine))) + (inst li stub nl0)) + (let ((cur-nfp (current-nfp-tn vop))) + (when cur-nfp + (store-stack-tn nfp-save cur-nfp)) + (inst li (make-fixup "setup_return_from_lisp_stub" :foreign) cfunc) + (let ((fixup (make-fixup "call_into_c" :foreign))) + (inst ldil fixup temp) + (inst ble fixup c-text-space temp)) + (inst addi 64 nsp-tn nsp-tn) + (inst addi -64 nsp-tn nsp-tn) + (when cur-nfp + (load-stack-tn cur-nfp nfp-save))))) ;;;; Dynamic vop count collection support @@ -212,3 +235,4 @@ (inst ldw offset count-vector count) (inst addi 1 count count) (inst stw count offset count-vector)))) + diff --git a/src/runtime/hppa-assem.S b/src/runtime/hppa-assem.S index fd2068f..25cb29d 100644 --- a/src/runtime/hppa-assem.S +++ b/src/runtime/hppa-assem.S @@ -108,12 +108,16 @@ call_into_lisp: /* Indirect the closure */ ldw CLOSURE_FUN_OFFSET(0,reg_LEXENV),reg_CODE - addi 6*4-FUN_POINTER_LOWTAG,reg_CODE,reg_LIP - - /* And into lisp we go. */ - .export break_here -break_here: - be,n 0(%sr5,reg_LIP) + addi SIMPLE_FUN_CODE_OFFSET,reg_CODE,reg_LIP + +#ifdef LISP_FEATURE_HPUX + /* Get the stub address, ie assembly-routine return-from-lisp */ + addil L%return_from_lisp_stub-$global$,%dp + ldw R%return_from_lisp_stub-$global$(0,%r1),reg_NL0 + be,n 0(%sr5,reg_NL0) +#else + be,n 0(%sr5,reg_NL0) +#endif break 0,0 diff --git a/src/runtime/runtime.c b/src/runtime/runtime.c index 6c2df40..159d7f6 100644 --- a/src/runtime/runtime.c +++ b/src/runtime/runtime.c @@ -70,6 +70,10 @@ #define SBCL_HOME "/usr/local/lib/sbcl/" #endif +#ifdef LISP_FEATURE_HPUX +extern void *return_from_lisp_stub; +#endif + /* SIGINT handler that invokes the monitor (for when Lisp isn't up to it) */ static void @@ -426,6 +430,10 @@ main(int argc, char *argv[], char *envp[]) if (initial_function == NIL) { lose("couldn't find initial function\n"); } +#ifdef LISP_FEATURE_HPUX + return_from_lisp_stub = (void *) ((char *)*((unsigned long *) + ((char *)initial_function - 1)) + 23); +#endif gc_initialize_pointers(); diff --git a/version.lisp-expr b/version.lisp-expr index 000af67..e8a18e8 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.24.20" +"1.0.24.21" -- 1.7.10.4