Commit 014a3451 authored by sewardj's avatar sewardj
Browse files

[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.
parent 803030e7
# -----------------------------------------------------------------------------
# $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
......
......@@ -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}
%************************************************************************
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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")
......
This diff is collapsed.
......@@ -57,6 +57,7 @@ data PrimRep
| WeakPtrRep
| ForeignObjRep
| BCORep
| StablePtrRep -- guaranteed to be represented by a pointer
......
......@@ -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}
......
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment