Something

;stack
;node is (value . (prev . next))
;bottom -> bla -> bla -> top
(define sentinel-value 'sentinel)
(define (make-stack-node value prev next)
  (cons value (cons prev next)))
;sets both sides
(define (set-node-prev! node to)
  (set-car! (cdr node) to)
  (set-cdr! (cdr to) node))
(define node-value car)
(define node-next cddr)
(define node-prev cadr)
;set-next is really jsut set-prev with node 
;and to switched
(define (set-node-next! node to)
  (set-node-prev! to node))
(define (make-stack)
  (let ((ret (cons 0
		   (cons (make-stack-node 
			  sentinel-value '() '())
			 (make-stack-node
			  sentinel-value '() '())))))
	(set-node-prev! (cddr ret) (cadr ret))
	ret))
(define (stack-bottom stack) ;first non-sentinel
  (node-next (cadr stack)))
(define (stack-top stack) ;last non-sentinel
  (node-prev (cddr stack)))
(define (stack-empty? stack) ;if 1 before sent is sent
  (eq? sentinel-value (node-value (stack-top stack))))
(define stack-len car)
(define (stack-pop! stack)
  (if (stack-empty? stack)
      #f
      (let ((ret (node-value (stack-top stack))))
	;set end sentinel val to one
	;before last element
	(set-node-prev! (cddr stack)
			(node-prev (stack-top stack)))
	(set-car! stack (- (stack-len stack) 1))
	ret)))
(define (stack-push! stack value)
  (let ((node (make-stack-node value '() '())))
    (set-node-prev! node (stack-top stack))
    (set-node-prev! (cddr stack) node)
    (set-car! stack (+ (stack-len stack) 1))))
(define (stack->list stack)
  (define (loop node)
    (if (eq? sentinel-value (node-value node))
	'()
	(cons (node-value node) (loop (node-next node)))))
  (loop (stack-bottom stack)))