Index: ghc/compiler/absCSyn/AbsCUtils.lhs =================================================================== RCS file: /cvs/fptools/ghc/compiler/absCSyn/AbsCUtils.lhs,v retrieving revision 1.47 diff -r1.47 AbsCUtils.lhs 19a20 > #include "../includes/config.h" Index: ghc/driver/mangler/ghc-asm.lprl =================================================================== RCS file: /cvs/fptools/ghc/driver/mangler/ghc-asm.lprl,v retrieving revision 1.70 diff -r1.70 ghc-asm.lprl 272,273c272,273 < } elsif ( $TargetPlatform =~ /^powerpc-.*|^rs6000-.*/ ) { < --- > } elsif ( $TargetPlatform =~ /^powerpc-apple-.*/ ) { > # Apple PowerPC Darwin/MacOS X. 275,277c275,277 < $T_US = ''; # _ if symbols have an underscore on the front < $T_PRE_APP = 'NOT APPLICABLE'; # regexp that says what comes before APP/NO_APP < $T_CONST_LBL = 'NOT APPLICABLE'; # regexp for what such a lbl looks like --- > $T_US = '_'; # _ if symbols have an underscore on the front > $T_PRE_APP = 'WHAT IS THIS'; # regexp that says what comes before APP/NO_APP > $T_CONST_LBL = '^\LC\d+:'; # regexp for what such a lbl looks like 280c280 < $T_MOVE_DIRVS = '^(\s*(\.toc|\.align \d+|\.csect \S+|\t\.?l?globl \S+)\n)'; --- > $T_MOVE_DIRVS = '^(\s*(\.align \d+|\.text|\.data|\.cstring|\.non_lazy_symbol_pointer|\.globl \S+)\n)'; 284c284 < $T_DOT_WORD = '\.long'; --- > $T_DOT_WORD = '\.(long|short|byte)'; 287,297c287,297 < $T_HDR_literal = "\.csect .data[RW]\n\t\.align 2\n"; #not RO!? < $T_HDR_misc = "# misc\n\.csect \.text[PR]\n\t\.align 2\n"; < $T_HDR_data = "# data\n\.csect \.data[RW]\n\t\.align 2\n"; < $T_HDR_consist = "# consist\n\.csect \.data[RW]\n\t\.align 2\n"; < $T_HDR_closure = "# closure\n\.csect \.data[RW]\n\t\.align 2\n"; < $T_HDR_srt = "# closure\n\.csect \.data[RW]\n\t\.align 2\n"; < $T_HDR_info = "# info\n\.csect \.data[RW]\n\t\.align 2\n"; #not RO!? < $T_HDR_entry = "# entry\n\.csect \.text[PR]\n\t\.align 2\n"; < $T_HDR_fast = "# fast\n\.csect \.text[PR]\n\t\.align 2\n"; < $T_HDR_vector = "# vector\n\.csect \.data[RW]\n\t\.align 2\n"; #not RO!? < $T_HDR_direct = "# direct\n"; --- > $T_HDR_literal = "\t\.data\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_consist = "\t\.text\n\t\.align 2\n"; > $T_HDR_closure = "\t\.data\n\t\.align 2\n"; > $T_HDR_srt = "\t\.text\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_fast = "\t\.text\n\t\.align 2\n"; > $T_HDR_vector = "\t\.text\n\t\.align 2\n"; > $T_HDR_direct = "\t\.text\n\t\.align 2\n"; 440,442c440 < next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^(mips|powerpc|rs6000)-/; < < last if /^_section_\.text:$/ && $TargetPlatform =~ /^powerpc-|^rs6000-/; --- > next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^(mips)-/; 546,550d543 < } elsif ( $TargetPlatform =~ /^powerpc-|^rs6000-/ && /^LC\.\.([0-9]+)/ ) { < $chk[++$i] = $_; < $chkcat[$i] = 'toc'; < $chksymb[$i] = $1; < 561,563d553 < #$symbtmp = $1; < #$chksymb[$i] = $symbtmp if ($TargetPlatform =~ /^powerpc-|^rs6000-/) ; #rm andre < 595,597c585 < || ! /^L\$\d+$/ ) < && ( $TargetPlatform !~ /^powerpc|^rs6000/ # ditto < || ! /^(L\.\.\d+|LT\.\..*):$/ ) ) { --- > || ! /^L\$\d+$/ ) ) { 611,613c599 < if ($TargetPlatform =~ /^powerpc-|^rs6000-/) < { $chksymb[$i] = $thing; } < else { $chksymb[$i] = ''; }; --- > $chksymb[$i] = ''; 622,624c608,612 < # open CHUNKS, ">/tmp/chunks1" or die "Cannot open /tmp/chunks1: $!\n"; < # for (my $i = 0; $i < @chk; ++$i) { print CHUNKS "======= $i =======\n", $chk[$i] } < # close CHUNKS; --- > open CHUNKS, ">/tmp/chunks1" or die "Cannot open /tmp/chunks1: $!\n"; > for (my $i = 0; $i < @chk; ++$i) { print CHUNKS "======= $i =======\n", $chk[$i] } > close CHUNKS; > > # ######## 647,677d634 < if ($TargetPlatform =~ /^powerpc|^rs6000/) { < print OUTASM $T_HDR_toc; # yes, we have to put a .toc < # in the beginning of every file! < %tocequiv = (); # maps toc symbol number to toc symbol < %revtocequiv = (); # maps toc symbol to toc symbol number < for ($i = 1; $i < $numchks; $i++) { < $chk[$i] =~ s/\[RW\]//g; < $chk[$i] =~ s/\[DS\]//g; < $chk[$i] =~ s/^\.csect .*\[DS\]$//g; < < if ( $chkcat[$i] eq 'toc' && $chk[$i] !~ /\.byte/ ) < #ToDo: instead of all these changes, just fix mangle_powerpc_tailjump and delete/ignore these tocs? < { $chk[$i] =~ s/$T_MOVE_DIRVS//g; < $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(\S+_fast\d+)/\t\.tc \1\[TC\],\.\2/; < $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(\S+_entry)\n/\t\.tc \1\[TC\],\.\2\n/; < $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(ret_\S+)/\t\.tc \1\[TC\],\.\2/; < $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(alt_\S+)/\t\.tc \1\[TC\],\.\2/; < $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(vtbl_\S+)/\t\.tc \1\[TC\],\.\2/; < < $tocnumber = $chksymb[$i]; < $tocsymb = $chk[$i]; < $tocsymb =~ s/^LC\.\.\d+:\n//; < $tocsymb =~ s/^\t\.tc \S+,(\S+)\n/\1/; < $tocequiv{$tocnumber} = $tocsymb; < < } elsif ( $chkcat[$i] eq 'toc' && $chk[$i] =~ /\.byte/ ) { < $chkcat[$i] = 'literal'; < } < } < }; < 721,729c678,685 < } elsif ($TargetPlatform =~ /^powerpc-|^rs6000/) { < $p =~ s/^\tmflr 0\n//; < $p =~ s/^\tstm \d+,-\d+\(1\)\n//; < $p =~ s/^\tstw? 0,\d+\(1\)\n//g; < $p =~ s/^\tstw? 1,\d+\(1\)\n//g; #mc < $p =~ s/^\tlw?z 0,0\(1\)\n//g; #mc < $p =~ s/^\tstw?u 1,-\d+\(1\)\n//; < $p =~ s/^\tstw? \d+,-\d+\(1\)\n//g; < $p =~ s/^\tstfd \d+,-\d+\(1\)\n//g; --- > } elsif ($TargetPlatform =~ /^powerpc-apple-.*/) { > $p =~ s/^\tmflr r0\n//; > $p =~ s/^\tbl saveFP # f\d+\n//; > $p =~ s/^\tstmw r\d+,-\d+\(r1\)\n//; > $p =~ s/^\tstfd f\d+,-\d+\(r1\)\n//g; > $p =~ s/^\tstw r0,\d+\(r1\)\n//g; > $p =~ s/^\tstwu r1,-\d+\(r1\)\n//; > $p =~ s/^\tstw r\d+,-\d+\(r1\)\n//g; 734,739c690,702 < # HWL HACK: dont die, just print a warning < #print stderr "HWL: this should die! Prologue junk?: $p\n" if $p =~ /^\t[^\.]/ < # && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test < die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/ < && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test < --- > if ($TargetPlatform =~ /^powerpc-apple-.*/) { > # on PowerPC, we have to keep a part of the prologue > # (which loads the current instruction pointer into register r31) > $u_p = $p; # $u_p is for unexpected prologue > $u_p =~ s/^\tbcl 20,31,L\d+\$pb\n//; > $u_p =~ s/^L\d+\$pb:\n//; > $u_p =~ s/^\tmflr r31\n//; > die "Prologue junk?: $u_p\n" if $u_p =~ /^\t[^\.]/ > } else { > # HWL HACK: dont die, just print a warning > #print stderr "HWL: this should die! Prologue junk?: $p\n" if $p =~ /^\t[^\.]/; > die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/; > } 770,775c733,738 < } elsif ($TargetPlatform =~ /^powerpc-|^rs6000-/) { < $e =~ s/^\taddi 1,1,\d+\n//; < $e =~ s/^\tcal 1,\d+\(1\)\n//; < $e =~ s/^\tlw?z? \d+,\d+\(1\)\n//; < $e =~ s/^\tmtlr 0\n//; < $e =~ s/^\tbl?r\n//; --- > } elsif ($TargetPlatform =~ /^powerpc-apple-.*/) { > $e =~ s/^\taddi r1,r1,\d+\n//; > $e =~ s/^\tcal r1,\d+\(r1\)\n//; > $e =~ s/^\tlw?z? r\d+,\d+\(r1\)\n//; > $e =~ s/^\tmtlr r0\n//; > $e =~ s/^\tblr\n//; 780,781c743 < print STDERR "WARNING: Epilogue junk?: $e\n" if $e =~ /^\t\s*[^\.\s\n]/ < && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test --- > print STDERR "WARNING: Epilogue junk?: $e\n" if $e =~ /^\t\s*[^\.\s\n]/; 801a764 > $c =~ s/^\tbl\s+L___DISCARD__\$stub\n//go if $TargetPlatform =~ /^powerpc-apple-.*/; 945,957d907 < if ($TargetPlatform =~ /^powerpc-|^rs6000/) { < $chksymb[$i] =~ s/://; < #new if ($chksymb[$i] =~ /ret.*upd/ || $KNOWN_FUNNY_THING{$chksymb[$i]} < #new || $chksymb[$i] =~ /^$.{T_US}_(PRIn|PRStart).*${T_POST_LBL}$/o ) < #new { print OUTASM "\t\.globl $chksymb[$i]\n"; } < # if ($chksymb[$i] ne '' && $chksymb[$i] !~ /ret_[a-z]/ && $chksymb[$i] !~ /djn_[a-z]/) < if ($chksymb[$i] ne '') < { print OUTASM "\t\.globl \.$chksymb[$i]\n"; }; < if ($chk[$i] =~ /TOC\[tc0\], 0\n/) < { ($p, $r) = split(/TOC\[tc0\], 0\n/, $chk[$i]); $printDS = 1;} < else { $r = $chk[$i]; $printDS = 0; }; < $chk[$i] = &mangle_powerpc_tailjump($r); < }; 959,964d908 < if ($TargetPlatform =~ /^powerpc-|^rs6000-/ && $printDS) { < #ok if ($chksymb[$i] !~ /\__stginit_Main/) { < print OUTASM "\.csect ${chksymb[$i]}[DS]\n"; < print OUTASM "${p}TOC[tc0], 0\n"; < #ok } < } 1043,1054c987,988 < if ($TargetPlatform =~ /^powerpc-|^rs6000-/) { < if ( !defined($slowchk{$symb}) && defined($fastchk{$symb}) ) { < $fastname = $chk[$fastchk{$symb}]; < $fastname =~ s/([_A-Za-z]*_fast\d+):.*(.*\n)*/\1/; < $chk[$infochk{$symb}] =~ s/\.long StdErrorCode/\.long $fastname/; < } < $chk[$infochk{$symb}] =~ s/\.long ([_A-Za-z]\S+_entry)/\.long \.\1/; < $chk[$infochk{$symb}] =~ s/\.long ([A-Za-z]\S+_upd)/\.long \.\1/; < print OUTASM $chk[$infochk{$symb}]; < } else { < print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1); < } --- > print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1); > 1066,1077d999 < if ($TargetPlatform =~ /^powerpc-|^rs6000-/) { < ($p, $r) = split(/TOC\[tc0\], 0\n/, $c); < if ($symb =~ /^[_A-Z]/) < { < print OUTASM "\t\.globl \.${chksymb[$i]}_entry\n"; < print OUTASM "\.csect ${symb}_entry[DS]\n"; < print OUTASM "${p}TOC[tc0], 0\n"; < }; < $r =~ s/\.csect \.text\[PR\]\n//; # todo: properly - andre < $c = &mangle_powerpc_tailjump($r); < }; < 1097c1019 < } elsif ( $TargetPlatform =~ /^powerpc-|^rs6000-/ ) { --- > } elsif ( $TargetPlatform =~ /^powerpc-apple-.*/ ) { 1098a1021 > $c =~ s/^\tbl \.${T_US}${symb}_fast\d+\n//; 1107c1030 < if ( $TargetPlatform !~ /^(alpha-|hppa|mips-)/ ) { --- > if ( $TargetPlatform !~ /^(alpha-|hppa|mips-|powerpc-apple-)/) { 1132,1143c1055 < if ($TargetPlatform =~ /^powerpc-|^rs6000-/) { < local(@lbls) = split(/:/, $c); < $fullname = $lbls[0]; < $fullname =~ s/$T_MOVE_DIRVS//g; < if ( $fullname =~ /^[A-Z]/) < { print OUTASM "\t\.globl \.${fullname}\n"; < } else { < # print OUTASM "\t\.lglobl \.${fullname}\n"; #todo: rm - andre < }; < $c =~ s/((.*\n)*)\t.long \S+, TOC\[tc0\], 0\n\.csect \.text\[PR\]\n((.*\n)*)/\1\3/; < $c = &mangle_powerpc_tailjump($c); < }; --- > 1155,1164c1067,1068 < if ($TargetPlatform =~ /^powerpc-|^rs6000-/) { < if ( $symb =~ /^[A-Z]/) { < print OUTASM "\t\.globl \.${symb}_vtbl\n"; < print OUTASM "\t\.globl ${symb}_vtbl\n"; < }; < $chk[$vectorchk{$symb}] =~ s/\.long (\S+)/\.long \.\1/g; < print OUTASM ".${symb}_vtbl:\n"; < print OUTASM $chk[$vectorchk{$symb}]; < } else { < print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0); --- > > print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0); 1183,1184c1087,1088 < print OUTASM "${T_create_word} 0\n"; < } --- > print OUTASM "${T_create_word} 0\n"; > 1219,1222d1122 < if ($TargetPlatform =~ /^powerpc-|^rs6000-/) { < print OUTASM ".csect .text[PR]\n_section_.text:\n.csect .data[RW]\n\t.long _section_.text\n" < }; < 1532,1579d1431 < \end{code} < < \begin{code} < sub mini_mangle_asm_powerpc { < local($in_asmf, $out_asmf) = @_; < < open(INASM, "< $in_asmf") < || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n"); < open(OUTASM,"> $out_asmf") < || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n"); < < while () { < s/long _PRStart/long ._PRStart/; < s/long _PRIn_/long ._PRIn_/; < s/long _Dummy_(\S+)_entry/long ._Dummy_\1_entry/; < s/long _PRMarking_MarkNextRoot\[DS\]/long ._PRMarking_MarkNextRoot/; < s/long _PRMarking_MarkNextCAF\[DS\]/long ._PRMarking_MarkNextCAF/; < s/long _PRMarking_MarkNextAStack\[DS\]/long ._PRMarking_MarkNextAStack/; < s/long _PRMarking_MarkNextBStack\[DS\]/long ._PRMarking_MarkNextBStack/; < s/\.tc EnterNodeCode\[TC]\,EnterNodeCode\[DS\]/\.tc EnterNodeCode\[TC]\,.EnterNodeCode/; # CONC < s/\.tc CheckHeapCode\[TC]\,CheckHeapCode\[DS\]/\.tc CheckHeapCode\[TC]\,.CheckHeapCode/; # CONC < print OUTASM; < } < < # finished: < close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n"); < close(INASM) || &tidy_up_and_die(1,"Failed reading from $in_asmf\n"); < } < < sub mangle_powerpc_tailjump { < local($c) = @_; < local($maybe_more) = 1; < while (($c =~ /\tlw?z? \d+,LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n/) && $maybe_more) < { $maybe_more = 0; < $lcsymb = $c; < $lcsymb =~ s/(.*\n)*\tlw?z? \d+,LC\.\.(\d+)\(2\)\n\tmtctr \d+\n\tbctr\n(.*\n)*/\2/; < # the checks for r1 and r2 are mostly paranoia... < $r1 = $c; < $r1 =~ s/(.*\n)*\tlw?z? (\d+),LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n(.*\n)*/\2/; < $r2 = $c; < $r2 =~ s/(.*\n)*\tlw?z? \d+,LC\.\.(\d+)\(2\)\n\tmtctr (\d+)\n\tbctr\n(.*\n)*/\3/; < if (r1 == r2) < { $maybe_more = 1; < $c =~ s/((.*\n)*)\tlw?z? \d+,LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n((.*\n)*)/\1\tb $tocequiv{$lcsymb}\n\3/; < } < }; < $c; < } Index: ghc/includes/TailCalls.h =================================================================== RCS file: /cvs/fptools/ghc/includes/TailCalls.h,v retrieving revision 1.7 diff -r1.7 TailCalls.h 24a25,26 > extern void __DISCARD__(void); > 31,32d32 < extern void __DISCARD__(void); < 152a153,176 > > /* ----------------------------------------------------------------------------- > Tail calling on PowerPC > -------------------------------------------------------------------------- */ > > #ifdef powerpc_TARGET_ARCH > > #define JMP_(cont) \ > { \ > void *target; \ > target = (void *)(cont); \ > goto *target; \ > } > > /* > I would _love_ to use the following instead, > but GCC fails to generate code for it if it is called for a casted > data pointer - which is exactly what we are going to do... > > #define JMP_(cont) ((F_) (cont))() > */ > > > #endif /* sparc_TARGET_ARCH */ Index: ghc/rts/Adjustor.c =================================================================== RCS file: /cvs/fptools/ghc/rts/Adjustor.c,v retrieving revision 1.13 diff -r1.13 Adjustor.c 45,46c45 < #if defined(i386_TARGET_ARCH) || defined(sparc_TARGET_ARCH) || defined(alpha_TARGET_ARCH) < --- > #if defined(i386_TARGET_ARCH) || defined(sparc_TARGET_ARCH) || defined(alpha_TARGET_ARCH) || defined(powerpc_TARGET_ARCH) 282a282,330 > #elif defined(powerpc_TARGET_ARCH) > /* > For PowerPC, the following code is used: > > mr r10,r8 > mr r9,r7 > mr r8,r6 > mr r7,r5 > mr r6,r4 > mr r5,r3 > lis r0,0xDEAD ;hi(wptr) > lis r3,0xDEAF ;hi(hptr) > ori r0,r0,0xBEEF ; lo(wptr) > ori r3,r3,0xFACE ; lo(hptr) > mtctr r0 > bctr > > The arguments (passed in registers r3 - r10) are shuffled along by two to > make room for hptr and a dummy argument. As r9 and r10 are overwritten by > this code, it only works for up to 6 arguments (when floating point arguments > are involved, this may be more or less, depending on the exact situation). > */ > if ((adjustor = stgMallocBytes(4*13, "createAdjustor")) != NULL) { > unsigned long *const adj_code = (unsigned long *)adjustor; > > // make room for extra arguments > adj_code[0] = 0x7d0a4378; //mr r10,r8 > adj_code[1] = 0x7ce93b78; //mr r9,r7 > adj_code[2] = 0x7cc83378; //mr r8,r6 > adj_code[3] = 0x7ca72b78; //mr r7,r5 > adj_code[4] = 0x7c862378; //mr r6,r4 > adj_code[5] = 0x7c651b78; //mr r5,r3 > > adj_code[6] = 0x3c000000; //lis r0,hi(wptr) > adj_code[6] |= ((unsigned long)wptr) >> 16; > > adj_code[7] = 0x3c600000; //lis r3,hi(hptr) > adj_code[6] |= ((unsigned long)hptr) >> 16; > > adj_code[8] = 0x60000000; //ori r0,r0,lo(wptr) > adj_code[8] |= ((unsigned long)wptr) & 0xFFFF; > > adj_code[9] = 0x60630000; //ori r3,r3,lo(hptr) > adj_code[9] |= ((unsigned long)hptr) & 0xFFFF; > > adj_code[10] = 0x7c0903a6; //mtctr r0 > adj_code[11] = 0x4e800420; //bctr > adj_code[12] = (unsigned long)hptr; > } 323c371 < #elif defined(sparc_TARGET_ARCH) --- > #elif defined(alpha_TARGET_ARCH) 330a379,384 > #elif defined(powerpc_TARGET_ARCH) > if ( *(StgWord*)ptr != 0x7d0a4378 ) { > fprintf(stderr, "freeHaskellFunctionPtr: not for me, guv! %p\n", ptr); > return; > } > freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 4*12))); Index: ghc/rts/ClosureFlags.c =================================================================== RCS file: /cvs/fptools/ghc/rts/ClosureFlags.c,v retrieving revision 1.11 diff -r1.11 ClosureFlags.c 13,14d12 < StgWord16 closure_flags[] = { < 30,94c28 < [INVALID_OBJECT ] = ( 0 ), < [CONSTR ] = (_HNF| _NS ), < [CONSTR_1_0 ] = (_HNF| _NS ), < [CONSTR_0_1 ] = (_HNF| _NS ), < [CONSTR_2_0 ] = (_HNF| _NS ), < [CONSTR_1_1 ] = (_HNF| _NS ), < [CONSTR_0_2 ] = (_HNF| _NS ), < [CONSTR_INTLIKE ] = (_HNF| _NS|_STA ), < [CONSTR_CHARLIKE ] = (_HNF| _NS|_STA ), < [CONSTR_STATIC ] = (_HNF| _NS|_STA ), < [CONSTR_NOCAF_STATIC ] = (_HNF| _NS|_STA ), < [FUN ] = (_HNF| _NS| _SRT ), < [FUN_1_0 ] = (_HNF| _NS ), < [FUN_0_1 ] = (_HNF| _NS ), < [FUN_2_0 ] = (_HNF| _NS ), < [FUN_1_1 ] = (_HNF| _NS ), < [FUN_0_2 ] = (_HNF| _NS ), < [FUN_STATIC ] = (_HNF| _NS|_STA| _SRT ), < [THUNK ] = ( _BTM| _THU| _SRT ), < [THUNK_1_0 ] = ( _BTM| _THU| _SRT ), < [THUNK_0_1 ] = ( _BTM| _THU| _SRT ), < [THUNK_2_0 ] = ( _BTM| _THU| _SRT ), < [THUNK_1_1 ] = ( _BTM| _THU| _SRT ), < [THUNK_0_2 ] = ( _BTM| _THU| _SRT ), < [THUNK_STATIC ] = ( _BTM| _STA|_THU| _SRT ), < [THUNK_SELECTOR ] = ( _BTM| _THU| _SRT ), < [BCO ] = (_HNF| _NS ), < [AP_UPD ] = ( _BTM| _THU ), < [PAP ] = (_HNF| _NS ), < [IND ] = ( _NS |_IND ), < [IND_OLDGEN ] = ( _NS |_IND ), < [IND_PERM ] = ( _NS |_IND ), < [IND_OLDGEN_PERM ] = ( _NS |_IND ), < [IND_STATIC ] = ( _NS|_STA |_IND ), < [CAF_BLACKHOLE ] = ( _BTM|_NS| _UPT ), < [RET_BCO ] = ( _BTM ), < [RET_SMALL ] = ( _BTM| _SRT ), < [RET_VEC_SMALL ] = ( _BTM| _SRT ), < [RET_BIG ] = ( _SRT ), < [RET_VEC_BIG ] = ( _SRT ), < [RET_DYN ] = ( _SRT ), < [UPDATE_FRAME ] = ( _BTM ), < [CATCH_FRAME ] = ( _BTM ), < [STOP_FRAME ] = ( _BTM ), < [SEQ_FRAME ] = ( _BTM ), < [BLACKHOLE ] = ( _NS| _UPT ), < [BLACKHOLE_BQ ] = ( _NS| _MUT|_UPT ), < [SE_BLACKHOLE ] = ( _NS| _UPT ), < [SE_CAF_BLACKHOLE ] = ( _NS| _UPT ), < [MVAR ] = (_HNF| _NS| _MUT|_UPT ), < [ARR_WORDS ] = (_HNF| _NS| _UPT ), < [MUT_ARR_PTRS ] = (_HNF| _NS| _MUT|_UPT ), < [MUT_ARR_PTRS_FROZEN ] = (_HNF| _NS| _UPT ), < [MUT_VAR ] = (_HNF| _NS| _MUT|_UPT ), < [MUT_CONS ] = (_HNF| _NS| _UPT ), < [WEAK ] = (_HNF| _NS| _UPT ), < [FOREIGN ] = (_HNF| _NS| _UPT ), < [STABLE_NAME ] = (_HNF| _NS| _UPT ), < [TSO ] = (_HNF| _NS| _MUT|_UPT ), < [BLOCKED_FETCH ] = (_HNF| _NS| _MUT|_UPT ), < [FETCH_ME ] = (_HNF| _NS| _MUT|_UPT ), < [FETCH_ME_BQ ] = ( _NS| _MUT|_UPT ), < [RBH ] = ( _NS| _MUT|_UPT ), < [EVACUATED ] = ( 0 ), < [REMOTE_REF ] = (_HNF| _NS| _UPT ), --- > StgWord16 closure_flags[N_CLOSURE_TYPES+1]; 96,97c30,99 < [N_CLOSURE_TYPES ] = ( 0 ) < }; --- > void InitClosureFlags() > { > closure_flags[INVALID_OBJECT ] = ( 0 ), > closure_flags[CONSTR ] = (_HNF| _NS ), > closure_flags[CONSTR_1_0 ] = (_HNF| _NS ), > closure_flags[CONSTR_0_1 ] = (_HNF| _NS ), > closure_flags[CONSTR_2_0 ] = (_HNF| _NS ), > closure_flags[CONSTR_1_1 ] = (_HNF| _NS ), > closure_flags[CONSTR_0_2 ] = (_HNF| _NS ), > closure_flags[CONSTR_INTLIKE ] = (_HNF| _NS|_STA ), > closure_flags[CONSTR_CHARLIKE ] = (_HNF| _NS|_STA ), > closure_flags[CONSTR_STATIC ] = (_HNF| _NS|_STA ), > closure_flags[CONSTR_NOCAF_STATIC ] = (_HNF| _NS|_STA ), > closure_flags[FUN ] = (_HNF| _NS| _SRT ), > closure_flags[FUN_1_0 ] = (_HNF| _NS ), > closure_flags[FUN_0_1 ] = (_HNF| _NS ), > closure_flags[FUN_2_0 ] = (_HNF| _NS ), > closure_flags[FUN_1_1 ] = (_HNF| _NS ), > closure_flags[FUN_0_2 ] = (_HNF| _NS ), > closure_flags[FUN_STATIC ] = (_HNF| _NS|_STA| _SRT ), > closure_flags[THUNK ] = ( _BTM| _THU| _SRT ), > closure_flags[THUNK_1_0 ] = ( _BTM| _THU| _SRT ), > closure_flags[THUNK_0_1 ] = ( _BTM| _THU| _SRT ), > closure_flags[THUNK_2_0 ] = ( _BTM| _THU| _SRT ), > closure_flags[THUNK_1_1 ] = ( _BTM| _THU| _SRT ), > closure_flags[THUNK_0_2 ] = ( _BTM| _THU| _SRT ), > closure_flags[THUNK_STATIC ] = ( _BTM| _STA|_THU| _SRT ), > closure_flags[THUNK_SELECTOR ] = ( _BTM| _THU| _SRT ), > closure_flags[BCO ] = (_HNF| _NS ), > closure_flags[AP_UPD ] = ( _BTM| _THU ), > closure_flags[PAP ] = (_HNF| _NS ), > closure_flags[IND ] = ( _NS |_IND ), > closure_flags[IND_OLDGEN ] = ( _NS |_IND ), > closure_flags[IND_PERM ] = ( _NS |_IND ), > closure_flags[IND_OLDGEN_PERM ] = ( _NS |_IND ), > closure_flags[IND_STATIC ] = ( _NS|_STA |_IND ), > closure_flags[CAF_BLACKHOLE ] = ( _BTM|_NS| _UPT ), > closure_flags[RET_BCO ] = ( _BTM ), > closure_flags[RET_SMALL ] = ( _BTM| _SRT ), > closure_flags[RET_VEC_SMALL ] = ( _BTM| _SRT ), > closure_flags[RET_BIG ] = ( _SRT ), > closure_flags[RET_VEC_BIG ] = ( _SRT ), > closure_flags[RET_DYN ] = ( _SRT ), > closure_flags[UPDATE_FRAME ] = ( _BTM ), > closure_flags[CATCH_FRAME ] = ( _BTM ), > closure_flags[STOP_FRAME ] = ( _BTM ), > closure_flags[SEQ_FRAME ] = ( _BTM ), > closure_flags[BLACKHOLE ] = ( _NS| _UPT ), > closure_flags[BLACKHOLE_BQ ] = ( _NS| _MUT|_UPT ), > closure_flags[SE_BLACKHOLE ] = ( _NS| _UPT ), > closure_flags[SE_CAF_BLACKHOLE ] = ( _NS| _UPT ), > closure_flags[MVAR ] = (_HNF| _NS| _MUT|_UPT ), > closure_flags[ARR_WORDS ] = (_HNF| _NS| _UPT ), > closure_flags[MUT_ARR_PTRS ] = (_HNF| _NS| _MUT|_UPT ), > closure_flags[MUT_ARR_PTRS_FROZEN ] = (_HNF| _NS| _UPT ), > closure_flags[MUT_VAR ] = (_HNF| _NS| _MUT|_UPT ), > closure_flags[MUT_CONS ] = (_HNF| _NS| _UPT ), > closure_flags[WEAK ] = (_HNF| _NS| _UPT ), > closure_flags[FOREIGN ] = (_HNF| _NS| _UPT ), > closure_flags[STABLE_NAME ] = (_HNF| _NS| _UPT ), > closure_flags[TSO ] = (_HNF| _NS| _MUT|_UPT ), > closure_flags[BLOCKED_FETCH ] = (_HNF| _NS| _MUT|_UPT ), > closure_flags[FETCH_ME ] = (_HNF| _NS| _MUT|_UPT ), > closure_flags[FETCH_ME_BQ ] = ( _NS| _MUT|_UPT ), > closure_flags[RBH ] = ( _NS| _MUT|_UPT ), > closure_flags[EVACUATED ] = ( 0 ), > closure_flags[REMOTE_REF ] = (_HNF| _NS| _UPT ), > > closure_flags[N_CLOSURE_TYPES ] = ( 0 ); > } Index: ghc/rts/Main.c =================================================================== RCS file: /cvs/fptools/ghc/rts/Main.c,v retrieving revision 1.34 diff -r1.34 Main.c 41a42,109 > #ifdef darwin_TARGET_OS > #include > #include > #include > #include > #include > #include > #include "Storage.h" > > unsigned long macho_end = 0; > unsigned long macho_etext = 0; > unsigned long macho_etext2 = 0; > unsigned long macho_edata = 0; > > #define IN_RANGE(base,size,x) (((P_)base) <= ((P_)x) && ((P_)x) < ((P_)((unsigned long)base + size))) > static void macosx_get_memory_layout(void) > { > vm_address_t address; > vm_size_t size; > struct vm_region_basic_info info; > mach_msg_type_number_t info_count; > mach_port_t object_name; > task_t task = mach_task_self(); > int is_info; > int is_static_closure; > unsigned *p; > > p = (void*)&stg_BLACKHOLE_info; > p = (void*)&stg_dummy_ret_closure; > address = 0; /* VM_MIN_ADDRESS */ > while (1) { > info_count = VM_REGION_BASIC_INFO_COUNT; > if (vm_region(task, &address, &size, VM_REGION_BASIC_INFO, > (vm_region_info_t)&info, &info_count, &object_name) > != KERN_SUCCESS) > break; > is_info = IN_RANGE(address,size,&stg_BLACKHOLE_info); > is_static_closure = IN_RANGE(address,size,&stg_dummy_ret_closure); > if (is_info) > macho_etext2 = address + size; > if (is_static_closure) > macho_edata = address + size; > address += size; > } > if (LOOKS_LIKE_STATIC_CLOSURE(&stg_BLACKHOLE_info)) { > printf("%08x, %08x, %08x\n",&stg_BLACKHOLE_info,macho_etext,macho_edata); > barf("LOOKS_LIKE_STATIC_CLOSURE- is incorrectly defined"); > exit(0); > } > if (!LOOKS_LIKE_STATIC_CLOSURE(&stg_dummy_ret_closure)) { > barf("LOOKS_LIKE_STATIC_CLOSURE+ is incorrectly defined"); > exit(0); > } > if (!LOOKS_LIKE_GHC_INFO(&stg_BLACKHOLE_info)) { > barf("LOOKS_LIKE_GHC_INFO+ is incorrectly defined"); > exit(0); > } > if (LOOKS_LIKE_GHC_INFO(&stg_dummy_ret_closure)) { > barf("LOOKS_LIKE_GHC_INFO- is incorrectly defined"); > exit(0); > } > return; > } > > void __DISCARD__ () {} > > #endif > 46a115,117 > > void InitClosureFlags(); > 52a124,131 > > #if defined(darwin_TARGET_OS) > macho_end = get_end(); > macho_etext = get_etext(); > macho_edata = get_edata(); > macosx_get_memory_layout(); > #endif > InitClosureFlags(); Index: ghc/rts/StgCRun.c =================================================================== RCS file: /cvs/fptools/ghc/rts/StgCRun.c,v retrieving revision 1.30 diff -r1.30 StgCRun.c 452a453,486 > /* ----------------------------------------------------------------------------- > PowerPC architecture > > We can use a simple function call as a tail call (the bl instruction places > the return address in the Link Register, and we ignore it). > We make GCC do the register saving. GCC does a good job > and saves all general purpose registers with a single stmw > (store multiple words) instruction. > > -------------------------------------------------------------------------- */ > > #ifdef powerpc_TARGET_ARCH > > StgThreadReturnCode > StgRun(StgFunPtr f, StgRegTable *basereg) { > > unsigned char space[RESERVED_C_STACK_BYTES]; > > f(); > __asm__ volatile ( > ".align 4\n" > ".globl " STG_RETURN "\n" > STG_RETURN ":" > : : : > "r14","r15","r16","r17","r18","r19","r20","r21","r22","r23","r24","r25","r26", > "r27","r28","r29","r30","r31", > "fr14","fr15","fr16","fr17","fr18","fr19","fr20", > "fr21","fr22","fr23","fr24","fr25","fr26","fr27","fr28","fr29","fr30","fr31"); > > return (StgThreadReturnCode)R1.i; > } > > #endif > 453a488 > Index: ghc/rts/Storage.h =================================================================== RCS file: /cvs/fptools/ghc/rts/Storage.h,v retrieving revision 1.41 diff -r1.41 Storage.h 421a422,435 > #ifdef darwin_TARGET_OS > extern unsigned long macho_end; > extern unsigned long macho_etext; > extern unsigned long macho_etext2; > extern unsigned long macho_edata; > > #define IS_CODE_PTR(p) ( ((P_)(p) < (P_)macho_etext) \ > || is_dynamically_loaded_code_or_rodata_ptr((char *)p) ) > #define IS_DATA_PTR(p) ( ((P_)(p) >= (P_)macho_etext && \ > (P_)(p) < (P_)macho_edata) \ > || is_dynamically_loaded_rwdata_ptr((char *)p) ) > #define IS_USER_PTR(p) ( ((P_)(p) >= (P_)macho_edata) \ > && is_not_dynamically_loaded_ptr((char *)p) ) > #else 428a443 > #endif 541a557,560 > #elif defined(darwin_TARGET_OS) && defined(NO_REGS) > #define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r))) > # define LOOKS_LIKE_STATIC_CLOSURE(r) \ > (IS_DATA_PTR(r) && !LOOKS_LIKE_GHC_INFO(r)) 563a583,586 > #if defined(darwin_TARGET_OS) && defined(NO_REGS) > /* Plan C, see above */ > # define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(((P_*)(info))[0]) > #else 566c589 < --- > #endif Index: libraries/base/GHC/Posix.hs =================================================================== RCS file: /cvs/fptools/libraries/base/GHC/Posix.hs,v retrieving revision 1.4 diff -r1.4 Posix.hs 343c343 < c_sigaddset :: Ptr CSigset -> CInt -> IO () --- > c_sigaddset :: Ptr CSigset -> CInt -> IO CInt Index: libraries/base/include/HsBase.h =================================================================== RCS file: /cvs/fptools/libraries/base/include/HsBase.h,v retrieving revision 1.3 diff -r1.3 HsBase.h 89a90,106 > /* For Posix */ > #ifdef darwin_TARGET_OS > > #include > #ifdef sigaddset > // on MacOS X, sigaddset is defined as a macro... we need a wrapper > > static inline int sigaddsetWrapper (sigset_t * set, int s) > { > return sigaddset(set,s); > } > > #undef sigaddset > #define sigaddset sigaddsetWrapper > #endif > #endif > Index: libraries/network/Network/Socket.hsc =================================================================== RCS file: /cvs/fptools/libraries/network/Network/Socket.hsc,v retrieving revision 1.5 diff -r1.5 Socket.hsc 243,245c243 < #ifndef mingw32_TARGET_OS < type CSaFamily = (#type sa_family_t) < #else --- > #ifdef mingw32_TARGET_OS 246a245,248 > #elif defined(darwin_TARGET_OS) > type CSaFamily = (#type u_char) > #else > type CSaFamily = (#type sa_family_t)