lib/cml/core-cml/trans-id.sml

   1 (* trans-id.sml
   2  * 2004 Matthew Fluet (mfluet@acm.org)
   3  *  Ported to MLton threads.
   4  *)
   5
   6 (* ???
   7  *
   8  * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
   9  * COPYRIGHT (c) 1989-1991 John H. Reppy
  10  *)
  11
  12 structure TransID : TRANS_ID =
  13    struct
  14       structure Assert = LocalAssert(val assert = false)
  15
  16       structure R = RepTypes
  17
  18
  19       (* Transaction IDs are used to mark blocked threads in the various waiting
  20        * queues.  They are "cancelled" when some other event is selected.
  21        *)
  22       datatype trans_id = datatype R.trans_id
  23       datatype trans_id_state = datatype R.trans_id_state
  24
  25       (* create a new transaction ID. *)
  26       fun mkTxId () = TXID(ref TRANS)
  27
  28       (* create a transaction flag (ID and cleanUp). *)
  29       fun mkFlg () =
  30          let
  31             val txid as TXID txst = mkTxId ()
  32             val cleanUp = fn () =>
  33                (Assert.assertAtomic' ("TransID.mkFlg.cleanUp", NONE)
  34                 ; txst := CANCEL)
  35          in
  36             (txid, cleanUp)
  37          end
  38
  39       (* given a transaction ID, mark it cancelled. *)
  40       fun force (TXID txst) =
  41          (Assert.assertAtomic' ("TransID.force", NONE)
  42           ; case !txst of
  43                TRANS => txst := CANCEL
  44              | CANCEL => raise Fail "TransID.force")
  45
  46       (*
  47       fun toString (TXID txst) =
  48          case !txst of
  49             TRANS => "TRANS"
  50           | CANCEL => "CANCEL"
  51       *)
  52    end