Index: tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.301
diff -b -u -r1.301 tclBasic.c
--- tclBasic.c	8 Jun 2008 03:21:31 -0000	1.301
+++ tclBasic.c	13 Jun 2008 22:20:42 -0000
@@ -697,6 +697,13 @@
 
     Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble",
 	    Tcl_DisassembleObjCmd, NULL, NULL);
+
+    /*
+     * Create a command for creating Cons'es.
+     */
+
+    Tcl_CreateObjCommand(interp, "cons",
+			 Tcl_ConsObjCmd, NULL, NULL);
 
 #ifdef USE_DTRACE
     /*
Index: tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.370
diff -b -u -r1.370 tclInt.h
--- tclInt.h	6 Jun 2008 19:46:37 -0000	1.370
+++ tclInt.h	13 Jun 2008 22:20:59 -0000
@@ -2975,6 +2979,11 @@
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
 
+MODULE_SCOPE int	Tcl_ConsObjCmd(ClientData dummy,
+				       Tcl_Interp *interp,
+				       int objc,
+				       Tcl_Obj *const objv[]);
+
 /*
  *----------------------------------------------------------------
  * Compilation procedures for commands in the generic core:
Index: tclListObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclListObj.c,v
retrieving revision 1.50
diff -b -u -r1.50 tclListObj.c
--- tclListObj.c	27 Apr 2008 22:21:30 -0000	1.50
+++ tclListObj.c	13 Jun 2008 22:21:04 -0000
@@ -25,6 +25,9 @@
 static int		SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 static void		UpdateStringOfList(Tcl_Obj *listPtr);
 
+static void		FreeConsInternalRep(Tcl_Obj *listPtr);
+static void		UpdateStringOfCons(Tcl_Obj *listPtr);
+
 /*
  * The structure below defines the list Tcl object type by means of functions
  * that can be invoked by generic object code.
@@ -46,6 +49,14 @@
     SetListFromAny		/* setFromAnyProc */
 };
 
+Tcl_ObjType tclConsType = {
+    "cons",			/* name */
+    FreeConsInternalRep,	/* freeIntRepProc */
+    NULL,			/* dupIntRepProc */
+    UpdateStringOfCons,		/* updateStringProc */
+    NULL			/* setFromAnyProc */
+};
+
 /*
  *----------------------------------------------------------------------
  *
@@ -193,6 +204,57 @@
 }
 #endif /* if TCL_MEM_DEBUG */
 
