1 \ *****************************************************************************
2 \ * Copyright (c) 2004, 2008 IBM Corporation
3 \ * All rights reserved.
4 \ * This program and the accompanying materials
5 \ * are made available under the terms of the BSD License
6 \ * which accompanies this distribution, and is available at
7 \ * http://www.opensource.org/licenses/bsd-license.php
10 \ * IBM Corporation - initial implementation
11 \ ****************************************************************************/
16 \ To get a 30 element stack, go:
18 \ 0 > 30 new-stack my-stack
25 : new-stack ( cells <>name -- )
26 create >r here ( here R: cells )
27 dup r@ 2 + cells ( here here bytes R: cells )
28 dup allot erase ( here R: cells)
29 cell+ r> ( here+1cell cells )
31 DOES> to current-stack
38 : stack-depth ( -- depth )
44 current-stack cell+ @ over <= ABORT" Stack overflow"
47 current-stack 2 cells + + !
51 current-stack @ 0= ABORT" Stack underflow"
53 current-stack + cell+ @