From 903edb2a6d4a102645eb094786f52290f0ef9b07 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Sun, 11 Dec 2005 18:30:51 +0000 Subject: [PATCH] Make ppc port look a little more like sparc by making fdefn-raw-addr-slot actually hold a tagged pointer instead of the raw address. Not sure if this is good or not, but making it like sparc makes ppc a little easier. Might need a cross-compile; the 2005-12-1-ppc cross-compile script works fine. assembly/ppc/arith.lisp: o Static functions are now tagged, so need to adjust address before branching to them. compiler/generic/new-genesis.lisp: o Fill fdefn-raw-addr-slot with the tagged address instead of converting to untagged. compiler/ppc/call.lisp: o fdefn-raw-addr-slot is tagged, so need to adjust it before branching to function. compiler/ppc/cell.lisp: o No need to adjust function address before storing it in the fdefn-raw-addr-slot. compiler/ppc/static-fn.lisp: o Static functions are tagged, so need to adjust address before branching to them. lisp/gc.c: o Don't need scav_fdefn, because the fdefn is a tagged object now. lisp/ppc-assem.S: o Make undefined_tramp and closure_tramp be tagged instead of untagged. lisp/purify.c o RAW_ADDR_OFFSET is 0 now, like sparc. --- assembly/ppc/arith.lisp | 26 +++++++++++++++++--------- compiler/generic/new-genesis.lisp | 4 ++-- compiler/ppc/call.lisp | 9 ++++++--- compiler/ppc/cell.lisp | 4 +++- compiler/ppc/static-fn.lisp | 7 +++++-- lisp/gc.c | 6 +++--- lisp/ppc-assem.S | 22 ++++++++++++++++++++++ lisp/purify.c | 4 ++-- 8 files changed, 60 insertions(+), 22 deletions(-) diff --git a/assembly/ppc/arith.lisp b/assembly/ppc/arith.lisp index 6c775c897..7f1c8841e 100644 --- a/assembly/ppc/arith.lisp +++ b/assembly/ppc/arith.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/arith.lisp,v 1.5 2005/04/08 04:11:01 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/arith.lisp,v 1.6 2005/12/11 18:30:45 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -62,7 +62,8 @@ (inst li nargs (fixnumize 2)) (inst mr ocfp cfp-tn) (inst mr cfp-tn csp-tn) - (inst j lip 0) + ;; (inst j lip 0) + (inst j lip (- (* function-code-offset word-bytes) function-pointer-type)) DONE (move res temp)) @@ -110,7 +111,8 @@ (inst li nargs (fixnumize 2)) (inst mr ocfp cfp-tn) (inst mr cfp-tn csp-tn) - (inst j lip 0) + ;;(inst j lip 0) + (inst j lip (- (* function-code-offset word-bytes) function-pointer-type)) DONE (move res temp)) @@ -187,8 +189,9 @@ (inst li nargs (fixnumize 2)) (inst mr ocfp cfp-tn) (inst mr cfp-tn csp-tn) - (inst j lip 0) - + ;;(inst j lip 0) + (inst j lip (- (* function-code-offset word-bytes) function-pointer-type)) + LOW-FITS-IN-FIXNUM (move res lo)) @@ -319,7 +322,9 @@ (inst li nargs (fixnumize 2)) (inst mr ocfp cfp-tn) (inst mr cfp-tn csp-tn) - (inst j lip 0) + ;;(inst j lip 0) + (inst j lip + (- (* function-code-offset word-bytes) function-pointer-type)) DO-COMPARE (load-symbol res t) @@ -364,7 +369,8 @@ (inst li nargs (fixnumize 2)) (inst mr ocfp cfp-tn) (inst mr cfp-tn csp-tn) - (inst j lip 0) + ;;(inst j lip 0) + (inst j lip (- (* function-code-offset word-bytes) function-pointer-type)) RETURN-T (load-symbol res t)) @@ -400,7 +406,8 @@ (inst li nargs (fixnumize 2)) (inst mr ocfp cfp-tn) (inst mr cfp-tn csp-tn) - (inst j lip 0) + ;;(inst j lip 0) + (inst j lip (- (* function-code-offset word-bytes) function-pointer-type)) RETURN-T (load-symbol res t)) @@ -433,8 +440,9 @@ (inst lwz lip null-tn (static-function-offset 'two-arg-=)) (inst li nargs (fixnumize 2)) (inst mr ocfp cfp-tn) - (inst j lip 0) + ;;(inst j lip 0) (inst mr cfp-tn csp-tn) + (inst j lip (- (* function-code-offset word-bytes) function-pointer-type)) RETURN-NIL (inst mr res null-tn)) diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp index 633a065ad..4adc21ce8 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.75 2005/02/06 19:43:13 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.76 2005/12/11 18:30:47 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -910,7 +910,7 @@ (#.vm:function-header-type (if (or (c:backend-featurep :sparc) (and (c:backend-featurep :ppc) - (c:backend-featurep :ppc-fun-hack))) + #+nil (c:backend-featurep :ppc-fun-hack))) defn (make-random-descriptor (+ (logandc2 (descriptor-bits defn) vm:lowtag-mask) diff --git a/compiler/ppc/call.lisp b/compiler/ppc/call.lisp index f05ba6937..17761842b 100644 --- a/compiler/ppc/call.lisp +++ b/compiler/ppc/call.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/call.lisp,v 1.7 2005/04/08 04:11:02 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/call.lisp,v 1.8 2005/12/11 18:30:47 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -806,8 +806,11 @@ default-value-8 (loadw name-pass code-tn (tn-offset name) vm:other-pointer-type) (do-next-filler))) - (loadw entry-point name-pass fdefn-raw-addr-slot - other-pointer-type) + (loadw function name-pass fdefn-raw-addr-slot + other-pointer-type) + (inst addi entry-point function + (- (ash vm:function-code-offset vm:word-shift) + vm:function-pointer-type)) (do-next-filler)) `((sc-case arg-fun (descriptor-reg (move lexenv arg-fun)) diff --git a/compiler/ppc/cell.lisp b/compiler/ppc/cell.lisp index 1be9eb76e..6cff635cc 100644 --- a/compiler/ppc/cell.lisp +++ b/compiler/ppc/cell.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/cell.lisp,v 1.5 2005/04/08 04:11:02 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/cell.lisp,v 1.6 2005/12/11 18:30:47 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -140,9 +140,11 @@ (let ((normal-fn (gen-label))) (load-type type function (- function-pointer-type)) (inst cmpwi type function-header-type) + #+nil (inst addi lip function (- (ash vm:function-code-offset vm:word-shift) function-pointer-type)) + (move lip function) (inst beq normal-fn) ;; For the linkage-table stuff, we need to look up the address ;; from the linkage table instead of using the address directly. diff --git a/compiler/ppc/static-fn.lisp b/compiler/ppc/static-fn.lisp index 16790f71a..bc3cf2d76 100644 --- a/compiler/ppc/static-fn.lisp +++ b/compiler/ppc/static-fn.lisp @@ -7,7 +7,7 @@ ;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU) ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/static-fn.lisp,v 1.4 2005/04/08 04:11:02 rtoy Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/static-fn.lisp,v 1.5 2005/12/11 18:30:47 rtoy Rel $ ;;; ;;; This file contains the VOPs and macro magic necessary to call static ;;; functions. @@ -87,13 +87,16 @@ (let ((lra-label (gen-label)) (cur-nfp (current-nfp-tn vop))) ,@(moves (temp-names) (arg-names)) - (inst lwz entry-point null-tn (static-function-offset symbol)) + (inst lwz func null-tn (static-function-offset symbol)) (inst lr nargs (fixnumize ,num-args)) (when cur-nfp (store-stack-tn nfp-save cur-nfp)) (inst mr old-fp cfp-tn) (inst mr cfp-tn csp-tn) (inst compute-lra-from-code lra code-tn lra-label temp) + (inst addi entry-point func + (- (ash function-code-offset word-shift) + function-pointer-type)) (note-this-location vop :call-site) (inst mtctr entry-point) (inst bctr) diff --git a/lisp/gc.c b/lisp/gc.c index dcb4009dc..a0a8cd69b 100644 --- a/lisp/gc.c +++ b/lisp/gc.c @@ -1,7 +1,7 @@ /* * Stop and Copy GC based on Cheney's algorithm. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gc.c,v 1.23 2005/09/15 18:26:51 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gc.c,v 1.24 2005/12/11 18:30:48 rtoy Exp $ * * Written by Christopher Hoover. */ @@ -1152,7 +1152,7 @@ size_boxed(lispobj * where) /* Note: on the sparc we don't have to do anything special for fdefns, */ /* cause the raw-addr has a function lowtag. */ -#ifndef sparc +#if !(defined(sparc) || defined(DARWIN)) static int scav_fdefn(lispobj * where, lispobj object) { @@ -2047,7 +2047,7 @@ gc_init(void) scavtab[type_UnboundMarker] = scav_immediate; scavtab[type_WeakPointer] = scav_weak_pointer; scavtab[type_InstanceHeader] = scav_boxed; -#ifndef sparc +#if !(defined(sparc) || defined(DARWIN)) scavtab[type_Fdefn] = scav_fdefn; #else scavtab[type_Fdefn] = scav_boxed; diff --git a/lisp/ppc-assem.S b/lisp/ppc-assem.S index 433d00a3f..a7405b9de 100644 --- a/lisp/ppc-assem.S +++ b/lisp/ppc-assem.S @@ -408,6 +408,7 @@ lra: GFUNCDEF(xundefined_tramp) .globl _undefined_tramp +#if 0 .byte 0,0,0,type_FunctionHeader /* Header */ .long _undefined_tramp /* self slot */ @@ -416,6 +417,16 @@ lra: .long NIL /* arglist slot */ .long NIL /* type slot */ _undefined_tramp: +#else + .byte 0 +_undefined_tramp: + .byte 0, 0, type_FunctionHeader + .long _undefined_tramp /* self slot */ + .long NIL /* next slot */ + .long NIL /* name slot */ + .long NIL /* arglist slot */ + .long NIL /* type slot */ +#endif twllei reg_ZERO,trap_Cerror /* Number of argument bytes */ .byte 4 @@ -442,6 +453,7 @@ _undefined_tramp: GFUNCDEF(xclosure_tramp) .globl _closure_tramp +#if 0 .byte 0,0,0,type_FunctionHeader /* Header */ .long _closure_tramp .long NIL @@ -449,6 +461,16 @@ _undefined_tramp: .long NIL .long NIL _closure_tramp: +#else + .byte 0 +_closure_tramp: + .byte 0,0,type_FunctionHeader /* Header */ + .long _closure_tramp + .long NIL + .long NIL + .long NIL + .long NIL +#endif lwz reg_LEXENV,FDEFN_FUNCTION_OFFSET(reg_FDEFN) lwz reg_CODE,CLOSURE_FUNCTION_OFFSET(reg_LEXENV) la reg_LIP,FUNCTION_CODE_OFFSET(reg_CODE) diff --git a/lisp/purify.c b/lisp/purify.c index 10870a6af..819a695dc 100644 --- a/lisp/purify.c +++ b/lisp/purify.c @@ -10,7 +10,7 @@ and x86/GENCGC stack scavenging, by Douglas Crosher, 1996, 1997, 1998. - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.34 2005/09/15 18:26:52 rtoy Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.35 2005/12/11 18:30:51 rtoy Exp $ */ #include <stdio.h> @@ -86,7 +86,7 @@ static int later_count = 0; #define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1))) #define NWORDS(x,y) (CEILING((x),(y)) / (y)) -#ifdef sparc +#if defined(sparc) || defined(DARWIN) #define RAW_ADDR_OFFSET 0 #else #define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer) -- GitLab