[project @ 2000-08-07 14:11:48 by sewardj]

Reorganise the way primops are done.  Most of the information about
primops, their types and relevant attributes is in prelude/primops.txt.
A supporting program in fptools/ghc/utils/genprimopcode reads this
file and generates various bits of code which are #include'd into
prelude/PrimOp.lhs.  Eventually this mechanism will be extended to
generate PrelGHC.hi and C code for primops in the bytecode evaluator.

Also, add a few primops for creating, reading and writing BCOs.

ghc/compiler/Makefile

 # -----------------------------------------------------------------------------
-# $Id: Makefile,v 1.85 2000/07/21 08:45:05 rrt Exp $
+# $Id: Makefile,v 1.86 2000/08/07 14:11:48 sewardj Exp $
 
 TOP = ..
 include $(TOP)/mk/boilerplate.mk
@@ -228,6 +228,38 @@ simplStg/UpdAnal_HC_OPTS	= -fno-strictness
 SRC_C_OPTS     += -O -I. -IcodeGen
 
 
+# ----------------------------------------------------------------------------
+#		Generate supporting stuff for prelude/PrimOp.lhs 
+#		from prelude/primops.txt
+
+GENPOC=$(TOP)/utils/genprimopcode/genprimopcode
+
+prelude/PrimOp.o : prelude/PrimOp.lhs prelude/primops.txt
+	$(RM) primop-data-decl.hs
+	$(RM) primop-tag
+	$(RM) primop-list
+	$(RM) primop-has-side-effects.hs
+	$(RM) primop-out-of-line.hs
+	$(RM) primop-commutable.hs
+	$(RM) primop-needs-wrapper.hs
+	$(RM) primop-can-fail.hs
+	$(RM) primop-strictness.hs
+	$(RM) primop-usage.hs
+	$(RM) primop-primop-info.hs
+	$(GENPOC) --data-decl          < prelude/primops.txt > primop-data-decl.hs
+	$(GENPOC) --primop-tag         < prelude/primops.txt > primop-tag.hs
+	$(GENPOC) --primop-list        < prelude/primops.txt > primop-list.hs
+	$(GENPOC) --has-side-effects   < prelude/primops.txt > primop-has-side-effects.hs
+	$(GENPOC) --out-of-line        < prelude/primops.txt > primop-out-of-line.hs
+	$(GENPOC) --commutable         < prelude/primops.txt > primop-commutable.hs
+	$(GENPOC) --needs-wrapper      < prelude/primops.txt > primop-needs-wrapper.hs
+	$(GENPOC) --can-fail           < prelude/primops.txt > primop-can-fail.hs
+	$(GENPOC) --strictness         < prelude/primops.txt > primop-strictness.hs
+	$(GENPOC) --usage              < prelude/primops.txt > primop-usage.hs
+	$(GENPOC) --primop-primop-info < prelude/primops.txt > primop-primop-info.hs
+	$(RM) $@
+	$(HC) -c -o $@ $(HC_OPTS) prelude/PrimOp.lhs
+
 # ----------------------------------------------------------------------------
 #		Parsers/lexers
 

ghc/compiler/basicTypes/Unique.lhs

@@ -50,6 +50,7 @@ module Unique (
 	arrayPrimTyConKey,
 	assertIdKey,
 	augmentIdKey,
+	bcoPrimTyConKey,
 	bindIOIdKey,
 	boolTyConKey,
 	boundedClassKey,
@@ -567,6 +568,7 @@ kindConKey				= mkPreludeTyConUnique 67
 boxityConKey				= mkPreludeTyConUnique 68
 typeConKey				= mkPreludeTyConUnique 69
 threadIdPrimTyConKey			= mkPreludeTyConUnique 70
+bcoPrimTyConKey				= mkPreludeTyConUnique 71
 \end{code}
 
 %************************************************************************

ghc/compiler/nativeGen/MachMisc.lhs

@@ -284,6 +284,7 @@ primRepToSize ArrayRep	    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc(
 primRepToSize ByteArrayRep  = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
 primRepToSize WeakPtrRep    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
 primRepToSize ForeignObjRep = IF_ARCH_alpha( Q,  IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
+primRepToSize BCORep        = IF_ARCH_alpha( Q,  IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
 primRepToSize StablePtrRep  = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
 primRepToSize ThreadIdRep   = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
 -- SUP: Wrong!!! Only for testing the rest of the NCG

ghc/compiler/nativeGen/StixPrim.lhs

@@ -170,62 +170,6 @@ primCode [] WriteArrayOp [obj, ix, v]
     in
     returnUs (\xs -> assign : xs)
 
-primCode lhs@[_] (IndexByteArrayOp pk) args
-  = primCode lhs (ReadByteArrayOp pk) args
-
--- NB: indexing in "pk" units, *not* in bytes (WDP 95/09)
-
-primCode [lhs] (ReadByteArrayOp pk) [obj, ix]
-  = let
-	lhs' = amodeToStix lhs
-    	obj' = amodeToStix obj
-    	ix' = amodeToStix ix
-    	base = StIndex IntRep obj' arrWordsHS
-    	assign = StAssign pk lhs' (StInd pk (StIndex pk base ix'))
-    in
-    returnUs (\xs -> assign : xs)
-
-primCode lhs@[_] (ReadOffAddrOp pk) args
-  = primCode lhs (IndexOffAddrOp pk) args
-
-primCode [lhs] (IndexOffAddrOp pk) [obj, ix]
-  = let
-	lhs' = amodeToStix lhs
-    	obj' = amodeToStix obj
-    	ix' = amodeToStix ix
-    	assign = StAssign pk lhs' (StInd pk (StIndex pk obj' ix'))
-    in
-    returnUs (\xs -> assign : xs)
-
-primCode [lhs] (IndexOffForeignObjOp pk) [obj, ix]
-  = let
-	lhs' = amodeToStix lhs
-    	obj' = amodeToStix obj
-    	ix' = amodeToStix ix
-	obj'' = StIndex AddrRep obj' fixedHS
-    	assign = StAssign pk lhs' (StInd pk (StIndex pk obj'' ix'))
-    in
-    returnUs (\xs -> assign : xs)
-
-primCode [] (WriteOffAddrOp pk) [obj, ix, v]
-  = let
-	obj' = amodeToStix obj
-    	ix' = amodeToStix ix
-    	v' = amodeToStix v
-    	assign = StAssign pk (StInd pk (StIndex pk obj' ix')) v'
-    in
-    returnUs (\xs -> assign : xs)
-
-primCode [] (WriteByteArrayOp pk) [obj, ix, v]
-  = let
-	obj' = amodeToStix obj
-    	ix' = amodeToStix ix
-    	v' = amodeToStix v
-    	base = StIndex IntRep obj' arrWordsHS
-    	assign = StAssign pk (StInd pk (StIndex pk base ix')) v'
-    in
-    returnUs (\xs -> assign : xs)
-
 primCode [] WriteForeignObjOp [obj, v]
   = let
     	obj' = amodeToStix obj
@@ -234,6 +178,78 @@ primCode [] WriteForeignObjOp [obj, v]
     	assign = StAssign AddrRep (StInd AddrRep obj'') v'
     in
     returnUs (\xs -> assign : xs)
+
+-- NB: indexing in "pk" units, *not* in bytes (WDP 95/09)
+primCode ls IndexByteArrayOp_Char      rs = primCode_ReadByteArrayOp CharRep      ls rs
+primCode ls IndexByteArrayOp_Int       rs = primCode_ReadByteArrayOp IntRep       ls rs
+primCode ls IndexByteArrayOp_Word      rs = primCode_ReadByteArrayOp WordRep      ls rs
+primCode ls IndexByteArrayOp_Addr      rs = primCode_ReadByteArrayOp AddrRep      ls rs
+primCode ls IndexByteArrayOp_Float     rs = primCode_ReadByteArrayOp FloatRep     ls rs
+primCode ls IndexByteArrayOp_Double    rs = primCode_ReadByteArrayOp DoubleRep    ls rs
+primCode ls IndexByteArrayOp_StablePtr rs = primCode_ReadByteArrayOp StablePtrRep ls rs
+primCode ls IndexByteArrayOp_Int64     rs = primCode_ReadByteArrayOp Int64Rep     ls rs
+primCode ls IndexByteArrayOp_Word64    rs = primCode_ReadByteArrayOp Word64Rep    ls rs
+
+primCode ls ReadByteArrayOp_Char      rs = primCode_ReadByteArrayOp CharRep      ls rs
+primCode ls ReadByteArrayOp_Int       rs = primCode_ReadByteArrayOp IntRep       ls rs
+primCode ls ReadByteArrayOp_Word      rs = primCode_ReadByteArrayOp WordRep      ls rs
+primCode ls ReadByteArrayOp_Addr      rs = primCode_ReadByteArrayOp AddrRep      ls rs
+primCode ls ReadByteArrayOp_Float     rs = primCode_ReadByteArrayOp FloatRep     ls rs
+primCode ls ReadByteArrayOp_Double    rs = primCode_ReadByteArrayOp DoubleRep    ls rs
+primCode ls ReadByteArrayOp_StablePtr rs = primCode_ReadByteArrayOp StablePtrRep ls rs
+primCode ls ReadByteArrayOp_Int64     rs = primCode_ReadByteArrayOp Int64Rep     ls rs
+primCode ls ReadByteArrayOp_Word64    rs = primCode_ReadByteArrayOp Word64Rep    ls rs
+
+primCode ls ReadOffAddrOp_Char      rs = primCode_IndexOffAddrOp CharRep      ls rs
+primCode ls ReadOffAddrOp_Int       rs = primCode_IndexOffAddrOp IntRep       ls rs
+primCode ls ReadOffAddrOp_Word      rs = primCode_IndexOffAddrOp WordRep      ls rs
+primCode ls ReadOffAddrOp_Addr      rs = primCode_IndexOffAddrOp AddrRep      ls rs
+primCode ls ReadOffAddrOp_Float     rs = primCode_IndexOffAddrOp FloatRep     ls rs
+primCode ls ReadOffAddrOp_Double    rs = primCode_IndexOffAddrOp DoubleRep    ls rs
+primCode ls ReadOffAddrOp_StablePtr rs = primCode_IndexOffAddrOp StablePtrRep ls rs
+primCode ls ReadOffAddrOp_Int64     rs = primCode_IndexOffAddrOp Int64Rep     ls rs
+primCode ls ReadOffAddrOp_Word64    rs = primCode_IndexOffAddrOp Word64Rep    ls rs
+
+primCode ls IndexOffAddrOp_Char      rs = primCode_IndexOffAddrOp CharRep      ls rs
+primCode ls IndexOffAddrOp_Int       rs = primCode_IndexOffAddrOp IntRep       ls rs
+primCode ls IndexOffAddrOp_Word      rs = primCode_IndexOffAddrOp WordRep      ls rs
+primCode ls IndexOffAddrOp_Addr      rs = primCode_IndexOffAddrOp AddrRep      ls rs
+primCode ls IndexOffAddrOp_Float     rs = primCode_IndexOffAddrOp FloatRep     ls rs
+primCode ls IndexOffAddrOp_Double    rs = primCode_IndexOffAddrOp DoubleRep    ls rs
+primCode ls IndexOffAddrOp_StablePtr rs = primCode_IndexOffAddrOp StablePtrRep ls rs
+primCode ls IndexOffAddrOp_Int64     rs = primCode_IndexOffAddrOp Int64Rep     ls rs
+primCode ls IndexOffAddrOp_Word64    rs = primCode_IndexOffAddrOp Word64Rep    ls rs
+
+primCode ls IndexOffForeignObjOp_Char      rs = primCode_IndexOffForeignObjOp CharRep      ls rs
+primCode ls IndexOffForeignObjOp_Int       rs = primCode_IndexOffForeignObjOp IntRep       ls rs
+primCode ls IndexOffForeignObjOp_Word      rs = primCode_IndexOffForeignObjOp WordRep      ls rs
+primCode ls IndexOffForeignObjOp_Addr      rs = primCode_IndexOffForeignObjOp AddrRep      ls rs
+primCode ls IndexOffForeignObjOp_Float     rs = primCode_IndexOffForeignObjOp FloatRep     ls rs
+primCode ls IndexOffForeignObjOp_Double    rs = primCode_IndexOffForeignObjOp DoubleRep    ls rs
+primCode ls IndexOffForeignObjOp_StablePtr rs = primCode_IndexOffForeignObjOp StablePtrRep ls rs
+primCode ls IndexOffForeignObjOp_Int64     rs = primCode_IndexOffForeignObjOp Int64Rep     ls rs
+primCode ls IndexOffForeignObjOp_Word64    rs = primCode_IndexOffForeignObjOp Word64Rep    ls rs
+
+primCode ls WriteOffAddrOp_Char      rs = primCode_WriteOffAddrOp CharRep      ls rs
+primCode ls WriteOffAddrOp_Int       rs = primCode_WriteOffAddrOp IntRep       ls rs
+primCode ls WriteOffAddrOp_Word      rs = primCode_WriteOffAddrOp WordRep      ls rs
+primCode ls WriteOffAddrOp_Addr      rs = primCode_WriteOffAddrOp AddrRep      ls rs
+primCode ls WriteOffAddrOp_Float     rs = primCode_WriteOffAddrOp FloatRep     ls rs
+primCode ls WriteOffAddrOp_Double    rs = primCode_WriteOffAddrOp DoubleRep    ls rs
+primCode ls WriteOffAddrOp_StablePtr rs = primCode_WriteOffAddrOp StablePtrRep ls rs
+primCode ls WriteOffAddrOp_Int64     rs = primCode_WriteOffAddrOp Int64Rep     ls rs
+primCode ls WriteOffAddrOp_Word64    rs = primCode_WriteOffAddrOp Word64Rep    ls rs
+
+primCode ls WriteByteArrayOp_Char      rs = primCode_WriteByteArrayOp CharRep      ls rs
+primCode ls WriteByteArrayOp_Int       rs = primCode_WriteByteArrayOp IntRep       ls rs
+primCode ls WriteByteArrayOp_Word      rs = primCode_WriteByteArrayOp WordRep      ls rs
+primCode ls WriteByteArrayOp_Addr      rs = primCode_WriteByteArrayOp AddrRep      ls rs
+primCode ls WriteByteArrayOp_Float     rs = primCode_WriteByteArrayOp FloatRep     ls rs
+primCode ls WriteByteArrayOp_Double    rs = primCode_WriteByteArrayOp DoubleRep    ls rs
+primCode ls WriteByteArrayOp_StablePtr rs = primCode_WriteByteArrayOp StablePtrRep ls rs
+primCode ls WriteByteArrayOp_Int64     rs = primCode_WriteByteArrayOp Int64Rep     ls rs
+primCode ls WriteByteArrayOp_Word64    rs = primCode_WriteByteArrayOp Word64Rep    ls rs
+
 \end{code}
 
 ToDo: saving/restoring of volatile regs around ccalls.
@@ -331,6 +347,63 @@ primCode lhs op rhs
     returnUs (\ xs -> simplePrim pk lhs' op rhs' : xs)
 \end{code}
 
+Helper fns for some array ops.
+
+\begin{code}
+primCode_ReadByteArrayOp pk [lhs] [obj, ix]
+  = let
+	lhs' = amodeToStix lhs
+    	obj' = amodeToStix obj
+    	ix' = amodeToStix ix
+    	base = StIndex IntRep obj' arrWordsHS
+    	assign = StAssign pk lhs' (StInd pk (StIndex pk base ix'))
+    in
+    returnUs (\xs -> assign : xs)
+
+
+primCode_IndexOffAddrOp pk [lhs] [obj, ix]
+  = let
+	lhs' = amodeToStix lhs
+    	obj' = amodeToStix obj
+    	ix' = amodeToStix ix
+    	assign = StAssign pk lhs' (StInd pk (StIndex pk obj' ix'))
+    in
+    returnUs (\xs -> assign : xs)
+
+
+primCode_IndexOffForeignObjOp pk [lhs] [obj, ix]
+  = let
+	lhs' = amodeToStix lhs
+    	obj' = amodeToStix obj
+    	ix' = amodeToStix ix
+	obj'' = StIndex AddrRep obj' fixedHS
+    	assign = StAssign pk lhs' (StInd pk (StIndex pk obj'' ix'))
+    in
+    returnUs (\xs -> assign : xs)
+
+
+primCode_WriteOffAddrOp pk [] [obj, ix, v]
+  = let
+	obj' = amodeToStix obj
+    	ix' = amodeToStix ix
+    	v' = amodeToStix v
+    	assign = StAssign pk (StInd pk (StIndex pk obj' ix')) v'
+    in
+    returnUs (\xs -> assign : xs)
+
+
+primCode_WriteByteArrayOp pk [] [obj, ix, v]
+  = let
+	obj' = amodeToStix obj
+    	ix' = amodeToStix ix
+    	v' = amodeToStix v
+    	base = StIndex IntRep obj' arrWordsHS
+    	assign = StAssign pk (StInd pk (StIndex pk base ix')) v'
+    in
+    returnUs (\xs -> assign : xs)
+
+\end{code}
+
 \begin{code}
 simpleCoercion
       :: PrimRep

ghc/compiler/prelude/PrelInfo.lhs

@@ -157,6 +157,7 @@ prim_tycons
     , intPrimTyCon
     , int64PrimTyCon
     , foreignObjPrimTyCon
+    , bcoPrimTyCon
     , weakPrimTyCon
     , mutableArrayPrimTyCon
     , mutableByteArrayPrimTyCon
@@ -211,6 +212,7 @@ knownKeyNames
     , (byteArrayTyCon_RDR, 	byteArrayTyConKey)
     , (mutableByteArrayTyCon_RDR, mutableByteArrayTyConKey)
     , (foreignObjTyCon_RDR, 	foreignObjTyConKey)
+    , (bcoPrimTyCon_RDR, 	bcoPrimTyConKey)
     , (stablePtrTyCon_RDR, 	stablePtrTyConKey)
     , (stablePtrDataCon_RDR,    stablePtrDataConKey)
 

ghc/compiler/prelude/PrelNames.lhs

@@ -42,6 +42,7 @@ module PrelNames
 
 	orderingTyCon_RDR, rationalTyCon_RDR, ratioTyCon_RDR, byteArrayTyCon_RDR,
 	mutableByteArrayTyCon_RDR, foreignObjTyCon_RDR,
+        bcoPrimTyCon_RDR,
 	intTyCon_RDR, stablePtrTyCon_RDR, stablePtrDataCon_RDR, 
 	int8TyCon_RDR, int16TyCon_RDR, int32TyCon_RDR, int64TyCon_RDR,
 	word8TyCon_RDR, word16TyCon_RDR, word32TyCon_RDR, word64TyCon_RDR,
@@ -182,6 +183,7 @@ byteArrayTyCon_RDR		= tcQual pREL_BYTEARR_Name  SLIT("ByteArray")
 mutableByteArrayTyCon_RDR	= tcQual pREL_BYTEARR_Name  SLIT("MutableByteArray")
 
 foreignObjTyCon_RDR	= tcQual   pREL_IO_BASE_Name SLIT("ForeignObj")
+bcoPrimTyCon_RDR	= tcQual   pREL_BASE_Name SLIT("BCO#")
 stablePtrTyCon_RDR	= tcQual   pREL_STABLE_Name SLIT("StablePtr")
 stablePtrDataCon_RDR	= dataQual pREL_STABLE_Name SLIT("StablePtr")
 deRefStablePtr_RDR      = varQual  pREL_STABLE_Name SLIT("deRefStablePtr")

ghc/compiler/prelude/PrimRep.lhs

@@ -57,6 +57,7 @@ data PrimRep
 
   | WeakPtrRep
   | ForeignObjRep	
+  | BCORep
 
   | StablePtrRep	-- guaranteed to be represented by a pointer
 

ghc/compiler/prelude/TysPrim.lhs

@@ -10,7 +10,7 @@ types and operations.''
 module TysPrim(
 	alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
 	alphaTy, betaTy, gammaTy, deltaTy,
-	openAlphaTyVar, openAlphaTyVars,
+	openAlphaTy, openAlphaTyVar, openAlphaTyVars,
 
 	charPrimTyCon, 		charPrimTy,
 	intPrimTyCon,		intPrimTy,
@@ -31,6 +31,7 @@ module TysPrim(
 	mVarPrimTyCon,			mkMVarPrimTy,	
 	stablePtrPrimTyCon,		mkStablePtrPrimTy,
 	stableNamePrimTyCon,		mkStableNamePrimTy,
+	bcoPrimTyCon,			bcoPrimTy,
 	weakPrimTyCon,  		mkWeakPrimTy,
 	foreignObjPrimTyCon,		foreignObjPrimTy,
 	threadIdPrimTyCon,		threadIdPrimTy,
@@ -50,7 +51,7 @@ import Name		( mkWiredInTyConName )
 import PrimRep		( PrimRep(..), isFollowableRep )
 import TyCon		( mkPrimTyCon, TyCon, ArgVrcs )
 import Type		( Type, 
-			  mkTyConApp, mkTyConTy, mkTyVarTys,
+			  mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
 			  unboxedTypeKind, boxedTypeKind, openTypeKind, mkArrowKinds
 			)
 import PrelNames	( pREL_GHC )
@@ -81,6 +82,8 @@ openAlphaTyVars :: [TyVar]
 openAlphaTyVars = [ mkSysTyVar u openTypeKind
 		  | u <- map mkAlphaTyVarUnique [2..] ]
 
+openAlphaTy = mkTyVarTy openAlphaTyVar
+
 vrcPos,vrcZero :: (Bool,Bool)
 vrcPos  = (True,False)
 vrcZero = (False,False)
@@ -266,6 +269,17 @@ foreignObjPrimTy    = mkTyConTy foreignObjPrimTyCon
 foreignObjPrimTyCon = pcPrimTyCon foreignObjPrimTyConKey SLIT("ForeignObj#") 0 [] ForeignObjRep
 \end{code}
   
+%************************************************************************
+%*									*
+\subsection[TysPrim-BCOs]{The ``bytecode object'' type}
+%*									*
+%************************************************************************
+
+\begin{code}
+bcoPrimTy    = mkTyConTy bcoPrimTyCon
+bcoPrimTyCon = pcPrimTyCon bcoPrimTyConKey SLIT("BCO#") 0 [] BCORep
+\end{code}
+  
 %************************************************************************
 %*									*
 \subsection[TysPrim-Weak]{The ``weak pointer'' type}