diff --git a/compiler-lib/compiler/decompile.rkt b/compiler-lib/compiler/decompile.rkt
index d048b3b90b..cde92e1104 100644
--- a/compiler-lib/compiler/decompile.rkt
+++ b/compiler-lib/compiler/decompile.rkt
@@ -116,6 +116,16 @@
                            (for/list ([(k v) (in-hash e)])
                              (cons (loop k) (loop v)))))
         ph]
+       [(prefab-struct-key e)
+        => (lambda (k)
+             (define ph (make-placeholder #f))
+             (hash-set! ht e ph)
+             (placeholder-set! ph
+                               (apply make-prefab-struct
+                                      k
+                                      (map loop
+                                           (cdr (vector->list (struct->vector e))))))
+             ph)]
        [else
         e])))
   (define l (make-reader-graph (cons main mconses)))
@@ -174,7 +184,7 @@
                 (map (lambda (stx id)
                        `(define ,id ,(if stx
                                          `(#%decode-syntax 
-                                           ,(decompile-stx (stx-encoded stx) stx-ht))
+                                           ,(decompile-stx (stx-content stx) stx-ht))
                                          #f)))
                      stxs stx-ids))))]
     [else (error 'decompile-prefix "huh?: ~e" a-prefix)]))
@@ -184,7 +194,7 @@
       (let ([p (mcons #f #f)])
         (hash-set! stx-ht stx p)
         (match stx
-          [(wrapped datum wraps tamper-status)
+          [(stx-obj datum wrap tamper-status)
            (set-mcar! p (case tamper-status
                           [(clean) 'wrap]
                           [(tainted) 'wrap-tainted]
@@ -207,7 +217,7 @@
                           [(box? datum)
                            (box (decompile-stx (unbox datum) stx-ht))]
                           [else datum])
-                         wraps))
+                         wrap))
            p]))))
 
 (define (mpi->string modidx)
@@ -231,7 +241,7 @@
            (quote internal-context 
                   ,(if (stx? internal-context)
                        `(#%decode-syntax 
-                         ,(decompile-stx (stx-encoded internal-context) stx-ht))
+                         ,(decompile-stx (stx-content internal-context) stx-ht))
                        internal-context))
            (quote bindings ,(for/hash ([(phase ht) (in-hash binding-names)])
                               (values phase
@@ -240,7 +250,7 @@
                                                 (if (eq? id #t)
                                                     #t
                                                     `(#%decode-syntax 
-                                                      ,(decompile-stx (stx-encoded id) stx-ht))))))))
+                                                      ,(decompile-stx (stx-content id) stx-ht))))))))
            (quote language-info ,lang-info)
            ,@(if (null? flags) '() (list `(quote ,flags)))
            ,@(let ([l (apply
diff --git a/compiler-lib/compiler/demodularizer/module.rkt b/compiler-lib/compiler/demodularizer/module.rkt
index 1be8d31309..f33b675008 100644
--- a/compiler-lib/compiler/demodularizer/module.rkt
+++ b/compiler-lib/compiler/demodularizer/module.rkt
@@ -17,7 +17,7 @@
      (define-values (reqs new-forms)
        (partition req? (splice-forms form)))
      (define requires
-       (map (compose ->module-path-index wrapped-datum stx-encoded req-reqs) reqs))
+       (map (compose ->module-path-index stx-obj-datum stx-content req-reqs) reqs))
      (make-compilation-top 
       0
       (make-prefix 0 (list #f) empty)
diff --git a/compiler-lib/compiler/demodularizer/nodep.rkt b/compiler-lib/compiler/demodularizer/nodep.rkt
index 59995fc9e0..d1652826ff 100644
--- a/compiler-lib/compiler/demodularizer/nodep.rkt
+++ b/compiler-lib/compiler/demodularizer/nodep.rkt
@@ -197,13 +197,13 @@
          empty
          (begin
            (hash-set! REQUIRED ct #t)
-           (list (make-req (make-stx (make-wrapped ct empty 'clean)) (make-toplevel 0 0 #f #f)))))]
+           (list (make-req (make-stx (make-stx-obj ct (wrap empty empty empty) 'clean)) (make-toplevel 0 0 #f #f)))))]
     [(module-path-index? ct)
      (if (hash-has-key? REQUIRED ct)
          empty
          (begin
            (hash-set! REQUIRED ct #t)
-           (list (make-req (make-stx (make-wrapped ct empty 'clean)) (make-toplevel 0 0 #f #f)))))]
+           (list (make-req (make-stx (make-stx-obj ct (wrap empty empty empty) 'clean)) (make-toplevel 0 0 #f #f)))))]
     [(not ct)
      empty]
     [(@phase? ct)
diff --git a/compiler-test/tests/compiler/zo-exs.rkt b/compiler-test/tests/compiler/zo-exs.rkt
index fbf325980f..03c836bbd0 100644
--- a/compiler-test/tests/compiler/zo-exs.rkt
+++ b/compiler-test/tests/compiler/zo-exs.rkt
@@ -28,16 +28,16 @@
 (test
  (roundtrip
     (compilation-top 0 
-                     (prefix 0 empty empty)
+                     (prefix 0 empty empty 'insp0)
                      (list 1 (list 2 3) (list 2 3) 4 5)))
  
  (roundtrip
     (compilation-top 0 
-                     (prefix 1 empty empty)
+                     (prefix 1 empty empty 'insp0)
                      (list (lam 'proc null 0 null #f #(0) '(val/ref) (set 0) 3 1))))
  (roundtrip
     (compilation-top 0 
-                     (prefix 1 empty empty)
+                     (prefix 1 empty empty 'insp0)
                      (list (lam 'proc null 0 null #f #(0) '(val/ref) #f 3 1))))
  
  #;(roundtrip
@@ -94,23 +94,23 @@
 
  (roundtrip 
     (compilation-top 0 
-                     (prefix 0 empty empty)
+                     (prefix 0 empty empty 'insp0)
                      (current-directory)))
  
  (roundtrip 
     (compilation-top 0 
-                     (prefix 0 empty empty)
+                     (prefix 0 empty empty 'insp0)
                      (list (current-directory))))
  
  (roundtrip
     (compilation-top
      0
-     (prefix 0 empty empty)
+     (prefix 0 empty empty 'insp0)
      (cons #hash()
            #hash())))
  
  (roundtrip
     (compilation-top
      0
-     (prefix 0 empty empty)
+     (prefix 0 empty empty 'insp0)
      #hash())))
diff --git a/zo-lib/compiler/zo-marshal.rkt b/zo-lib/compiler/zo-marshal.rkt
index 13ed9bc42e..6c4e657a3d 100644
--- a/zo-lib/compiler/zo-marshal.rkt
+++ b/zo-lib/compiler/zo-marshal.rkt
@@ -20,6 +20,8 @@
 
 (struct not-ready ())
 
+(struct encoded-scope ([content #:mutable]) #:prefab)
+
 (define (zo-marshal top)
   (define bs (open-output-bytes))
   (zo-marshal-to top bs)
@@ -142,8 +144,10 @@
 
 (define (zo-marshal-top-to top outp) 
   
-  ; XXX: wraps were encoded in traverse, now needs to be handled when writing
-  (define wrapped (make-hash))
+  ; For detecting sharing in wraps:
+  (define stx-objs (make-hasheq))
+  (define wraps (make-hasheq))
+  (define hash-consed (make-hash))
   
   ; (obj -> (or pos #f)) output-port -> number
   ; writes top to outp using shared-obj-pos to determine symref
@@ -153,7 +157,8 @@
       (match top
         [(compilation-top max-let-depth prefix form)
          (list* max-let-depth prefix (protect-quote form))]))
-    (out-anything ct (make-out outp shared-obj-pos shared-obj-unsee wrapped))
+    (out-anything ct (make-out outp shared-obj-pos shared-obj-unsee
+                               stx-objs wraps hash-consed))
     (file-position outp))
   
   ; -> vector
@@ -227,7 +232,8 @@
                 [i (in-naturals)])
        (begin0
          (file-position outp)
-         (out-anything v (make-out outp (shared-obj-pos/modulo-v v) void wrapped))))
+         (out-anything v (make-out outp (shared-obj-pos/modulo-v v) void
+                                   stx-objs wraps hash-consed))))
      (file-position outp)))
   
   ; Calculate file positions
@@ -336,8 +342,8 @@
   CPT_DELAY_REF ; XXX unused, but appears to be same as CPT_SYMREF
   CPT_PREFAB
   CPT_LET_ONE_UNUSED
-  CPT_MARK
-  CPT_ROOT_MARK
+  CPT_SCOPE
+  CPT_ROOT_SCOPE
   CPT_SHARED)
 
 (define CPT_SMALL_NUMBER_START 39)
@@ -383,68 +389,23 @@
                           #f
                           #f))
 
-(define (encode-module-bindings module-bindings)
-  (define encode-nominal-path
-    (match-lambda
-      [(struct simple-nominal-path (value))
-       value]
-      [(struct imported-nominal-path (value import-phase))
-       (cons value import-phase)]
-      [(struct phased-nominal-path (value import-phase phase))
-       (cons value (cons import-phase phase))]))
-  (define encoded-bindings (make-vector (* (length module-bindings) 2)))
-  (for ([i (in-naturals)]
-        [(k v) (in-dict module-bindings)])
-    (vector-set! encoded-bindings (* i 2) k)
-    (vector-set! encoded-bindings (add1 (* i 2))
-                 (match v
-                   [(struct simple-module-binding (path))
-                    path]
-                   [(struct exported-module-binding (path export-name))
-                    (cons path export-name)]
-                   [(struct nominal-module-binding (path nominal-path))
-                    (cons path (encode-nominal-path nominal-path))]
-                   [(struct exported-nominal-module-binding (path export-name nominal-path nominal-export-name))
-                    (list* path export-name (encode-nominal-path nominal-path) nominal-export-name)]
-                   [(struct phased-module-binding (path phase export-name nominal-path nominal-export-name))
-                    (list* path phase export-name (encode-nominal-path nominal-path) nominal-export-name)])))
-  encoded-bindings)
-
-(define (encode-all-from-module afm)
-  (match afm
-    [(struct all-from-module (path phase src-phase '() #f '()))
-     (list* path phase src-phase)]
-    [(struct all-from-module (path phase src-phase '() #f context))
-     (list* path phase context src-phase)]
-    [(struct all-from-module (path phase src-phase exns prefix '()))
-     (list* path phase src-phase exns prefix)]))
-
-(define (encode-wraps wraps)
-  #f)
-
-(define (encode-mark-map mm)
-  mm
-  #;(for/fold ([l empty])
-      ([(k v) (in-hash ht)])
-      (list* k v l)))
-
 (define-struct protected-symref (val))
 
-(define (encode-wrapped w)
+(define (encode-stx-obj w wraps-ht)
   (match w
-    [(struct wrapped (datum wraps tamper-status))
+    [(struct stx-obj (datum wraps tamper-status))
      (let* ([enc-datum
              (match datum
                [(cons a b) 
-                (let ([p (cons (encode-wrapped a)
+                (let ([p (cons (encode-stx-obj a wraps-ht)
                                (let bloop ([b b])
                                  (match b
                                    ['() null]
                                    [(cons b1 b2)
-                                    (cons (encode-wrapped b1)
+                                    (cons (encode-stx-obj b1 wraps-ht)
                                           (bloop b2))]
                                    [else
-                                    (encode-wrapped b)])))]
+                                    (encode-stx-obj b wraps-ht)])))]
                       ; XXX Cylic list error possible
                       [len (let loop ([datum datum][len 0])
                              (cond
@@ -457,24 +418,24 @@
                       (cons len p) 
                       p))]
                [(box x)
-                (box (encode-wrapped x))]
+                (box (encode-stx-obj x wraps-ht))]
                [(? vector? v)
-                (vector-map encode-wrapped v)]
+                (vector-map (lambda (e) (encode-stx-obj e wraps-ht)) v)]
                [(? prefab-struct-key)
                 (define l (vector->list (struct->vector datum)))
                 (apply
                  make-prefab-struct
                  (car l)
-                 (map encode-wrapped (cdr l)))]
+                 (map (lambda (e) (encode-stx-obj e wraps-ht)) (cdr l)))]
                [_ datum])]
             [p (cons enc-datum
-                     (encode-wraps wraps))])
+                     (encode-wrap wraps wraps-ht))])
        (case tamper-status
          [(clean) p]
          [(tainted) (vector p)]
          [(armed) (vector p #f)]))]))
 
-(define-struct out (s shared-index shared-unsee encoded-wraps))
+(define-struct out (s shared-index shared-unsee stx-objs wraps hash-consed))
 (define (out-shared v out k)
   (if (shareable? v)
       (let ([v ((out-shared-index out) v)])
@@ -523,7 +484,9 @@
 
 (define (shareable? v)
   (define never-share-this?
-    (or-pred? v char? maybe-same-as-fixnum? empty? boolean? void? hash?))
+    (or-pred? v char? maybe-same-as-fixnum? empty? boolean? void? hash?
+              ;; For root scope:
+              scope?))
   (define always-share-this?
     (or-pred? v closure?))
   (or always-share-this?
@@ -584,6 +547,8 @@
         (out-byte CPT_FALSE out)]
        [(? void?)
         (out-byte CPT_VOID out)]
+       [(? (lambda (s) (and (scope? s) (eq? (scope-name s) 'root))))
+        (out-byte CPT_ROOT_SCOPE out)]
        [(struct module-variable (modidx sym pos phase constantness))
         (define (to-sym n) (string->symbol (format "struct~a" n)))
         (out-byte CPT_MODULE_VAR out)
@@ -917,11 +882,23 @@
           (out-anything base out)
           (unless (or name base)
             (out-anything (module-path-index-submodule v) out)))]
-       [(stx encoded)
+       [(stx content)
         (out-byte CPT_STX out)
-        (out-anything encoded out)]
-       [(? wrapped?)
-        (out-anything (lookup-encoded-wrapped v out) out)]
+        ;; The core Racket printer currently records more sharing
+        ;; by ensureing that list tails are shared, while the printer
+        ;; here detects sharing only at the start of a list. That
+        ;; doesn't seem to matter much. Meanwhile, we ensure that
+        ;; as much sharing as possible is present before printing.
+        (out-anything content out)]
+       [(encoded-scope content)
+        (out-byte CPT_SCOPE out)
+        ;; The `out-shared` wrapper already called `((out-shared-index out) v)` 
+        ;; once, so `pos` will defintely be a number:
+        (let ([pos ((out-shared-index out) v)])
+          (out-number pos out))
+        (out-anything (share-everywhere content out) out)]
+       [(? stx-obj?)
+        (out-anything (lookup-encoded-stx-obj v out) out)]
        [(? prefab-struct-key)
         (define pre-v (struct->vector v))
         (vector-set! pre-v 0 (prefab-struct-key v))
@@ -1072,10 +1049,10 @@
             [l (cons (if (pair? name) (cdr name) null) l)])
        l)]))
 
-(define (lookup-encoded-wrapped w out)
-  (hash-ref! (out-encoded-wraps out) w
-            (λ ()
-              (encode-wrapped w))))
+(define (lookup-encoded-stx-obj w out)
+  (hash-ref! (out-stx-objs out) w
+             (λ ()
+               (encode-stx-obj w (out-wraps out)))))
 
 (define (pack-binding-names binding-names)
   (define (ht-to-vector ht)
@@ -1178,6 +1155,237 @@
         (find-relative-path r v)
         v)))
 
+;; ----------------------------------------
+
+;; We want to hash-cons syntax-object wraps, but a normal `equal?`-based
+;; table would equate different "self" modidxes that we need to keep
+;; separate. So, roll a `simple-equal?` that inspects wraps. We don't
+;; have to deal with cycles, since cycles would always go through a scope,
+;; and we recur into scopes.
+
+(struct modidx-must-be-eq (content)
+        #:property prop:equal+hash
+        (list (lambda (a b eql?)
+                (simple-equal? (modidx-must-be-eq-content a)
+                               (modidx-must-be-eq-content b)))
+              (lambda (a h) (h (modidx-must-be-eq-content a)))
+              (lambda (a h) (h (modidx-must-be-eq-content a)))))
+
+(define (simple-equal? a b)
+  (cond
+   [(eqv? a b) #t]
+   [(pair? a)
+    (and (pair? b)
+         (simple-equal? (car a) (car b))
+         (simple-equal? (cdr a) (cdr b)))]
+   [(vector? a)
+    (and (vector? b)
+         (= (vector-length a) (vector-length b))
+         (for/and ([ae (in-vector a)]
+                   [be (in-vector b)])
+           (simple-equal? ae be)))]
+   [(box? a)
+    (and (box? b)
+         (simple-equal? (unbox a) (unbox b)))]
+   [else #f]))
+
+(define (share-everywhere v out)
+  (hash-ref! (out-hash-consed out)
+             (modidx-must-be-eq v)
+             (lambda ()
+               (cond
+                [(pair? v)
+                 (cons (share-everywhere (car v) out)
+                       (share-everywhere (cdr v) out))]
+                [(vector? v)
+                 (for/vector #:length (vector-length v) ([e (in-vector v)])
+                             (share-everywhere e out))]
+                [(box? v)
+                 (box (share-everywhere (unbox v) out))]
+                [else v]))))
 
 ;; ----------------------------------------
 
+(define (encode-wrap w ht)
+  (hash-ref! ht w
+             (lambda ()
+               (vector (map-encode encode-shift (wrap-shifts w) ht)
+                       (encode-scope-list (wrap-simple-scopes w) ht)
+                       (map-encode encode-multi-scope (wrap-multi-scopes w) ht)))))
+
+(define (map-encode encode l ht)
+  (cond
+   [(null? l) l]
+   [else
+    (hash-ref! ht l
+               (lambda ()
+                 (cons (encode (car l) ht)
+                       (map-encode encode (cdr l) ht))))]))
+
+(define (encode-shift s ht)
+  (hash-ref! ht s
+             (lambda ()
+               (if (module-shift-from-inspector-desc s)
+                   (vector (module-shift-to s)
+                           (module-shift-from s)
+                           (module-shift-from-inspector-desc s)
+                           (module-shift-to-inspector-desc s))
+                   (vector (module-shift-to s)
+                           (module-shift-from s))))))
+
+(define (encode-scope s ht)
+  (if (eq? 'root (scope-name s))
+      s
+      (hash-ref ht s
+                (lambda ()
+                  (define es (encoded-scope #f))
+                  (hash-set! ht s es)
+                  (define kind
+                    (case (scope-kind s)
+                      [(module) (if (scope-multi-owner s)
+                                    1
+                                    0)]
+                      [(macro) 2]
+                      [(local) 3]
+                      [(intdef) 4]
+                      [else 5]))
+                  (cond
+                   [(and (null? (scope-bindings s))
+                         (null? (scope-bulk-bindings s)))
+                    (set-encoded-scope-content! es kind)]
+                   [else
+                    (define binding-table
+                      (for/fold ([bt (hasheq)]) ([b (in-list (scope-bindings s))])
+                        (hash-set bt
+                                  (car b)
+                                  (cons (cons (encode-scope-list (cadr b) ht)
+                                              (encode-binding (caddr b) (car b) ht))
+                                        (hash-ref bt (car b) null)))))
+                    (define bindings
+                      (list->vector
+                       (apply
+                        append
+                        (sort (hash-map binding-table list)
+                              symbol<?
+                              #:key car))))
+                    (set-encoded-scope-content!
+                     es
+                     (cons kind
+                           (append (map-encode
+                                    encode-bulk-binding
+                                    (scope-bulk-bindings s)
+                                    ht)
+                                   bindings)))])
+                  es))))
+
+(define (encode-scope-list l ht)
+  (map-encode encode-scope
+              (sort l > #:key (lambda (s)
+                                (if (eq? 'root (scope-name s))
+                                    -1
+                                    (scope-name s))))
+              ht))
+
+(define (encode-multi-scope ms+phase ht)
+  (define ms (car ms+phase))
+  (cons (hash-ref ht ms
+                  (lambda ()
+                    (define v (make-vector (add1 (* 2 (length (multi-scope-scopes ms))))))
+                    (hash-set! ht ms v)
+                    (vector-copy!
+                     v
+                     0
+                     (list->vector
+                      (append (apply
+                               append
+                               (for/list ([e (in-list (multi-scope-scopes ms))])
+                                 (list (car e)
+                                       (encode-scope (cadr e) ht))))
+                              (list (multi-scope-src-name ms)))))
+                    v))
+        (cadr ms+phase)))
+
+(define (encode-binding b name ht)
+  (match b
+    [(free-id=?-binding base id)
+     (hash-ref ht b
+               (lambda ()
+                 (match b
+                   [(free-id=?-binding base id)
+                    (define bx (box #f))
+                    (hash-set! ht b bx)
+                    (set-box! bx
+                              (cons (encode-binding base name ht)
+                                    (cons (stx-obj-datum id)
+                                          (stx-obj-wrap id))))])))]
+    [_
+     (hash-ref! ht b
+                (lambda ()
+                  (match b
+                    [(local-binding name)
+                     name]
+                    [(module-binding encoded)
+                     encoded]
+                    [(? decoded-module-binding?)
+                     (encode-module-binding b name ht)])))]))
+                             
+                 
+(define (encode-module-binding b name ht)
+  (hash-ref! ht (cons name b)
+             (lambda ()
+               (match b
+                 [(decoded-module-binding path export-name phase
+                                          nominal-path nominal-export-name nominal-phase
+                                          import-phase inspector-desc)
+                  (define l 
+                    (cond
+                     [(and (eq? path nominal-path)
+                           (eq? export-name nominal-export-name)
+                           (eqv? phase 0)
+                           (eqv? import-phase 0)
+                           (eqv? nominal-phase phase))
+                      (if (eq? name export-name)
+                          path
+                          (cons path export-name))]
+                     [(and (eq? export-name nominal-export-name)
+                           (eq? name export-name)
+                           (eqv? 0 phase)
+                           (eqv? import-phase 0)
+                           (eqv? nominal-phase phase))
+                      (cons path nominal-path)]
+                     [else
+                      (define nom-mod+phase
+                        (if (eqv? nominal-phase phase)
+                            (if (eqv? 0 import-phase)
+                                nominal-path
+                                (cons nominal-path import-phase))
+                            (cons nominal-path (cons import-phase nominal-phase))))
+                      (define l (list* export-name nom-mod+phase nominal-export-name))
+                      (if (zero? phase)
+                          l
+                          (cons phase l))]))
+                  (if inspector-desc
+                      (cons inspector-desc l)
+                      l)]))))
+
+(define (encode-bulk-binding p ht)
+  (cons (encode-scope-list (car p) ht)
+        (encode-all-from-module (cadr p) ht)))
+
+(define (encode-all-from-module b ht)
+  (hash-ref! ht b
+             (lambda ()
+               (match b
+                 [(all-from-module path phase src-phase inspector-desc exceptions prefix)
+                  (vector path src-phase
+                          (cond
+                           [(and (not prefix) (null? exceptions))
+                            phase]
+                           [(not prefix)
+                            (cons phase (list->vector exceptions))]
+                           [(null? exceptions)
+                            (cons phase prefix)]
+                           [else
+                            (cons phase (cons (list->vector exceptions) prefix))])
+                          inspector-desc)]))))
+
diff --git a/zo-lib/compiler/zo-parse.rkt b/zo-lib/compiler/zo-parse.rkt
index aec5c78cd1..dc53a5bc75 100644
--- a/zo-lib/compiler/zo-parse.rkt
+++ b/zo-lib/compiler/zo-parse.rkt
@@ -7,28 +7,10 @@
          racket/dict
          racket/set)
 
-(provide zo-parse)
+(provide zo-parse
+         decode-module-binding)
 (provide (all-from-out compiler/zo-structs))
 
-#| Unresolved Issues
-
-  The order of indirect-et-provides, indirect-syntax-provides, indirect-provides was changed, is that okay?
- 
-  orig-port of cport struct is never used, is it needed?
-
-  Lines 628, 630 seem to be only for debugging and should probably throw errors
-
-  vector and pair cases of decode-wraps seem to do different things from the corresponding C code
-
-  Line 816: This should be an eqv placeholder (but they don't exist)
-
-  Line 634: Export registry is always matched as false, but might not be
-
-  What are the real differences between the module-binding cases?
-
-  I think parse-module-path-index was only used for debugging, so it is short-circuited now
-
-|#
 ;; ----------------------------------------
 ;; Bytecode unmarshalers for various forms
 
@@ -506,8 +488,8 @@
     [33 delayed]
     [34 prefab]
     [35 let-one-unused]
-    [36 mark]
-    [37 root-mark]
+    [36 scope]
+    [37 root-scope]
     [38 shared]
     [39 62 small-number]
     [62 80 small-symbol]
@@ -521,6 +503,8 @@
     [249 small-application3]
     [247 255 small-application]))
 
+(define root-scope (scope 'root 'module null null #f))
+
 ;; To accelerate cpt-table lookup, we flatten out the above
 ;; list into a vector:
 (define cpt-table (make-vector 256 #f))
@@ -607,7 +591,10 @@
 (define-syntax-rule (with-memo mt arg body ...)
   (with-memo* mt arg (λ () body ...)))
 
-(define (decode-stx cp v)
+;; placeholder for a `scope` decoded in a second pass:
+(struct encoded-scope (content) #:prefab)
+
+(define (decode-wrapped cp v)
   (let loop ([v v])
     (let-values ([(tamper-status v encoded-wraps)
                   (match v
@@ -615,9 +602,8 @@
                     [`#((,datum . ,wraps) #f) (values 'armed datum wraps)]
                     [`(,datum . ,wraps) (values 'clean datum wraps)]
                     [else (error 'decode-wraps "bad datum+wrap: ~.s" v)])])
-      (let* ([wraps (decode-wraps cp encoded-wraps)]
-             [wrapped-memo (make-memo)]
-             [add-wrap (lambda (v) (with-memo wrapped-memo v (make-wrapped v wraps tamper-status)))])
+      (let* ([wrapped-memo (make-memo)]
+             [add-wrap (lambda (v) (with-memo wrapped-memo v (make-stx-obj v encoded-wraps tamper-status)))])
         (cond
          [(pair? v)
           (if (eq? #t (car v))
@@ -670,35 +656,6 @@
                  (map loop (struct->list v)))))]
          [else (add-wrap v)])))))
 
-(define (afm-context? v)
-  (or (and (list? v) (andmap exact-integer? v))
-      (and (vector? v) 
-           (= 2 (vector-length v))
-           (list? (vector-ref v 0))
-           (andmap exact-integer? (vector-ref v 0)))))
-
-(define all-from-module-memo (make-memo))
-(define (decode-all-from-module cp afm)
-  (define (phase? v)
-    (or (number? v) (not v)))
-  (with-memo all-from-module-memo afm
-    (match afm
-      [(list* path (? phase? phase) (? phase? src-phase) (list exn ...) prefix)
-       (make-all-from-module
-        (parse-module-path-index cp path)
-        phase src-phase exn prefix null)]
-      [(list* path (? phase? phase) (? afm-context? context) (? phase? src-phase))
-       (make-all-from-module
-        (parse-module-path-index cp path)
-        phase src-phase null #f context)]
-      [(list* path (? phase? phase) (? phase? src-phase))
-       (make-all-from-module
-        (parse-module-path-index cp path)
-        phase src-phase null #f null)])))
-
-(define (decode-wraps cp w)
-  w)
-
 (define (in-vector* v n)
   (make-do-sequence
    (λ ()
@@ -709,49 +666,6 @@
              (λ _ #t)
              (λ _ #t)))))
 
-(define nominal-path-memo (make-memo))
-(define (decode-nominal-path np)
-  (with-memo nominal-path-memo np
-    (match np
-      [(cons nominal-path (cons import-phase nominal-phase))
-       (make-phased-nominal-path nominal-path import-phase nominal-phase)]
-      [(cons nominal-path import-phase)
-       (make-imported-nominal-path nominal-path import-phase)]
-      [nominal-path
-       (make-simple-nominal-path nominal-path)])))
-
-; XXX Weird test copied from C code. Matthew?
-(define (nom_mod_p p)
-  (and (pair? p) (not (pair? (cdr p))) (not (symbol? (cdr p))))) 
-
-(define rename-v-memo (make-memo))
-(define (decode-rename-v v)
-  (with-memo rename-v-memo v
-    (match v
-      [(list-rest path phase export-name nominal-path nominal-export-name)
-       (make-phased-module-binding path
-                                   phase
-                                   export-name
-                                   (decode-nominal-path nominal-path) 
-                                   nominal-export-name)]
-      [(list-rest path export-name nominal-path nominal-export-name)
-       (make-exported-nominal-module-binding path
-                                             export-name 
-                                             (decode-nominal-path nominal-path)
-                                             nominal-export-name)]
-      [(cons module-path-index (? nom_mod_p nominal-path))
-       (make-nominal-module-binding module-path-index (decode-nominal-path nominal-path))]
-      [(cons module-path-index export-name)
-       (make-exported-module-binding module-path-index export-name)]
-      [module-path-index 
-       (make-simple-module-binding module-path-index)])))
-
-(define renames-memo (make-memo))
-(define (decode-renames renames)
-  (with-memo renames-memo renames
-    (for/list ([(k v) (in-vector* renames 2)])
-      (cons k (decode-rename-v v)))))
-
 (define (parse-module-path-index cp s)
   s)
 
@@ -934,7 +848,7 @@
         [(marshalled) (read-marshalled (read-compact-number cp) cp)]
         [(stx)
          (let ([v (read-compact cp)])
-           (make-stx (decode-stx cp v)))]
+           (make-stx (decode-wrapped cp v)))]
         [(local local-unbox)
          (let ([c (read-compact-number cp)]
                [unbox? (eq? cpt-tag 'local-unbox)])
@@ -1027,11 +941,13 @@
          (read-compact-svector cp (read-compact-number cp))]
         [(small-svector)
          (read-compact-svector cp (- ch cpt-start))]
-        [(mark)
+        [(scope)
          (let ([pos (read-compact-number cp)])
            (if (zero? pos)
-               (box (read-compact cp))
-               (read-cyclic cp pos 'mark box)))]
+               (encoded-scope (read-compact cp))
+               (read-cyclic cp pos 'scope encoded-scope)))]
+        [(root-scope)
+         root-scope]
         [(shared)
          (let ([pos (read-compact-number cp)])
            (read-cyclic cp pos 'shared))]
@@ -1210,7 +1126,299 @@
   #;(for ([(i v) (in-dict (cport-symtab cp))])
       (printf "~a = ~a\n" i (placeholder-get v)))
   (set-cport-pos! cp shared-size)
-  (make-reader-graph (read-marshalled 'compilation-top-type cp)))
+  
+  (define decoded-except-for-stx
+    (make-reader-graph (read-marshalled 'compilation-top-type cp)))
+  
+  (decode-stxes decoded-except-for-stx))
+
+;; ----------------------------------------
+
+(define (decode-stxes v)
+  ;; Walk `v` to find `stx-obj` instances and decode the `wrap` field.
+  ;; We do this after building a graph from the input, and `decode-wrap`
+  ;; preserves graph structure.
+  (define decode-ht (make-hasheq))
+  (let walk ([p v])
+    (match p
+      [(compilation-top _ pfx c)
+       (struct-copy compilation-top p
+                    [prefix (walk pfx)]
+                    [code (walk c)])]
+      [(prefix _ _ s _)
+       (struct-copy prefix p [stxs (map walk s)])]
+      [(req rs _)
+       (struct-copy req p
+                    [reqs (map walk rs)])]
+      [(? mod?)
+       (struct-copy mod p
+                    [prefix (walk (mod-prefix p))]
+                    [syntax-bodies
+                     (for/list ([e (in-list (mod-syntax-bodies p))])
+                       (cons (car e)
+                             (map walk (cdr e))))]
+                    [internal-context
+                     (walk (mod-internal-context p))]
+                    [binding-names
+                     (for/hash ([(p ht) (in-hash (mod-binding-names p))])
+                       (values p
+                               (for/hash ([(k v) (in-hash ht)])
+                                 (values k (walk v)))))]
+                    [pre-submodules
+                     (map walk (mod-pre-submodules p))]
+                    [post-submodules
+                     (map walk (mod-post-submodules p))])]
+      [(stx c)
+       (struct-copy stx p [content (walk c)])]
+      [(def-syntaxes _ _ pfx _ _)
+       (struct-copy def-syntaxes p
+                    [prefix (walk pfx)])]
+      [(seq-for-syntax _ pfx _ _)
+       (struct-copy seq-for-syntax p
+                    [prefix (walk pfx)])]
+      [(stx-obj d w _)
+       (struct-copy stx-obj p
+                    [datum (walk d)]
+                    [wrap (decode-wrap w decode-ht)])]
+      [(? zo?) p]
+      ;; Generic constructors happen inside the `datum` of `stx-obj`,
+      ;; for example (with no cycles):
+      [(cons a d)
+       (cons (walk a) (walk d))]
+      [(? vector?)
+       (vector->immutable-vector
+        (for/vector #:length (vector-length p) ([e (in-vector p)])
+                    (walk e)))]
+      [(box v)
+       (box-immutable (walk v))]
+      [(? prefab-struct-key)
+       (apply make-prefab-struct
+              (prefab-struct-key p)
+              (cdr (for/list ([e (in-vector (struct->vector p))])
+                     (walk e))))]
+      [(? hash?)
+       (cond
+        [(hash-eq? p)
+         (for/hasheq ([(k v) (in-hash p)])
+           (values k (walk v)))]
+        [(hash-eqv? p)
+         (for/hasheqv ([(k v) (in-hash p)])
+           (values k (walk v)))]
+        [else
+         (for/hash ([(k v) (in-hash p)])
+           (values k (walk v)))])]
+      [_ p])))
+
+;; ----------------------------------------
+
+(define (decode-wrap encoded-wrap ht)
+  (hash-ref! ht
+             encoded-wrap
+             (lambda ()
+               (match encoded-wrap
+                 [(vector shifts simple-scopes multi-scopes)
+                  (make-wrap (decode-map decode-shift shifts ht)
+                             (decode-map decode-scope simple-scopes ht)
+                             (decode-map decode-shifted-multi-scope multi-scopes ht))]
+                 [_ (error 'decode-wrap "bad wrap")]))))
+
+(define (decode-map decode-one l ht)
+  (cond
+   [(null? l) l]
+   [(not (pair? l))
+    (error 'decode-wrap "bad list")]
+   [else (hash-ref! ht l
+                    (lambda ()
+                      (cons (decode-one (car l) ht)
+                            (decode-map decode-one (cdr l) ht))))]))
+
+(define (decode-shift s ht)
+  (hash-ref! ht s
+             (lambda ()
+               (match s
+                 [(vector to from)
+                  (module-shift to from #f #f)]
+                 [(vector to from i-to i-from)
+                  (module-shift to from i-to i-from)]
+                 [_ (error 'decode-wrap "bad shift")]))))
+
+(define (decode-scope s ht)
+  (hash-ref ht s
+            (lambda ()
+              (unless (encoded-scope? s)
+                (error 'decode-wrap "bad scope: ~e" s))
+              (define v (encoded-scope-content s))
+              (define kind
+                (match v
+                  [(? number?) v]
+                  [(cons (? number?) _)
+                   (car v)]
+                  [else (error 'decode-wrap "bad scope")]))
+              (define sc (scope (hash-count ht)
+                                (case kind
+                                  [(0 1) 'module]
+                                  [(2) 'macro]
+                                  [(3) 'local]
+                                  [(4) 'intdef]
+                                  [else 'use-site])
+                                null
+                                null
+                                #f))
+              (hash-set! ht s sc)
+              (unless (number? v)
+                (define-values (bulk-bindings end)
+                  (let loop ([l (cdr v)] [bulk-bindings null])
+                    (cond
+                     [(pair? l)
+                      (loop (cdr l) (cons (list (decode-scope-set (caar l) ht)
+                                                (decode-bulk-import (cdar l) ht))
+                                          bulk-bindings))]
+                     [else (values (reverse bulk-bindings) l)])))
+                (set-scope-bulk-bindings! sc bulk-bindings)
+                (unless (and (vector? end)
+                             (even? (vector-length end)))
+                  (error 'decode-wrap "bad scope"))
+                (define bindings
+                  (let loop ([i 0])
+                    (cond
+                     [(= i (vector-length end)) null]
+                     [else
+                      (append (for/list ([p (in-list (vector-ref end (add1 i)))])
+                                (list (vector-ref end i)
+                                      (decode-scope-set (car p) ht)
+                                      (decode-binding (cdr p) ht)))
+                              (loop (+ i 2)))])))
+                (set-scope-bindings! sc bindings))
+              sc)))
+
+(define (decode-scope-set l ht)
+  (decode-map decode-scope l ht))
+
+(define (decode-binding b ht)
+  (hash-ref! ht b
+             (lambda ()
+               (match b
+                 [(box (cons base-b (cons sym wraps)))
+                  (free-id=?-binding
+                   (decode-binding base-b ht)
+                   (stx-obj sym wraps 'clean))]
+                 [(? symbol?)
+                  (local-binding b)]
+                 [else
+                  ;; Leave it encoded, so that the compactness (or not)
+                  ;; of the encoding is visible; clients decode further
+                  ;; with `decode-module-binding`
+                  (module-binding b)]))))
+
+(define (decode-module-binding b name)
+  (define-values (insp-desc rest-b)
+    (match b
+      [(cons (? symbol?) _)
+       (values (car b) (cdr b))]
+      [else
+       (values #f b)]))
+  (define (decode-nominal-modidx-plus-phase n mod-phase)
+    (match n
+      [(? module-path-index?)
+       (values n mod-phase 0)]
+      [(cons nom-modix (cons import-phase nom-phase))
+       (values nom-modix nom-phase import-phase)]
+      [(cons nom-modix import-phase)
+       (values nom-modix mod-phase import-phase)]
+      [_
+       (error 'decode-module-binding "bad encoding")]))
+  (match rest-b
+    [(and modidx (? module-path-index?))
+     (decoded-module-binding modidx name 0
+                             modidx name 0
+                             0 insp-desc)]
+    [(cons (and modidx (? module-path-index?))
+           (and name (? symbol?)))
+     (decoded-module-binding modidx name 0
+                             modidx name 0
+                             0 insp-desc)]
+    [(cons (and modidx (? module-path-index?))
+           (and nom-modidx (? module-path-index?)))
+     (decoded-module-binding modidx name 0
+                             nom-modidx name 0
+                             0 insp-desc)]
+    [(list* modidx (and name (? symbol?))
+            nominal-modidx-plus-phase nom-name)
+     (define-values (nom-modidx nom-phase import-phase)
+       (decode-nominal-modidx-plus-phase nominal-modidx-plus-phase 0))
+     (decoded-module-binding modidx name 0
+                             nom-modidx nom-name nom-phase
+                             import-phase insp-desc)]
+    [(list* modidx mod-phase (and name (? symbol?))
+            nominal-modidx-plus-phase nom-name)
+     (define-values (nom-modidx nom-phase import-phase)
+       (decode-nominal-modidx-plus-phase nominal-modidx-plus-phase mod-phase))
+     (decoded-module-binding modidx name mod-phase
+                             nom-modidx nom-name nom-phase
+                             import-phase insp-desc)]
+    [_ (error 'decode-module-binding "bad encoding")]))
+
+(define (decode-bulk-import l ht)
+  (hash-ref! ht l
+             (lambda ()
+               (match l
+                 [(vector (and modidx (? module-path-index?))
+                          src-phase
+                          info
+                          (and insp-desc (or #f (? symbol?))))
+                  (define-values (phase prefix excepts)
+                    (match info
+                      [(or #f (? exact-integer?))
+                       (values info #f '#())]
+                      [(cons phase (and prefix (? symbol?)))
+                       (values phase prefix '#())]
+                      [(cons phase (cons excepts prefix))
+                       (values phase prefix excepts)]
+                      [(cons phase excepts)
+                       (values phase #f excepts)]
+                      [_ (error 'decode-wrap "bad bulk import info")]))
+                  (all-from-module modidx
+                                   phase
+                                   src-phase
+                                   insp-desc
+                                   (if excepts
+                                       (vector->list excepts)
+                                       null)
+                                   prefix)]
+                 [_ (error 'decode-wrap "bad bulk import")]))))
+
+(define (decode-shifted-multi-scope sms ht)
+  (unless (pair? sms)
+    (error 'decode-wrap "bad multi-scope pair"))
+  (list (decode-multi-scope (car sms) ht)
+        (cdr sms)))
+
+(define (decode-multi-scope ms ht)
+  (unless (and (vector? ms)
+               (odd? (vector-length ms)))
+    (error 'decode-wrap "bad multi scope"))
+  (hash-ref ht ms
+            (lambda ()
+              (define multi (multi-scope (hash-count ht)
+                                         (vector-ref ms (sub1 (vector-length ms)))
+                                         null))
+              (hash-set! ht ms multi)
+              (define scopes
+                (let loop ([i 0])
+                  (cond
+                   [(= (add1 i) (vector-length ms)) null]
+                   [else
+                    (define s (decode-scope (vector-ref ms (add1 i)) ht))
+                    (when (scope-multi-owner s)
+                      (error 'decode-wrap "bad scope owner: ~e while reading ~e"
+                             (scope-multi-owner s)
+                             multi))
+                    (set-scope-multi-owner! s multi)
+                    (cons (list (vector-ref ms i)
+                                s)
+                          (loop (+ i 2)))])))
+              (set-multi-scope-scopes! multi scopes)
+              multi)))
 
 ;; ----------------------------------------
 
diff --git a/zo-lib/compiler/zo-structs.rkt b/zo-lib/compiler/zo-structs.rkt
index d6f9e19ff5..c1b83b3478 100644
--- a/zo-lib/compiler/zo-structs.rkt
+++ b/zo-lib/compiler/zo-structs.rkt
@@ -20,12 +20,12 @@
 ;; ----------------------------------------
 ;;  Structures to represent bytecode
 
-(define-syntax-rule (define-form-struct* id id+par ([field-id field-contract] ...))
+(define-syntax-rule (define-form-struct* id id+par ([field-id field-contract . options] ...))
   (begin
-    (define-struct id+par (field-id ...) #:prefab)
-    #;(provide (struct-out id))
-    (provide/contract
-     [struct id ([field-id field-contract] ...)])))
+    (define-struct id+par ([field-id . options] ...) #:prefab)
+    (provide
+     (contract-out
+      [struct id ([field-id field-contract] ...)]))))
 
 (define-struct zo () #:prefab)
 (provide (struct-out zo))
@@ -58,30 +58,9 @@
                                                          function-shape? 
                                                          struct-shape?)]))
 
-;; Syntax object
-(define ((alist/c k? v?) l)
-  (let loop ([l l])
-    (match l
-      [(list) #t]
-      [(list* (? k?) (? v?) l)
-       (loop l)]
-      [_ #f])))
-
-(define mark-map? 
-  (alist/c number? module-path-index?)
-  #;(hash/c number? module-path-index?))
-
-(define-form-struct wrap ())
-(define-form-struct wrapped ([datum any/c] 
-                             [wraps any/c]
-                             [tamper-status (or/c 'clean 'armed 'tainted)]))
-
-;; In stxs of prefix:
-(define-form-struct stx ([encoded wrapped?]))
-
 (define-form-struct prefix ([num-lifts exact-nonnegative-integer?] 
                             [toplevels (listof (or/c #f symbol? global-bucket? module-variable?))] 
-                            [stxs list?]   ; should be (listof stx?) sets up top-level and syntax-object array
+                            [stxs (listof (or/c #f stx?))] ; #f is unusual, but it can happen when one is optimized away at the last moment
                             [src-inspector-desc symbol?]))
 
 (define-form-struct form ())
@@ -196,55 +175,52 @@
 ;; Top-level `require'
 (define-form-struct (req form) ([reqs stx?] [dummy toplevel?]))
 
+
+;; Syntax objects
+
+(define-form-struct stx ([content stx-obj?]))
+
+(define-form-struct stx-obj ([datum any/c] ; S-expression with `wrapped` components
+                             [wrap any/c] ; shuold be `wrap?`, but encoded form appears initially
+                             [tamper-status (or/c 'clean 'armed 'tainted)]))
+
+(define-form-struct wrap ([shifts (listof module-shift?)]
+                          [simple-scopes (listof scope?)]
+                          [multi-scopes (listof (list/c multi-scope? (or/c #f exact-integer?)))]))
+
+(define-form-struct module-shift ([from (or/c #f module-path-index?)]
+                                  [to (or/c #f module-path-index?)]
+                                  [from-inspector-desc (or/c #f symbol?)]
+                                  [to-inspector-desc (or/c #f symbol?)]))
+
+(define-form-struct scope ([name (or/c 'root exact-nonnegative-integer?)] ; 'root is special; otherwise, just for printing
+                           [kind symbol?]
+                           [bindings (listof (list/c symbol? (listof scope?) binding?)) #:mutable]
+                           [bulk-bindings (listof (list/c (listof scope?) all-from-module?)) #:mutable]
+                           [multi-owner (or/c #f multi-scope?) #:mutable]))
+(define-form-struct multi-scope ([name exact-nonnegative-integer?]
+                                 [src-name any/c] ; debugging info, such as module name
+                                 [scopes (listof (list/c (or/c #f exact-integer?) scope?)) #:mutable]))
+
+(define-form-struct binding ())
+(define-form-struct (free-id=?-binding binding) ([base (and/c binding?
+                                                              (not/c free-id=?-binding?))]
+                                                 [id stx-obj?]))
+(define-form-struct (local-binding binding) ([name symbol?]))
+(define-form-struct (module-binding binding) ([encoded any/c]))
+;; Convert `module-binding` to `decoded-module-binding` with `decode-module-binding`:
+(define-form-struct (decoded-module-binding binding) ([path (or/c #f module-path-index?)]
+                                                      [name symbol?]
+                                                      [phase exact-integer?]
+                                                      [nominal-path (or/c #f module-path-index?)]
+                                                      [nominal-export-name symbol?]
+                                                      [nominal-phase (or/c #f exact-integer?)]
+                                                      [import-phase (or/c #f exact-integer?)]
+                                                      [inspector-desc (or/c #f symbol?)]))
+
 (define-form-struct all-from-module ([path module-path-index?] 
                                      [phase (or/c exact-integer? #f)] 
                                      [src-phase (or/c exact-integer? #f)]
+                                     [inspector-desc symbol?]
                                      [exceptions (listof symbol?)]
-                                     [prefix (or/c symbol? #f)]
-                                     [context (or/c (listof exact-integer?) 
-                                                    (vector/c (listof exact-integer?) any/c))]))
-
-(define-form-struct nominal-path ())
-(define-form-struct (simple-nominal-path nominal-path) ([value module-path-index?]))
-(define-form-struct (imported-nominal-path nominal-path) ([value module-path-index?] 
-                                                          [import-phase exact-integer?]))
-(define-form-struct (phased-nominal-path nominal-path) ([value module-path-index?]
-                                                        [import-phase (or/c false/c exact-integer?)]
-                                                        [phase exact-integer?]))
-
-(define-form-struct module-binding ())
-(define-form-struct (phased-module-binding module-binding) ([path module-path-index?]
-                                                            [phase exact-integer?]
-                                                            [export-name any/c]
-                                                            [nominal-path nominal-path?]
-                                                            [nominal-export-name any/c]))
-(define-form-struct (exported-nominal-module-binding module-binding) ([path module-path-index?]
-                                                                      [export-name any/c]
-                                                                      [nominal-path nominal-path?]
-                                                                      [nominal-export-name any/c]))
-(define-form-struct (nominal-module-binding module-binding) ([path module-path-index?]
-                                                             [nominal-path nominal-path?]))
-(define-form-struct (exported-module-binding module-binding) ([path module-path-index?]
-                                                              [export-name any/c]))
-(define-form-struct (simple-module-binding module-binding) ([path module-path-index?]))
-
-(define-form-struct (module-rename wrap) ([phase (or/c exact-integer? #f)] 
-                                          [kind (or/c 'marked 'normal)] 
-                                          [set-id any/c] 
-                                          [unmarshals (listof all-from-module?)]
-                                          [renames (listof (cons/c symbol? module-binding?))] 
-                                          [mark-renames any/c] 
-                                          [plus-kern? boolean?]))
-
-; XXX better name for 'flag'
-(define-form-struct (top-level-rename wrap) ([flag boolean?]))
-
-; XXX better name for 'value'
-(define-form-struct (mark-barrier wrap) ([value symbol?]))
-
-
-
-
-
-
-
+                                     [prefix (or/c symbol? #f)]))