From b46345044a6b9e2db26700e297daedb05307919b Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sat, 10 Jan 2009 11:19:22 +0000 Subject: [PATCH] 1.0.24.30: fixed and tested some more cleanups on hppa-hpux * Fix a stray #+ -> #!+. * Removed unneeded nops. * Explanation of magic numbers (but not yet substituted.) (Above changes in patch by Larry Valkama) * Fix a bunch of comments in the HPPA backend to use the right number of semicolons, and use FIXME-lav instead of FIX-lav to mark things (better grepping for the rest of us.) --- CREDITS | 6 ++++++ src/compiler/hppa/arith.lisp | 16 ++++++++-------- src/compiler/hppa/array.lisp | 2 +- src/compiler/hppa/c-call.lisp | 26 +++++++++++++------------- src/compiler/hppa/call.lisp | 13 ++++++++----- src/compiler/hppa/cell.lisp | 2 +- src/compiler/hppa/debug.lisp | 2 +- src/compiler/hppa/float.lisp | 16 ++++++++-------- src/compiler/hppa/insts.lisp | 24 ++++++++++++------------ src/compiler/hppa/macros.lisp | 10 +++++----- src/compiler/hppa/nlx.lisp | 10 ++++------ src/compiler/hppa/sanctify.lisp | 2 +- src/compiler/hppa/system.lisp | 19 ++++++++----------- src/compiler/hppa/type-vops.lisp | 2 +- src/compiler/hppa/vm.lisp | 18 ++++++++++-------- src/runtime/runtime.c | 6 +++++- version.lisp-expr | 2 +- 17 files changed, 93 insertions(+), 83 deletions(-) diff --git a/CREDITS b/CREDITS index 3aafdf1..ae12250 100644 --- a/CREDITS +++ b/CREDITS @@ -784,6 +784,10 @@ Raymond Toy: floating point stuff. Various patches and fixes of his have been ported to SBCL, including his Sparc port of linkage-table. +Larry Valkama: + He resurrected the HPUX port, and worked on the HPPA backend in + general. + Peter Van Eynde: He wrestled the CLISP test suite into a mostly portable test suite (clocc ansi-test) which can be used on SBCL, provided a slew of @@ -821,6 +825,7 @@ DFL David Lichteblau DTC Douglas Crosher JES Juho Snellman JRXR Joshua Ross +LAV Larry Valkama MG Gabor Melis MNA Martin Atzmueller NJF Nathan Froyd @@ -830,6 +835,7 @@ PRM Pierre Mai PVE Peter Van Eynde PW Paul Werkowski RAM Robert MacLachlan +TCR Tobias Rittweiler THS Thiemo Seufer VJA Vincent Arkesteijn WHN William ("Bill") Newman diff --git a/src/compiler/hppa/arith.lisp b/src/compiler/hppa/arith.lisp index 984b141..8ae7ec0 100644 --- a/src/compiler/hppa/arith.lisp +++ b/src/compiler/hppa/arith.lisp @@ -357,8 +357,8 @@ (:temporary (:sc interior-reg :offset lip-offset) lip) (:ignore lip sign) ; fix-lav: why dont we ignore tmp ? (:generator 30 - ; looking at the register setup above, not sure if both can clash - ; maybe it is ok that x and x-pass share register ? like it was + ;; looking at the register setup above, not sure if both can clash + ;; maybe it is ok that x and x-pass share register ? like it was (unless (location= y y-pass) (inst sra x 2 x-pass)) (let ((fixup (make-fixup 'multiply :assembly-routine))) @@ -469,11 +469,11 @@ (inst bc := nil y zero-tn zero)) (move x x-pass) (move y y-pass) - ; really dirty trick to avoid the bug truncate/unsigned vop - ; followed by move-from/word->fixnum where the result from - ; the truncate is 0xe39516a7 and move-from-word will treat - ; the unsigned high number as an negative number. - ; instead we clear the high bit in the input to truncate. + ;; really dirty trick to avoid the bug truncate/unsigned vop + ;; followed by move-from/word->fixnum where the result from + ;; the truncate is 0xe39516a7 and move-from-word will treat + ;; the unsigned high number as an negative number. + ;; instead we clear the high bit in the input to truncate. (inst li #x1fffffff q) (inst comb :<> q y skip :nullify t) (inst addi -1 zero-tn q) @@ -481,7 +481,7 @@ (inst and x-pass q x-pass) (inst and y-pass q y-pass) SKIP - ; fix bug#2 (truncate #xe39516a7 #x3) => #0xf687078d,#x0 + ;; fix bug#2 (truncate #xe39516a7 #x3) => #0xf687078d,#x0 (inst li #x7fffffff q) (inst and x-pass q x-pass) (let ((fixup (make-fixup 'truncate :assembly-routine))) diff --git a/src/compiler/hppa/array.lisp b/src/compiler/hppa/array.lisp index 9afaf87..672d164 100644 --- a/src/compiler/hppa/array.lisp +++ b/src/compiler/hppa/array.lisp @@ -22,7 +22,7 @@ (:temporary (:scs (non-descriptor-reg)) header) (:results (result :scs (descriptor-reg))) (:generator 13 - ; Note: Cant use addi, the immediate is too large + ;; Note: Cant use addi, the immediate is too large (inst li (+ (* (1+ array-dimensions-offset) n-word-bytes) lowtag-mask) header) (inst add header rank bytes) diff --git a/src/compiler/hppa/c-call.lisp b/src/compiler/hppa/c-call.lisp index 4df3613..21aabde 100644 --- a/src/compiler/hppa/c-call.lisp +++ b/src/compiler/hppa/c-call.lisp @@ -11,13 +11,13 @@ (in-package "SB!VM") -; beware that we deal alot here with register-offsets directly -; instead of their symbol-name in vm.lisp -; offset works differently depending on sc-type +;;; beware that we deal alot here with register-offsets directly +;;; instead of their symbol-name in vm.lisp +;;; offset works differently depending on sc-type (defun my-make-wired-tn (prim-type-name sc-name offset state) (make-wired-tn (primitive-type-or-lose prim-type-name) (sc-number-or-lose sc-name) - ; try to utilize vm.lisp definitions of registers: + ;; try to utilize vm.lisp definitions of registers: (ecase sc-name ((any-reg sap-reg signed-reg unsigned-reg) (ecase offset ; FIX: port to other arch ??? @@ -36,9 +36,9 @@ (3 nl3-offset))) ((single-reg double-reg) ; only for return (+ 4 offset)) - ; A tn of stack type tells us that we have data on - ; stack. This offset is current argument number so - ; -1 points to the correct place to write that data + ;; A tn of stack type tells us that we have data on + ;; stack. This offset is current argument number so + ;; -1 points to the correct place to write that data ((sap-stack signed-stack unsigned-stack) (- (arg-state-nargs state) offset 8 1))))) @@ -260,8 +260,8 @@ (:temporary (:sc any-reg :offset cfunc-offset :from (:argument 0) :to (:result 0)) cfunc) (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save) - ; Not sure if using nargs is safe ( have we saved it ). - ; but we cant use any non-descriptor-reg because c-args nl-4 is of that type + ;; Not sure if using nargs is safe ( have we saved it ). + ;; but we cant use any non-descriptor-reg because c-args nl-4 is of that type (:temporary (:sc non-descriptor-reg :offset nargs-offset) temp) (:vop-var vop) (:generator 0 @@ -281,12 +281,12 @@ (:results (result :scs (sap-reg any-reg))) (:temporary (:scs (unsigned-reg) :to (:result 0)) temp) (:generator 0 - ; Because stack grows to higher addresses, we have the result - ; pointing to an lowerer address than nsp + ;; Because stack grows to higher addresses, we have the result + ;; pointing to an lowerer address than nsp (move nsp-tn result) (unless (zerop amount) - ; hp-ux stack grows towards larger addresses and stack must be - ; allocated in blocks of 64 bytes + ;; hp-ux stack grows towards larger addresses and stack must be + ;; allocated in blocks of 64 bytes (let ((delta (+ 0 (logandc2 (+ amount 63) 63)))) ; was + 16 (cond ((< delta (ash 1 10)) (inst addi delta nsp-tn nsp-tn)) diff --git a/src/compiler/hppa/call.lisp b/src/compiler/hppa/call.lisp index ff31fe1..6ec58b6 100644 --- a/src/compiler/hppa/call.lisp +++ b/src/compiler/hppa/call.lisp @@ -1025,10 +1025,13 @@ default-value-8 (lisp-return lra-arg :offset 2) ;; Nope, not the single case. (emit-label not-single) + ;; most of these moves will not be emitted and therefor + ;; isn't suitable to put in the delay slot below. But if + ;; you do, dont forget to force-emit as in (move src dst t) (move ocfp-arg ocfp) (move lra-arg lra) (move vals-arg vals) - (move nvals-arg nvals) ; FIX-lav: cant utilize branch-delay-slot, why? + (move nvals-arg nvals) (let ((fixup (make-fixup 'return-multiple :assembly-routine))) (inst ldil fixup tmp) (inst be fixup lisp-heap-space tmp :nullify t))) @@ -1061,7 +1064,7 @@ default-value-8 ;;; Copy a more arg from the argument area to the end of the current frame. ;;; Fixed is the number of non-more arguments. -;;; FIX-lav: old hppa code look smarter. +;;; FIXME-lav: old hppa code look smarter. (define-vop (copy-more-arg) (:temporary (:sc any-reg :offset nl0-offset) result) (:temporary (:sc any-reg :offset nl1-offset) count) @@ -1097,11 +1100,11 @@ default-value-8 (inst add nargs-tn cfp-tn src) (emit-label loop) - ; decrease src, then load src into temp + ;; decrease src, then load src into temp (inst ldwm (- n-word-bytes) src temp) - ; increase, compare if count >= to zero, if true, jump + ;; increase, compare if count >= to zero, if true, jump (inst addib :>= (fixnumize -1) count loop) - ; decrease dst, then store temp at dst + ;; decrease dst, then store temp at dst (inst stwm temp (- n-word-bytes) dst) (emit-label do-regs) diff --git a/src/compiler/hppa/cell.lisp b/src/compiler/hppa/cell.lisp index 78df196..070da3b 100644 --- a/src/compiler/hppa/cell.lisp +++ b/src/compiler/hppa/cell.lisp @@ -89,7 +89,7 @@ (:generator 2 (loadw temp symbol symbol-hash-slot other-pointer-lowtag) (inst dep 0 31 n-fixnum-tag-bits temp) - ; we must go through an temporary to avoid gc + ;; we must go through an temporary to avoid gc (move temp res))) diff --git a/src/compiler/hppa/debug.lisp b/src/compiler/hppa/debug.lisp index d25d226..e76df7d 100644 --- a/src/compiler/hppa/debug.lisp +++ b/src/compiler/hppa/debug.lisp @@ -31,7 +31,7 @@ (:policy :fast-safe) (:args (object :scs (sap-reg))) (:info offset) - ; make room for multiply by limiting to 12 bits + ;; make room for multiply by limiting to 12 bits (:arg-types system-area-pointer (:constant (signed-byte 12))) (:results (result :scs (descriptor-reg))) (:result-types *) diff --git a/src/compiler/hppa/float.lisp b/src/compiler/hppa/float.lisp index 9e80579..121fb5e 100644 --- a/src/compiler/hppa/float.lisp +++ b/src/compiler/hppa/float.lisp @@ -39,7 +39,7 @@ (inst fsts x offset base)) ((and (< offset (ash 1 13)) (> offset 0)) - ; FIX-lav, ok with GC to use lip-tn for arbitrary offsets ? + ;; FIXME-lav, ok with GC to use lip-tn for arbitrary offsets ? (inst ldo offset zero-tn lip-tn) ;(note-next-instruction vop :internal-error) (inst fstx x lip-tn base)) @@ -362,12 +362,12 @@ (double-stack y) (double-int-carg-reg temp))) (offset (* (tn-offset stack-tn) n-word-bytes))) - ; save 8 bytes of stack to two register, - ; write down float in stack and load it back - ; into result register. Notice the result hack, - ; we are writing to one extra register. - ; Double float argument convention uses two registers, - ; but we only know about one (thanks to c-call). + ;; save 8 bytes of stack to two register, + ;; write down float in stack and load it back + ;; into result register. Notice the result hack, + ;; we are writing to one extra register. + ;; Double float argument convention uses two registers, + ;; but we only know about one (thanks to c-call). (inst ldw offset nfp old1) (inst ldw (+ offset n-word-bytes) nfp old2) (str-float x offset nfp) ; writes 8 bytes @@ -496,7 +496,7 @@ (define-vop (,dname double-float-compare) (:translate ,translate) (:variant ,condition ,complement))))) - ;FIX-lav: let 'inst cmp' translate keywords into raw binary instead of giving it here + ;; FIXME-lav: let 'inst cmp' translate keywords into raw binary instead of giving it here (frob < #b01001 #b10101 #b10001 #b01101 >/single-float >/double-float) (frob = #b00101 #b11001 eql/single-float eql/double-float)) diff --git a/src/compiler/hppa/insts.lisp b/src/compiler/hppa/insts.lisp index 74d96c7..a1f6d24 100644 --- a/src/compiler/hppa/insts.lisp +++ b/src/compiler/hppa/insts.lisp @@ -123,8 +123,9 @@ ;;;; Initial disassembler setup. -;FIX-lav: is this still used, if so , why use package prefix -;(setf sb!disassem:*disassem-inst-alignment-bytes* 4) + +;;; FIXME-lav: is this still used, if so , why use package prefix +;;; (setf sb!disassem:*disassem-inst-alignment-bytes* 4) (defvar *disassem-use-lisp-reg-names* t) @@ -983,8 +984,7 @@ (:printer r3-inst ((op ,opcode) (c nil :type ',(symbolicate cond-kind "-CONDITION")))) - ;FIX-lav, change opcode test to name test - ,@(when (= opcode #x12) + ,@(when (eq name 'or) `((:printer r3-inst ((op ,opcode) (r2 0) (c nil :type ',(symbolicate cond-kind "-CONDITION"))) @@ -1531,7 +1531,7 @@ (assemble (segment vop) (cond ((<= (- (ash 1 11)) disp (1- (ash 1 11))) (inst comb (maybe-negate-cond cond not-p) r1 r2 target) - (inst nop)) ;FIX-lav, cant nullify when backward branch + (inst nop)) ; FIXME-lav, cant nullify when backward branch (t (inst comclr r1 r2 zero-tn (maybe-negate-cond cond (not not-p))) @@ -1599,10 +1599,10 @@ (emit-chooser ;; We emit either 12 or 4 bytes, so we maintain 3 byte alignments. segment 12 3 - ; This is the best-case that emits one instruction ( 4 bytes ) + ;; This is the best-case that emits one instruction ( 4 bytes ) (lambda (segment posn delta-if-after) (let ((delta (funcall calc label posn delta-if-after))) - ; WHEN, Why not AVER ? + ;; WHEN, Why not AVER ? (when (<= (- (ash 1 10)) delta (1- (ash 1 10))) (emit-back-patch segment 4 (lambda (segment posn) @@ -1610,19 +1610,19 @@ (inst addi (funcall calc label posn 0) src dst)))) t))) - ; This is the worst-case that emits three instruction ( 12 bytes ) + ;; This is the worst-case that emits three instruction ( 12 bytes ) (lambda (segment posn) (let ((delta (funcall calc label posn 0))) - ; FIX-lav: why do we hit below check ? - ;(when (<= (- (ash 1 10)) delta (1- (ash 1 10))) - ; (error "emit-compute-inst selected worst-case, but is shrinkable, delta is ~s" delta)) + ;; FIXME-lav: why do we hit below check ? + ;; (when (<= (- (ash 1 10)) delta (1- (ash 1 10))) + ;; (error "emit-compute-inst selected worst-case, but is shrinkable, delta is ~s" delta)) ;; Note: if we used addil/ldo to do this in 2 instructions then the ;; intermediate value would be tagged but pointing into space. ;; Does above note mean that the intermediate value would be ;; a bogus pointer that would be GCed wrongly ? ;; Also what I can see addil would also overwrite NFP (r1) ??? (assemble (segment vop) - ; Three instructions (4 * 3) this is the reason for 12 bytes + ;; Three instructions (4 * 3) this is the reason for 12 bytes (inst ldil delta temp) (inst ldo (ldb (byte 11 0) delta) temp temp :unsigned t) (inst add src temp dst)))))) diff --git a/src/compiler/hppa/macros.lisp b/src/compiler/hppa/macros.lisp index 6e3af24..4489af8 100644 --- a/src/compiler/hppa/macros.lisp +++ b/src/compiler/hppa/macros.lisp @@ -20,7 +20,7 @@ (,gensym)))) ;;; Instruction-like macros. -;;; FIX-lav: add if always-emit-code-p is :e= then error if location= +;;; FIXME-lav: add if always-emit-code-p is :e= then error if location= (defmacro move (src dst &optional always-emit-code-p) #!+sb-doc "Move SRC into DST (unless they are location= and ALWAYS-EMIT-CODE-P is nil)." @@ -101,8 +101,8 @@ byte-ordering issues." "Emit a return-pc header word. LABEL is the label to use for this return-pc." `(progn - ; alignment causes the return point to land on two address, - ; where the first must be nop pad. + ;; alignment causes the return point to land on two address, + ;; where the first must be nop pad. (emit-alignment n-lowtag-bits) (emit-label ,label) (inst lra-header-word))) @@ -176,8 +176,8 @@ initializes the object." write-body) ,@body))))) -;; is used for stack allocation of dynamic-extent objects -; FIX-lav, if using defun, atleast surround in assembly-form ? macro better ? +;;; is used for stack allocation of dynamic-extent objects +;;; FIXME-lav, if using defun, atleast surround in assembly-form ? macro better ? (defun align-csp (temp) (declare (ignore temp)) (let ((aligned (gen-label))) diff --git a/src/compiler/hppa/nlx.lisp b/src/compiler/hppa/nlx.lisp index b5dd83a..c6c81f4 100644 --- a/src/compiler/hppa/nlx.lisp +++ b/src/compiler/hppa/nlx.lisp @@ -135,8 +135,8 @@ (define-vop (nlx-entry) - (:args (sp) ; Note: we can't list an sc-restriction, 'cause any load vops - ; would be inserted before the LRA. + (:args (sp) ;; Note: we can't list an sc-restriction, 'cause any load vops + ;; would be inserted before the LRA. (start) (count)) (:results (values :more t)) @@ -179,8 +179,7 @@ (move null-tn tn)) (control-stack (store-stack-tn tn null-tn))))) - (inst b defaulting-done) - (inst nop)))))) ; FIX remove me or tell why I'm needed + (inst b defaulting-done :nullify t)))))) (load-stack-tn csp-tn sp))) @@ -211,8 +210,7 @@ (sc-case new-start (any-reg (move dst new-start)) (control-stack (store-stack-tn new-start dst))) - (inst comb := num zero-tn done) - (inst nop) ; fix-lav remove nop + (inst comb := num zero-tn done :nullify t) (sc-case new-count (any-reg (move num new-count)) (control-stack (store-stack-tn new-count num))) diff --git a/src/compiler/hppa/sanctify.lisp b/src/compiler/hppa/sanctify.lisp index 45afb7b..fa0aa0f 100644 --- a/src/compiler/hppa/sanctify.lisp +++ b/src/compiler/hppa/sanctify.lisp @@ -14,7 +14,7 @@ (in-package "SB!VM") -; FIX-lav, can we do this in assembly instead ? +;;; FIXME-lav, can we do this in assembly instead ? (defun sanctify-for-execution (component) (without-gcing (alien-funcall (extern-alien "sanctify_for_execution" diff --git a/src/compiler/hppa/system.lisp b/src/compiler/hppa/system.lisp index a6fc0ff..c156406 100644 --- a/src/compiler/hppa/system.lisp +++ b/src/compiler/hppa/system.lisp @@ -37,15 +37,14 @@ (inst and object temp2 result) (inst comb :<> result zero-tn LOWTAG-ONLY :nullify t) - ; must be an other immediate + ;; must be an other immediate (inst li widetag-mask temp2) (inst b DONE) (inst and temp2 object result) FUNCTION-PTR (load-type result object (- fun-pointer-lowtag)) - (inst b done) - (inst nop) + (inst b done :nullify t) LOWTAG-ONLY (inst li lowtag-mask temp1) @@ -54,11 +53,9 @@ OTHER-PTR (load-type result object (- other-pointer-lowtag)) - (inst nop) DONE)) - (define-vop (fun-subtype) (:translate fun-subtype) (:policy :fast-safe) @@ -66,8 +63,7 @@ (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 6 - (load-type result function (- fun-pointer-lowtag)) - (inst nop))) ;FIX-lav, not sure this nop is needed + (load-type result function (- fun-pointer-lowtag)))) (define-vop (set-fun-subtype) (:translate (setf fun-subtype)) @@ -100,7 +96,8 @@ (:generator 6 (loadw res x 0 fun-pointer-lowtag) (inst srl res n-widetag-bits res))) -;FIX-lav, not sure we need data of type immediate and zero, test without, if so revert to old hppa code +;;; FIXME-lav, not sure we need data of type immediate and zero, test without, +;;; if so revert to old hppa code (define-vop (set-header-data) (:translate set-header-data) (:policy :fast-safe) @@ -111,7 +108,7 @@ (:temporary (:scs (non-descriptor-reg)) t1 t2) (:generator 6 (loadw t1 x 0 other-pointer-lowtag) - ; replace below 2 inst with: (mask widetag-mask t1 t1) + ;; replace below 2 inst with: (mask widetag-mask t1 t1) (inst li widetag-mask t2) (inst and t1 t2 t1) (sc-case data @@ -202,7 +199,7 @@ (:temporary (:scs (non-descriptor-reg)) ndescr) (:generator 10 (loadw ndescr code 0 other-pointer-lowtag) - ;FIX-lav: replace below two with DEPW + ;; FIXME-lav: replace below two with DEPW (inst srl ndescr n-widetag-bits ndescr) (inst sll ndescr word-shift ndescr) (inst add ndescr offset ndescr) @@ -225,7 +222,7 @@ (:generator 1 (inst break halt-trap))) -#+hpux +#!+hpux (define-vop (setup-return-from-lisp-stub) (:results) (:save-p t) diff --git a/src/compiler/hppa/type-vops.lisp b/src/compiler/hppa/type-vops.lisp index 03144c8..7953a33 100644 --- a/src/compiler/hppa/type-vops.lisp +++ b/src/compiler/hppa/type-vops.lisp @@ -167,7 +167,7 @@ ;; Get the second digit. (loadw temp value (1+ bignum-digits-offset) other-pointer-lowtag) ;; All zeros, its an (unsigned-byte 32). - ; Dont nullify comb here, because we cant guarantee target is forward + ;; Dont nullify comb here, because we cant guarantee target is forward (inst comb (if not-p := :<>) temp zero-tn not-target) (inst nop) (inst b target) diff --git a/src/compiler/hppa/vm.lisp b/src/compiler/hppa/vm.lisp index d67d49c..e7e8868 100644 --- a/src/compiler/hppa/vm.lisp +++ b/src/compiler/hppa/vm.lisp @@ -95,7 +95,7 @@ ;;; ;;; Handy macro so we don't have to keep changing all the numbers whenever ;;; we insert a new storage class. -;;; FIX-lav: move this into arch-generic-helpers.lisp and rip out from arches +;;; FIXME-lav: move this into arch-generic-helpers.lisp and rip out from arches (defmacro !define-storage-classes (&rest classes) (do ((forms (list 'progn) (let* ((class (car classes)) @@ -259,10 +259,12 @@ ;;;; Make some random tns for important registers. -; how can we address reg L0 through L0-offset when it is not -; defined here ? do all registers have an -offset and this is -; redundant work ? -;FIX-lav: move this into arch-generic-helpers + +;;; how can we address reg L0 through L0-offset when it is not +;;; defined here ? do all registers have an -offset and this is +;;; redundant work ? +;;; +;;; FIXME-lav: move this into arch-generic-helpers (macrolet ((defregtn (name sc) (let ((offset-sym (symbolicate name "-OFFSET")) (tn-sym (symbolicate name "-TN"))) @@ -275,9 +277,9 @@ (defregtn zero any-reg) (defregtn nargs any-reg) - ;FIX-lav: 20080820: not a fix, but fdefn and lexenv is used in assembly-rtns - (defregtn fdefn descriptor-reg) ; FIX-lav, not used - (defregtn lexenv descriptor-reg) ; FIX-lav, not used + ;; FIXME-lav: 20080820: not a fix, but fdefn and lexenv is used in assembly-rtns + (defregtn fdefn descriptor-reg) ; FIXME-lav, not used + (defregtn lexenv descriptor-reg) ; FIXME-lav, not used (defregtn nfp descriptor-reg) ; why not descriptor-reg ? (defregtn ocfp any-reg) ; why not descriptor-reg ? diff --git a/src/runtime/runtime.c b/src/runtime/runtime.c index 159d7f6..09e92c8 100644 --- a/src/runtime/runtime.c +++ b/src/runtime/runtime.c @@ -72,6 +72,8 @@ #ifdef LISP_FEATURE_HPUX extern void *return_from_lisp_stub; +#include "genesis/closure.h" +#include "genesis/simple-fun.h" #endif @@ -431,8 +433,10 @@ main(int argc, char *argv[], char *envp[]) lose("couldn't find initial function\n"); } #ifdef LISP_FEATURE_HPUX + /* -1 = CLOSURE_FUN_OFFSET, 23 = SIMPLE_FUN_CODE_OFFSET, we are not in LANGUAGE_ASSEMBLY + so we cant reach them. */ return_from_lisp_stub = (void *) ((char *)*((unsigned long *) - ((char *)initial_function - 1)) + 23); + ((char *)initial_function + -1)) + 23); #endif gc_initialize_pointers(); diff --git a/version.lisp-expr b/version.lisp-expr index 0d66989..f3cbb87 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.29" +"1.0.24.30" -- 1.7.10.4