[project @ 2003-06-19 10:42:24 by simonmar]
[ghc-hetmet.git] / ghc / compiler / prelude / primops.txt.pp
index 8d12268..37c6c6f 100644 (file)
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------
--- $Id: primops.txt.pp,v 1.11 2001/12/07 11:34:48 sewardj Exp $
+-- $Id: primops.txt.pp,v 1.27 2003/06/19 10:42:26 simonmar Exp $
 --
 -- Primitive Operations
 --
 --       strictness attributes, whether it is defined as a macro
 --       or as out-of-line code, etc.)
 --
---     - ghc/lib/std/PrelGHC.hi-boot, to declare the primop
---
 --     - if the primop is inline (i.e. a macro), then:
---             ghc/includes/PrimOps.h
---             ghc/compiler/nativeGen/StixPrim.lhs 
---              ghc/compiler/nativeGen/MachCode.lhs (if implementation is machine-dependent)
+--             ghc/compiler/AbsCUtils.lhs (dscCOpStmt)
+--               defines the translation of the primop into simpler
+--               abstract C operations.
 --             
 --     - or, for an out-of-line primop:
 --             ghc/includes/PrimOps.h (just add the declaration)
 --             ghc/rts/PrimOps.hc     (define it here)
+--             ghc/rts/Linker.c       (declare the symbol for GHCi)
 --
 --     - the User's Guide 
 --
@@ -57,7 +56,7 @@ defaults
    commutable       = False
    needs_wrapper    = False
    can_fail         = False
-   strictness       = { \ arity -> StrictnessInfo (replicate arity wwPrim) False }
+   strictness       = { \ arity -> mkStrictSig (mkTopDmdType (replicate arity lazyDmd) TopRes) }
    usage            = { nomangle other }
 
 -- Currently, documentation is produced using latex, so contents of
@@ -180,6 +179,31 @@ primop   IntSubOp    "-#"    Dyadic   Int# -> Int# -> Int#
 
 primop   IntMulOp    "*#" 
    Dyadic   Int# -> Int# -> Int#
+   {Low word of signed integer multiply.}
+   with commutable = True
+
+primop   IntMulMayOfloOp  "mulIntMayOflo#" 
+   Dyadic   Int# -> Int# -> Int#
+   {Return non-zero if there is any possibility that the upper word of a
+    signed integer multiply might contain useful information.  Return
+    zero only if you are completely sure that no overflow can occur.
+    On a 32-bit platform, the recommmended implementation is to do a 
+    32 x 32 -> 64 signed multiply, and subtract result[63:32] from
+    (result[31] >>signed 31).  If this is zero, meaning that the 
+    upper word is merely a sign extension of the lower one, no
+    overflow can occur.
+
+    On a 64-bit platform it is not always possible to 
+    acquire the top 64 bits of the result.  Therefore, a recommended 
+    implementation is to take the absolute value of both operands, and 
+    return 0 iff bits[63:31] of them are zero, since that means that their 
+    magnitudes fit within 31 bits, so the magnitude of the product must fit 
+    into 62 bits.
+
+    If in doubt, return non-zero, but do make an effort to create the
+    correct answer for small args, since otherwise the performance of
+    (*) :: Integer -> Integer -> Integer will be poor.
+   }
    with commutable = True
 
 primop   IntQuotOp    "quotInt#"    Dyadic
@@ -197,11 +221,12 @@ primop   IntGcdOp    "gcdInt#"    Dyadic   Int# -> Int# -> Int#
 
 primop   IntNegOp    "negateInt#"    Monadic   Int# -> Int#
 primop   IntAddCOp   "addIntC#"    GenPrimOp   Int# -> Int# -> (# Int#, Int# #)
-        {Add with carry.  First member of result is (wrapped) sum; second member is 0 iff no overflow occured.}
+        {Add with carry.  First member of result is (wrapped) sum; 
+          second member is 0 iff no overflow occured.}
 primop   IntSubCOp   "subIntC#"    GenPrimOp   Int# -> Int# -> (# Int#, Int# #)
-        {Subtract with carry.  First member of result is (wrapped) difference; second member is 0 iff no overflow occured.}
-primop   IntMulCOp   "mulIntC#"    GenPrimOp   Int# -> Int# -> (# Int#, Int# #)
-        {Multiply with carry.  First member of result is (wrapped) product; second member is 0 iff no overflow occured.}
+        {Subtract with carry.  First member of result is (wrapped) difference; 
+          second member is 0 iff no overflow occured.}
+
 primop   IntGtOp  ">#"   Compare   Int# -> Int# -> Bool
 primop   IntGeOp  ">=#"   Compare   Int# -> Int# -> Bool
 
