\ Software Stacks based on:
\ http://www.forth.org/svfig/Len/softstak.htm      

\ creates a unnamed lifo
: s-allot ( n -- ) ( -- adr)
	here cell+ , cells allot ;

\ creates a named lifo
: s-create ( n "name" -- ) ( -- adr)
	create s-allot does> ;

: s-push ( n lifo -- )
	swap over @ ! cell swap +! ;
: >s ( n lifo -- )
	s-push ;

: s-pop ( lifo -- x )
	cell negate over +! dup @ swap over >=
	abort" [pseudostack underflow] " @ ;
: s> ( lifo -- x )
	s-pop ;
: s-drop ( lifo -- )
	cell negate over +! dup @ >=
	abort" [pseudostack underflow] " ;
: 2s-drop ( lifo -- )
	dup s-drop s-drop ;

: s-pushAll { n lifo }
	n 0 u+do
		lifo s-push
	loop ;

: s-clear ( lifo -- )
	dup cell+ swap ! ;

: s-bounds ( lifo -- addr1 addr2 )
	dup @ swap cell+ ;

: s-depth ( lifo -- n )
	s-bounds - cell / ;

: s-empty ( lifo -- e )
	s-depth 0= ;

: s-head ( lifo -- x )
	@ cell - @ ;
: s-last ( lifo -- x )
	cell+ @ ;

: s-takeLeft ( n lifo -- x )
	@ swap 1+ cells - @ ;
: s-takeRight ( n lifo -- x )
	swap 1+ cells + @ ;

: s-all { lifo -- n... }
	lifo s-depth 0 u+do
		i lifo s-takeRight
	loop ;

\ executes xt on all elements of the lifo
: s-apply { lifo xt -- }
	lifo s-depth 0 u+do
		i lifo s-takeRight xt execute
	loop ;

\ executes all elements of a lifo
: s-exec ( lifo -- )
	['] execute s-apply ;

\ collects n xts in a new lifo
: bat ( xt... n -- addr )
	dup s-allot here over 1+ cells -
	swap 0 u+do swap over s-push loop ;

\ checks whether the given xt is a named word or an address
: word? ( xt -- n )
	>name 0> ;

\ executes the given xt or lifo
: ex ( xt|lifo )
	dup word? if execute else s-exec endif ;