;
;  STACK.MAC - Stack Manipulation
;
;  SP@  SP!  RP@  RP!  >R  R>  R@  2>R  2R>  2R@  2DROP  DROP  DUP
;  ?DUP  SWAP  OVER  ROT  -ROT  ROLL  -ROLL  PICK  NIP  TUCK  ><
;  2DUP  2SWAP  2OVER  2ROT  DEPTH
;

;	SP@  ( -- addr )

	hdr	1,'SP@'
spat:	ld	hl,0
	add	hl,sp
	jp	hpush

;	SP!  ( addr -- )

	hdr	1,'SP!'
spsto:	pop	hl
	ld	sp,hl
	jp	next

;	RP@  ( -- addr )

	hdr	1,'RP@'
rpat:	ld	hl,(rpp)
	jp	hpush

;	RP!  ( addr -- )

	hdr	1,'RP!'
rpsto:	pop	hl
	ld	(rpp),hl
	jp	next

;	>R  ( x -- )

	hdr	1,'>R'
tor:	ld	hl,(rpp)
	pop	de
	dec	hl
	ld	(hl),d
	dec	hl
	ld	(hl),e
	ld	(rpp),hl
	jp	next

;	R>  ( -- x )

	hdr	1,'R>'
fromr:	ld	hl,(rpp)
	ld	e,(hl)
	inc	hl
	ld	d,(hl)
	inc	hl
	ld	(rpp),hl
	push	de
	jp	next

;	R@  ( -- x )

	hdr	1,'R@'
rat:	ld	hl,(rpp)
	jp	at1

;	2>R  ( x1 x2 -- )

	hdr	1,'2>R'
ttor:	ld	hl,(rpp)
	ld	de,-4
	add	hl,de
	ld	(rpp),hl
	jp	tstor1

;	2R>  ( -- x1 x2 )

	hdr	1,'2R>'
tfrom:	ld	hl,(rpp)
	push	hl
	ld	de,4
	add	hl,de
	ld	(rpp),hl
	jp	tat

;	2R@  ( -- x1 x2 )

	hdr	1,'2R@'
trat:	ld	hl,(rpp)
	jp	tat1

;	2DROP  ( xd -- )

	hdr	1,'2DROP'
tdrop:	pop	hl
;	jp	next

;	DROP  ( x -- )

	hdr	1,'DROP'
drop:	pop	hl
	jp	next

;	DUP  ( x -- x x )

	hdr	1,'DUP'
dupp:	pop	hl
	push	hl
	jp	hpush

;	?DUP  ( x -- 0 | x x )

	hdr	1,'?DUP'
qdup:	pop	hl
	ld	a,l
	or	h
	jp	z,hpush
	push	hl
	jp	hpush

;	SWAP  ( x1 x2 -- x2 x1 )

	hdr	1,'SWAP'
swap:	pop	hl
	ex	(sp),hl
	jp	hpush

;	OVER  ( x1 x2 -- x1 x2 x1 )

	hdr	1,'OVER'
over:	pop	de
	pop	hl
	push	hl
	jp	dpush

;	ROT  ( x1 x2 x3 -- x2 x3 x1 )

	hdr	1,'ROT'
rot:	pop	de
	pop	hl
	ex	(sp),hl
	jp	dpush

;	-ROT  ( x1 x2 x3 -- x3 x1 x2 )

	hdr	1,'-ROT'
drot:	pop	hl
	pop	de
	ex	(sp),hl
	ex	de,hl
	jp	dpush

;	ROLL  ( xu xn .. x0 u -- xn .. x0 xu )

	hdr	1,'ROLL'
roll:	pop	hl
	add	hl,hl
	ld	e,l
	ld	d,h
	add	hl,sp
	push	bc
	ld	c,(hl)
	inc	hl
	ld	b,(hl)
	push	bc
	ld	c,e
	ld	b,d
	ld	e,l
	ld	d,h
	inc	de
	dec	hl
	call	bmovu1
	pop	hl
	pop	bc
	ex	(sp),hl
	jp	next

	 if	cfs

;	-ROLL  ( xu .. xu+1 x0 u -- x0 xu .. xu+1 )

	hdr	1,'-ROLL'
droll:	call	docol
	dw	cells,ttor
	dw	spat,spat,tuck
	dw	rat,cmove
	dw	spat,tfrom
	dw	rot,plus,store
	dw	exit

	 endif

;	PICK  ( xu .. x1 x0 u -- xu .. x1 x0 xu )

	hdr	1,'PICK'
pick:	pop	hl
	add	hl,hl
	add	hl,sp
	jp	at1

;	NIP  ( x1 x2 -- x2 )

	hdr	1,'NIP'
nip:	pop	hl
	inc	sp
	inc	sp
	jp	hpush

;	TUCK  ( x1 x2 -- x2 x1 x2 )

	hdr	1,'TUCK'
tuck:	pop	hl
	pop	de
	push	hl
	jp	dpush

;	><  ( x1 -- x2 )

	hdr	1,'><'
bswp:	pop	de
	ld	h,e
	ld	l,d
	jp	hpush

;	2DUP  ( xd -- xd xd )

	hdr	1,'2DUP'
tdup:	pop	hl
	pop	de
	push	de
	push	hl
	jp	dpush

;	2SWAP  ( xd1 xd2 -- xd2 xd1 )

	hdr	1,'2SWAP'
tswap:	pop	de
	pop	hl
	inc	sp
	inc	sp
	ex	(sp),hl
	dec	sp
	dec	sp
	ex	de,hl
	ex	(sp),hl
	jp	dpush

;	2OVER  ( xd1 xd2 -- xd1 xd2 xd1 )

	hdr	1,'2OVER'
tover:	ld	hl,4
	add	hl,sp
	jp	tat1

;	2ROT  ( xd1 xd2 xd3 -- xd2 xd3 xd1 )  5 roll 5 roll

	hdr	1,'2ROT'
trot:	call	docol
	dw	clit
	db	5
	dw	roll
	dw	clit
	db	5
	dw	roll
	dw	exit

;	DEPTH  ( -- u )		sp@ s0 @ swap - 2/

	hdr	1,'DEPTH'
depth:	call	docol
	dw	spat
	dw	szero,at
	dw	swap,subb
	dw	twodiv
	dw	exit

;	end

