diff --git a/pkgs/racket-test-core/tests/racket/macro.rktl b/pkgs/racket-test-core/tests/racket/macro.rktl
index 515233e646..1ada0a044d 100644
--- a/pkgs/racket-test-core/tests/racket/macro.rktl
+++ b/pkgs/racket-test-core/tests/racket/macro.rktl
@@ -2604,5 +2604,19 @@
           (def-h h x)]
     (test 'ok values (f 'ok))))
 
+;; ----------------------------------------
+;; Make sure that `block` does not evaluate phase 1 expressions multiple times
+
+(module block-define-syntax-evaluation racket/base
+  (require (for-syntax racket/base) racket/block)
+  (provide final-counter)
+
+  (define-for-syntax counter 0)
+  (define-syntax (get-counter stx) #`'#,counter)
+  (block (define-syntax m (set! counter (add1 counter))))
+  (define final-counter (get-counter)))
+
+(test 1 dynamic-require ''block-define-syntax-evaluation 'final-counter)
+
 
 (report-errs)
diff --git a/racket/collects/racket/block.rkt b/racket/collects/racket/block.rkt
index 6196dea8f8..1a67fa1f89 100644
--- a/racket/collects/racket/block.rkt
+++ b/racket/collects/racket/block.rkt
@@ -1,100 +1,33 @@
 #lang racket/base
 
-(require
-  (for-syntax
-   racket/base
-   syntax/stx
-   syntax/transformer
-   syntax/context
-   "private/intdef-util.rkt"))
+(require (for-syntax syntax/context
+                     syntax/kerncase
+                     syntax/transformer
+                     racket/base)
+         syntax/parse/define)
 
 (provide block)
 
 (define-syntax block
   (make-expression-transformer
-   (lambda (stx)
-     ;; Body can have mixed exprs and defns. Wrap expressions with
-     ;; `(define-values () ... (values))' as needed, and add a (void)
-     ;; at the end if needed.
-     (let* ([def-ctx (syntax-local-make-definition-context)]
-            [ctx (generate-expand-context #t)]
-            ;; [kernel-forms (kernel-form-identifier-list)]
-            [stoplist (list #'begin #'define-syntaxes #'define-values)]
-            [init-exprs (let ([v (syntax->list stx)])
-                          (unless v (raise-syntax-error #f "bad syntax" stx))
-                          (cdr v))]
-            [exprs
-             (let loop ([todo init-exprs] [r '()])
-               (if (null? todo)
-                 (reverse r)
-                 (let ([expr (local-expand (car todo) ctx stoplist def-ctx)]
-                       [todo (cdr todo)])
-                   (syntax-case expr (begin define-syntaxes define-values)
-                     [(begin . rest)
-                      (loop (append (syntax->list #'rest) todo) r)]
-                     [(define-syntaxes (id ...) rhs)
-                      (andmap identifier? (syntax->list #'(id ...)))
-                      (with-syntax ([rhs (local-transformer-expand
-                                          #'rhs 'expression null)])
-                        (syntax-local-bind-syntaxes
-                         (syntax->list #'(id ...))
-                         #'rhs def-ctx)
-                        (with-syntax ([(id ...) (map syntax-local-identifier-as-binding
-                                                     (syntax->list #'(id ...)))])
-                          (loop todo (cons (datum->syntax
-                                            expr
-                                            (list #'define-syntaxes #'(id ...) #'rhs)
-                                            expr
-                                            expr)
-                                           r))))]
-                     [(define-values (id ...) rhs)
-                      (andmap identifier? (syntax->list #'(id ...)))
-                      (let ([ids (syntax->list #'(id ...))])
-                        (syntax-local-bind-syntaxes ids #f def-ctx)
-                        (with-syntax ([(id ...) (map syntax-local-identifier-as-binding
-                                                       (syntax->list #'(id ...)))])
-                          (loop todo (cons (datum->syntax
-                                            expr
-                                            (list #'define-values #'(id ...) #'rhs)
-                                            expr
-                                            expr)
-                                           r))))]
-                     [else (loop todo (cons expr r))]))))])
-       (let loop ([exprs exprs]
-                  [prev-stx-defns null]
-                  [prev-defns null]
-                  [prev-exprs null])
-         (cond
-           [(null? exprs)
-            (add-decl-props
-             def-ctx
-             (append prev-stx-defns prev-defns)
-             #`(letrec-syntaxes+values
-                #,(map stx-cdr (reverse prev-stx-defns))
-                #,(map stx-cdr (reverse prev-defns))
-                #,@(if (null? prev-exprs)
-                       (list #'(void))
-                       (reverse prev-exprs))))]
-           [(and (stx-pair? (car exprs))
-                 (identifier? (stx-car (car exprs)))
-                 (free-identifier=? #'define-syntaxes (stx-car (car exprs))))
-            (loop (cdr exprs)
-                  (cons (car exprs) prev-stx-defns)
-                  prev-defns
-                  prev-exprs)]
-           [(and (stx-pair? (car exprs))
-                 (identifier? (stx-car (car exprs)))
-                 (free-identifier=? #'define-values (stx-car (car exprs))))
-            (loop (cdr exprs)
-                  prev-stx-defns
-                  (cons (car exprs)
-                        (append
-                         (map (lambda (expr)
-                                #`(define-values () (begin #,expr (values))))
-                              prev-exprs)
-                         prev-defns))
-                  null)]
-           [else (loop (cdr exprs)
-                       prev-stx-defns
-                       prev-defns
-                       (cons (car exprs) prev-exprs))]))))))
+   (syntax-parser
+     [(_ defn-or-expr ...)
+      (quasisyntax/loc this-syntax
+        (let () (block-trampoline #,(generate-expand-context #t) #f defn-or-expr ...)))])))
+
+(define-syntax-parser block-trampoline
+  [(_ _ #f) #'(void)]
+  [(_ _ #t) #'(begin)]
+  [(_ context-v follows-expr? defn-or-expr more ...)
+   (syntax-parse (local-expand #'defn-or-expr
+                               (list (syntax-e #'context-v))
+                               (kernel-form-identifier-list))
+     #:literal-sets [kernel-literals]
+     [(head:begin defn-or-expr ...)
+      (syntax-track-origin #'(block-trampoline context-v follows-expr? defn-or-expr ... more ...)
+                           this-syntax
+                           (syntax-local-introduce #'head))]
+     [({~or define-values define-syntaxes} . _)
+      #`(begin #,this-syntax (block-trampoline context-v #f more ...))]
+     [_
+      #`(begin #,this-syntax (block-trampoline context-v #t more ...))])])