-- GHC 構築メモ --

* ghc6_6.4.orig.tar.gz を展開、ghc6_6.4-4.diff.gz を当てる。
  この souce tree が
    http://haskell.org/ghc/docs/latest/html/building/sec-porting-ghc.html#unregisterised-porting
  の 10.2.1 の説明の H (host の tree)

* これと同じ tree を複製して target にもおく。 これが上記説明 の T
  (target の tree)

* T に 下につけた ghc6-6.4-sh.diff を当てる。
  (必要なのは configure.ac, configure に対する部分のみのはず。
   他の patch は 10.2.2-4 のために書いたものの全くテキトー)

* 上記 10.2.1 の説明に従って作業。

  (注1) H/mk/config.mk の修正は以下の通り。LeadingUnderscore は
        そのままで ok。

* registered な ghc は perl を書かなくちゃいけないのだが途中で面倒に
  なってしまって挫折。

--- TMP/ghc6-6.4/mk/config.mk	2005-07-29 16:16:05.000000000 +0900
+++ H/ghc6-6.4/mk/config.mk	2005-07-27 09:54:26.000000000 +0900
@@ -82,7 +82,7 @@
 # section on "Porting GHC" in the Building Guide.
 
 HOSTPLATFORM			= i386-unknown-linux
-TARGETPLATFORM			= i386-unknown-linux
+TARGETPLATFORM			= sh4-unknown-linux
 BUILDPLATFORM			= i386-unknown-linux
 
 # Hack alert:
@@ -96,8 +96,8 @@ HostOS_CPP			= linux
 HostOS_Full			= linux-gnu
 HostVendor_CPP	                = unknown
 
-TargetPlatform_CPP		= i386_unknown_linux
-TargetArch_CPP			= i386
+TargetPlatform_CPP		= sh4_unknown_linux
+TargetArch_CPP			= sh4
 TargetOS_CPP			= linux
 TargetVendor_CPP                = unknown
 
--
  (注2) 説明に make boot && make とあるところは make boot が終ってから
        make としないと、マズいのかも。compiler がうまくできた時は分けて
        実行。

  (注3) Host でやる最後の作業のところに copy H/*-hc.tar.gz  to T/...
        とあるが、実際 make hc-file-bundle Project=Ghc でできるのは
        H/ghc-6.4-sh4-unknown-linux-hc.tar.gz でこれを T に持ちこんで
        展開すると ghc-6.4/ という directory の下に host で作った C
        のファイルなどが出来る。 どうもそれだけではあちこちうまくいか
	なかったので target で

	cd T
	(cd ghc-6.4; tar -cf - *)| tar -xvf -
	rm -rf ghc-6.4
	ln -s . ghc-6.4

	として host と同じ file の配置にしたところ target での作業

	./distrib/hc-build --enable-hc-boot-unregisterised

	が最後まで error なしに終了した。

  (注4) /usr/lib/libgmp.a のない target で試みたところ自前で持って
	いる gmp library をつくろうとするのだがそこに入っている
	config.sub が変で sh4- ではじまる triplet が理解できずに
	おこられた。 予め libgmp を full に install した方が良さそう
	だが

--- TMP/ghc6-6.4/ghc/rts/gmp/config.sub 2000-08-22 00:12:04.000000000 +0900
+++ ghc6-6.4/ghc/rts/gmp/config.sub        2005-07-28 11:20:15.000000000 +0900
@@ -214,7 +214,7 @@ case $basic_machine in
              | alphaev6[78]-* \
              | we32k-* | cydra-* | ns16k-* | pn-* | np1-* | xps100-* \
              | clipper-* | orion-* \
-             | sparclite-* | pdp11-* | sh-* | powerpc-* | powerpcle-* \
+             | sparclite-* | pdp11-* | sh*-* | powerpc-* | powerpcle-* \
              | sparc64-* | sparcv9-* | sparc86x-* | mips16-* | mips64-* | mipsel-* \
              | mips64el-* | mips64orion-* | mips64orionel-* \
              | mips64vr4100-* | mips64vr4100el-* | mips64vr4300-* | mips64vr4300el-* \

	
	で逃げられるかも。

	(注5) ./distrib/hc-build --enable-hc-boot-unregisterised には
	非常に時間がかかる。 ghc/compiler/ghc-inplace ができた後これで
	Haskel source の compile をしているらしいのだがやたらにメモリ
	を食うようだ。 Haskel の compile 時メモリ使用の reportがでて
	いたがそれが 100MB を超えていたりして 1 file の compile に 30分
	程かかっているものがあった。

-- ghc6-6.4-sh.diff

diff -upr TMP/ghc6-6.4/configure ghc6-6.4/configure
--- TMP/ghc6-6.4/configure	2005-03-11 04:44:38.000000000 +0900
+++ ghc6-6.4/configure	2005-07-28 05:52:25.000000000 +0900
@@ -1814,6 +1814,17 @@ s390-ibm-linux*)
         HostVendor_CPP='ibm'
         HostOS_CPP='linux'
         ;;
+
+sh4-unknown-linux*)
+	HostPlatform=sh4-unknown-linux
+	TargetPlatform=sh4-unknown-linux
+	BuildPlatform=sh4-unknown-linux
+	HostPlatform_CPP='sh4_unknown_linux'
+	HostArch_CPP='sh4'
+        HostVendor_CPP='unknown'
+	HostOS_CPP='linux'
+	;;
+
 sparc-sun-sunos4*)
 	HostPlatform=sparc-sun-sunos4
 	TargetPlatform=sparc-sun-sunos4 #hack
diff -upr TMP/ghc6-6.4/configure.ac ghc6-6.4/configure.ac
--- TMP/ghc6-6.4/configure.ac	2005-03-08 18:31:32.000000000 +0900
+++ ghc6-6.4/configure.ac	2005-07-28 05:52:17.000000000 +0900
@@ -425,6 +425,17 @@ s390-ibm-linux*)
         HostVendor_CPP='ibm'
         HostOS_CPP='linux'
         ;;
+
+sh4-unknown-linux*)
+	HostPlatform=sh4-unknown-linux
+	TargetPlatform=sh4-unknown-linux
+	BuildPlatform=sh4-unknown-linux
+	HostPlatform_CPP='sh4_unknown_linux'
+	HostArch_CPP='sh4'
+        HostVendor_CPP='unknown'
+	HostOS_CPP='linux'
+	;;
+
 sparc-sun-sunos4*)
 	HostPlatform=sparc-sun-sunos4
 	TargetPlatform=sparc-sun-sunos4 #hack
diff -upr TMP/ghc6-6.4/ghc/driver/mangler/ghc-asm.lprl ghc6-6.4/ghc/driver/mangler/ghc-asm.lprl
--- TMP/ghc6-6.4/ghc/driver/mangler/ghc-asm.lprl	2005-03-08 22:33:36.000000000 +0900
+++ ghc6-6.4/ghc/driver/mangler/ghc-asm.lprl	2005-07-29 14:49:45.000000000 +0900
@@ -432,6 +432,30 @@ sub init_TARGET_STUFF {
     $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;
@@ -903,6 +927,11 @@ sub mangle_asm {
 		    # I have no idea why, and I don't think it is necessary, so let's toss it.
 		    $p =~ s/^\tli \d+,0\n//g;
 		    $p =~ s/^\tstd \d+,\d+\(1\)\n//g;
+		} 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";
 		}
@@ -985,6 +1014,12 @@ sub mangle_asm {
 
 		    # incase we missed it with the last one get the blr alone
 		    $e =~ s/^\tblr\n//;
+		} 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 -upr TMP/ghc6-6.4/ghc/driver/split/ghc-split.lprl ghc6-6.4/ghc/driver/split/ghc-split.lprl
--- TMP/ghc6-6.4/ghc/driver/split/ghc-split.lprl	2005-02-18 07:12:58.000000000 +0900
+++ ghc6-6.4/ghc/driver/split/ghc-split.lprl	2005-07-29 15:02:59.000000000 +0900
@@ -216,6 +216,7 @@ sub process_asm_block {
                             if $TargetPlatform =~ /^powerpc-apple-darwin/;
     return(&process_asm_block_powerpc_linux($str))
                             if $TargetPlatform =~ /^powerpc-[^-]+-linux/;
+    return(&process_asm_block_sh4($str))   if $TargetPlatform =~ /^sh4s-/;
 
     # otherwise...
     &tidy_up_and_die(1,"$Pgm: no process_asm_block for $TargetPlatform\n");
@@ -557,6 +558,37 @@ sub process_asm_block_powerpc_linux {
 \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 -upr TMP/ghc6-6.4/ghc/includes/MachRegs.h ghc6-6.4/ghc/includes/MachRegs.h
--- TMP/ghc6-6.4/ghc/includes/MachRegs.h	2005-07-29 06:46:55.000000000 +0900
+++ ghc6-6.4/ghc/includes/MachRegs.h	2005-07-28 05:51:32.000000000 +0900
@@ -44,6 +44,7 @@
 #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
@@ -55,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
 
 /* ----------------------------------------------------------------------------
@@ -632,6 +634,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 -upr TMP/ghc6-6.4/ghc/includes/TailCalls.h ghc6-6.4/ghc/includes/TailCalls.h
--- TMP/ghc6-6.4/ghc/includes/TailCalls.h	2005-03-08 18:38:57.000000000 +0900
+++ ghc6-6.4/ghc/includes/TailCalls.h	2005-07-29 06:44:59.000000000 +0900
@@ -245,6 +245,22 @@ but uses $$dyncall if necessary to cope,
 #endif
 
 /* -----------------------------------------------------------------------------
+   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 -upr TMP/ghc6-6.4/ghc/rts/Adjustor.c ghc6-6.4/ghc/rts/Adjustor.c
--- TMP/ghc6-6.4/ghc/rts/Adjustor.c	2005-07-29 06:46:55.000000000 +0900
+++ ghc6-6.4/ghc/rts/Adjustor.c	2005-07-29 08:13:25.000000000 +0900
@@ -818,6 +818,47 @@ TODO: Depending on how much allocation o
 	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
@@ -889,6 +930,14 @@ freeHaskellFunctionPtr(void* ptr)
  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 -upr TMP/ghc6-6.4/ghc/rts/StgCRun.c ghc6-6.4/ghc/rts/StgCRun.c
--- TMP/ghc6-6.4/ghc/rts/StgCRun.c	2005-01-28 21:56:19.000000000 +0900
+++ ghc6-6.4/ghc/rts/StgCRun.c	2005-07-29 10:58:45.000000000 +0900
@@ -839,4 +839,69 @@ static void StgRunIsImplementedInAssembl
 
 #endif
 
+/* ----------------------------------------------------------------------------
+   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 */