- cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][master] 2 commits: Revert sparc64 changes.
by Raymond Toy 17 Dec '16

17 Dec '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: a3a37628 by Raymond Toy at 2016-12-17T08:45:23-08:00 Revert sparc64 changes. These were committed accidentally. Revert to previous version. - - - - - b6e6372c by Raymond Toy at 2016-12-17T08:46:48-08:00 Revert sparc64 changes. These were committed accidentally. Revert to previous version. - - - - - 2 changed files: - src/lisp/Config.sparc_common - src/lisp/Config.sparc_sunc Changes: ===================================== src/lisp/Config.sparc_common ===================================== --- a/src/lisp/Config.sparc_common +++ b/src/lisp/Config.sparc_common @@ -43,7 +43,7 @@ CPPFLAGS += -I. -I$(PATH1) $(CC_V8PLUS) $(CPP_DEFINE_OPTIONS) CFLAGS += -g $(CC_V8PLUS) NM = $(PATH1)/solaris-nm -#ASSEM_SRC = sparc-assem.S +ASSEM_SRC = sparc-assem.S ARCH_SRC = sparc-arch.c DEPEND=$(CC) ===================================== src/lisp/Config.sparc_sunc ===================================== --- a/src/lisp/Config.sparc_sunc +++ b/src/lisp/Config.sparc_sunc @@ -20,11 +20,10 @@ include Config.sparc_common ifdef FEATURE_SPARC_V9 # For SunStudio 11, use -xarch=v8plus. For SunStudio 12, that is # deprecated; use -m32 -xarch=sparc. -CC_V8PLUS = -xarch=sparc -AS_V8PLUS = -xarch=sparc +CC_V8PLUS = -m32 -xarch=sparc +AS_V8PLUS = -m32 -xarch=sparc endif -ASSEM_SRC = sparcv9-assem.S CFLAGS += -xlibmieee -O DEPEND_FLAGS = -xM ASFLAGS = $(AS_V8PLUS) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/5c9837fd4bda7cc7349ed53a…

1 0

[Git][cmucl/cmucl][sparc64-dev] Put sparc64 case before sparc
by Raymond Toy 17 Dec '16

17 Dec '16

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: fe4f6806 by Raymond Toy at 2016-12-17T08:40:21-08:00 Put sparc64 case before sparc Currently we still define :sparc so we need :sparc64 to come first to get the correct sparc64 directory instead of sparc. - - - - - 1 changed file: - src/tools/setup.lisp Changes: ===================================== src/tools/setup.lisp ===================================== --- a/src/tools/setup.lisp +++ b/src/tools/setup.lisp @@ -298,13 +298,13 @@ (cond ((c:target-featurep :pmax) "mips/") ((c:target-featurep :rt) "rt/") ((c:target-featurep :hppa) "hppa/") + ((c:target-featurep :sparc64) "sparc64/") ((c:target-featurep :sparc) "sparc/") ((c:target-featurep :x86) "x86/") ((c:target-featurep :alpha) "alpha/") ((c:target-featurep :sgi) "mips/") ((c:target-featurep :ppc) "ppc/") ((c:target-featurep :amd64) "amd64/") - ((c:target-featurep :sparc64) "sparc64/") (t (error "What machine is this?"))) (make-pathname :directory (pathname-directory f))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/fe4f6806960ad5c0cdaab4176…

1 0

[Git][cmucl/cmucl][sparc64-dev] Add more sparc64 files.
by Raymond Toy 17 Dec '16

17 Dec '16

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: 314541e9 by Raymond Toy at 2016-12-16T21:59:14-08:00 Add more sparc64 files. Config.sparc64_sunc and sparc64-assem.S are straight copies of the corresponding sparc files. - - - - - 2 changed files: - + src/lisp/Config.sparc64_sunc - + src/lisp/sparc64-assem.S Changes: ===================================== src/lisp/Config.sparc64_sunc ===================================== --- /dev/null +++ b/src/lisp/Config.sparc64_sunc @@ -0,0 +1,31 @@ +# -*- Mode: makefile -*- + +# Build cmucl using Sun C compiler. We assume cc is Sun's C compiler. +# If you don't have it, why are you using this Config anyway? You're +# on your own if you use this Config without Sun C compiler available. + +include Config.sparc_common + +# For v8plus support (allows 64-bit integer support on V9 +# architectures), uncomment the definitions for CC_V8PLUS and +# AS_V8PLUS. The -Wa,xarch=v8plus option tells the assembler to +# accept v8plus instructions and generate a v8plus object files and +# executable. +# +# However, we should also make sure the binary is marked as v8plus by +# enabling AS_V8PLUS whenever we have the :sparc-v9 *feature* enabled +# because we really are a v8plus application by using some of the v9 +# instructions, even if we don't use the 64-bit registers. + +ifdef FEATURE_SPARC_V9 +# For SunStudio 11, use -xarch=v8plus. For SunStudio 12, that is +# deprecated; use -m32 -xarch=sparc. +CC_V8PLUS = -xarch=sparc +AS_V8PLUS = -xarch=sparc +endif + +ASSEM_SRC = sparcv9-assem.S +CFLAGS += -xlibmieee -O +DEPEND_FLAGS = -xM +ASFLAGS = $(AS_V8PLUS) +OS_LINK_FLAGS = -M /usr/lib/ld/map.noexstk ===================================== src/lisp/sparc64-assem.S ===================================== --- /dev/null +++ b/src/lisp/sparc64-assem.S @@ -0,0 +1,565 @@ + +#ifdef SOLARIS +#define _ASM +#include <sys/asm_linkage.h> +#include <sys/psw.h> +#include <sys/trap.h> +#ifdef __STDC__ +#define FUNCDEF(x) .type x, \#function +#else +#define FUNCDEF(x) .type x, #function +#endif +#else +#endif + +#define LANGUAGE_ASSEMBLY +#include "lispregs.h" +#include "internals.h" +#include "globals.h" + +#define load(sym, reg) \ + sethi %hi(sym), reg; ld [reg+%lo(sym)], reg +#define store(reg, sym) \ + sethi %hi(sym), reg_L0; st reg, [reg_L0+%lo(sym)] + +/* + * Our frame size needs to be large enough to hold our window, + * the structure return pointer, and some temp space. The temp space + * is to hold the 64-bit %o registers that might be converted to %i + * registers. A task switch will will not preserve all 64 bits of the + * %i registers, so we need to save our %o registers before entering C. + * Since %o0 and %o1 contain the return results, we do not have to save + * these. + */ +#ifdef v8plus +#define FRAMESIZE (SA(WINDOWSIZE+4 + 6*8)) +#else +#define FRAMESIZE (SA(MINFRAME)) +#endif + .seg "text" + .global call_into_lisp + FUNCDEF(call_into_lisp) +call_into_lisp: + save %sp, -FRAMESIZE, %sp + /* Flush all of C's register windows to the stack. */ + ta ST_FLUSH_WINDOWS + + /* Save the return address. */ + st %i7, [%fp-4] + + /* Clear the descriptor regs. (See sparc/vm.lisp) */ + mov reg_ZERO, reg_A0 + mov reg_ZERO, reg_A1 + mov reg_ZERO, reg_A2 + mov reg_ZERO, reg_A3 + mov reg_ZERO, reg_A4 + mov reg_ZERO, reg_A5 + mov reg_ZERO, reg_OCFP + mov reg_ZERO, reg_LRA + mov reg_ZERO, reg_CODE + + /* Establish NIL */ + set NIL, reg_NIL + + /* Set the pseudo-atomic flag. */ + set pseudo_atomic_Value, reg_ALLOC + + /* Turn off foreign function call. */ + sethi %hi(foreign_function_call_active), reg_NL0 + st reg_ZERO, [reg_NL0+%lo(foreign_function_call_active)] + + /* Load the rest of lisp state. */ + load(current_dynamic_space_free_pointer, reg_NL0) + add reg_NL0, reg_ALLOC, reg_ALLOC + load(current_binding_stack_pointer, reg_BSP) + load(current_control_stack_pointer, reg_CSP) + load(current_control_frame_pointer, reg_OCFP) + + /* No longer atomic, and check for interrupt. */ + andn reg_ALLOC, pseudo_atomic_Value, reg_ALLOC + andcc reg_ALLOC, pseudo_atomic_InterruptedValue, reg_ZERO + tne trap_PseudoAtomic + + /* Pass in the args. */ + sll %i2, 2, reg_NARGS + mov %i1, reg_CFP + mov %i0, reg_LEXENV + ld [reg_CFP+0], reg_A0 + ld [reg_CFP+4], reg_A1 + ld [reg_CFP+8], reg_A2 + ld [reg_CFP+12], reg_A3 + ld [reg_CFP+16], reg_A4 + ld [reg_CFP+20], reg_A5 + + /* Calculate LRA */ + set lra + type_OtherPointer, reg_LRA + + /* Indirect closure */ + ld [reg_LEXENV+CLOSURE_FUNCTION_OFFSET], reg_CODE + + jmp reg_CODE+FUNCTION_CODE_OFFSET + nop + + .align 8 +lra: + .word type_ReturnPcHeader + + /* Blow off any extra values. */ + mov reg_OCFP, reg_CSP + nop + + /* Return the one value. */ + mov reg_A0, %i0 + + /* Turn on pseudo_atomic */ + or reg_ALLOC, pseudo_atomic_Value, reg_ALLOC + + /* Store LISP state */ + andn reg_ALLOC, lowtag_Mask, reg_NL1 + store(reg_NL1,current_dynamic_space_free_pointer) + store(reg_BSP,current_binding_stack_pointer) + store(reg_CSP,current_control_stack_pointer) + store(reg_CFP,current_control_frame_pointer) + + /* No longer in Lisp. */ + store(reg_NL1,foreign_function_call_active) + + /* Were we interrupted? */ + andn reg_ALLOC, pseudo_atomic_Value, reg_ALLOC + andcc reg_ALLOC, pseudo_atomic_InterruptedValue, reg_ZERO + tne trap_PseudoAtomic + + /* Back to C we go. */ + ld [%sp+FRAMESIZE-4], %i7 + ret + restore %sp, FRAMESIZE, %sp + SET_SIZE(call_into_lisp) + + + + .global call_into_c + FUNCDEF(call_into_c) +call_into_c: +#ifdef v8plus + stx %o2, [%fp - 8 - 1*8] + stx %o3, [%fp - 8 - 2*8] + stx %o4, [%fp - 8 - 3*8] + stx %o5, [%fp - 8 - 4*8] + stx %o6, [%fp - 8 - 5*8] + stx %o7, [%fp - 8 - 6*8] +#endif + /* Build a lisp stack frame */ + mov reg_CFP, reg_OCFP + mov reg_CSP, reg_CFP + add reg_CSP, 32, reg_CSP + st reg_OCFP, [reg_CFP] + st reg_CODE, [reg_CFP+8] + + /* Turn on pseudo-atomic. */ + or reg_ALLOC, pseudo_atomic_Value, reg_ALLOC + + /* Convert the return address to an offset and save it on the stack. */ + sub reg_LIP, reg_CODE, reg_L0 + add reg_L0, type_OtherPointer, reg_L0 + st reg_L0, [reg_CFP+4] + + /* Store LISP state */ + store(reg_BSP,current_binding_stack_pointer) + store(reg_CSP,current_control_stack_pointer) + store(reg_CFP,current_control_frame_pointer) + + /* Use reg_CFP as a work register, and restore it */ + andn reg_ALLOC, lowtag_Mask, reg_CFP + store(reg_CFP,current_dynamic_space_free_pointer) + load(current_control_frame_pointer, reg_CFP) + + /* No longer in Lisp. */ + store(reg_CSP,foreign_function_call_active) + + /* Were we interrupted? */ + andn reg_ALLOC, pseudo_atomic_Value, reg_ALLOC + andcc reg_ALLOC, pseudo_atomic_InterruptedValue, reg_ZERO + tne trap_PseudoAtomic + + /* Into C we go. */ + call reg_CFUNC + nop + + /* + * Note: C calling conventions (32-bit) say that %o0 and %o1 + * are used to return function results. In particular 64-bit + * results are in %o0 (hi) and %o1 (low). + */ + + /* Re-establish NIL */ + set NIL, reg_NIL + + /* Atomic. */ + set pseudo_atomic_Value, reg_ALLOC + + /* No longer in foreign function call. */ + sethi %hi(foreign_function_call_active), reg_NL2 + st reg_ZERO, [reg_NL2+%lo(foreign_function_call_active)] + + /* Load the rest of lisp state. */ + load(current_dynamic_space_free_pointer, reg_NL2) + add reg_NL2, reg_ALLOC, reg_ALLOC + load(current_binding_stack_pointer, reg_BSP) + load(current_control_stack_pointer, reg_CSP) + load(current_control_frame_pointer, reg_CFP) + + /* Get the return address back. */ + ld [reg_CFP+4], reg_LIP + ld [reg_CFP+8], reg_CODE + add reg_LIP, reg_CODE, reg_LIP + sub reg_LIP, type_OtherPointer, reg_LIP + + /* No longer atomic. */ + andn reg_ALLOC, pseudo_atomic_Value, reg_ALLOC + andcc reg_ALLOC, pseudo_atomic_InterruptedValue, reg_ZERO + tne trap_PseudoAtomic + + /* Reset the lisp stack. */ + /* Note: OCFP is in one of the locals, it gets preserved across C. */ + mov reg_CFP, reg_CSP + mov reg_OCFP, reg_CFP + +#ifdef v8plus + ldx [%fp - 8 - 1*8], %o2 + ldx [%fp - 8 - 2*8], %o3 + ldx [%fp - 8 - 3*8], %o4 + ldx [%fp - 8 - 4*8], %o5 + ldx [%fp - 8 - 5*8], %o6 + ldx [%fp - 8 - 6*8], %o7 +#endif + /* And back into lisp. */ + ret + nop + + SET_SIZE(call_into_c) + +#if 0 +/* undefined_tramp and closure_tramp are now Lisp assembly routines. + * so we don't need these anymore. Leave them here for a bit so + * we can look at the "real" versions for a while. But eventually, + * remove these. + */ + .global _undefined_tramp + FUNCDEF(_undefined_tramp) + .align 8 + .byte 0 +_undefined_tramp: + .byte 0, 0, type_FunctionHeader + .word _undefined_tramp + .word NIL + .word NIL + .word NIL + .word NIL + + b 1f + unimp trap_Cerror + /* Number of argument bytes */ + .byte 4 + .byte UNDEFINED_SYMBOL_ERROR + /* Escape to create 16bit number from following two bytes, + in little-endian order */ + .byte 254 + /* SC_OFFSET(sc_DescriptorReg,reg_FDEFN) */ + .byte SC_OFFSET_LO(sc_DescriptorReg,reg_FDEFN_NUM) + .byte SC_OFFSET_HI(sc_DescriptorReg,reg_FDEFN_NUM) + + .align 4 +1: + ld [reg_FDEFN+FDEFN_RAW_ADDR_OFFSET], reg_CODE + jmp reg_CODE+FUNCTION_CODE_OFFSET + nop + SET_SIZE(_undefined_tramp) + + .global _closure_tramp + FUNCDEF(_closure_tramp) + .align 8 + .byte 0 +_closure_tramp: + .byte 0, 0, type_FunctionHeader + .word _closure_tramp + .word NIL + .word NIL + .word NIL + .word NIL + + ld [reg_FDEFN+FDEFN_FUNCTION_OFFSET], reg_LEXENV + ld [reg_LEXENV+CLOSURE_FUNCTION_OFFSET], reg_CODE + jmp reg_CODE+FUNCTION_CODE_OFFSET + nop + SET_SIZE(_closure_tramp) +#endif + + +/* + * Function-end breakpoint magic. + */ + + .text + .align 8 + .global function_end_breakpoint_guts +function_end_breakpoint_guts: + .word type_ReturnPcHeader + b 1f + nop + mov reg_CSP, reg_OCFP + add 4, reg_CSP, reg_CSP + mov 4, reg_NARGS + mov reg_NIL, reg_A1 + mov reg_NIL, reg_A2 + mov reg_NIL, reg_A3 + mov reg_NIL, reg_A4 + mov reg_NIL, reg_A5 +1: + + .global function_end_breakpoint_trap +function_end_breakpoint_trap: + unimp trap_FunctionEndBreakpoint + b 1b + nop + + .global function_end_breakpoint_end +function_end_breakpoint_end: + + .global flush_icache + FUNCDEF(flush_icache) +flush_icache: + add %o0,%o1,%o2 +1: iflush %o0 ! flush instruction cache + add %o0,8,%o0 + cmp %o0,%o2 + blt 1b + nop + retl ! return from leaf routine + nop + SET_SIZE(flush_icache) + + .global do_pending_interrupt + FUNCDEF(do_pending_interrupt) +do_pending_interrupt: + unimp trap_PendingInterrupt + retl + nop + SET_SIZE(do_pending_interrupt) + +#ifdef trap_DynamicSpaceOverflowError + .global do_dynamic_space_overflow_error + FUNCDEF(do_dynamic_space_overflow_error) +do_dynamic_space_overflow_error: + unimp trap_DynamicSpaceOverflowError + retl + nop + SET_SIZE(do_dynamic_space_overflow_error) +#endif + +#ifdef trap_DynamicSpaceOverflowWarning + .global do_dynamic_space_overflow_warning + FUNCDEF(do_dynamic_space_overflow_warning) +do_dynamic_space_overflow_warning: + unimp trap_DynamicSpaceOverflowWarning + retl + nop + SET_SIZE(do_dynamic_space_overflow_warning) +#endif + +#ifdef LINKAGE_TABLE +/* + * Call into C code to resolve a linkage entry. + * + * We get here by Lisp calling call_into_c with an address of the + * desired function which is contained in the register reg_CFUNC (aka + * %i4, aka %r28). This is the address of the entry in the linkage + * table, which is what we need to figure out what function we really + * wanted. + * + * Note that because we get here from call_into_c, all necessary live + * registers have been saved, including FP registers. Hence, no need + * to save them. + */ + .global lazy_resolve_linkage + .global resolve_linkage_tramp + FUNCDEF(resolve_linkage_tramp) +resolve_linkage_tramp: + /* + * At this point, all of the global %g registers have been + * saved by call_into_c, so we can use them as temps. %g2, + * aka reg_NIL, aka null-tn is a good choice. reg_L0 contains + * the address of the jmpl instruction in the linkage jump + * table. (See sparc-arch.c.) + */ + + mov reg_L0, reg_NIL + + /* + * New stack frame so the %o regs become %i. We can't touch + * the original %o because they contain the parameters to the + * function! + */ + save %sp, -FRAMESIZE, %sp + + /* %g2 tells where we came from in the linkage table */ + call lazy_resolve_linkage + mov reg_NIL, %o0 ! in the delay slot + + mov %o0, reg_NIL + restore %sp, FRAMESIZE, %sp + + /* And away we go! */ + jmp reg_NIL + nop + + SET_SIZE(resolve_linkage_tramp) + + .global undefined_foreign_symbol_trap + FUNCDEF(undefined_foreign_symbol_trap) +/* + * When we get called, %o0 contains the address of the data_vector object + * which is a string naming the bad symbol. + */ +undefined_foreign_symbol_trap: + /* + Need to restore all the global registers with the Lisp values that + were saved away in call_into_c. (This routine is only called from + os_link_one_symbol, which is called from resolve_linkage_tramp, which + is called from call_into_c.) + + The global registers are volatile across function calls, so who + knows what values have been they contain now! + + */ + + load(current_dynamic_space_free_pointer, reg_ALLOC) + load(current_binding_stack_pointer, reg_BSP) + load(current_control_stack_pointer, reg_CSP) + load(current_control_frame_pointer, reg_CFP) + + set NIL, reg_NIL + + mov %o0, reg_A0 + unimp trap_Error + .byte 4 /* Number of argument bytes */ + .byte UNDEFINED_FOREIGN_SYMBOL_ERROR + /* Escape to create 16bit number from following two bytes, in + little-endian order */ + .byte 254 + .byte SC_OFFSET_LO(sc_DescriptorReg, reg_A0_NUM) + .byte SC_OFFSET_HI(sc_DescriptorReg, reg_A0_NUM) + .align 4 + +#endif +/* + * Save the FPU state. %o0 contains a pointer to where we can + * store our state. + */ + +/* + * Note we only save the 16 double-float registers (which saves + * the 32 single-float values too, I think). If we're compiling for + * a sparc v9, the Lisp code can actually use all 32 double-float + * registers. For later. + */ + .global fpu_save + FUNCDEF(fpu_save) +fpu_save: + std %f0, [%o0 + 4*0] + std %f2, [%o0 + 4*2] + std %f4, [%o0 + 4*4] + std %f6, [%o0 + 4*6] + std %f8, [%o0 + 4*8] + std %f10, [%o0 + 4*10] + std %f12, [%o0 + 4*12] + std %f14, [%o0 + 4*14] + std %f16, [%o0 + 4*16] + std %f18, [%o0 + 4*18] + std %f20, [%o0 + 4*20] + std %f22, [%o0 + 4*22] + std %f24, [%o0 + 4*24] + std %f26, [%o0 + 4*26] + std %f28, [%o0 + 4*28] + std %f30, [%o0 + 4*30] +#ifdef FEATURE_SPARC_V9 + std %f32, [%o0 + 4*32] + std %f34, [%o0 + 4*34] + std %f36, [%o0 + 4*36] + std %f38, [%o0 + 4*38] + std %f40, [%o0 + 4*40] + std %f42, [%o0 + 4*42] + std %f44, [%o0 + 4*44] + std %f46, [%o0 + 4*46] + std %f48, [%o0 + 4*48] + std %f50, [%o0 + 4*50] + std %f52, [%o0 + 4*52] + std %f54, [%o0 + 4*54] + std %f56, [%o0 + 4*56] + std %f58, [%o0 + 4*58] + std %f60, [%o0 + 4*60] + std %f62, [%o0 + 4*62] + st %fsr, [%o0 + 4*64] +#else + st %fsr, [%o0 + 4*32] +#endif + retl + nop + SET_SIZE(fpu_save) + + .global fpu_restore + FUNCDEF(fpu_restore) +fpu_restore: + ldd [%o0 + 4*0], %f0 + ldd [%o0 + 4*2], %f2 + ldd [%o0 + 4*4], %f4 + ldd [%o0 + 4*6], %f6 + ldd [%o0 + 4*8], %f8 + ldd [%o0 + 4*10], %f10 + ldd [%o0 + 4*12], %f12 + ldd [%o0 + 4*14], %f14 + ldd [%o0 + 4*16], %f16 + ldd [%o0 + 4*18], %f18 + ldd [%o0 + 4*20], %f20 + ldd [%o0 + 4*22], %f22 + ldd [%o0 + 4*24], %f24 + ldd [%o0 + 4*26], %f26 + ldd [%o0 + 4*28], %f28 + ldd [%o0 + 4*30], %f30 +#ifdef FEATURE_SPARC_V9 + ldd [%o0 + 4*32], %f32 + ldd [%o0 + 4*34], %f34 + ldd [%o0 + 4*36], %f36 + ldd [%o0 + 4*38], %f38 + ldd [%o0 + 4*40], %f40 + ldd [%o0 + 4*42], %f42 + ldd [%o0 + 4*44], %f44 + ldd [%o0 + 4*46], %f46 + ldd [%o0 + 4*48], %f48 + ldd [%o0 + 4*50], %f50 + ldd [%o0 + 4*52], %f52 + ldd [%o0 + 4*54], %f54 + ldd [%o0 + 4*56], %f56 + ldd [%o0 + 4*58], %f58 + ldd [%o0 + 4*60], %f60 + ldd [%o0 + 4*62], %f62 + ld [%o0 + 4*64], %fsr +#else + ld [%o0 + 4*32], %fsr +#endif + retl + nop + SET_SIZE(fpu_restore) + + .global save_context + FUNCDEF(save_context) +save_context: + ta ST_FLUSH_WINDOWS ! flush register windows + retl ! return from leaf routine + nop + SET_SIZE(save_context) +/* + * Local variables: + * tab-width: 8 + * End: + */ + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/314541e9622792aefdecbce2f…

1 0

[Git][cmucl/cmucl] Pushed new branch sparc64-dev
by Raymond Toy 17 Dec '16

17 Dec '16

Raymond Toy pushed new branch sparc64-dev at cmucl / cmucl

1 0

[Git][cmucl/cmucl][master] Remove sparc64 stuff so we can do this on a branch.
by Raymond Toy 17 Dec '16

17 Dec '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 5c9837fd by Raymond Toy at 2016-12-16T21:43:33-08:00 Remove sparc64 stuff so we can do this on a branch. - - - - - 7 changed files: - − src/assembly/sparc64/alloc.lisp - − src/assembly/sparc64/arith.lisp - − src/assembly/sparc64/array.lisp - − src/assembly/sparc64/assem-rtns.lisp - − src/assembly/sparc64/support.lisp - − src/compiler/sparc64/alloc.lisp - − src/compiler/sparc64/arith.lisp The diff was not included because it is too large. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/5c9837fd4bda7cc7349ed53ae…

1 0

[Git][cmucl/cmucl][master] 2 commits: Forgot to remove the original assembly/sparcv9 files.
by Raymond Toy 11 Dec '16

11 Dec '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: e5c415bd by Raymond Toy at 2016-12-11T10:01:42-08:00 Forgot to remove the original assembly/sparcv9 files. These were moved to assembly/sparc64. - - - - - 0f4c649a by Raymond Toy at 2016-12-11T10:05:01-08:00 Default motif_variant for sparc64_sunc Make motif variant default to solaris_sunc when sparc64_sunc is the lisp variant. - - - - - 6 changed files: - bin/create-target.sh - − src/assembly/sparcv9/alloc.lisp - − src/assembly/sparcv9/arith.lisp - − src/assembly/sparcv9/array.lisp - − src/assembly/sparcv9/assem-rtns.lisp - − src/assembly/sparcv9/support.lisp Changes: ===================================== bin/create-target.sh ===================================== --- a/bin/create-target.sh +++ b/bin/create-target.sh @@ -78,7 +78,7 @@ case $uname_s in OpenBSD*) motif_variant=OpenBSD ;; *_darwin) motif_variant=Darwin ;; sun4_solaris_gcc|sparc_gcc) motif_variant=solaris ;; - sun4_solaris_sunc|sparc_sunc|x86_solaris_sunc) motif_variant=solaris_sunc ;; + sun4_solaris_sunc|sparc_sunc|x86_solaris_sunc|sparc64_sunc) motif_variant=solaris_sunc ;; sun4c*) motif_variant=sun4c_411 ;; hp700*) motif_variant=hpux_cc ;; pmax_mach) motif_variant=pmax_mach ;; ===================================== src/assembly/sparcv9/alloc.lisp deleted ===================================== --- a/src/assembly/sparcv9/alloc.lisp +++ /dev/null @@ -1,19 +0,0 @@ -;;; -*- Package: SPARC -*- -;;; -;;; ********************************************************************** -;;; This code was written as part of the CMU Common Lisp project at -;;; Carnegie Mellon University, and has been placed in the public domain. -;;; -(ext:file-comment - "$Header: src/assembly/sparc/alloc.lisp $") -;;; -;;; ********************************************************************** -;;; -;;; Stuff to handle allocating simple objects. -;;; -;;; Written by William Lott. -;;; - -(in-package "SPARC") - -;;; But we do everything inline now that we have a better pseudo-atomic. ===================================== src/assembly/sparcv9/arith.lisp deleted ===================================== --- a/src/assembly/sparcv9/arith.lisp +++ /dev/null @@ -1,364 +0,0 @@ -;;; -*- Package: SPARC -*- -;;; -;;; ********************************************************************** -;;; This code was written as part of the CMU Common Lisp project at -;;; Carnegie Mellon University, and has been placed in the public domain. -;;; -(ext:file-comment - "$Header: src/assembly/sparc/arith.lisp $") -;;; -;;; ********************************************************************** -;;; -;;; Stuff to handle simple cases for generic arithmetic. -;;; -;;; Written by William Lott. -;;; - -(in-package "SPARC") - - - -;;;; Addition and subtraction. - -(define-assembly-routine (generic-+ - (:cost 10) - (:return-style :full-call) - (:translate +) - (:policy :safe) - (:save-p t)) - ((:arg x (descriptor-reg any-reg) a0-offset) - (:arg y (descriptor-reg any-reg) a1-offset) - - (:res res (descriptor-reg any-reg) a0-offset) - - (:temp temp non-descriptor-reg nl0-offset) - (:temp temp2 non-descriptor-reg nl1-offset) - (:temp lra descriptor-reg lra-offset) - (:temp nargs any-reg nargs-offset) - (:temp ocfp any-reg ocfp-offset)) - (inst andcc zero-tn x fixnum-tag-mask) - (inst b :ne DO-STATIC-FUN) - (inst andcc zero-tn y fixnum-tag-mask) - (inst b :ne DO-STATIC-FUN) - (inst nop) - (inst addcc temp x y) - (inst b :vc done) - (inst nop) - - (inst sra temp x fixnum-tag-bits) - (inst sra temp2 y fixnum-tag-bits) - (inst add temp2 temp) - (with-fixed-allocation (res temp bignum-type (1+ bignum-digits-offset)) - (storew temp2 res bignum-digits-offset other-pointer-type)) - (lisp-return lra :offset 2) - - DO-STATIC-FUN - (inst ld code-tn null-tn (static-function-offset 'two-arg-+)) - (inst li nargs (fixnumize 2)) - (inst move ocfp cfp-tn) - (inst j code-tn - (- (* function-code-offset word-bytes) function-pointer-type)) - (inst move cfp-tn csp-tn) - - DONE - (move res temp)) - - -(define-assembly-routine (generic-- - (:cost 10) - (:return-style :full-call) - (:translate -) - (:policy :safe) - (:save-p t)) - ((:arg x (descriptor-reg any-reg) a0-offset) - (:arg y (descriptor-reg any-reg) a1-offset) - - (:res res (descriptor-reg any-reg) a0-offset) - - (:temp temp non-descriptor-reg nl0-offset) - (:temp temp2 non-descriptor-reg nl1-offset) - (:temp lra descriptor-reg lra-offset) - (:temp nargs any-reg nargs-offset) - (:temp ocfp any-reg ocfp-offset)) - (inst andcc zero-tn x fixnum-tag-mask) - (inst b :ne DO-STATIC-FUN) - (inst andcc zero-tn y fixnum-tag-mask) - (inst b :ne DO-STATIC-FUN) - (inst nop) - (inst subcc temp x y) - (inst b :vc done) - (inst nop) - - (inst sra temp x fixnum-tag-bits) - (inst sra temp2 y fixnum-tag-bits) - (inst sub temp2 temp temp2) - (with-fixed-allocation (res temp bignum-type (1+ bignum-digits-offset)) - (storew temp2 res bignum-digits-offset other-pointer-type)) - (lisp-return lra :offset 2) - - DO-STATIC-FUN - (inst ld code-tn null-tn (static-function-offset 'two-arg--)) - (inst li nargs (fixnumize 2)) - (inst move ocfp cfp-tn) - (inst j code-tn - (- (* function-code-offset word-bytes) function-pointer-type)) - (inst move cfp-tn csp-tn) - - DONE - (move res temp)) - - - -;;;; Multiplication - - -(define-assembly-routine (generic-* - (:cost 50) - (:return-style :full-call) - (:translate *) - (:policy :safe) - (:save-p t)) - ((:arg x (descriptor-reg any-reg) a0-offset) - (:arg y (descriptor-reg any-reg) a1-offset) - - (:res res (descriptor-reg any-reg) a0-offset) - - (:temp temp non-descriptor-reg nl0-offset) - (:temp lo non-descriptor-reg nl1-offset) - (:temp hi non-descriptor-reg nl2-offset) - (:temp lra descriptor-reg lra-offset) - (:temp nargs any-reg nargs-offset) - (:temp ocfp any-reg ocfp-offset)) - ;; If either arg is not a fixnum, call the static function. - (inst andcc zero-tn x fixnum-tag-mask) - (inst b :ne DO-STATIC-FUN) - (inst andcc zero-tn y fixnum-tag-mask) - (inst b :ne DO-STATIC-FUN) - (inst nop) - - ;; Remove the tag from one arg so that the result will have the correct - ;; fixnum tag. - (inst sra temp x fixnum-tag-bits) - ;; Compute the produce temp * y and return the double-word product - ;; in hi:lo. - (cond ((backend-featurep :sparc-64) - ;; Sign extend y to a full 64-bits. temp was already - ;; sign-extended by the sra instruction above. - (inst sra y 0) - (inst mulx hi temp y) - (inst move lo hi) - (inst srax hi 32)) - ((or (backend-featurep :sparc-v8) - (backend-featurep :sparc-v9)) - (inst smul lo temp y) - (inst rdy hi)) - (t - (let ((MULTIPLIER-POSITIVE (gen-label))) - (inst wry temp) - (inst andcc hi zero-tn) - (inst nop) - (inst nop) - (dotimes (i 32) - (inst mulscc hi y)) - (inst mulscc hi zero-tn) - (inst cmp x) - (inst b :ge MULTIPLIER-POSITIVE) - (inst nop) - (inst sub hi y) - (emit-label MULTIPLIER-POSITIVE) - (inst rdy lo)))) - - ;; Check to see if the result will fit in a fixnum. (I.e. the high word - ;; is just 32 copies of the sign bit of the low word). - (inst sra temp lo 31) - (inst xorcc temp hi) - (inst b :eq LOW-FITS-IN-FIXNUM) - ;; Shift the double word hi:lo down two bits to get rid of the fixnum tag. - (inst sll temp hi 30) - (inst srl lo fixnum-tag-bits) - (inst or lo temp) - (inst sra hi fixnum-tag-bits) - ;; Allocate a BIGNUM for the result. We always allocate 2 words for - ;; the bignum result, even if we only need one. The copying GC will - ;; take care of the extra word if it isn't needed. - (with-fixed-allocation - (res temp bignum-type (+ 2 bignum-digits-offset)) - (let ((one-word (gen-label))) - ;; We start out assuming that we need one word. Is that correct? - (inst sra temp lo 31) - (inst xorcc temp hi) - (inst b :eq one-word) - (inst li temp (logior (ash 1 type-bits) bignum-type)) - ;; Need 2 words. Set the header appropriately, and save the - ;; high and low parts. - (inst li temp (logior (ash 2 type-bits) bignum-type)) - (storew hi res (1+ bignum-digits-offset) other-pointer-type) - (emit-label one-word) - (storew temp res 0 other-pointer-type) - (storew lo res bignum-digits-offset other-pointer-type))) - ;; Out of here - (lisp-return lra :offset 2) - - DO-STATIC-FUN - (inst ld code-tn null-tn (static-function-offset 'two-arg-*)) - (inst li nargs (fixnumize 2)) - (inst move ocfp cfp-tn) - (inst j code-tn - (- (* function-code-offset word-bytes) function-pointer-type)) - (inst move cfp-tn csp-tn) - - LOW-FITS-IN-FIXNUM - (move res lo)) - - -;;;; Comparison - -(macrolet - ((define-cond-assem-rtn (name translate static-fn cmp) - `(define-assembly-routine (,name - (:cost 10) - (:return-style :full-call) - (:policy :safe) - (:translate ,translate) - (:save-p t)) - ((:arg x (descriptor-reg any-reg) a0-offset) - (:arg y (descriptor-reg any-reg) a1-offset) - - (:res res descriptor-reg a0-offset) - - (:temp nargs any-reg nargs-offset) - (:temp ocfp any-reg ocfp-offset)) - (inst andcc zero-tn x fixnum-tag-mask) - (inst b :ne DO-STATIC-FN) - (inst andcc zero-tn y fixnum-tag-mask) - (inst b :eq DO-COMPARE) - (inst cmp x y) - - DO-STATIC-FN - (inst ld code-tn null-tn (static-function-offset ',static-fn)) - (inst li nargs (fixnumize 2)) - (inst move ocfp cfp-tn) - (inst j code-tn - (- (* function-code-offset word-bytes) function-pointer-type)) - (inst move cfp-tn csp-tn) - - DO-COMPARE - (inst b ,cmp done) - (load-symbol res t) - (inst move res null-tn) - DONE))) - - (define-cond-assem-rtn generic-< < two-arg-< :lt) - (define-cond-assem-rtn generic-<= <= two-arg-<= :le) - (define-cond-assem-rtn generic-> > two-arg-> :gt) - (define-cond-assem-rtn generic->= >= two-arg->= :ge)) - - -(define-assembly-routine (generic-eql - (:cost 10) - (:return-style :full-call) - (:policy :safe) - (:translate eql) - (:save-p t)) - ((:arg x (descriptor-reg any-reg) a0-offset) - (:arg y (descriptor-reg any-reg) a1-offset) - - (:res res descriptor-reg a0-offset) - - (:temp lra descriptor-reg lra-offset) - (:temp nargs any-reg nargs-offset) - (:temp ocfp any-reg ocfp-offset)) - (inst cmp x y) - (inst b :eq RETURN-T) - (inst andcc zero-tn x fixnum-tag-mask) - (inst b :eq RETURN-NIL) - (inst andcc zero-tn y fixnum-tag-mask) - (inst b :ne DO-STATIC-FN) - (inst nop) - - RETURN-NIL - (inst move res null-tn) - (lisp-return lra :offset 2) - - DO-STATIC-FN - (inst ld code-tn null-tn (static-function-offset 'eql)) - (inst li nargs (fixnumize 2)) - (inst move ocfp cfp-tn) - (inst j code-tn - (- (* function-code-offset word-bytes) function-pointer-type)) - (inst move cfp-tn csp-tn) - - RETURN-T - (load-symbol res t)) - -(define-assembly-routine (generic-= - (:cost 10) - (:return-style :full-call) - (:policy :safe) - (:translate =) - (:save-p t)) - ((:arg x (descriptor-reg any-reg) a0-offset) - (:arg y (descriptor-reg any-reg) a1-offset) - - (:res res descriptor-reg a0-offset) - - (:temp lra descriptor-reg lra-offset) - (:temp nargs any-reg nargs-offset) - (:temp ocfp any-reg ocfp-offset)) - (inst andcc zero-tn x fixnum-tag-mask) - (inst b :ne DO-STATIC-FN) - (inst andcc zero-tn y fixnum-tag-mask) - (inst b :ne DO-STATIC-FN) - (inst cmp x y) - (inst b :eq RETURN-T) - (inst nop) - - (inst move res null-tn) - (lisp-return lra :offset 2) - - DO-STATIC-FN - (inst ld code-tn null-tn (static-function-offset 'two-arg-=)) - (inst li nargs (fixnumize 2)) - (inst move ocfp cfp-tn) - (inst j code-tn - (- (* function-code-offset word-bytes) function-pointer-type)) - (inst move cfp-tn csp-tn) - - RETURN-T - (load-symbol res t)) - -(define-assembly-routine (generic-/= - (:cost 10) - (:return-style :full-call) - (:policy :safe) - (:translate /=) - (:save-p t)) - ((:arg x (descriptor-reg any-reg) a0-offset) - (:arg y (descriptor-reg any-reg) a1-offset) - - (:res res descriptor-reg a0-offset) - - (:temp lra descriptor-reg lra-offset) - (:temp nargs any-reg nargs-offset) - (:temp ocfp any-reg ocfp-offset)) - (inst cmp x y) - (inst b :eq RETURN-NIL) - (inst andcc zero-tn x fixnum-tag-mask) - (inst b :ne DO-STATIC-FN) - (inst andcc zero-tn y fixnum-tag-mask) - (inst b :ne DO-STATIC-FN) - (inst nop) - - (load-symbol res t) - (lisp-return lra :offset 2) - - DO-STATIC-FN - (inst ld code-tn null-tn (static-function-offset 'two-arg-=)) - (inst li nargs (fixnumize 2)) - (inst move ocfp cfp-tn) - (inst j code-tn - (- (* function-code-offset word-bytes) function-pointer-type)) - (inst move cfp-tn csp-tn) - - RETURN-NIL - (inst move res null-tn)) ===================================== src/assembly/sparcv9/array.lisp deleted ===================================== --- a/src/assembly/sparcv9/array.lisp +++ /dev/null @@ -1,169 +0,0 @@ -;;; -*- Package: SPARC -*- -;;; -;;; ********************************************************************** -;;; This code was written as part of the CMU Common Lisp project at -;;; Carnegie Mellon University, and has been placed in the public domain. -;;; -(ext:file-comment - "$Header: src/assembly/sparc/array.lisp $") -;;; -;;; ********************************************************************** -;;; -;;; $Header: src/assembly/sparc/array.lisp $ -;;; -;;; This file contains the support routines for arrays and vectors. -;;; -;;; Written by William Lott. -;;; -(in-package "SPARC") - - -(define-assembly-routine (allocate-vector - (:policy :fast-safe) - (:translate allocate-vector) - (:arg-types positive-fixnum - positive-fixnum - positive-fixnum)) - ((:arg type any-reg a0-offset) - (:arg length any-reg a1-offset) - (:arg words any-reg a2-offset) - (:res result descriptor-reg a0-offset) - - (:temp ndescr non-descriptor-reg nl0-offset) - (:temp gc-temp non-descriptor-reg nl1-offset) - (:temp vector descriptor-reg a3-offset)) - (pseudo-atomic () - (inst add ndescr words (* (1+ vm:vector-data-offset) vm:word-bytes)) - (inst andn ndescr vm:lowtag-mask) - (allocation vector ndescr other-pointer-type :temp-tn gc-temp) - #+gencgc - (progn - ;; ndescr points to one word past the end of the allocated - ;; space. Fill the last word with a zero. - (inst add ndescr vector) - (storew zero-tn ndescr -1 vm:other-pointer-type)) - (inst srl ndescr type vm:word-shift) - (storew ndescr vector 0 vm:other-pointer-type) - (storew length vector vm:vector-length-slot vm:other-pointer-type)) - ;; This makes sure the zero byte at the end of a string is paged in so - ;; the kernel doesn't bitch if we pass it the string. - ;; - ;; This used to write to the word after the last allocated word. I - ;; (RLT) made it write to the last allocated word, which is where - ;; the zero-byte of the string is. Look at the deftransform for - ;; make-array in array-tran.lisp. For strings we always allocate - ;; enough space to hold the zero-byte. - #-gencgc - (storew zero-tn alloc-tn -1) - (move result vector)) - - - -;;;; Hash primitives - -#+assembler -(defparameter sxhash-simple-substring-entry (gen-label)) - -(define-assembly-routine (sxhash-simple-string - (:translate %sxhash-simple-string) - (:policy :fast-safe) - (:result-types positive-fixnum)) - ((:arg string descriptor-reg a0-offset) - (:res result any-reg a0-offset) - - (:temp length any-reg a1-offset) - (:temp accum non-descriptor-reg nl0-offset) - (:temp data non-descriptor-reg nl1-offset) - (:temp temp non-descriptor-reg nl2-offset) - (:temp offset non-descriptor-reg nl3-offset)) - - (declare (ignore result accum data temp offset)) - - (inst b sxhash-simple-substring-entry) - (loadw length string vm:vector-length-slot vm:other-pointer-type)) - - -;; Implement the one-at-a-time algorithm designed by Bob Jenkins -;; (see <http://burtleburtle.net/bob/hash/doobs.html> for some -;; more information). -;; -;; For completeness, here is the hash function, in C, from that web -;; page. ub4 is an unsigned 32-bit integer. - -#|| -ub4 one_at_a_time(char *key, ub4 len) -{ - ub4 hash, i; - for (hash=0, i=0; i<len; ++i) - { - hash += key[i]; - hash += (hash << 10); - hash ^= (hash >> 6); - } - hash += (hash << 3); - hash ^= (hash >> 11); - hash += (hash << 15); - return (hash & mask); -} - -||# - - -(define-assembly-routine (sxhash-simple-substring - (:translate %sxhash-simple-substring) - (:policy :fast-safe) - (:arg-types * positive-fixnum) - (:result-types positive-fixnum)) - ((:arg string descriptor-reg a0-offset) - (:arg length any-reg a1-offset) - (:res result any-reg a0-offset) - - (:temp accum non-descriptor-reg nl0-offset) - (:temp data non-descriptor-reg nl1-offset) - (:temp temp non-descriptor-reg nl2-offset) - (:temp offset non-descriptor-reg nl3-offset)) - (emit-label sxhash-simple-substring-entry) - - #+unicode - (inst sll length 1) ; Number of bytes = twice the length - - (inst li offset (- (* vector-data-offset word-bytes) other-pointer-type)) - (inst b test) - (move accum zero-tn) - - LOOP - - ;; hash += key[i] - (inst add accum data) - ;; hash += (hash << 10) - (inst slln temp accum 10) - (inst add accum temp) - ;; hash ^= (hash >> 6) - (inst srln temp accum 6) - (inst xor accum temp) - (inst add offset 1) - - TEST - - (inst subcc length (fixnumize 1)) - (inst b :ge loop) - (inst ldub data string offset) - - ;; hash += (hash << 3) - (inst slln temp accum 3) - (inst add accum temp) - ;; hash ^= (hash >> 11) - (inst srln temp accum 11) - (inst xor accum temp) - ;; hash += (hash << 15) - (inst slln temp accum 15) - (inst add accum temp) - - ;;(inst li temp most-positive-fixnum) - ;;(inst and accum temp) - ;; Make it a fixnum result - - ;; Make the result a positive fixnum. Shifting it left, then right - ;; does what we want, and extracts the bits we need. - (inst slln accum (1+ vm:fixnum-tag-bits)) - (inst srln result accum 1)) ===================================== src/assembly/sparcv9/assem-rtns.lisp deleted ===================================== --- a/src/assembly/sparcv9/assem-rtns.lisp +++ /dev/null @@ -1,311 +0,0 @@ -;;; -*- Package: SPARC -*- -;;; -;;; ********************************************************************** -;;; This code was written as part of the CMU Common Lisp project at -;;; Carnegie Mellon University, and has been placed in the public domain. -;;; -(ext:file-comment - "$Header: src/assembly/sparc/assem-rtns.lisp $") -;;; -;;; ********************************************************************** -;;; -;;; $Header: src/assembly/sparc/assem-rtns.lisp $ -;;; -;;; -(in-package "SPARC") - - -;;;; Return-multiple with other than one value - -#+assembler ;; we don't want a vop for this one. -(define-assembly-routine - (return-multiple - (:return-style :none)) - - ;; These four are really arguments. - ((:temp nvals any-reg nargs-offset) - (:temp vals any-reg nl0-offset) - (:temp ocfp any-reg nl1-offset) - (:temp lra descriptor-reg lra-offset) - - ;; These are just needed to facilitate the transfer - (:temp count any-reg nl2-offset) - (:temp src any-reg nl3-offset) - (:temp dst any-reg nl4-offset) - (:temp temp descriptor-reg cname-offset) - - ;; These are needed so we can get at the register args. - (:temp a0 descriptor-reg a0-offset) - (:temp a1 descriptor-reg a1-offset) - (:temp a2 descriptor-reg a2-offset) - (:temp a3 descriptor-reg a3-offset) - (:temp a4 descriptor-reg a4-offset) - (:temp a5 descriptor-reg a5-offset)) - - ;; Note, because of the way the return-multiple vop is written, we can - ;; assume that we are never called with nvals == 1 and that a0 has already - ;; been loaded. - (inst cmp nvals) - (inst b :le default-a0-and-on) - (inst cmp nvals (fixnumize 2)) - (inst b :le default-a2-and-on) - (inst ld a1 vals (* 1 vm:word-bytes)) - (inst cmp nvals (fixnumize 3)) - (inst b :le default-a3-and-on) - (inst ld a2 vals (* 2 vm:word-bytes)) - (inst cmp nvals (fixnumize 4)) - (inst b :le default-a4-and-on) - (inst ld a3 vals (* 3 vm:word-bytes)) - (inst cmp nvals (fixnumize 5)) - (inst b :le default-a5-and-on) - (inst ld a4 vals (* 4 vm:word-bytes)) - (inst cmp nvals (fixnumize 6)) - (inst b :le done) - (inst ld a5 vals (* 5 vm:word-bytes)) - - ;; Copy the remaining args to the top of the stack. - (inst add src vals (* 6 vm:word-bytes)) - (inst add dst cfp-tn (* 6 vm:word-bytes)) - (inst subcc count nvals (fixnumize 6)) - - LOOP - (inst ld temp src) - (inst add src vm:word-bytes) - (inst st temp dst) - (inst add dst vm:word-bytes) - (inst b :gt loop) - (inst subcc count (fixnumize 1)) - - (inst b done) - (inst nop) - - DEFAULT-A0-AND-ON - (inst move a0 null-tn) - (inst move a1 null-tn) - DEFAULT-A2-AND-ON - (inst move a2 null-tn) - DEFAULT-A3-AND-ON - (inst move a3 null-tn) - DEFAULT-A4-AND-ON - (inst move a4 null-tn) - DEFAULT-A5-AND-ON - (inst move a5 null-tn) - DONE - - ;; Clear the stack. - (move ocfp-tn cfp-tn) - (move cfp-tn ocfp) - (inst add csp-tn ocfp-tn nvals) - - ;; Return. - (lisp-return lra)) - - - -;;;; tail-call-variable. - -#+assembler ;; no vop for this one either. -(define-assembly-routine - (tail-call-variable - (:return-style :none)) - - ;; These are really args. - ((:temp args any-reg nl0-offset) - (:temp lexenv descriptor-reg lexenv-offset) - - ;; We need to compute this - (:temp nargs any-reg nargs-offset) - - ;; These are needed by the blitting code. - (:temp src any-reg nl1-offset) - (:temp dst any-reg nl2-offset) - (:temp count any-reg nl3-offset) - (:temp temp descriptor-reg cname-offset) - - ;; These are needed so we can get at the register args. - (:temp a0 descriptor-reg a0-offset) - (:temp a1 descriptor-reg a1-offset) - (:temp a2 descriptor-reg a2-offset) - (:temp a3 descriptor-reg a3-offset) - (:temp a4 descriptor-reg a4-offset) - (:temp a5 descriptor-reg a5-offset)) - - - ;; Calculate NARGS (as a fixnum) - (inst sub nargs csp-tn args) - - ;; Load the argument regs (must do this now, 'cause the blt might - ;; trash these locations) - (inst ld a0 args (* 0 vm:word-bytes)) - (inst ld a1 args (* 1 vm:word-bytes)) - (inst ld a2 args (* 2 vm:word-bytes)) - (inst ld a3 args (* 3 vm:word-bytes)) - (inst ld a4 args (* 4 vm:word-bytes)) - (inst ld a5 args (* 5 vm:word-bytes)) - - ;; Calc SRC, DST, and COUNT - (inst addcc count nargs (fixnumize (- register-arg-count))) - (inst b :le done) - (inst add src args (* vm:word-bytes register-arg-count)) - (inst add dst cfp-tn (* vm:word-bytes register-arg-count)) - - LOOP - ;; Copy one arg. - (inst ld temp src) - (inst add src src vm:word-bytes) - (inst st temp dst) - (inst addcc count (fixnumize -1)) - (inst b :gt loop) - (inst add dst dst vm:word-bytes) - - DONE - ;; We are done. Do the jump. - (loadw temp lexenv vm:closure-function-slot vm:function-pointer-type) - (lisp-jump temp)) - - - -;;;; Non-local exit noise. - -(define-assembly-routine (unwind - (:return-style :none) - (:translate %continue-unwind) - (:policy :fast-safe)) - ((:arg block (any-reg descriptor-reg) a0-offset) - (:arg start (any-reg descriptor-reg) ocfp-offset) - (:arg count (any-reg descriptor-reg) nargs-offset) - (:temp lra descriptor-reg lra-offset) - (:temp cur-uwp any-reg nl0-offset) - (:temp next-uwp any-reg nl1-offset) - (:temp target-uwp any-reg nl2-offset)) - (declare (ignore start count)) - - (let ((error (generate-error-code nil invalid-unwind-error))) - (inst cmp block) - (inst b :eq error)) - - (load-symbol-value cur-uwp lisp::*current-unwind-protect-block*) - (loadw target-uwp block vm:unwind-block-current-uwp-slot) - (inst cmp cur-uwp target-uwp) - (inst b :ne do-uwp) - (inst nop) - - (move cur-uwp block) - - DO-EXIT - - (loadw cfp-tn cur-uwp vm:unwind-block-current-cont-slot) - (loadw code-tn cur-uwp vm:unwind-block-current-code-slot) - (loadw lra cur-uwp vm:unwind-block-entry-pc-slot) - (lisp-return lra :frob-code nil) - - DO-UWP - - (loadw next-uwp cur-uwp vm:unwind-block-current-uwp-slot) - (inst b do-exit) - (store-symbol-value next-uwp lisp::*current-unwind-protect-block*)) - - -(define-assembly-routine (throw - (:return-style :none)) - ((:arg target descriptor-reg a0-offset) - (:arg start any-reg ocfp-offset) - (:arg count any-reg nargs-offset) - (:temp catch any-reg a1-offset) - (:temp tag descriptor-reg a2-offset) - (:temp temp non-descriptor-reg nl0-offset)) - - (declare (ignore start count)) - - (load-symbol-value catch lisp::*current-catch-block*) - - loop - - (let ((error (generate-error-code nil unseen-throw-tag-error target))) - (inst cmp catch) - (inst b :eq error) - (inst nop)) - - (loadw tag catch vm:catch-block-tag-slot) - (inst cmp tag target) - (inst b :eq exit) - (inst nop) - (loadw catch catch vm:catch-block-previous-catch-slot) - (inst b loop) - (inst nop) - - exit - - (move target catch) - (inst li temp (make-fixup 'unwind :assembly-routine)) - (inst j temp) - (inst nop)) - - - - -;; Assembly routines for undefined_tramp and closure_tramp - -#+assembler -(define-assembly-routine (closure-tramp-function-alignment - (:return-style :none)) - () - ;; Align to a dualword and put in the magic function header stuff so - ;; that closure-tramp looks like a normal function with a function - ;; tag. - (align vm:lowtag-bits) - (inst byte 0)) - -#+assembler -(define-assembly-routine (closure-tramp - (:return-style :none)) - () - (inst byte 0) - (inst byte 0) - (inst byte vm:function-header-type) - ;; This is supposed to be closure-tramp, not 0. - (inst word 0) - (inst word (kernel:get-lisp-obj-address nil)) - (inst word (kernel:get-lisp-obj-address nil)) - (inst word (kernel:get-lisp-obj-address nil)) - (inst word (kernel:get-lisp-obj-address nil)) - - (loadw lexenv-tn cname-tn fdefn-function-slot other-pointer-type) - (loadw code-tn lexenv-tn closure-function-slot function-pointer-type) - (inst j code-tn (- (* function-code-offset word-bytes) function-pointer-type)) - (inst nop) - ;; Make sure following routine is dual-word aligned - (align vm:lowtag-bits)) - -#+assembler -(define-assembly-routine (undefined-tramp-function-alignment - (:return-style :none)) - () - ;; Align to a dualword and put in the magic function header stuff so - ;; that closure-tramp looks like a normal function with a function - ;; tag. - (align vm:lowtag-bits) - (inst byte 0)) - -#+assembler -(define-assembly-routine (undefined-tramp - (:return-style :none)) - () - (inst byte 0) - (inst byte 0) - (inst byte vm:function-header-type) - ;; This is supposed to be undefined-tramp, not 0. - (inst word 0) - (inst word (kernel:get-lisp-obj-address nil)) - (inst word (kernel:get-lisp-obj-address nil)) - (inst word (kernel:get-lisp-obj-address nil)) - (inst word (kernel:get-lisp-obj-address nil)) - - (let ((error (generate-cerror-code nil undefined-symbol-error cname-tn))) - (inst b error) - (inst nop) - ;; I don't think we ever return from the undefined-symbol-error - ;; handler, but the assembly code did this so we'll do it too. - (loadw code-tn cname-tn fdefn-raw-addr-slot other-pointer-type) - (inst j code-tn (- (* function-code-offset word-bytes) function-pointer-type)) - (inst nop))) ===================================== src/assembly/sparcv9/support.lisp deleted ===================================== --- a/src/assembly/sparcv9/support.lisp +++ /dev/null @@ -1,78 +0,0 @@ -;;; -*- Package: SPARC -*- -;;; -;;; ********************************************************************** -;;; This code was written as part of the CMU Common Lisp project at -;;; Carnegie Mellon University, and has been placed in the public domain. -;;; -(ext:file-comment - "$Header: src/assembly/sparc/support.lisp $") -;;; -;;; ********************************************************************** -;;; -(in-package "SPARC") - -(def-vm-support-routine generate-call-sequence (name style vop) - (ecase style - (:raw - (let ((temp (make-symbol "TEMP")) - (lip (make-symbol "LIP"))) - (values - `((inst jali ,lip ,temp (make-fixup ',name :assembly-routine)) - (inst nop)) - `((:temporary (:scs (non-descriptor-reg) :from (:eval 0) :to (:eval 1)) - ,temp) - (:temporary (:scs (interior-reg) :from (:eval 0) :to (:eval 1)) - ,lip))))) - (:full-call - (let ((temp (make-symbol "TEMP")) - (nfp-save (make-symbol "NFP-SAVE")) - (lra (make-symbol "LRA"))) - (values - `((let ((lra-label (gen-label)) - (cur-nfp (current-nfp-tn ,vop))) - (when cur-nfp - (store-stack-tn ,nfp-save cur-nfp)) - (inst compute-lra-from-code ,lra code-tn lra-label ,temp) - (note-next-instruction ,vop :call-site) - (inst ji ,temp (make-fixup ',name :assembly-routine)) - (inst nop) - (emit-return-pc lra-label) - (note-this-location ,vop :single-value-return) - (without-scheduling () - (move csp-tn ocfp-tn) - (inst nop)) - (inst compute-code-from-lra code-tn code-tn - lra-label ,temp) - (when cur-nfp - (load-stack-tn cur-nfp ,nfp-save)))) - `((:temporary (:scs (non-descriptor-reg) :from (:eval 0) :to (:eval 1)) - ,temp) - (:temporary (:sc descriptor-reg :offset lra-offset - :from (:eval 0) :to (:eval 1)) - ,lra) - (:temporary (:scs (control-stack) :offset nfp-save-offset) - ,nfp-save) - (:save-p :compute-only))))) - (:none - (let ((temp (make-symbol "TEMP"))) - (values - `((inst ji ,temp (make-fixup ',name :assembly-routine)) - (inst nop)) - `((:temporary (:scs (non-descriptor-reg) :from (:eval 0) :to (:eval 1)) - ,temp))))))) - -(def-vm-support-routine generate-return-sequence (style) - (ecase style - (:raw - `((inst j - (make-random-tn :kind :normal - :sc (sc-or-lose 'interior-reg *backend*) - :offset lip-offset) - 8) - (inst nop))) - (:full-call - `((lisp-return (make-random-tn :kind :normal - :sc (sc-or-lose 'descriptor-reg *backend*) - :offset lra-offset) - :offset 2))) - (:none))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/7f62ee97f9d815eeb37c5bfd…

1 0

[Git][cmucl/cmucl][master] 3 commits: Rename sparcv9 to sparc64.
by Raymond Toy 11 Dec '16

11 Dec '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 2aed10fc by Raymond Toy at 2016-12-11T09:51:34-08:00 Rename sparcv9 to sparc64. I keep typing sparc64, so let's make it sparc64 instead of sparcv9. No other changes. - - - - - 0c7901b6 by Raymond Toy at 2016-12-11T09:54:54-08:00 Update paths to sparc64 from sparcv9. - - - - - 7f62ee97 by Raymond Toy at 2016-12-11T17:58:54+00:00 Merge branch 'rtoy-rename-to-sparc64' into 'master' Rename sparcv9 to sparc64 * Rename directories from sparcv9 to sparc64. * Rename sparcv9-assem.S to sparc64-assem.S. * Rename Config.sparcv9_sunc to Config.sparc64_sunc. * Update files to refer to sparc64 instead of sparcv9. See merge request !20 - - - - - 30 changed files: - + src/assembly/sparc64/alloc.lisp - + src/assembly/sparc64/arith.lisp - + src/assembly/sparc64/array.lisp - + src/assembly/sparc64/assem-rtns.lisp - + src/assembly/sparc64/support.lisp - src/compiler/sparcv9/alloc.lisp → src/compiler/sparc64/alloc.lisp - src/compiler/sparcv9/arith.lisp → src/compiler/sparc64/arith.lisp - src/compiler/sparcv9/array.lisp → src/compiler/sparc64/array.lisp - src/compiler/sparcv9/c-call.lisp → src/compiler/sparc64/c-call.lisp - src/compiler/sparcv9/c-callback.lisp → src/compiler/sparc64/c-callback.lisp - src/compiler/sparcv9/call.lisp → src/compiler/sparc64/call.lisp - src/compiler/sparcv9/cell.lisp → src/compiler/sparc64/cell.lisp - src/compiler/sparcv9/char.lisp → src/compiler/sparc64/char.lisp - src/compiler/sparcv9/debug.lisp → src/compiler/sparc64/debug.lisp - src/compiler/sparcv9/float.lisp → src/compiler/sparc64/float.lisp - src/compiler/sparcv9/insts.lisp → src/compiler/sparc64/insts.lisp - src/compiler/sparcv9/macros.lisp → src/compiler/sparc64/macros.lisp - src/compiler/sparcv9/memory.lisp → src/compiler/sparc64/memory.lisp - src/compiler/sparcv9/move.lisp → src/compiler/sparc64/move.lisp - src/compiler/sparcv9/nlx.lisp → src/compiler/sparc64/nlx.lisp - src/compiler/sparcv9/parms.lisp → src/compiler/sparc64/parms.lisp - src/compiler/sparcv9/pred.lisp → src/compiler/sparc64/pred.lisp - src/compiler/sparcv9/print.lisp → src/compiler/sparc64/print.lisp - src/compiler/sparcv9/sap.lisp → src/compiler/sparc64/sap.lisp - src/compiler/sparcv9/static-fn.lisp → src/compiler/sparc64/static-fn.lisp - src/compiler/sparcv9/subprim.lisp → src/compiler/sparc64/subprim.lisp - src/compiler/sparcv9/system.lisp → src/compiler/sparc64/system.lisp - src/compiler/sparcv9/type-vops.lisp → src/compiler/sparc64/type-vops.lisp - src/compiler/sparcv9/values.lisp → src/compiler/sparc64/values.lisp - src/compiler/sparcv9/vm.lisp → src/compiler/sparc64/vm.lisp The diff was not included because it is too large. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/dc74345792038ce473026fcd…

1 0

[Git][cmucl/cmucl] Pushed new branch rtoy-rename-to-sparc64
by Raymond Toy 11 Dec '16

11 Dec '16

Raymond Toy pushed new branch rtoy-rename-to-sparc64 at cmucl / cmucl

1 0

[Git][cmucl/cmucl][master] Fix typo
by Raymond Toy 08 Dec '16

08 Dec '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: dc743457 by Raymond Toy at 2016-12-07T21:30:55-08:00 Fix typo "Cound" -> "Could" - - - - - 1 changed file: - src/code/run-program.lisp Changes: ===================================== src/code/run-program.lisp ===================================== --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -767,7 +767,7 @@ (multiple-value-bind (read-fd write-fd) (unix:unix-pipe) (unless read-fd - (error (intl:gettext "Cound not create pipe: ~A") + (error (intl:gettext "Could not create pipe: ~A") (unix:get-unix-error-msg write-fd))) (copy-descriptor-to-stream read-fd object cookie) (push read-fd *close-on-error*) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/dc74345792038ce473026fcd5…

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #34: Handle newline character correctly
by Raymond Toy 08 Dec '16

08 Dec '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: d959c164 by Raymond Toy at 2016-12-07T21:19:19-08:00 Fix #34: Handle newline character correctly The string containing #\Newline that is used to output the newline character worked on little-endian architectures because the low octet was first in memory. However on a big-endian sparc, a NUL character was output instead since the high octet is first in memory. So, create a explicit unsigned-byte 8 array containing exactly 1 octet that represents a newline character code. Tests pass on both sparc and x86/linux. - - - - - 3b4745d3 by Raymond Toy at 2016-12-08T05:20:53+00:00 Merge branch 'rtoy-fix-issue-34' into 'master' Fix #34: Handle newline character correctly The string containing #\Newline that is used to output the newline character worked on little-endian architectures because the low octet was first in memory. However on a big-endian sparc, a NUL character was output instead since the high octet is first in memory. So, create a explicit unsigned-byte 8 array containing exactly 1 octet that represents a newline character code. Tests pass on both sparc and x86/linux. See merge request !19 - - - - - 1 changed file: - src/code/run-program.lisp Changes: ===================================== src/code/run-program.lisp ===================================== --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -742,7 +742,8 @@ #o666))) (unix:unix-unlink name) (when fd - (let ((newline (string #\Newline))) + (let ((newline (make-array 1 :element-type '(unsigned-byte 8) + :initial-element (char-code #\Newline)))) (loop (multiple-value-bind (line no-cr) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/f10c6b6fbb035c89f37610fa…

1 0