1.0.24.21: call stub needed to switch between hpux heap-spaces

 * Patch by Larry Valkama.

diff --git a/src/assembly/hppa/assem-rtns.lisp b/src/assembly/hppa/assem-rtns.lisp
index 4cae72b..b90b2cb 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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*))
 \f
 ;;; specials initialized by !COLD-INIT

diff --git a/src/compiler/generic/parms.lisp b/src/compiler/generic/parms.lisp
index c134c87..df1f733 100644 (file)
--- 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 (file)
--- 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)))))
 \f
 ;;;; 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 (file)
--- 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 (file)
--- 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
+
 \f
 /* 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 (file)
--- 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"