diff -urN ./driver/mangler/ghc-asm.lprl ../sh4/ghc6-6.10.4/driver/mangler/ghc-asm.lprl --- a/driver/mangler/ghc-asm.lprl 2009-07-15 02:10:52.000000000 +0900 +++ b/driver/mangler/ghc-asm.lprl 2009-11-02 15:15:34.000000000 +0900 @@ -495,6 +495,30 @@ $T_HDR_vector = "\.text\n\t\.align 4\n"; #--------------------------------------------------------# + } elsif ( $TargetPlatform =~ /^sh4-.*-linux/ ) { + # SH Linux + $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) + $T_US = ''; # _ if symbols have an underscore on the front + $T_PRE_APP = '^#'; # regexp that says what comes before APP/NO_APP + $T_CONST_LBL = '^\.LC\d+:'; # regexp for what such a lbl looks like + $T_POST_LBL = ':'; + + $T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s+\d+(,\s*0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.size\s+\S+\s*,\s*\d+|\.ident.*|\.local.*)\n)'; + $T_COPY_DIRVS = '^\s*\.(globl|type|size|local)'; + + $T_DOT_WORD = '\.(long|short|byte|fill|space)'; + $T_DOT_GLOBAL = '\.globl'; + $T_HDR_toc = "\.toc\n"; + $T_HDR_literal = "\t\.section\t.rodata\n\t\.align 2\n"; + $T_HDR_misc = "\t\.text\n\t\.align 2\n"; + $T_HDR_data = "\t\.data\n\t\.align 2\n"; + $T_HDR_rodata = "\t\.section\t.rodata\n\t\.align 2\n"; + $T_HDR_closure = "\t\.data\n\t\.align 2\n"; + $T_HDR_info = "\t\.text\n\t\.align 2\n"; + $T_HDR_entry = "\t\.text\n\t\.align 2\n"; + $T_HDR_vector = "\t\.text\n\t\.align 2\n"; + + #--------------------------------------------------------# } else { print STDERR "$Pgm: don't know how to mangle assembly language for: $TargetPlatform\n"; exit 1; @@ -1050,6 +1074,11 @@ # I have no idea why, and I don't think it is necessary, so let's toss it. $p =~ s/^\tli \d+,0\n//gm; $p =~ s/^\tstd \d+,\d+\(1\)\n//gm; + } elsif ($TargetPlatform =~ /^sh4-/) { + $p =~ s/^\tsts.l\s+pr,\s*\@-r15\n//g; + $p =~ s/^\tmov.l\s+r(8|9|10|11|12|13|14),\s*\@-r15\n//g; + $p =~ s/^\tfmov.s\s+r(12|13|14|15),\s*\@-r15\n//g; + $p =~ s/^\tadd\s+\#-\d+,\s*r15\n//; } else { print STDERR "$Pgm: unknown prologue mangling? $TargetPlatform\n"; } @@ -1171,6 +1200,12 @@ # incase we missed it with the last one get the blr alone $e =~ s/^\tblr\n//m; + } elsif ($TargetPlatform =~ /^sh4-/) { + $e =~ s/^\trts\s*\n//; + $e =~ s/^\tlds.l\s+\@r15\+,\s*pr\n//g; + $e =~ s/^\tmov.l\s+\@r15\+,\s*r(8|9|10|11|12|13|14)\n//g; + $e =~ s/^\tfmov.s\s+\@r15\+,\s*fr(12|13|14|15)\n//g; + $e =~ s/^\tadd\s+\#\d+,\s*r15\n//; } else { print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n"; } diff -urN ./driver/split/ghc-split.lprl ../sh4/ghc6-6.10.4/driver/split/ghc-split.lprl --- a/driver/split/ghc-split.lprl 2009-07-15 02:10:52.000000000 +0900 +++ b/driver/split/ghc-split.lprl 2009-11-02 15:18:17.000000000 +0900 @@ -232,6 +232,7 @@ return(&process_asm_block_mips($str)) if $TargetPlatform =~ /^mips-/m; return(&process_asm_block_powerpc_linux($str)) if $TargetPlatform =~ /^powerpc-[^-]+-linux/m; + return(&process_asm_block_sh4($str)) if $TargetPlatform =~ /^sh4s-/; # otherwise... &tidy_up_and_die(1,"$Pgm: no process_asm_block for $TargetPlatform\n"); @@ -613,6 +614,37 @@ \end{code} \begin{code} +sub process_asm_block_sh4 { + local($str) = @_; + + # strip the marker + $str =~ s/__stg_split_marker.*\n//; + + # remove/record any literal constants defined here + while ( $str =~ s/^(\s+.section\s+\.rodata\n\s+\.align.*\n(\.LC\d+):\n(\s\.(byte|short|long|quad|2byte|4byte|8byte|fill|space|ascii|string).*\n)+)// ) { + local($label) = $2; + local($body) = $1; + + &tidy_up_and_die(1,"Local constant label $label already defined!\n") + if $LocalConstant{$label}; + + $LocalConstant{$label} = $body; + } + + # inject definitions for any local constants now used herein + foreach $k (keys %LocalConstant) { + if ( $str =~ /[\s,]$k\b/ ) { + $str = $LocalConstant{$k} . $str; + } + } + + print STDERR "### STRIPPED BLOCK (SH):\n$str" if $Dump_asm_splitting_info; + + $str; +} +\end{code} + +\begin{code} sub tidy_up_and_die { local($return_val, $msg) = @_; print STDERR $msg; diff -urN ./includes/MachRegs.h ../sh4/ghc6-6.10.4/includes/MachRegs.h --- a/includes/stg/MachRegs.h 2009-07-15 02:10:52.000000000 +0900 +++ b/includes/stg/MachRegs.h 2009-11-02 15:22:37.000000000 +0900 @@ -43,6 +43,8 @@ #define ia64_REGS ia64_TARGET_ARCH #define sparc_REGS sparc_TARGET_ARCH #define darwin_REGS darwin_TARGET_OS +#define sh4_REGS sh4_TARGET_ARCH + #else #define alpha_REGS alpha_HOST_ARCH #define hppa1_1_REGS hppa1_1_HOST_ARCH @@ -54,6 +56,7 @@ #define ia64_REGS ia64_HOST_ARCH #define sparc_REGS sparc_HOST_ARCH #define darwin_REGS darwin_HOST_OS +#define sh4_REGS sh4_HOST_ARCH #endif /* ---------------------------------------------------------------------------- @@ -649,6 +652,52 @@ #endif /* sparc */ +/* ----------------------------------------------------------------------------- + SuperH register mapping + + SH-4 registers + \tr{r8}--\tr{r13} are our ``prize'' callee-save registers. + \tr{r14} is the frame pointer, and \tr{r4}--\tr{r7} are argument registers. + \tr{f12}--\tr{f15} are some callee-save floating-point registers. + + -------------------------------------------------------------------------- */ + +#if sh4_REGS +# define REG(x) __asm__(#x) + +#define CALLER_SAVES_R1 +#define CALLER_SAVES_R2 +#define CALLER_SAVES_R3 +#define CALLER_SAVES_R4 +#define CALLER_SAVES_R5 +#define CALLER_SAVES_R6 +#define CALLER_SAVES_R7 + +#define CALLER_SAVES_USER + +#define REG_R1 r1 +#define REG_R2 r2 +#define REG_R3 r3 +#define REG_R4 r4 +#define REG_R5 r5 +#define REG_R6 r6 +#define REG_R7 r7 + +#define REG_F1 fr12 +#define REG_F2 fr13 +#define REG_F3 fr14 +#define REG_F4 fr15 + +#define REG_D1 fr2 +#define REG_D2 fr4 + +#define REG_Sp r8 +#define REG_SpLim r9 + +#define REG_Hp r10 +#define REG_HpLim r11 + +#endif /* sh4_REGS */ #endif /* NO_REGS */ /* ----------------------------------------------------------------------------- diff -urN ./includes/TailCalls.h ../sh4/ghc6-6.10.4/includes/TailCalls.h --- a/includes/stg/TailCalls.h 2009-07-15 02:10:52.000000000 +0900 +++ b/includes/stg/TailCalls.h 2009-11-02 15:23:27.000000000 +0900 @@ -274,6 +274,22 @@ #endif /* mips_HOST_ARCH */ /* ----------------------------------------------------------------------------- + Tail calling on SH + -------------------------------------------------------------------------- */ + +#if sh4_HOST_ARCH + +#define JMP_(cont) \ + { \ + void *__target; \ + __DISCARD__(); \ + __target = (void *)(cont); \ + goto *__target; \ + } + +#endif /* sh4_HOST_ARCH */ + +/* ----------------------------------------------------------------------------- FUNBEGIN and FUNEND. These are markers indicating the start and end of Real Code in a diff -urN ./rts/Adjustor.c ../sh4/ghc6-6.10.4/rts/Adjustor.c --- a/rts/Adjustor.c 2009-07-15 02:10:52.000000000 +0900 +++ b/rts/Adjustor.c 2009-11-02 15:25:50.000000000 +0900 @@ -1082,6 +1082,49 @@ code[16] = (StgWord64)hptr; code[17] = (StgWord64)stable; } + +#elif defined(sh4_HOST_ARCH) + /* Adjuster code for SH looks like: + + <00>: 2f76 mov.l r7, @-r15 + <02>: 2f66 mov.l r6, @-r15 + <04>: 6643 mov r4, r6 + <06>: 6753 mov r5, r7 + <08>: d401 mov.l 0f, r4 # load up hptr + <0a>: d502 mov.l 1f, r5 + <0c>: 452b jmp @r5 # jump to wptr + <0e>: 0009 nop + <10>: 0: ... # 4 bytes for hptr + <14>: 1: ... # 4 bytes for wptr + + We only support passing 4 or fewer argument words, for the same + reason described under sparc_HOST_ARCH above by JRS, 21 Aug 01. + On the SuperH the first 4 integer arguments are in r4 through r7, + and the rest on the stack. Hence we want to shuffle the original + caller's arguments by two. + */ + ASSERT(((unsigned long)wptr & 2) == 0); + adjustor = mallocBytesRWX(18); + { + unsigned short *const code = (unsigned short *)adjustor; + extern __ic_invalidate(); + + code[0] = 0x2f76; + code[1] = 0x2f66; + code[2] = 0x6643; + code[3] = 0x6753; + code[4] = 0xd401; + code[5] = 0xd502; + code[6] = 0x452b; + code[7] = 0x0009; + + *(unsigned long *)(code + 8) = (unsigned long)hptr; + *(unsigned int *)(code + 10) = (unsigned long)wptr; + + /* Ensure that instruction cache is consistent with our new code */ + __ic_invalidate(code); + } + #else barf("adjustor creation not supported on this platform"); #endif @@ -1168,6 +1211,14 @@ freeStablePtr((StgStablePtr)code[16]); freeStablePtr((StgStablePtr)code[17]); return; +#elif defined(sh4_HOST_ARCH) + if ( *(unsigned short*)ptr != 0x2f76 ) { + errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr); + return; + } + + /* Free the stable pointer first..*/ + freeStablePtr(*((StgStablePtr*)((unsigned long*)ptr + 4))); #else ASSERT(0); #endif diff -urN ./rts/StgCRun.c ../sh4/ghc6-6.10.4/rts/StgCRun.c --- a/rts/StgCRun.c 2009-07-15 02:10:52.000000000 +0900 +++ b/rts/StgCRun.c 2009-11-02 15:28:59.000000000 +0900 @@ -963,4 +963,69 @@ #endif /* mips_HOST_ARCH */ +/* ---------------------------------------------------------------------------- + SH-4 architecture + ------------------------------------------------------------------------- */ + +#ifdef sh4_HOST_ARCH + +extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg); + +static void StgRunIsImplementedInAssembler(void) +{ + __asm__ volatile ( + /* + * save callee-saves registers on behalf of the STG code. + */ + ".globl StgRun\n" + "StgRun:\n\t" + "mov.l 0f,r0\n\t" + "sub r0,r15\n\t" + "mov.l r8,@-r15\n\t" + "mov.l r9,@-r15\n\t" + "mov.l r10,@-r15\n\t" + "mov.l r11,@-r15\n\t" + "mov.l r12,@-r15\n\t" + "mov.l r13,@-r15\n\t" + "mov.l r14,@-r15\n\t" + "fmov.s fr12,@-r15\n\t" + "fmov.s fr13,@-r15\n\t" + "fmov.s fr14,@-r15\n\t" + "fmov.s fr15,@-r15\n\t" + "sts.l pr,@-r15\n\t" + + "jmp @r4\n\t" + " nop\n\t" + + ".global " STG_RETURN "\n" + STG_RETURN ":\n\t" + + "mov r1,r0\n\t" /* Return value in R1 */ + + /* + * restore callee-saves registers. (Don't stomp on r0!) + */ + "mov.l 0f,r1\n\t" + "lds.l @r15+,pr\n\t" + "fmov.s @r15+,fr15\n\t" + "fmov.s @r15+,fr14\n\t" + "fmov.s @r15+,fr13\n\t" + "fmov.s @r15+,fr12\n\t" + "mov.l @r15+,r14\n\t" + "mov.l @r15+,r13\n\t" + "mov.l @r15+,r12\n\t" + "mov.l @r15+,r11\n\t" + "mov.l @r15+,r10\n\t" + "mov.l @r15+,r9\n\t" + "mov.l @r15+,r8\n\t" + "rts\n\t" + " add r1,r15\n\t" + ".align 2\n\t" + "0: .long %0\n\t" + + : : "i" (RESERVED_C_STACK_BYTES)); +} + +#endif /* SH-4 * + #endif /* !USE_MINIINTERPRETER */