From: sewardj Date: Tue, 19 Dec 2000 16:48:35 +0000 (+0000) Subject: [project @ 2000-12-19 16:48:35 by sewardj] X-Git-Tag: Approximately_9120_patches~3045 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=333ddd13aebd80793bbcb746428c256dbb6a74e5;p=ghc-hetmet.git [project @ 2000-12-19 16:48:35 by sewardj] Try to get the repo rts into a buildable state. --- diff --git a/ghc/rts/Disassembler.c b/ghc/rts/Disassembler.c index 00a1167..e03ea7e 100644 --- a/ghc/rts/Disassembler.c +++ b/ghc/rts/Disassembler.c @@ -5,10 +5,12 @@ * Copyright (c) 1994-1998. * * $RCSfile: Disassembler.c,v $ - * $Revision: 1.14 $ - * $Date: 2000/10/09 11:20:16 $ + * $Revision: 1.15 $ + * $Date: 2000/12/19 16:48:35 $ * ---------------------------------------------------------------------------*/ +#if 0 + #include "Rts.h" #ifdef INTERPRETER @@ -18,11 +20,77 @@ #include "Assembler.h" #include "Printer.h" #include "Disassembler.h" +#include "Interpreter.h" /* -------------------------------------------------------------------------- * Disassembler * ------------------------------------------------------------------------*/ +static int disInstr ( StgBCO *bco, int pc ) +{ + StgArrWords* instr_arr = bco->instrs; + UShort* instrs = (UShort*)(&instr_arr->payload[0]); + + switch (instrs[pc++]) { + case i_ARGCHECK: + fprintf(stderr, "ARGCHECK %d\n", instrs[pc] ); + pc += 1; break; + case i_PUSH_L: + fprintf(stderr, "PUSH_L %d\n", instrs[pc] ); + pc += 1; break; + case i_PUSH_LL: + fprintf(stderr, "PUSH_LL %d %d\n", instrs[pc], instrs[pc+1] ); + pc += 2; break; + case i_PUSH_LLL: + fprintf(stderr, "PUSH_LLL %d %d %d\n", instrs[pc], instrs[pc+1], + instrs[pc+2] ); + pc += 3; break; + case i_PUSH_G: + fprintf(stderr, "PUSH_G " ); printPtr( ptrs[instrs[pc]] ); + pc += 1; break; + case i_PUSH_AS: + fprintf(stderr, "PUSH_AS " ); printPtr( ptrs[instrs[pc]] ); + fprintf(stderr, " 0x%x", literals[instrs[pc+1]] ); + pc += 2; break; + case i_PUSH_UBX: + fprintf(stderr, "PUSH_UBX "); + for (i = 0; i < instrs[pc+1]; i++) + fprintf(stderr, "0x%x ", literals[i + instrs[pc]] ); + fprintf(stderr, "\n"); + pc += 2; break; + case i_PUSH_TAG: + fprintf(stderr, "PUSH_TAG %d\n", instrs[pc] ); + pc += 1; break; + case i_SLIDE: + fprintf(stderr, "SLIDE %d down by %d\n", instrs[pc], instrs[pc+1] ); + pc += 2; break; + case i_ALLOC: + fprintf(stderr, "ALLOC %d words\n", instrs[pc] ); + pc += 1; break; + case i_MKAP: + fprintf(stderr, "MKAP %d words, %d stkoff\n", instrs[pc+1], + instrs[pc] ); + pc += 2; break; + case i_UNPACK: + fprintf(stderr, "UNPACK %d\n", instrs[pc] ); + pc += 1; break; + case i_UPK_TAG: + fprintf(stderr, "UPK_TAG %d words, %d conoff, %d stkoff\n", + instrs[pc], instrs[pc+1], instrs[pc+2] ); + pc += 3; break; + case i_PACK: + fprintf(stderr, "PACK %d words with itbl ", instrs[pc+1] ); + printPtr( itbls[instrs[pc]] ); + pc += 2; break; + + case i_TESTLT_I: + +pc = disLitN ( bco, pc ); break; + case i_TESTEQ_I: pc = disLitNInt ( bco, pc ); + } +} + + static InstrPtr disNone ( StgBCO *bco, InstrPtr pc, char* i ); static InstrPtr disInt ( StgBCO *bco, InstrPtr pc, char* i ); static InstrPtr disIntInt ( StgBCO *bco, InstrPtr pc, char* i ); @@ -519,3 +587,4 @@ void disassemble( StgBCO *bco, char* prefix ) } #endif /* INTERPRETER */ +#endif 0 \ No newline at end of file diff --git a/ghc/rts/Disassembler.h b/ghc/rts/Disassembler.h index cade4ff..3751dff 100644 --- a/ghc/rts/Disassembler.h +++ b/ghc/rts/Disassembler.h @@ -1,11 +1,16 @@ + /* ----------------------------------------------------------------------------- - * $Id: Disassembler.h,v 1.4 2000/12/11 12:53:44 sewardj Exp $ + * $Id: Disassembler.h,v 1.5 2000/12/19 16:48:35 sewardj Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2000 * * Prototypes for functions in Disassembler.c * * ---------------------------------------------------------------------------*/ +#ifdef GHCI + extern int disInstr ( StgBCO *bco, int pc ); extern void disassemble( StgBCO *bco, char* prefix ); + +#endif diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c index eb6fd24..8fa1c46 100644 --- a/ghc/rts/Interpreter.c +++ b/ghc/rts/Interpreter.c @@ -7,8 +7,8 @@ * Copyright (c) 1994-2000. * * $RCSfile: Interpreter.c,v $ - * $Revision: 1.3 $ - * $Date: 2000/12/14 15:19:48 $ + * $Revision: 1.4 $ + * $Date: 2000/12/19 16:48:35 $ * ---------------------------------------------------------------------------*/ #include "Rts.h" @@ -46,6 +46,7 @@ #endif /* 0 */ #include + int /*StgThreadReturnCode*/ interpretBCO ( void* /* Capability* */ cap ) { fprintf(stderr, "Greetings, earthlings. I am not yet implemented. Bye!\n"); diff --git a/ghc/rts/Interpreter.h b/ghc/rts/Interpreter.h index 6b48864..bcc4187 100644 --- a/ghc/rts/Interpreter.h +++ b/ghc/rts/Interpreter.h @@ -1,5 +1,6 @@ + /* ----------------------------------------------------------------------------- - * $Id: Interpreter.h,v 1.1 2000/12/19 13:09:52 sewardj Exp $ + * $Id: Interpreter.h,v 1.2 2000/12/19 16:48:35 sewardj Exp $ * * (c) The GHC Team, 1998-2000. * @@ -11,6 +12,8 @@ extern StgThreadReturnCode interpretBCO ( Capability* cap ); +typedef unsigned short UShort; + #endif #if 0 diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc index 2d27886..a332874 100644 --- a/ghc/rts/PrimOps.hc +++ b/ghc/rts/PrimOps.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.hc,v 1.64 2000/12/19 12:34:01 sewardj Exp $ + * $Id: PrimOps.hc,v 1.65 2000/12/19 16:48:35 sewardj Exp $ * * (c) The GHC Team, 1998-2000 * @@ -1032,10 +1032,10 @@ FN_(newBCOzh_fast) bco = (StgBCO *) (Hp + 1 - sizeofW(StgBCO)); SET_HDR(bco, &stg_BCO_info, CCCS); - bco->instrs = R1.cl; - bco->literals = R2.cl; - bco->ptrs = R3.cl; - bco->itbls = R4.cl; + bco->instrs = (StgArrWords*)R1.cl; + bco->literals = (StgArrWords*)R2.cl; + bco->ptrs = (StgMutArrPtrs*)R3.cl; + bco->itbls = (StgArrWords*)R4.cl; TICK_RET_UNBOXED_TUP(1); RET_P(bco);