;
;		STACK.MAC - Stack Manipulation
;
; 97/12/28
;
; SP@  SP!  RP@  RP!  >R  R>  R@  2>R  2R>  2R@  DROP  DUP  ?DUP
; SWAP  OVER  ROT  ROLL  PICK  2DROP  2DUP  2SWAP  2OVER  2ROT
; DEPTH
;

;	SP@  ( -- addr )

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

;	SP!  ( addr -- )

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

;	RP@  ( -- addr )

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

;	RP!  ( addr -- )

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

;	>R  ( x -- )

	hdr	2,'>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	2,'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	2,'R@'
rat:	ld	hl,(rpp)
	jp	at1

;	2>R  ( x1 x2 -- )

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

;	2R>  ( -- x1 x2 )

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

;	2R@  ( -- x1 x2 )

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

;	DROP  ( x -- )

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

;	DUP  ( x -- x x )

	hdr	3,'DUP'
dup:	pop	hl
	push	hl
	jp	hpush

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

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

;	SWAP  ( x1 x2 -- x2 x1 )

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

;	OVER  ( x1 x2 -- x1 x2 x1 )

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

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

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

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

	hdr	4,'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	movu1
	pop	hl
	pop	bc
	ex	(sp),hl
	jp	next

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

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

;	2DROP  ( xd -- )

	hdr	5,'2DROP'
tdrop:	pop	hl
	pop	hl
	jp	next

;	2DUP  ( xd -- xd xd )

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

;	2SWAP  ( xd1 xd2 -- xd2 xd1 )

	hdr	5,'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	5,'2OVER'
tover:	ld	hl,4
	add	hl,sp
	jp	tat1

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

	hdr	4,'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	5,'DEPTH'
depth:	call	docol
	dw	spat
	dw	szero,at
	dw	swap,subb
	dw	twodiv
	dw	exit

;	end