@@ -227,14 +252,14 @@ primop   Int2IntegerOp    "int2Integer#"
    with out_of_line = True
 
 primop   ISllOp   "uncheckedIShiftL#" GenPrimOp  Int# -> Int# -> Int#
-        {Shift left.  Result undefined if shift amount equals 
-          or exceeds word size.} 
+        {Shift left.  Result undefined if shift amount is not
+          in the range 0 to word size - 1 inclusive.}
 primop   ISraOp   "uncheckedIShiftRA#" GenPrimOp Int# -> Int# -> Int#
-        {Shift right arithmetic.  Result undefined if shift amount equals 
-          or exceeds word size.} 
+        {Shift right arithmetic.  Result undefined if shift amount is not
+          in the range 0 to word size - 1 inclusive.}
 primop   ISrlOp   "uncheckedIShiftRL#" GenPrimOp Int# -> Int# -> Int#
-        {Shift right logical.  Result undefined if shift amount equals 
-          or exceeds word size.} 
+        {Shift right logical.  Result undefined if shift amount is not
+          in the range 0 to word size - 1 inclusive.}
 
 ------------------------------------------------------------------------
 section "Word#"
@@ -267,11 +292,11 @@ primop   XorOp   "xor#"   Dyadic   Word# -> Word# -> Word#
 primop   NotOp   "not#"   Monadic   Word# -> Word#
 
 primop   SllOp   "uncheckedShiftL#"   GenPrimOp   Word# -> Int# -> Word#
-        {Shift left logical.   Result undefined if shift amount equals 
-          or exceeds word size.}
+        {Shift left logical.   Result undefined if shift amount is not
+          in the range 0 to word size - 1 inclusive.}
 primop   SrlOp   "uncheckedShiftRL#"   GenPrimOp   Word# -> Int# -> Word#
-        {Shift right logical.   Result undefined if shift amount equals 
-          or exceeds word size.}
+        {Shift right logical.   Result undefined if shift  amount is not
+          in the range 0 to word size - 1 inclusive.}
 
 primop   Word2IntOp   "word2Int#"   GenPrimOp   Word# -> Int#
 
@@ -686,7 +711,6 @@ primop  NewArrayOp "newArray#" GenPrimOp
     in the specified state thread,
     with each element containing the specified initial value.}
    with
-   strictness  = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
    usage       = { mangle NewArrayOp [mkP, mkM, mkP] mkM }
    out_of_line = True
 
@@ -706,7 +730,6 @@ primop  WriteArrayOp "writeArray#" GenPrimOp
    {Write to specified index of mutable array.}
    with
    usage            = { mangle WriteArrayOp [mkM, mkP, mkM, mkP] mkR }
-   strictness       = { \ arity -> StrictnessInfo [wwPrim, wwPrim, wwLazy, wwPrim] False }
    has_side_effects = True
 
 primop  IndexArrayOp "indexArray#" GenPrimOp
@@ -1164,7 +1187,6 @@ primop TouchOp "touch#" GenPrimOp
    o -> State# RealWorld -> State# RealWorld
    with
    has_side_effects = True
-   strictness       = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
 
 primop EqForeignObj "eqForeignObj#" GenPrimOp
    ForeignObj# -> ForeignObj# -> Bool
@@ -1232,7 +1254,6 @@ primop  NewMutVarOp "newMutVar#" GenPrimOp
    {Create MutVar\# with specified initial value in specified state thread.}
    with
    usage       = { mangle NewMutVarOp [mkM, mkP] mkM }
-   strictness  = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
    out_of_line = True
 
 primop  ReadMutVarOp "readMutVar#" GenPrimOp
@@ -1245,7 +1266,6 @@ primop  WriteMutVarOp "writeMutVar#"  GenPrimOp
    MutVar# s a -> a -> State# s -> State# s
    {Write contents of MutVar\#.}
    with
-   strictness       = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
    usage            = { mangle WriteMutVarOp [mkM, mkM, mkP] mkR }
    has_side_effects = True
 
@@ -1254,6 +1274,18 @@ primop  SameMutVarOp "sameMutVar#" GenPrimOp
    with
    usage = { mangle SameMutVarOp [mkP, mkP] mkM }
 
+-- not really the right type, but we don't know about pairs here.  The
+-- correct type is
+--
+--   MutVar# s a -> (a -> (a,b)) -> State# s -> (# State# s, b #)
+--
+primop  AtomicModifyMutVarOp "atomicModifyMutVar#" GenPrimOp
+   MutVar# s a -> (a -> b) -> State# s -> (# State# s, c #)
+   with
+   usage = { mangle AtomicModifyMutVarOp [mkP, mkM, mkP] mkM }
+   has_side_effects = True
+   out_of_line = True
+
 ------------------------------------------------------------------------
 section "Exceptions"
 ------------------------------------------------------------------------
@@ -1264,7 +1296,6 @@ primop  CatchOp "catch#" GenPrimOp
        -> State# RealWorld
        -> (# State# RealWorld, a #)
    with
-   strictness = { \ arity -> StrictnessInfo [wwLazy, wwLazy, wwPrim] False }
        -- Catch is actually strict in its first argument
        -- but we don't want to tell the strictness
        -- analyser about that!
@@ -1276,23 +1307,30 @@ primop  CatchOp "catch#" GenPrimOp
 primop  RaiseOp "raise#" GenPrimOp
    a -> b
    with
-   strictness  = { \ arity -> StrictnessInfo [wwLazy] True }
-      -- NB: True => result is bottom
+   strictness  = { \ arity -> mkStrictSig (mkTopDmdType [lazyDmd] BotRes) }
+      -- NB: result is bottom
    usage       = { mangle RaiseOp [mkM] mkM }
    out_of_line = True
 
+-- raiseIO# needs to be a primop, because exceptions in the IO monad
+-- must be *precise* - we don't want the strictness analyser turning
+-- one kind of bottom into another, as it is allowed to do in pure code.
+
+primop  RaiseIOOp "raiseIO#" GenPrimOp
+   a -> State# RealWorld -> (# State# RealWorld, b #)
+   with
+   out_of_line = True
+
 primop  BlockAsyncExceptionsOp "blockAsyncExceptions#" GenPrimOp
         (State# RealWorld -> (# State# RealWorld, a #))
      -> (State# RealWorld -> (# State# RealWorld, a #))
    with
-   strictness  = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
    out_of_line = True
 
 primop  UnblockAsyncExceptionsOp "unblockAsyncExceptions#" GenPrimOp
         (State# RealWorld -> (# State# RealWorld, a #))
      -> (State# RealWorld -> (# State# RealWorld, a #))
    with
-   strictness  = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
    out_of_line = True
 
 ------------------------------------------------------------------------
@@ -1333,7 +1371,6 @@ primop  PutMVarOp "putMVar#" GenPrimOp
    {If mvar is full, block until it becomes empty.
    Then store value arg as its new contents.}
    with
-   strictness       = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
    usage            = { mangle PutMVarOp [mkM, mkM, mkP] mkR }
    has_side_effects = True
    out_of_line      = True
@@ -1343,7 +1380,6 @@ primop  TryPutMVarOp "tryPutMVar#" GenPrimOp
    {If mvar is full, immediately return with integer 0.
     Otherwise, store value arg as mvar's new contents, and return with integer 1.}
    with
-   strictness       = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
    usage            = { mangle TryPutMVarOp [mkM, mkM, mkP] mkR }
    has_side_effects = True
    out_of_line      = True
@@ -1388,6 +1424,24 @@ primop  WaitWriteOp "waitWrite#" GenPrimOp
    has_side_effects = True
    out_of_line      = True
 
+#ifdef mingw32_TARGET_OS
+primop  AsyncReadOp "asyncRead#" GenPrimOp
+   Int# -> Int# -> Int# -> Addr# -> State# RealWorld-> (# State# RealWorld, Int#, Int# #)
+   {Asynchronously read bytes from specified file descriptor.}
+   with
+   needs_wrapper    = True
+   has_side_effects = True
+   out_of_line      = True
+
+primop  AsyncWriteOp "asyncWrite#" GenPrimOp
+   Int# -> Int# -> Int# -> Addr# -> State# RealWorld-> (# State# RealWorld, Int#, Int# #)
+   {Asynchronously write bytes from specified file descriptor.}
+   with
+   needs_wrapper    = True
+   has_side_effects = True
+   out_of_line      = True
+#endif
+
 ------------------------------------------------------------------------
 section "Concurrency primitives"
        {(In a non-concurrent implementation, ThreadId\# can be as singleton
@@ -1399,7 +1453,12 @@ primop  ForkOp "fork#" GenPrimOp
    a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
    with
    usage            = { mangle ForkOp [mkO, mkP] mkR }
-   strictness       = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
+   has_side_effects = True
+   out_of_line      = True
+
+primop ForkProcessOp "forkProcess#" GenPrimOp
+   State# RealWorld -> (# State# RealWorld, Int#  #)
+   with
    has_side_effects = True
    out_of_line      = True
 
@@ -1421,6 +1480,12 @@ primop  MyThreadIdOp "myThreadId#" GenPrimOp
    with
    out_of_line = True
 
+primop LabelThreadOp "labelThread#" GenPrimOp
+   ThreadId# -> Addr# -> State# RealWorld -> State# RealWorld
+   with
+   has_side_effects = True
+   out_of_line      = True
+
 ------------------------------------------------------------------------
 section "Weak pointers"
 ------------------------------------------------------------------------
@@ -1430,7 +1495,6 @@ section "Weak pointers"
 primop  MkWeakOp "mkWeak#" GenPrimOp
    o -> b -> c -> State# RealWorld -> (# State# RealWorld, Weak# b #)
    with
-   strictness       = { \ arity -> StrictnessInfo [wwLazy, wwLazy, wwLazy, wwPrim] False }
    usage            = { mangle MkWeakOp [mkZ, mkM, mkM, mkP] mkM }
    has_side_effects = True
    out_of_line      = True
@@ -1444,7 +1508,7 @@ primop  DeRefWeakOp "deRefWeak#" GenPrimOp
 
 primop  FinalizeWeakOp "finalizeWeak#" GenPrimOp
    Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, 
-              (State# RealWorld -> (# State# RealWorld, Unit #)) #)
+              (State# RealWorld -> (# State# RealWorld, () #)) #)
    with
    usage            = { mangle FinalizeWeakOp [mkM, mkP] 
                                (mkR . (inUB FinalizeWeakOp 
@@ -1459,7 +1523,6 @@ section "Stable pointers and names"
 primop  MakeStablePtrOp "makeStablePtr#" GenPrimOp
    a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
    with
-   strictness       = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
    usage            = { mangle MakeStablePtrOp [mkM, mkP] mkM }
    has_side_effects = True
    out_of_line      = True
@@ -1482,7 +1545,6 @@ primop  MakeStableNameOp "makeStableName#" GenPrimOp
    a -> State# RealWorld -> (# State# RealWorld, StableName# a #)
    with
    usage            = { mangle MakeStableNameOp [mkZ, mkP] mkR }
-   strictness       = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
    needs_wrapper    = True
    has_side_effects = True
    out_of_line      = True
@@ -1498,22 +1560,23 @@ primop  StableNameToIntOp "stableNameToInt#" GenPrimOp
    usage = { mangle StableNameToIntOp [mkP] mkR }
 
 ------------------------------------------------------------------------
-section "Parallelism"
+section "Unsafe pointer equality"
+--  (#1 Bad Guy: Alistair Reid :)   
 ------------------------------------------------------------------------
 
-primop  SeqOp "seq#" GenPrimOp
-   a -> Int#
+primop  ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp
+   a -> a -> Int#
    with
-   usage            = { mangle  SeqOp [mkO] mkR }
-   strictness       = { \ arity -> StrictnessInfo [wwStrict] False }
-      -- Seq is strict in its argument; see notes in ConFold.lhs
-   has_side_effects = True
+   usage = { mangle ReallyUnsafePtrEqualityOp [mkZ, mkZ] mkR }
+
+------------------------------------------------------------------------
+section "Parallelism"
+------------------------------------------------------------------------
 
 primop  ParOp "par#" GenPrimOp
    a -> Int#
    with
    usage            = { mangle ParOp [mkO] mkR }
-   strictness       = { \ arity -> StrictnessInfo [wwLazy] False }
       -- Note that Par is lazy to avoid that the sparked thing
       -- gets evaluted strictly, which it should *not* be
    has_side_effects = True
@@ -1583,8 +1646,6 @@ section "Tag to enum stuff"
 
 primop  DataToTagOp "dataToTag#" GenPrimOp
    a -> Int#
-   with
-   strictness = { \ arity -> StrictnessInfo [wwLazy] False }
 
 primop  TagToEnumOp "tagToEnum#" GenPrimOp     
    Int# -> a
@@ -1600,19 +1661,19 @@ primop   AddrToHValueOp "addrToHValue#" GenPrimOp
    {Convert an Addr\# to a followable type.}
 
 primop   MkApUpd0_Op "mkApUpd0#" GenPrimOp
-   a -> (# a #)
+   BCO# -> (# a #)
    with
    out_of_line = True
 
 primop  NewBCOOp "newBCO#" GenPrimOp
-   ByteArr# -> ByteArr# -> Array# a -> ByteArr# -> State# s -> (# State# s, BCO# #)
+   ByteArr# -> ByteArr# -> Array# a -> ByteArr# -> Int# -> ByteArr# -> State# s -> (# State# s, BCO# #)
    with
    has_side_effects = True
    out_of_line      = True
 
 ------------------------------------------------------------------------
 section "Coercion" 
-       {{\tt unsafeCoerce# :: a -> b} is not a primop, but is defined in MkId.lhs.}
+       {{\tt unsafeCoerce\# :: a -> b} is not a primop, but is defined in MkId.lhs.}
 
 ------------------------------------------------------------------------