+static Tcl_Obj *
+Tcl_NewConsObj(Tcl_Obj *a,Tcl_Obj *b)
+{
+    Tcl_Obj *consPtr;
+
+    TclNewObj(consPtr);
+    Tcl_InvalidateStringRep(consPtr);
+    consPtr->internalRep.twoPtrValue.ptr1 = a;
+    Tcl_IncrRefCount(a);
+    consPtr->internalRep.twoPtrValue.ptr2 = b;
+    Tcl_IncrRefCount(b);
+    consPtr->typePtr = &tclConsType;
+
+    return consPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConsObjCmd --
+ *
+ *	This procedure is invoked to process the "cons" Tcl command. See the
+ *	user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ConsObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument objects. */
+{
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "elem1 elem2");
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, Tcl_NewConsObj(objv[1],objv[2]));
+    return TCL_OK;
+}
+
+
+
 /*
  *----------------------------------------------------------------------
  *
@@ -425,6 +487,11 @@
 {
     register List *listRepPtr;
 
+    if (listPtr->typePtr == &tclConsType) {
+	*objcPtr = 2;
+	*objvPtr = (Tcl_Obj **)&listPtr->internalRep.twoPtrValue.ptr1;
+	return TCL_OK;
+    }
     if (listPtr->typePtr != &tclListType) {
 	int result, length;
 
@@ -654,6 +721,15 @@
 {
     register List *listRepPtr;
 
+    if (listPtr->typePtr == &tclConsType) {
+	if ((index < 0) || (index > 1)) {
+	    *objPtrPtr = NULL;
+	} else {
+	    *objPtrPtr = (Tcl_Obj *)(index ? listPtr->internalRep.twoPtrValue.ptr2 : listPtr->internalRep.twoPtrValue.ptr1 );
+	}
+	return TCL_OK;
+    }
+
     if (listPtr->typePtr != &tclListType) {
 	int result, length;
 
@@ -709,6 +785,10 @@
 {
     register List *listRepPtr;
 
+    if (listPtr->typePtr == &tclConsType) {
+	*intPtr = 2;
+	return TCL_OK;
+    }
     if (listPtr->typePtr != &tclListType) {
 	int result, length;
 
@@ -1593,6 +1673,32 @@
     listPtr->internalRep.twoPtrValue.ptr1 = NULL;
     listPtr->internalRep.twoPtrValue.ptr2 = NULL;
 }
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeConsInternalRep --
+ *
+ *	Decrements the refcounts of both cons elements.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets consPtr's internalRep.twoPtrValue.ptr1,2 to NULL.
+ *	Decrements the ref counts of both element objects, which may free them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeConsInternalRep(
+    Tcl_Obj *consPtr)		/* Cons object with members to unlink. */
+{
+    Tcl_DecrRefCount((Tcl_Obj *)consPtr->internalRep.twoPtrValue.ptr1);
+    Tcl_DecrRefCount((Tcl_Obj *)consPtr->internalRep.twoPtrValue.ptr2);
+    consPtr->internalRep.twoPtrValue.ptr1 = NULL;
+    consPtr->internalRep.twoPtrValue.ptr2 = NULL;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -1845,6 +1951,78 @@
 
     listRepPtr->canonicalFlag = 1;
 }
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfCons --
+ *
+ *	Update the string representation for a cons object. Note: This
+ *	function does not invalidate an existing old string rep so storage
+ *	will be lost if this has not already been done.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Just like UpdateStringOfList for a two-element list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfCons(
+    Tcl_Obj *consPtr)		/* Cons object with string rep to update. */
+{
+    int localFlags[2], *flagPtr;
+    register int i;
+    char *elem, *dst;
+    int length;
+
+    /*
+     * Convert each element of the cons to string form and then convert it to
+     * proper list/cons element form, adding it to the result buffer.
+     */
+
+    /*
+     * Pass 1: estimate space, gather flags.
+     */
+
+    flagPtr = localFlags;
+    consPtr->length = 1;
+    for (i = 0; i < 2; i++) {
+	elem = TclGetStringFromObj( (Tcl_Obj *)(i ? consPtr->internalRep.twoPtrValue.ptr2 : consPtr->internalRep.twoPtrValue.ptr1 ), &length);
+	consPtr->length += Tcl_ScanCountedElement(elem, length, flagPtr+i)+1;
+
+	/*
+	 * Check for continued sanity. [Bug 1267380]
+	 */
+
+	if (consPtr->length < 1) {
+	    Tcl_Panic("string representation size exceeds sane bounds");
+	}
+    }
+
+    /*
+     * Pass 2: copy into string rep buffer.
+     */
+
+    consPtr->bytes = ckalloc((unsigned) consPtr->length);
+    dst = consPtr->bytes;
+    for (i = 0; i < 2; i++) {
+	elem = TclGetStringFromObj((Tcl_Obj *)(i ? consPtr->internalRep.twoPtrValue.ptr2 : consPtr->internalRep.twoPtrValue.ptr1 ), &length);
+	dst += Tcl_ConvertCountedElement(elem, length, dst,
+		flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH));
+	*dst = ' ';
+	dst++;
+    }
+    if (dst == consPtr->bytes) {
+	*dst = 0;
+    } else {
+	dst--;
+	*dst = 0;
+    }
+    consPtr->length = dst - consPtr->bytes;
+}
 
 /*
  * Local Variables:
