From: sewardj Date: Mon, 21 May 2001 16:34:22 +0000 (+0000) Subject: [project @ 2001-05-21 16:34:22 by sewardj] X-Git-Tag: Approximately_9120_patches~1909 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;ds=sidebyside;h=930b60d0440d9843ee688f028f37bf69a53c5a98;p=ghc-hetmet.git [project @ 2001-05-21 16:34:22 by sewardj] Implement opcodes bci_TESTLT_F and case bci_TESTEQ_F. (Duh.) --- diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c index ccbac4a..52b25bf 100644 --- a/ghc/rts/Interpreter.c +++ b/ghc/rts/Interpreter.c @@ -5,8 +5,8 @@ * Copyright (c) 1994-2000. * * $RCSfile: Interpreter.c,v $ - * $Revision: 1.21 $ - * $Date: 2001/03/21 10:56:04 $ + * $Revision: 1.22 $ + * $Date: 2001/05/21 16:34:22 $ * ---------------------------------------------------------------------------*/ #include "Rts.h" @@ -691,6 +691,30 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) bciPtr = failto; goto nextInsn; } + case bci_TESTLT_F: { + /* The top thing on the stack should be a tagged float. */ + int discr = BCO_NEXT; + int failto = BCO_NEXT; + StgFloat stackFlt, discrFlt; + ASSERT(sizeofW(StgFloat) == StackWord(0)); + stackFlt = PK_FLT( & StackWord(1) ); + discrFlt = PK_FLT( & BCO_LIT(discr) ); + if (stackFlt >= discrFlt) + bciPtr = failto; + goto nextInsn; + } + case bci_TESTEQ_F: { + /* The top thing on the stack should be a tagged float. */ + int discr = BCO_NEXT; + int failto = BCO_NEXT; + StgFloat stackFlt, discrFlt; + ASSERT(sizeofW(StgFloat) == StackWord(0)); + stackFlt = PK_FLT( & StackWord(1) ); + discrFlt = PK_FLT( & BCO_LIT(discr) ); + if (stackFlt != discrFlt) + bciPtr = failto; + goto nextInsn; + } /* Control-flow ish things */ case bci_ENTER: { @@ -747,10 +771,6 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) case bci_CASEFAIL: barf("interpretBCO: hit a CASEFAIL"); - /* As yet unimplemented */ - case bci_TESTLT_F: - case bci_TESTEQ_F: - /* Errors */ default: barf("interpretBCO: unknown or unimplemented opcode");