Skip to content

<interactive>: internal error: interpretBCO: unknown or unimplemented opcode

I did try to post this to glasgow-haskell-bugs@haskell.org before christmas because I could not log into trac but as a non-subscriber it was "moderated" and never appeared...

(Although architecture is set to x86, this also occurs on x86_64)

I'm not sure precisely what the problem is here, but if you remove all the strictness modifiers then the problem goes away.

Also, the following works fine:

buildOctTree (Vec 0 0 0) 10 10 10 [(a,(Vec a a a)) | a <- [(-4.0),(-2.0)..4.0]]

Also, having done that, the problematic expressions work fine - the bug only appears if the expression below is run as the first call to buildOctTree in the ghci session.

This is on a P4, 2GB RAM, Debian unstable, ghc 6.6 (both hand rolled and from debian).

uname -a =

Linux smudge 2.6.18-2-686 #1 (closed) SMP Wed Nov 8 19:52:12 UTC 2006 i686 GNU/Linux

ghci -v OctTree

/ _ \ /\ /\/ __(_)

/ /\// // / / | | GHC Interactive, version 6.6, for Haskell 98. / /\\/ __ / /| | http://www.haskell.org/ghc/ \__/\/ //\___/|_| Type :? for help.

Using package config file: /usr/lib/ghc-6.6/package.conf wired-in package base mapped to base-2.0 wired-in package rts mapped to rts-1.0 wired-in package haskell98 mapped to haskell98-1.0 wired-in package template-haskell mapped to template-haskell-2.0 Hsc static flags: -static Loading package base ... linking ... done.

  • ** Parser:
  • ** Desugar:
  • ** Simplify:
  • ** CorePrep:
  • ** ByteCodeGen:
  • ** Parser:
  • ** Desugar:
  • ** Simplify:
  • ** CorePrep:
  • ** ByteCodeGen:
  • ** Chasing dependencies:

Stable obj: [] Stable BCO: [] unload: retaining objs [] unload: retaining bcos [] Upsweep completely successful.

  • ** Deleting temp files:

Deleting:

  • ** Chasing dependencies:

Stable obj: [] Stable BCO: [] unload: retaining objs [] unload: retaining bcos [] compile: input file OctTree.hs

  • ** Checking old interface for main:OctTree:

[1 of 1] Compiling OctTree ( OctTree.hs, interpreted )

  • ** Parser:
  • ** Renamer/typechecker:
  • ** Desugar:

Result size = 1587

  • ** Simplify:

Result size = 2390

Result size = 2137

Result size = 2105

Result size = 2100

  • ** Tidy Core:

Result size = 2198

  • ** CorePrep:

Result size = 2646

  • ** ByteCodeGen:
  • ** Deleting temp files:

Deleting: Upsweep completely successful.

  • ** Deleting temp files:

Deleting: Ok, modules loaded: OctTree.

  • OctTree> buildOctTree (Vec 0 0 0) 10 10 10 [(a,(Vec a a a)) | a <- [(-4.0),(-3.9)..4.0]]
  • ** Parser:
  • ** Desugar:
  • ** Simplify:
  • ** CorePrep:
  • ** ByteCodeGen:

<interactive>: internal error: interpretBCO: unknown or unimplemented opcode 20196

(GHC version 6.6 for i386_unknown_linux)

Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug

Aborted

Thanks,

Matthew

Code follows:

{-

  • OctTrees.hs: Implementation of OctTrees in Haskell
  • Copyright (C) 2006 Matthew Sackman
  • This program is free software; you can redistribute it and/or
  • modify it under the terms of the GNU General Public License
  • as published by the Free Software Foundation; version 2
  • of the License only.
  • This program is distributed in the hope that it will be useful,
  • but WITHOUT ANY WARRANTY; without even the implied warranty of
  • MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  • GNU General Public License for more details.
  • You should have received a copy of the GNU General Public License
  • along with this program; if not, write to the Free Software
  • Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -}

module OctTree

(OctTree,

buildOctTree,

findInRadius

)

where

import Data.List

data Vector = Vec !Double !Double !Double

deriving (Show, Eq)

findDisplacement :: Vector -> Vector -> (Double, Vector) findDisplacement (Vec ax ay az) (Vec bx by bz) =

(len, Vec dx dy dz)

where

len = sqrt ((dx*dx) + (dy*dy) + (dz*dz))

dx = (bx - ax)

dy = (by - ay)

dz = (bz - az)

-- lne usw data OctTree value = OctTree !Vector !Vector !(OctTreeNode value)

deriving (Show)

data OctTreeNode value = EmptyLeaf -- pos value

| Leaf !Vector !(value)

| Node

-- lne lse lsw lnw

!(OctTree value) !(OctTree value) !(OctTree value) !(OctTree value)

-- unw usw use une

!(OctTree value) !(OctTree value) !(OctTree value) !(OctTree value)

deriving (Show)

buildOctTree :: (Show a) => Vector -> Double -> Double -> Double -> [(a,Vector)] -> (OctTree a) buildOctTree (Vec mx my mz) x_size y_size z_size values = foldl' (\t (v,pos) -> insertValue t v pos) initial values

where

initial = OctTree (Vec (mx+x) (my+y) (mz-z)) (Vec (mx-x) (my-y) (mz+z)) EmptyLeaf

x = x_size /2

y = y_size /2

z = z_size /2

insertValue :: (Show a) => (OctTree a) -> a -> Vector -> (OctTree a) insertValue (OctTree lnePos uswPos EmptyLeaf) value pos = OctTree lnePos uswPos (Leaf pos value) insertValue (OctTree lnePos@(Vec lne_x lne_y lne_z) uswPos@(Vec usw_x usw_y usw_z) (Leaf pos1 v1)) v2 pos2 = n3

where

n1 = OctTree lnePos uswPos (Node lne lse lsw lnw unw usw use une)

n2 = insertValue n1 v1 pos1

n3 = insertValue n2 v2 pos2

middle@(Vec mx my mz) = (Vec ((lne_x + usw_x)/2) ((lne_y + usw_y)/2) ((lne_z + usw_z)/2))

lne = OctTree lnePos middle EmptyLeaf

lse = OctTree (Vec lne_x my lne_z) (Vec mx usw_y mz) EmptyLeaf

lsw = OctTree (Vec mx my lne_z) (Vec usw_x usw_y mz) EmptyLeaf

lnw = OctTree (Vec mx lne_y lne_z) (Vec usw_x my mz) EmptyLeaf

unw = OctTree (Vec mx lne_y mz) (Vec usw_x my usw_z) EmptyLeaf

usw = OctTree middle uswPos EmptyLeaf

use = OctTree (Vec lne_x my mz) (Vec mx usw_y usw_z) EmptyLeaf

une = OctTree (Vec lne_x lne_y mz) (Vec mx my usw_z) EmptyLeaf

insertValue n@(OctTree lnePos uswPos (Node lne lse lsw lnw unw usw use une))

value pos = OctTree lnePos uswPos node

where

node =

case inQuadrant lne pos of

True -> (Node (insertValue lne value pos) lse lsw lnw unw usw use une)

False -> case inQuadrant lse pos of

True -> (Node lne (insertValue lse value pos) lsw lnw unw usw use une)

False -> case inQuadrant lsw pos of

True -> (Node lne lse (insertValue lsw value pos) lnw unw usw use une)

False -> case inQuadrant lnw pos of

True -> (Node lne lse lsw (insertValue lnw value pos) unw usw use une)

False -> case inQuadrant unw pos of

True -> (Node lne lse lsw lnw (insertValue unw value pos) usw use une)

False -> case inQuadrant usw pos of

True -> (Node lne lse lsw lnw unw (insertValue usw value pos) use une)

False -> case inQuadrant use pos of

True -> (Node lne lse lsw lnw unw usw (insertValue use value pos) une)

False -> case inQuadrant une pos of

True -> (Node lne lse lsw lnw unw usw use (insertValue une value pos))

False -> error $ "Value " ++ (show value)

+++ " at position " ++ (show pos) ++ " is not in node " ++ (show n)

inQuadrant :: (OctTree a) -> Vector -> Bool inQuadrant (OctTree (Vec lne_x lne_y lne_z) (Vec usw_x usw_y usw_z) _) (Vec x y z) =

(x > usw_x) && (y > usw_y) && (z < usw_z) && (x <= lne_x) && (y <= lne_y) && (z >= lne_z)

findInRadius :: OctTree a -> Vector -> Double -> [(a,Vector,Double)] findInRadius (OctTree _ _ EmptyLeaf) _ _ = [] findInRadius (OctTree _ _ (Leaf vPos value)) from radius =

case dist <= radius of

True -> [(value, vPos, dist)]

False -> []

where

(dist,_) = findDisplacement from vPos

findInRadius (OctTree _ _ (Node lne lse lsw lnw unw usw use une)) from@(Vec fx fy fz) radius =

concat result

where

children = filter findInRadius' [lne, lse, lsw, lnw, unw, usw, use, une]

result = map (\n -> findInRadius n from radius) children

findInRadius' OctTree a -\> Bool
findInRadius' (OctTree _ _ EmptyLeaf) = False
findInRadius' (OctTree (Vec lne_x lne_y lne_z) (Vec usw_x usw_y usw_z) _) =
((fx + radius) \> usw_x) && ((fx - radius) \<= lne_x) &&
((fy + radius) \> usw_y) && ((fy - radius) \<= lne_y) &&
((fz - radius) \< usw_z) && ((fz + radius) \>= lne_z)
Trac metadata
Trac field Value
Version 6.6
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component GHCi
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information