ADDED   doc/lpop.n
Index: doc/lpop.n
==================================================================
--- /dev/null
+++ doc/lpop.n
@@ -0,0 +1,96 @@
+'\"
+'\" Copyright (c) 2018 by Peter Spjuth.  All rights reserved.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH lpop n 8.7 Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+lpop \- Get and remove an element in a list
+.SH SYNOPSIS
+\fBlpop \fIvarName ?index ...?\fR
+.BE
+.SH DESCRIPTION
+.PP
+The \fBlpop\fR command accepts a parameter, \fIvarName\fR, which
+it interprets as the name of a variable containing a Tcl list.
+It also accepts one or more \fIindices\fR into
+the list. If no indices are presented, it defaults to "end".
+.PP
+When presented with a single index, the \fBlpop\fR command
+addresses the \fIindex\fR'th element in it, removes if from the list
+and returns the element.
+.PP
+If \fIindex\fR is negative or greater or equal than the number
+of elements in \fI$varName\fR, then an error occurs.
+.PP
+The interpretation of each simple \fIindex\fR value is the same as
+for the command \fBstring index\fR, supporting simple index
+arithmetic and indices relative to the end of the list.
+.PP
+If additional \fIindex\fR arguments are supplied, then each argument is
+used in turn to address an element within a sublist designated
+by the previous indexing operation,
+allowing the script to remove elements in sublists.
+The command,
+.PP
+.CS
+\fBlpop\fR a 1 2
+.CE
+.PP
+gets and removes element 2 of sublist 1.
+.PP
+.SH EXAMPLES
+.PP
+In each of these examples, the initial value of \fIx\fR is:
+.PP
+.CS
+set x [list [list a b c] [list d e f] [list g h i]]
+      \fI\(-> {a b c} {d e f} {g h i}\fR
+.CE
+.PP
+The indicated value becomes the new value of \fIx\fR
+(except in the last case, which is an error which leaves the value of
+\fIx\fR unchanged.)
+.PP
+.CS
+\fBlpop\fR x 0
+      \fI\(-> {d e f} {g h i}\fR
+\fBlpop\fR x 2
+      \fI\(-> {a b c} {d e f}\fR
+\fBlpop\fR x end
+      \fI\(-> {a b c} {d e f}\fR
+\fBlpop\fR x end-1
+      \fI\(-> {a b c} {g h i}\fR
+\fBlpop\fR x 2 1
+      \fI\(-> {a b c} {d e f} {g i}\fR
+\fBlpop\fR x 2 3 j
+      \fI\(-> list index out of range\fR
+.CE
+.PP
+In the following examples, the initial value of \fIx\fR is:
+.PP
+.CS
+set x [list [list [list a b] [list c d]] \e
+            [list [list e f] [list g h]]]
+      \fI\(-> {{a b} {c d}} {{e f} {g h}}\fR
+.CE
+.PP
+The indicated value becomes the new value of \fIx\fR.
+.PP
+.CS
+\fBlpop\fR x 1 1 0
+      \fI\(-> {{a b} {c d}} {{e f} h}\fR
+.CE
+.SH "SEE ALSO"
+list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
+lsort(n), lrange(n), lreplace(n), lset(n)
+string(n)
+.SH KEYWORDS
+element, index, list, remove, pop, stack, queue
+'\"Local Variables:
+'\"mode: nroff
+'\"End:

Index: generic/tclBasic.c
==================================================================
--- generic/tclBasic.c
+++ generic/tclBasic.c
@@ -258,10 +258,11 @@
     {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	CMD_IS_SAFE},
     {"linsert",		Tcl_LinsertObjCmd,	TclCompileLinsertCmd,	NULL,	CMD_IS_SAFE},
     {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
     {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	CMD_IS_SAFE},
     {"lmap",		Tcl_LmapObjCmd,		TclCompileLmapCmd,	TclNRLmapCmd,	CMD_IS_SAFE},
+    {"lpop",		Tcl_LpopObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
     {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	CMD_IS_SAFE},
     {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
     {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	CMD_IS_SAFE},
     {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
     {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	CMD_IS_SAFE},

Index: generic/tclCmdIL.c
==================================================================
--- generic/tclCmdIL.c
+++ generic/tclCmdIL.c
@@ -2563,10 +2563,100 @@
      * Set the interpreter's object result to an integer object holding the
      * length.
      */
 
     Tcl_SetObjResult(interp, Tcl_NewIntObj(listLen));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LpopObjCmd --
+ *
+ *	This procedure is invoked to process the "lpop" 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_LpopObjCmd(
+    ClientData notUsed,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    register Tcl_Obj *const objv[])
+				/* Argument objects. */
+{
+    int listLen, result;
+    Tcl_Obj *elemPtr;
+    Tcl_Obj *listPtr, **elemPtrs;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "listvar ?index?");
+	return TCL_ERROR;
+    }
+
+    listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
+    if (listPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    result = TclListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    /*
+     * First, extract the element to be returned.
+     * TclLindexFlat adds a ref count which is handled.
+     */
+    
+    if (objc == 2) {
+	elemPtr = elemPtrs[listLen - 1];
+	Tcl_IncrRefCount(elemPtr);
+    } else {
+	elemPtr = TclLindexFlat(interp, listPtr, objc-2, objv+2);
+
+	if (elemPtr == NULL) {
+	    return TCL_ERROR;
+	}
+    }
+    Tcl_SetObjResult(interp, elemPtr);
+    Tcl_DecrRefCount(elemPtr);
+
+    /*
+     * Second, remove the element.
+     */
+
+    if (objc == 2) {
+	if (Tcl_IsShared(listPtr)) {
+	    listPtr = TclListObjCopy(NULL, listPtr);
+	}
+	result = Tcl_ListObjReplace(interp, listPtr, listLen - 1, 1, 0, NULL);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    } else {
+	listPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);
+
+	if (listPtr == NULL) {
+	    return TCL_ERROR;
+	}
+    }
+    
+    listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG);
+    if (listPtr == NULL) {
+	return TCL_ERROR;
+    }
+
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------

Index: generic/tclInt.h
==================================================================
--- generic/tclInt.h
+++ generic/tclInt.h
@@ -3449,10 +3449,13 @@
 MODULE_SCOPE int	Tcl_LmapObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
 MODULE_SCOPE int	Tcl_LoadObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_LpopObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
 MODULE_SCOPE int	Tcl_LrangeObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
 MODULE_SCOPE int	Tcl_LrepeatObjCmd(ClientData clientData,

Index: generic/tclListObj.c
==================================================================
--- generic/tclListObj.c
+++ generic/tclListObj.c
@@ -1354,10 +1354,11 @@
  *
  * TclLsetList --
  *
  *	Core of the 'lset' command when objc == 4. Objv[2] may be either a
  *	scalar index or a list of indices.
+ *      It also handles 'lpop' when given a NULL value.
  *
  * Results:
  *	Returns the new value of the list variable, or NULL if there was an
  *	error. The returned object includes one reference count for the
  *	pointer returned.
@@ -1378,11 +1379,11 @@
 Tcl_Obj *
 TclLsetList(
     Tcl_Interp *interp,		/* Tcl interpreter. */
     Tcl_Obj *listPtr,		/* Pointer to the list being modified. */
     Tcl_Obj *indexArgPtr,	/* Index or index-list arg to 'lset'. */
-    Tcl_Obj *valuePtr)		/* Value arg to 'lset'. */
+    Tcl_Obj *valuePtr)		/* Value arg to 'lset' or NULL to 'lpop'. */
 {
     int indexCount = 0;		/* Number of indices in the index list. */
     Tcl_Obj **indices = NULL;	/* Vector of indices in the index list. */
     Tcl_Obj *retValuePtr;	/* Pointer to the list to be returned. */
     int index;			/* Current index in the list - discarded. */
@@ -1429,10 +1430,11 @@
  *----------------------------------------------------------------------
  *
  * TclLsetFlat --
  *
  *	Core engine of the 'lset' command.
+ *      It also handles 'lpop' when given a NULL value.
  *
  * Results:
  *	Returns the new value of the list variable, or NULL if an error
  *	occurred. The returned object includes one reference count for the
  *	pointer returned.
@@ -1473,22 +1475,25 @@
     Tcl_Interp *interp,		/* Tcl interpreter. */
     Tcl_Obj *listPtr,		/* Pointer to the list being modified. */
     int indexCount,		/* Number of index args. */
     Tcl_Obj *const indexArray[],
 				/* Index args. */
-    Tcl_Obj *valuePtr)		/* Value arg to 'lset'. */
+    Tcl_Obj *valuePtr)		/* Value arg to 'lset' or NULL to 'lpop'. */
 {
     int index, result, len;
     Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;
 
     /*
      * If there are no indices, simply return the new value.  (Without
      * indices, [lset] is a synonym for [set].
+     * [lpop] does not use this but protect for NULL valuePtr just in case.
      */
 
     if (indexCount == 0) {
-	Tcl_IncrRefCount(valuePtr);
+	if (valuePtr != NULL) {
+	    Tcl_IncrRefCount(valuePtr);
+	}
 	return valuePtr;
     }
 
     /*
      * If the list is shared, make a copy we can modify (copy-on-write).  We
@@ -1544,16 +1549,18 @@
 	    indexArray++;
 	    break;
 	}
 	indexArray++;
 
-	if (index < 0 || index > elemCount) {
+	if (index < 0 || index > elemCount
+		|| (valuePtr == NULL && index >= elemCount)) {
 	    /* ...the index points outside the sublist. */
 	    if (interp != NULL) {
 		Tcl_SetObjResult(interp,
 			Tcl_NewStringObj("list index out of range", -1));
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET",
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+			valuePtr == NULL ? "LPOP" : "LSET",
 			"BADINDEX", NULL);
 	    }
 	    result = TCL_ERROR;
 	    break;
 	}
@@ -1659,11 +1666,13 @@
      * proper list - or something convertible to one - above).
      */
 
     len = -1;
     TclListObjLength(NULL, subListPtr, &len);
-    if (index == len) {
+    if (valuePtr == NULL) {
+	Tcl_ListObjReplace(NULL, subListPtr, index, 1, 0, NULL);
+    } else if (index == len) {
 	Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);
     } else {
 	TclListObjSetElement(NULL, subListPtr, index, valuePtr);
     }
     TclInvalidateStringRep(subListPtr);

ADDED   tests/lpop.test
Index: tests/lpop.test
==================================================================
--- /dev/null
+++ tests/lpop.test
@@ -0,0 +1,140 @@
+# Commands covered:  lpop
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest
+    namespace import -force ::tcltest::*
+}
+
+test lpop-1.1 {error conditions} -returnCodes error -body {
+    lpop no
+} -result {can't read "no": no such variable}
+test lpop-1.2 {error conditions} -returnCodes error -body {
+    lpop no 0
+} -result {can't read "no": no such variable}
+test lpop-1.3 {error conditions} -returnCodes error -body {
+    set no "x {}x"
+    lpop no
+} -result {list element in braces followed by "x" instead of space}
+test lpop-1.4 {error conditions} -returnCodes error -body {
+    set no "x y"
+    lpop no -1
+} -result {list index out of range}
+test lpop-1.5 {error conditions} -returnCodes error -body {
+    set no "x y z"
+    lpop no 3
+} -result {list index out of range} ;#-errorCode {TCL OPERATION LPOP BADINDEX}
+test lpop-1.6 {error conditions} -returnCodes error -body {
+    set no "x y"
+    lpop no end+1
+} -result {list index out of range}
+test lpop-1.7 {error conditions} -returnCodes error -body {
+    set no "x y"
+    lpop no {}
+} -match glob -result {bad index *}
+test lpop-1.8 {error conditions} -returnCodes error -body {
+    set no "x y"
+    lpop no 0 0 0 0 1
+} -result {list index out of range}
+test lpop-1.9 {error conditions} -returnCodes error -body {
+    set no "x y"
+    lpop no {1 0}
+} -match glob -result {bad index *}
+
+test lpop-2.1 {basic functionality} -body {
+    set l "x y z"
+    list [lpop l 0] $l
+} -result {x {y z}}
+test lpop-2.2 {basic functionality} -body {
+    set l "x y z"
+    list [lpop l 1] $l
+} -result {y {x z}}
+test lpop-2.3 {basic functionality} -body {
+    set l "x y z"
+    list [lpop l] $l
+} -result {z {x y}}
+test lpop-2.4 {basic functionality} -body {
+    set l "x y z"
+    set l2 $l
+    list [lpop l] $l $l2
+} -result {z {x y} {x y z}}
+
+test lpop-3.1 {nested} -body {
+    set l "x y"
+    set l2 $l
+    list [lpop l 0 0 0 0] $l $l2
+} -result {x {{{{}}} y} {x y}}
+test lpop-3.2 {nested} -body {
+    set l "{x y} {a b}"
+    list [lpop l 0 1] $l
+} -result {y {x {a b}}}
+test lpop-3.3 {nested} -body {
+    set l "{x y} {a b}"
+    list [lpop l 1 0] $l
+} -result {a {{x y} b}}
+
+
+
+
+
+test lpop-99.1 {performance} -constraints perf -body {
+    set l [lrepeat 10000 x]
+    set l2 $l
+    set t1 [time {
+        while {[llength $l] >= 2} {
+            lpop l end
+        }
+    }]
+    set l [lrepeat 30000 x]
+    set l2 $l
+    set t2 [time {
+        while {[llength $l] >= 2} {
+            lpop l end
+        }
+    }]
+    regexp {\d+} $t1 ms1
+    regexp {\d+} $t2 ms2
+    set ratio [expr {double($ms2)/$ms1}]
+    # Deleting from end should have linear performance
+    expr {$ratio > 4 ? $ratio : 4}
+} -result {4}
+
+test lpop-99.2 {performance} -constraints perf -body {
+    set l [lrepeat 10000 x]
+    set l2 $l
+    set t1 [time {
+        while {[llength $l] >= 2} {
+            lpop l 1
+        }
+    }]
+    set l [lrepeat 30000 x]
+    set l2 $l
+    set t2 [time {
+        while {[llength $l] >= 2} {
+            lpop l 1
+        }
+    }]
+    regexp {\d+} $t1 ms1
+    regexp {\d+} $t2 ms2
+    set ratio [expr {double($ms2)/$ms1}]
+    expr {$ratio > 10 ? $ratio : 10}
+} -result {10}
+
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End: