diff --git a/collects/compiler/decompile.ss b/collects/compiler/decompile.ss
index 70a64f71c1..4fc5259255 100644
--- a/collects/compiler/decompile.ss
+++ b/collects/compiler/decompile.ss
@@ -28,12 +28,12 @@
           (hash-set! table n (car b)))))
     table))
 
-(define (list-ref/protect l pos)
+(define (list-ref/protect l pos who)
   (list-ref l pos)
   #;
   (if (pos . < . (length l))
       (list-ref l pos)
-      `(OUT-OF-BOUNDS ,pos ,l)))
+      `(OUT-OF-BOUNDS ,who ,pos ,(length l) ,l)))
 
 ;; ----------------------------------------
 
@@ -44,7 +44,7 @@
      (let-values ([(globs defns) (decompile-prefix prefix)])
        `(begin
           ,@defns
-          ,(decompile-form form globs '(#%globals))))]
+          ,(decompile-form form globs '(#%globals) (make-hasheq))))]
     [else (error 'decompile "unrecognized: ~e" top)]))
 
 (define (decompile-prefix a-prefix)
@@ -76,7 +76,7 @@
                 lift-ids)
                (map (lambda (stx id)
                       `(define ,id ,(if stx
-                                        `(#%decode-syntax ,(stx-encoded stx))
+                                        `(#%decode-syntax ,stx #;(stx-encoded stx))
                                         #f)))
                     stxs stx-ids)))]
     [else (error 'decompile-prefix "huh?: ~e" a-prefix)]))
@@ -90,18 +90,19 @@
   (match mod-form
     [(struct mod (name self-modidx prefix provides requires body syntax-body max-let-depth))
      (let-values ([(globs defns) (decompile-prefix prefix)]
-                  [(stack) (append '(#%modvars) stack)])
+                  [(stack) (append '(#%modvars) stack)]
+                  [(closed) (make-hasheq)])
        `(module ,name ....
           ,@defns
           ,@(map (lambda (form)
-                   (decompile-form form globs stack))
+                   (decompile-form form globs stack closed))
                  syntax-body)
           ,@(map (lambda (form)
-                   (decompile-form form globs stack))
+                   (decompile-form form globs stack closed))
                  body)))]
     [else (error 'decompile-module "huh?: ~e" mod-form)]))
 
-(define (decompile-form form globs stack)
+(define (decompile-form form globs stack closed)
   (match form
     [(? mod?)
      (decompile-module form stack)]
@@ -109,31 +110,31 @@
      `(define-values ,(map (lambda (tl)
                              (match tl
                                [(struct toplevel (depth pos const? mutated?))
-                                (list-ref/protect globs pos)]))
+                                (list-ref/protect globs pos 'def-vals)]))
                            ids)
-        ,(decompile-expr rhs globs stack))]
+        ,(decompile-expr rhs globs stack closed))]
     [(struct def-syntaxes (ids rhs prefix max-let-depth))
      `(define-syntaxes ,ids
         ,(let-values ([(globs defns) (decompile-prefix prefix)])
            `(let ()
               ,@defns
-              ,(decompile-form rhs globs '(#%globals)))))]
+              ,(decompile-form rhs globs '(#%globals) closed))))]
     [(struct def-for-syntax (ids rhs prefix max-let-depth))
      `(define-values-for-syntax ,ids
         ,(let-values ([(globs defns) (decompile-prefix prefix)])
            `(let ()
              ,@defns
-             ,(decompile-expr rhs globs '(#%globals)))))]
+             ,(decompile-expr rhs globs '(#%globals) closed))))]
     [(struct sequence (forms))
      `(begin ,@(map (lambda (form)
-                      (decompile-form form globs stack))
+                      (decompile-form form globs stack closed))
                     forms))]
     [(struct splice (forms))
      `(begin ,@(map (lambda (form)
-                      (decompile-form form globs stack))
+                      (decompile-form form globs stack closed))
                     forms))]
     [else
-     (decompile-expr form globs stack)]))
+     (decompile-expr form globs stack closed)]))
 
 (define (extract-name name)
   (if (symbol? name)
@@ -168,22 +169,22 @@
      (extract-ids! body ids)]
     [else #f]))
              
-(define (decompile-expr expr globs stack)
+(define (decompile-expr expr globs stack closed)
   (match expr
     [(struct toplevel (depth pos const? mutated?))
-     (let ([id (list-ref/protect globs pos)])
+     (let ([id (list-ref/protect globs pos 'toplevel)])
        (if const?
            id
            `(#%checked ,id)))]
     [(struct topsyntax (depth pos midpt))
-     (list-ref/protect globs (+ midpt pos))]
+     (list-ref/protect globs (+ midpt pos) 'topsyntax)]
     [(struct primitive (id))
      (hash-ref primitive-table id)]
     [(struct assign (id rhs undef-ok?))
-     `(set! ,(decompile-expr id globs stack)
-            ,(decompile-expr rhs globs stack))]
+     `(set! ,(decompile-expr id globs stack closed)
+            ,(decompile-expr rhs globs stack closed))]
     [(struct localref (unbox? offset clear?))
-     (let ([id (list-ref/protect stack offset)])
+     (let ([id (list-ref/protect stack offset 'localref)])
        (let ([e (if unbox?
                     `(#%unbox ,id)
                     id)])
@@ -191,17 +192,17 @@
              `(#%sfs-clear ,e)
              e)))]
     [(? lam?)
-     `(lambda . ,(decompile-lam expr globs stack))]
+     `(lambda . ,(decompile-lam expr globs stack closed))]
     [(struct case-lam (name lams))
      `(case-lambda
        ,@(map (lambda (lam)
-                (decompile-lam lam globs stack))
+                (decompile-lam lam globs stack closed))
               lams))]
     [(struct let-one (rhs body))
      (let ([id (or (extract-id rhs)
                    (gensym 'local))])
-       `(let ([,id ,(decompile-expr rhs globs (cons id stack))])
-          ,(decompile-expr body globs (cons id stack))))]
+       `(let ([,id ,(decompile-expr rhs globs (cons id stack) closed)])
+          ,(decompile-expr body globs (cons id stack) closed)))]
     [(struct let-void (count boxes? body))
      (let ([ids (make-vector count #f)])
        (extract-ids! body ids)
@@ -210,71 +211,76 @@
                      (or id (gensym 'localv)))])
          `(let ,(map (lambda (i) `[,i ,(if boxes? `(#%box ?) '?)])
                      vars)
-            ,(decompile-expr body globs (append vars stack)))))]
+            ,(decompile-expr body globs (append vars stack) closed))))]
     [(struct let-rec (procs body))
      `(begin
         (#%set!-rec-values ,(for/list ([p (in-list procs)]
                                        [i (in-naturals)])
-                              (list-ref/protect stack i))
+                              (list-ref/protect stack i 'let-rec))
                            ,@(map (lambda (proc)
-                                    (decompile-expr proc globs stack))
+                                    (decompile-expr proc globs stack closed))
                                   procs))
-        ,(decompile-expr body globs stack))]
+        ,(decompile-expr body globs stack closed))]
     [(struct install-value (count pos boxes? rhs body))
      `(begin
         (,(if boxes? '#%set-boxes! 'set!-values)
          ,(for/list ([i (in-range count)])
-            (list-ref/protect stack (+ i pos)))
-         ,(decompile-expr rhs globs stack))
-        ,(decompile-expr body globs stack))]
+            (list-ref/protect stack (+ i pos) 'install-value))
+         ,(decompile-expr rhs globs stack closed))
+        ,(decompile-expr body globs stack closed))]
     [(struct boxenv (pos body))
-     (let ([id (list-ref/protect stack pos)])
+     (let ([id (list-ref/protect stack pos 'boxenv)])
        `(begin
           (set! ,id (#%box ,id))
-          ,(decompile-expr body globs stack)))]
+          ,(decompile-expr body globs stack closed)))]
     [(struct branch (test then else))
-     `(if ,(decompile-expr test globs stack)
-          ,(decompile-expr then globs stack)
-          ,(decompile-expr else globs stack))]
+     `(if ,(decompile-expr test globs stack closed)
+          ,(decompile-expr then globs stack closed)
+          ,(decompile-expr else globs stack closed))]
     [(struct application (rator rands))
      (let ([stack (append (for/list ([i (in-list rands)]) (gensym 'rand))
                           stack)])
        (annotate-inline
-        `(,(decompile-expr rator globs stack)
+        `(,(decompile-expr rator globs stack closed)
           ,@(map (lambda (rand)
-                   (decompile-expr rand globs stack))
+                   (decompile-expr rand globs stack closed))
                  rands))))]
     [(struct apply-values (proc args-expr))
-     `(#%apply-values ,(decompile-expr proc globs stack) 
-                      ,(decompile-expr args-expr globs stack))]
+     `(#%apply-values ,(decompile-expr proc globs stack closed) 
+                      ,(decompile-expr args-expr globs stack closed))]
     [(struct sequence (exprs))
      `(begin ,@(for/list ([expr (in-list exprs)])
-                 (decompile-expr expr globs stack)))]
+                 (decompile-expr expr globs stack closed)))]
     [(struct beg0 (exprs))
      `(begin0 ,@(for/list ([expr (in-list exprs)])
-                  (decompile-expr expr globs stack)))]
+                  (decompile-expr expr globs stack closed)))]
     [(struct with-cont-mark (key val body))
      `(with-continuation-mark
-          ,(decompile-expr key globs stack)
-          ,(decompile-expr val globs stack)
-          ,(decompile-expr body globs stack))]
+          ,(decompile-expr key globs stack closed)
+          ,(decompile-expr val globs stack closed)
+          ,(decompile-expr body globs stack closed))]
     [(struct closure (lam gen-id))
-     `(#%closed ,gen-id ,(decompile-expr lam globs stack))]
+     (if (hash-ref closed gen-id #f)
+         gen-id
+         (begin
+           (hash-set! closed gen-id #t)
+           `(#%closed ,gen-id ,(decompile-expr lam globs stack closed))))]
     [(struct indirect (val))
      (if (closure? val)
-         (closure-gen-id val)
+         (decompile-expr val globs stack closed)
          '???)]
     [else `(quote ,expr)]))
 
-(define (decompile-lam expr globs stack)
+(define (decompile-lam expr globs stack closed)
   (match expr
-    [(struct closure (lam gen-id)) (decompile-lam lam globs stack)]
+    [(struct indirect (val)) (decompile-lam val globs stack closed)]
+    [(struct closure (lam gen-id)) (decompile-lam lam globs stack closed)]
     [(struct lam (name flags num-params rest? closure-map max-let-depth body))
      (let ([vars (for/list ([i (in-range num-params)]) 
                    (gensym (format "arg~a-" i)))]
            [rest-vars (if rest? (list (gensym 'rest)) null)]
            [captures (map (lambda (v)
-                            (list-ref/protect stack v))
+                            (list-ref/protect stack v 'lam))
                           (vector->list closure-map))])
        `((,@vars . ,(if rest?
                         (car rest-vars)
@@ -285,8 +291,10 @@
          ,@(if (null? captures)
                null
                `('(captures: ,@captures)))
-         ,(decompile-expr body globs (append captures
-                                             (append vars rest-vars)))))]))
+         ,(decompile-expr body globs
+                          (append captures
+                                  (append vars rest-vars))
+                          closed)))]))
 
 (define (annotate-inline a)
   (if (and (symbol? (car a))
@@ -301,16 +309,16 @@
                                       car cdr caar cadr cdar cddr
                                       mcar mcdr unbox vector-length syntax-e
                                       add1 sub1 - abs bitwise-not
-                                      list vector box))]
+                                      list list* vector vector-immutable box))]
              [(3) (memq (car a) '(eq? = <= < >= >
                                       bitwise-bit-set? char=?
                                       + - * / min max bitwise-and bitwise-ior
                                       arithmetic-shift vector-ref string-ref bytes-ref
                                       set-mcar! set-mcdr! cons mcons
-                                      list vector))]
+                                      list list* vector vector-immutable))]
              [(4) (memq (car a) '(vector-set! string-set! bytes-set!
-                                              list vector))]
-             [else (memq (car a) '(list vector))]))
+                                              list list* vector vector-immutable))]
+             [else (memq (car a) '(list list* vector vector-immutable))]))
       (cons '#%in a)
       a))
 
diff --git a/collects/compiler/zo-parse.ss b/collects/compiler/zo-parse.ss
index a19caea4ad..57472a6c38 100644
--- a/collects/compiler/zo-parse.ss
+++ b/collects/compiler/zo-parse.ss
@@ -661,7 +661,7 @@
 ;; Main parsing loop
 
 (define (read-compact cp)
-  (let loop ([need-car 0] [proper #f] [last #f] [first #f])
+  (let loop ([need-car 0] [proper #f])
     (begin-with-definitions
       (define ch (cp-getc cp))
       (define-values (cpt-start cpt-tag) (let ([x (cpt-table-lookup ch)])
@@ -707,7 +707,7 @@
                      (cons (read-compact cp)
                            (if ppr null (read-compact cp)))
                      (read-compact-list l ppr cp))
-                 (loop l ppr last first)))]
+                 (loop l ppr)))]
           [(let-one)
            (make-let-one (read-compact cp) (read-compact cp))]
           [(branch)
@@ -747,8 +747,10 @@
                                   (read-compact cp))])
                       (vector->immutable-vector (list->vector lst)))]
           [(list) (let* ([n (read-compact-number cp)])
-                    (for/list ([i (in-range n)])
-                      (read-compact cp)))]
+                    (append
+                     (for/list ([i (in-range n)])
+                       (read-compact cp))
+                     (read-compact cp)))]
           [(prefab)
            (let ([v (read-compact cp)])
              (apply make-prefab-struct
@@ -845,9 +847,8 @@
                                             [(symbol? s) s]
                                             [(vector? s) (vector-ref s 0)]
                                             [else 'closure]))))])
-               (vector-set! (cport-symtab cp) l cl)
                (set-indirect-v! ind cl)
-               cl))]
+               ind))]
           [(svector)
            (read-compact-svector cp (read-compact-number cp))]
           [(small-svector)
@@ -858,7 +859,7 @@
         [(and proper (= need-car 1))
          (cons v null)]
         [else
-         (cons v (loop (sub1 need-car) proper last first))]))))
+         (cons v (loop (sub1 need-car) proper))]))))
 
 ;; path -> bytes
 ;; implementes read.c:read_compiled
@@ -898,11 +899,13 @@
    (define symtab (make-vector symtabsize (make-not-ready)))
 
    (define cp (make-cport 0 port size* rst symtab so* (make-vector symtabsize #f) (make-hash) (make-hash)))
+
    (for/list ([i (in-range 1 symtabsize)])
      (when (not-ready? (vector-ref symtab i))
        (set-cport-pos! cp (vector-ref so* (sub1 i)))
        (let ([v (read-compact cp)])
          (vector-set! symtab i v))))
+
    (set-cport-pos! cp shared-size)
    (read-marshalled 'compilation-top-type cp)))
 
diff --git a/collects/handin-server/main.ss b/collects/handin-server/main.ss
index 1bd32f3b5d..55291a7012 100644
--- a/collects/handin-server/main.ss
+++ b/collects/handin-server/main.ss
@@ -10,7 +10,7 @@
          "private/run-status.ss"
          "private/reloadable.ss"
          "private/hooker.ss"
-         "web-status-server.ss"
+         (prefix-in web: "web-status-server.ss")
          ;; this sets some global parameter values, and this needs
          ;; to be done in the main thread, rather than later in a
          ;; user session thread (that will make the global changes
@@ -622,9 +622,7 @@
 (log-line "server started ------------------------------")
 (hook 'server-start `([port ,(get-conf 'port-number)]))
 
-(define stop-status
-  (cond [(get-conf 'https-port-number) => serve-status]
-        [else void]))
+(define stop-status (web:run))
 
 (define session-count 0)
 
diff --git a/collects/handin-server/private/config.ss b/collects/handin-server/private/config.ss
index 892c348c4e..ffaead0b06 100644
--- a/collects/handin-server/private/config.ss
+++ b/collects/handin-server/private/config.ss
@@ -74,7 +74,6 @@
     [(allow-new-users)         (values #f                    id           )]
     [(allow-change-info)       (values #f                    id           )]
     [(master-password)         (values #f                    id           )]
-    [(web-base-dir)            (values #f                    path/false   )]
     [(log-output)              (values #t                    id           )]
     [(log-file)                (values "log"                 path/false   )]
     [(web-log-file)            (values #f                    path/false   )]
diff --git a/collects/handin-server/scribblings/quick-start.scrbl b/collects/handin-server/scribblings/quick-start.scrbl
index 5fb1855056..dc522b882e 100644
--- a/collects/handin-server/scribblings/quick-start.scrbl
+++ b/collects/handin-server/scribblings/quick-start.scrbl
@@ -50,9 +50,8 @@
   The submitted file will be @filepath{.../test/tester/handin.scm}.}
 
 @item{Check the status of your submission by pointing a web browser at
-  @tt{https://localhost:7980/servlets/status.ss}.  Note the ``s'' in
-  ``https''. Use the ``@tt{tester}'' username and ``@tt{pw}''
-  password, as before.
+  @tt{https://localhost:7980/}.  Note the ``s'' in ``https''.  Use the
+  ``@tt{tester}'' username and ``@tt{pw}'' password, as before.
 
   NOTE: The @scheme[https-port-number] line in the
   @filepath{config.ss} file enables the embedded secure server.  You
diff --git a/collects/handin-server/scribblings/server-setup.scrbl b/collects/handin-server/scribblings/server-setup.scrbl
index 1116902f2d..90429b0d91 100644
--- a/collects/handin-server/scribblings/server-setup.scrbl
+++ b/collects/handin-server/scribblings/server-setup.scrbl
@@ -114,16 +114,6 @@ This directory contains the following files and sub-directories:
     option), or @scheme[#f] for no log file; defaults to
     @filepath{log}.}
 
-  @item{@indexed-scheme[web-base-dir] --- if @scheme[#f] (the
-    default), the built-in web server will use the
-    @filepath{status-web-root} in the handin collection for its
-    configuration; to have complete control over the built in server
-    content, you can copy and edit @filepath{status-web-root}, then
-    add this configuration entry set to the name of your new copy
-    (relative to the handin server directory, or absolute).  Note that
-    you must copy the @filepath{servlets} directory if you want the
-    status servlet.}
-
   @item{@indexed-scheme[web-log-file] --- a path (relative to handin
     server directory or absolute) that specifies a filename for
     logging the internal HTTPS status web server; or @scheme[#f] (the
@@ -218,11 +208,11 @@ This directory contains the following files and sub-directories:
 
   Changes to @filepath{config.ss} are detected, the file will be
   re-read, and options are reloaded.  A few options are fixed at
-  startup time: port numbers, log file specs, and the
-  @scheme[web-base-dir] are fixed as configured at startup.  All other
-  options will change the behavior of the running server (but things
-  like @scheme[username-case-sensitive?]  it would be unwise to do
-  so).  (For safety, options are not reloaded until the file parses
+  startup time: port numbers and log file specs are fixed as
+  configured at startup.  All other options will change the behavior
+  of the running server (but things like
+  @scheme[username-case-sensitive?]  it would be unwise to do so).
+  (For safety, options are not reloaded until the file parses
   correctly, but make sure that you don't save a copy that has
   inconsistent options: it is best to create a new configuration file
   and move it over the old one, or use an editor that does so and not
@@ -482,11 +472,11 @@ the correct assignment in the handin dialog.
 A student can download his/her own submissions through a web server
 that runs concurrently with the handin server.  The starting URL is
 
-@commandline{https://SERVER:PORT/servlets/status.ss}
+@commandline{https://SERVER:PORT/}
 
 to obtain a list of all assignments, or
 
-@commandline{https://SERVER:PORT/servlets/status.ss?handin=ASSIGNMENT}
+@commandline{https://SERVER:PORT/?handin=ASSIGNMENT}
 
 to start with a specific assignment (named ASSIGNMENT).  The default
 PORT is 7980.
diff --git a/collects/handin-server/status-web-root/index.html b/collects/handin-server/status-web-root/index.html
deleted file mode 100644
index 26af46228c..0000000000
--- a/collects/handin-server/status-web-root/index.html
+++ /dev/null
@@ -1,8 +0,0 @@
-<html>
-<head><title>Handin Status Web Server</title></head>
-<body>
-The handin status server is running.
-<br>
-You can <a href="/status.ss">check your submissions</a> on this server.
-</body>
-</html>
diff --git a/collects/handin-server/status-web-root/servlets/status.ss b/collects/handin-server/status-web-root/servlets/status.ss
deleted file mode 100644
index 1f939f9a52..0000000000
--- a/collects/handin-server/status-web-root/servlets/status.ss
+++ /dev/null
@@ -1,277 +0,0 @@
-(module status mzscheme
-  (require mzlib/file
-           mzlib/list
-           mzlib/string
-           mzlib/date
-           web-server/servlet
-           web-server/servlet/servlet-structs
-           web-server/managers/timeouts
-           web-server/private/util
-           net/uri-codec
-           net/url
-           handin-server/private/md5
-           handin-server/private/logger
-           handin-server/private/config
-           handin-server/private/hooker)
-
-  (define get-user-data
-    (let ([users-file (build-path server-dir "users.ss")])
-      (lambda (user)
-        (get-preference (string->symbol user) (lambda () #f) #f users-file))))
-
-  (define (clean-str s)
-    (regexp-replace #rx" +$" (regexp-replace #rx"^ +" s "") ""))
-
-  (define (aget alist key)
-    (cond [(assq key alist) => cdr] [else #f]))
-
-  (define (make-page title . body)
-    `(html (head (title ,title))
-           (body ([bgcolor "white"]) (h1 ((align "center")) ,title) ,@body)))
-
-  (define (relativize-path p)
-    (path->string (find-relative-path (normalize-path server-dir) p)))
-
-  (define (make-k k tag)
-    (format "~a~atag=~a" k (if (regexp-match? #rx"^[^#]*[?]" k) "&" "?")
-            (uri-encode tag)))
-
-  ;; `look-for' can be a username as a string (will find "bar+foo" for "foo"),
-  ;; or a regexp that should match the whole directory name (used with
-  ;; "^solution" below)
-  (define (find-handin-entry hi look-for)
-    (let ([dir (assignment<->dir hi)])
-      (and (directory-exists? dir)
-           (ormap
-            (lambda (d)
-              (let ([d (path->string d)])
-                (and (cond [(string? look-for)
-                            (member look-for (regexp-split #rx" *[+] *" d))]
-                           [(regexp? look-for) (regexp-match? look-for d)]
-                           [else (error 'find-handin-entry
-                                        "internal error: ~e" look-for)])
-                     (build-path dir d))))
-            (directory-list dir)))))
-
-  (define (handin-link k user hi)
-    (let* ([dir (find-handin-entry hi user)]
-           [l (and dir (with-handlers ([exn:fail? (lambda (x) null)])
-                         (parameterize ([current-directory dir])
-                           (sort (filter (lambda (f)
-                                           (and (not (equal? f "grade"))
-                                                (file-exists? f)))
-                                         (map path->string (directory-list)))
-                                 string<?))))])
-      (if (pair? l)
-        (cdr (apply append
-                    (map (lambda (f)
-                           (let ([hi (build-path dir f)])
-                             `((br)
-                               (a ([href ,(make-k k (relativize-path hi))]) ,f)
-                               " ("
-                               ,(date->string
-                                 (seconds->date
-                                  (file-or-directory-modify-seconds hi))
-                                 #t)
-                               ")")))
-                         l)))
-        (list (format "No handins accepted so far for user ~s, assignment ~s"
-                      user hi)))))
-
-  (define (solution-link k hi)
-    (let ([soln (and (member (assignment<->dir hi) (get-conf 'inactive-dirs))
-                     (find-handin-entry hi #rx"^solution"))]
-          [none `((i "---"))])
-      (cond [(not soln) none]
-            [(file-exists? soln)
-             `((a ((href ,(make-k k (relativize-path soln)))) "Solution"))]
-            [(directory-exists? soln)
-             (parameterize ([current-directory soln])
-               (let ([files (sort (map path->string
-                                       (filter file-exists? (directory-list)))
-                                  string<?)])
-                 (if (null? files)
-                   none
-                   (apply append
-                          (map (lambda (f)
-                                 `((a ([href ,(make-k k (relativize-path
-                                                         (build-path soln f)))])
-                                     (tt ,f))
-                                   (br)))
-                               files)))))]
-            [else none])))
-
-  (define (handin-grade user hi)
-    (let* ([dir (find-handin-entry hi user)]
-           [grade (and dir
-                       (let ([filename (build-path dir "grade")])
-                         (and (file-exists? filename)
-                              (with-input-from-file filename
-                                (lambda ()
-                                  (read-string (file-size filename)))))))])
-      (or grade "--")))
-
-  (define (one-status-page user for-handin)
-    (let* ([next (send/suspend
-                  (lambda (k)
-                    (make-page (format "User: ~a, Handin: ~a" user for-handin)
-                      `(p ,@(handin-link k user for-handin))
-                      `(p "Grade: " ,(handin-grade user for-handin))
-                      `(p ,@(solution-link k for-handin))
-                      `(p (a ([href ,(make-k k "allofthem")])
-                            ,(format "All handins for ~a" user))))))]
-           [tag (aget (request-bindings next) 'tag)])
-      (if (string=? tag "allofthem")
-        (all-status-page user)
-        (download user tag))))
-
-  (define (all-status-page user)
-    (define (cell  . texts) `(td ([bgcolor "white"]) ,@texts))
-    (define (rcell . texts) `(td ([bgcolor "white"] [align "right"]) ,@texts))
-    (define (header . texts) `(td ([bgcolor "#f0f0f0"]) (big (strong ,@texts))))
-    (define ((row k active?) dir)
-      (let ([hi (assignment<->dir dir)])
-        `(tr ([valign "top"])
-           ,(apply header hi
-                   (if active? `((br) (small (small "[active]"))) '()))
-           ,(apply cell (handin-link k user hi))
-           ,(rcell (handin-grade user hi))
-           ,(apply cell (solution-link k hi)))))
-    (let* ([next
-            (send/suspend
-             (lambda (k)
-               (make-page
-                (format "All Handins for ~a" user)
-                `(table ([bgcolor "#ddddff"] [cellpadding "6"] [align "center"])
-                   (tr () ,@(map header '(nbsp "Files" "Grade" "Solution")))
-                   ,@(append (map (row k #t) (get-conf 'active-dirs))
-                             (map (row k #f) (get-conf 'inactive-dirs)))))))]
-           [tag (aget (request-bindings next) 'tag)])
-      (download user tag)))
-
-  (define (download who tag)
-    (define (check path elts allow-active?)
-      (let loop ([path path] [elts (reverse elts)])
-        (let*-values ([(base name dir?) (split-path path)]
-                      [(name) (path->string name)]
-                      [(check) (and (pair? elts) (car elts))])
-          (if (null? elts)
-            ;; must be rooted in a submission directory (why build-path instead
-            ;; of using `path'? -- because path will have a trailing slash)
-            (member (build-path base name)
-                    (get-conf (if allow-active? 'all-dirs 'inactive-dirs)))
-            (and (cond [(eq? '* check) #t]
-                       [(regexp? check) (regexp-match? check name)]
-                       [(string? check)
-                        (or (equal? name check)
-                            (member check (regexp-split #rx" *[+] *" name)))]
-                       [else #f])
-                 (loop base (cdr elts)))))))
-    (define file (build-path server-dir tag))
-    (with-handlers ([exn:fail?
-                     (lambda (exn)
-                       (log-line "Status exception: ~a" (exn-message exn))
-                       (make-page "Error" "Illegal file access"))])
-      ;; Make sure the user is allowed to read the requested file:
-      (or (check file `(,who *) #t)
-          (check file `(#rx"^solution") #f)
-          (check file `(#rx"^solution" *) #f)
-          (error 'download "bad file access for ~s: ~a" who file))
-      (log-line "Status file-get: ~s ~a" who file)
-      (hook 'status-file-get `([username ,(string->symbol who)] [file ,file]))
-      ;; Return the downloaded file
-      (let* ([data (with-input-from-file file
-                     (lambda () (read-bytes (file-size file))))]
-             [html? (regexp-match? #rx"[.]html?$" (string-foldcase tag))]
-             [wxme? (regexp-match? #rx#"^(?:#reader[(]lib\"read.ss\"\"wxme\"[)])?WXME" data)])
-        (make-response/full 200 "Okay" (current-seconds)
-          (cond [html? #"text/html"]
-                [wxme? #"application/data"]
-                [else  #"text/plain"])
-          (list
-           (make-header #"Content-Length"
-                        (string->bytes/latin-1
-                         (number->string (bytes-length data))))
-           (make-header #"Content-Disposition"
-                        (string->bytes/utf-8
-                         (format "~a; filename=~s"
-                                 (if wxme? "attachment" "inline")
-                                 (let-values ([(base name dir?) (split-path file)])
-                                   (path->string name))))))
-          (list data)))))
-
-  (define (status-page user for-handin)
-    (log-line "Status access: ~s" user)
-    (hook 'status-login `([username ,(string->symbol user)]))
-    (if for-handin
-      (one-status-page user for-handin)
-      (all-status-page user)))
-
-  (define (login-page for-handin errmsg)
-    (let* ([request
-            (send/suspend
-             (lambda (k)
-               (make-page
-                "Handin Status Login"
-                `(form ([action ,k] [method "post"])
-                   (table ([align "center"])
-                     (tr (td ([colspan "2"] [align "center"])
-                           (font ([color "red"]) ,(or errmsg 'nbsp))))
-                     (tr (td "Username")
-                         (td (input ([type "text"] [name "user"] [size "20"]
-                                     [value ""]))))
-                     (tr (td nbsp))
-                     (tr (td "Password")
-                         (td (input ([type "password"] [name "passwd"]
-                                     [size "20"] [value ""]))))
-                     (tr (td ([colspan "2"] [align "center"])
-                           (input ([type "submit"] [name "post"]
-                                   [value "Login"])))))))))]
-           [bindings  (request-bindings request)]
-           [user      (aget bindings 'user)]
-           [passwd    (aget bindings 'passwd)]
-           [user      (and user (clean-str user))]
-           [user-data (get-user-data user)])
-      (cond [(and user-data
-                  (string? passwd)
-                  (let ([pw (md5 passwd)])
-                    (or (equal? pw (car user-data))
-                        (equal? pw (get-conf 'master-password)))))
-             (status-page user for-handin)]
-            [else (login-page for-handin "Bad username or password")])))
-
-  (define web-counter
-    (let ([sema (make-semaphore 1)]
-          [count 0])
-      (lambda ()
-        (dynamic-wind
-          (lambda () (semaphore-wait sema))
-          (lambda () (set! count (add1 count)) (format "w~a" count))
-          (lambda () (semaphore-post sema))))))
-
-  (define (start initial-request)
-    (parameterize ([current-session (web-counter)])
-      (login-page (aget (request-bindings initial-request) 'handin) #f)))
-
-  (define interface-version 'v2)
-  (define name "status")
-
-  (define (instance-expiration-handler failed-request)
-    (let* (;; get the current url, and strip off the continuation data
-           [cont-url (request-uri failed-request)]
-           [base-url (url-replace-path
-                      (lambda (pl)
-                        (map (lambda (pp)
-                               (make-path/param (path/param-path pp) empty))
-                             pl))
-                      cont-url)]
-           [base-url-str (url->string base-url)])
-      `(html (head (meta [(http-equiv "refresh")
-                          (content ,(format "3;URL=~a" base-url-str))]))
-             (body "Your session has expired, "
-                   (a ([href ,base-url-str]) "restarting") " in 3 seconds."))))
-
-  (define manager
-    (create-timeout-manager instance-expiration-handler 600 600))
-
-  (provide interface-version start name manager))
diff --git a/collects/handin-server/web-status-server.ss b/collects/handin-server/web-status-server.ss
index b95cd91ca3..f6cc7090ce 100644
--- a/collects/handin-server/web-status-server.ss
+++ b/collects/handin-server/web-status-server.ss
@@ -1,82 +1,283 @@
-#lang scheme/base
-(require scheme/unit
-         net/ssl-tcp-unit
-         net/tcp-sig
-         net/tcp-unit
-         (only-in mzlib/etc this-expression-source-directory)
-         web-server/web-server-unit
-         web-server/web-server-sig
-         web-server/web-config-sig
-         web-server/web-config-unit
-         web-server/configuration/namespace
-         "private/config.ss")
+#lang scheme
+(require scheme/list
+         scheme/file
+         scheme/date
+         net/uri-codec
+         web-server/servlet
+         web-server/servlet-env
+         web-server/managers/lru
+         handin-server/private/md5
+         handin-server/private/logger
+         handin-server/private/config
+         handin-server/private/hooker)
 
-(provide serve-status)
+(define (aget alist key)
+  (cond [(assq key alist) => cdr] [else #f]))
 
-(define (serve-status port-no)
+(define (clean-str s)
+  (regexp-replace #rx" +$" (regexp-replace #rx"^ +" s "") ""))
 
-  (define ((in-dir dir) . paths) (path->string (apply build-path dir paths)))
-  (define in-web-dir
-    (in-dir (or (get-conf 'web-base-dir)
-                (build-path (this-expression-source-directory)
-                            "status-web-root"))))
-  (define in-plt-web-dir
-    (in-dir (build-path (collection-path "web-server") "default-web-root")))
+(define (make-page title . body)
+  `(html (head (title ,title))
+         (body ([bgcolor "white"]) (h1 ((align "center")) ,title) ,@body)))
 
-  (define config
-    `((port ,port-no)
-      (max-waiting 40)
-      (initial-connection-timeout 30)
-      (default-host-table
-        (host-table
-         (default-indices "index.html")
-         (log-format parenthesized-default)
-         (messages
-          (servlet-message "servlet-error.html")
-          (authentication-message "forbidden.html")
-          (servlets-refreshed "servlet-refresh.html")
-          (passwords-refreshed "passwords-refresh.html")
-          (file-not-found-message "not-found.html")
-          (protocol-message "protocol-error.html")
-          (collect-garbage "collect-garbage.html"))
-         (timeouts
-          (default-servlet-timeout 120)
-          (password-connection-timeout 300)
-          (servlet-connection-timeout 86400)
-          (file-per-byte-connection-timeout 1/20)
-          (file-base-connection-timeout 30))
-         (paths
-          (configuration-root ,(in-plt-web-dir "conf"))
-          (host-root ".")
-          (log-file-path ,(cond [(get-conf 'web-log-file) => path->string]
-                                [else #f]))
-          (file-root ".")
-          (servlet-root ,(in-web-dir "servlets"))
-          (mime-types ,(in-plt-web-dir "mime.types"))
-          (password-authentication ,(in-plt-web-dir "passwords")))))
-      (virtual-host-table)))
+(define get-user-data
+  (let ([users-file (build-path server-dir "users.ss")])
+    (unless (file-exists? users-file)
+      (error 'get-user-data "users file missing at: ~a" users-file))
+    (lambda (user)
+      (get-preference (string->symbol user) (lambda () #f) #f users-file))))
 
-  (define configuration
-    (configuration-table-sexpr->web-config@
-     config
-     #:web-server-root (in-web-dir)
-     #:make-servlet-namespace
-     (make-make-servlet-namespace
-      #:to-be-copied-module-specs
-      '(handin-server/private/md5
-        handin-server/private/logger
-        handin-server/private/config
-        handin-server/private/hooker
-        handin-server/private/reloadable))))
+(define (relativize-path p)
+  (path->string (find-relative-path (normalize-path server-dir) p)))
 
-  (define-unit-binding config@ configuration (import) (export web-config^))
-  (define-unit-binding ssl-tcp@
-    (make-ssl-tcp@ "server-cert.pem" "private-key.pem" #f #f #f #f #f)
-    (import) (export tcp^))
-  (define-compound-unit/infer status-server@
-    (import)
-    (link ssl-tcp@ config@ web-server@)
-    (export web-server^))
-  (define-values/invoke-unit/infer status-server@)
+(define (make-k k tag)
+  (format "~a~atag=~a" k (if (regexp-match? #rx"^[^#]*[?]" k) "&" "?")
+          (uri-encode tag)))
 
-  (serve))
+;; `look-for' can be a username as a string (will find "bar+foo" for "foo"), or
+;; a regexp that should match the whole directory name (used with "^solution"
+;; below)
+(define (find-handin-entry hi look-for)
+  (let ([dir (assignment<->dir hi)])
+    (and (directory-exists? dir)
+         (ormap
+          (lambda (d)
+            (let ([d (path->string d)])
+              (and (cond [(string? look-for)
+                          (member look-for (regexp-split #rx" *[+] *" d))]
+                         [(regexp? look-for) (regexp-match? look-for d)]
+                         [else (error 'find-handin-entry
+                                      "internal error: ~e" look-for)])
+                   (build-path dir d))))
+          (directory-list dir)))))
+
+(define (handin-link k user hi)
+  (let* ([dir (find-handin-entry hi user)]
+         [l (and dir (with-handlers ([exn:fail? (lambda (x) null)])
+                       (parameterize ([current-directory dir])
+                         (sort (filter (lambda (f)
+                                         (and (not (equal? f "grade"))
+                                              (file-exists? f)))
+                                       (map path->string (directory-list)))
+                               string<?))))])
+    (if (pair? l)
+      (cdr (append-map
+            (lambda (f)
+              (let ([hi (build-path dir f)])
+                `((br)
+                  (a ([href ,(make-k k (relativize-path hi))]) ,f)
+                  " ("
+                  ,(date->string
+                    (seconds->date (file-or-directory-modify-seconds hi))
+                    #t)
+                  ")")))
+            l))
+      (list (format "No handins accepted so far for user ~s, assignment ~s"
+                    user hi)))))
+
+(define (solution-link k hi)
+  (let ([soln (and (member (assignment<->dir hi) (get-conf 'inactive-dirs))
+                   (find-handin-entry hi #rx"^solution"))]
+        [none `((i "---"))])
+    (cond [(not soln) none]
+          [(file-exists? soln)
+           `((a ((href ,(make-k k (relativize-path soln)))) "Solution"))]
+          [(directory-exists? soln)
+           (parameterize ([current-directory soln])
+             (let ([files (sort (map path->string
+                                     (filter file-exists? (directory-list)))
+                                string<?)])
+               (if (null? files)
+                 none
+                 (apply append
+                        (map (lambda (f)
+                               `((a ([href ,(make-k k (relativize-path
+                                                       (build-path soln f)))])
+                                    (tt ,f))
+                                 (br)))
+                             files)))))]
+          [else none])))
+
+(define (handin-grade user hi)
+  (let* ([dir (find-handin-entry hi user)]
+         [grade (and dir
+                     (let ([filename (build-path dir "grade")])
+                       (and (file-exists? filename)
+                            (with-input-from-file filename
+                              (lambda ()
+                                (read-string (file-size filename)))))))])
+    (or grade "--")))
+
+(define (one-status-page user for-handin)
+  (let* ([next (send/suspend
+                (lambda (k)
+                  (make-page (format "User: ~a, Handin: ~a" user for-handin)
+                    `(p ,@(handin-link k user for-handin))
+                    `(p "Grade: " ,(handin-grade user for-handin))
+                    `(p ,@(solution-link k for-handin))
+                    `(p (a ([href ,(make-k k "allofthem")])
+                           ,(format "All handins for ~a" user))))))]
+         [tag (aget (request-bindings next) 'tag)])
+    (if (string=? tag "allofthem")
+      (all-status-page user)
+      (download user tag))))
+
+(define (all-status-page user)
+  (define (cell  . texts) `(td ([bgcolor "white"]) ,@texts))
+  (define (rcell . texts) `(td ([bgcolor "white"] [align "right"]) ,@texts))
+  (define (header . texts) `(td ([bgcolor "#f0f0f0"]) (big (strong ,@texts))))
+  (define ((row k active?) dir)
+    (let ([hi (assignment<->dir dir)])
+      `(tr ([valign "top"])
+         ,(apply header hi (if active? `((br) (small (small "[active]"))) '()))
+         ,(apply cell (handin-link k user hi))
+         ,(rcell (handin-grade user hi))
+         ,(apply cell (solution-link k hi)))))
+  (let* ([next
+          (send/suspend
+           (lambda (k)
+             (make-page
+              (format "All Handins for ~a" user)
+              `(table ([bgcolor "#ddddff"] [cellpadding "6"] [align "center"])
+                 (tr () ,@(map header '(nbsp "Files" "Grade" "Solution")))
+                 ,@(append (map (row k #t) (get-conf 'active-dirs))
+                           (map (row k #f) (get-conf 'inactive-dirs)))))))]
+         [tag (aget (request-bindings next) 'tag)])
+    (download user tag)))
+
+(define (download who tag)
+  (define (check path elts allow-active?)
+    (let loop ([path path] [elts (reverse elts)])
+      (let*-values ([(base name dir?) (split-path path)]
+                    [(name) (path->string name)]
+                    [(check) (and (pair? elts) (car elts))])
+        (if (null? elts)
+          ;; must be rooted in a submission directory (why build-path instead
+          ;; of using `path'? -- because path will have a trailing slash)
+          (member (build-path base name)
+                  (get-conf (if allow-active? 'all-dirs 'inactive-dirs)))
+          (and (cond [(eq? '* check) #t]
+                     [(regexp? check) (regexp-match? check name)]
+                     [(string? check)
+                      (or (equal? name check)
+                          (member check (regexp-split #rx" *[+] *" name)))]
+                     [else #f])
+               (loop base (cdr elts)))))))
+  (define file (build-path server-dir tag))
+  (with-handlers ([exn:fail?
+                   (lambda (exn)
+                     (log-line "Status exception: ~a" (exn-message exn))
+                     (make-page "Error" "Illegal file access"))])
+    ;; Make sure the user is allowed to read the requested file:
+    (or (check file `(,who *) #t)
+        (check file `(#rx"^solution") #f)
+        (check file `(#rx"^solution" *) #f)
+        (error 'download "bad file access for ~s: ~a" who file))
+    (log-line "Status file-get: ~s ~a" who file)
+    (hook 'status-file-get `([username ,(string->symbol who)] [file ,file]))
+    ;; Return the downloaded file
+    (let* ([data (file->bytes file)]
+           [html? (regexp-match? #rx"[.]html?$" (string-foldcase tag))]
+           [wxme? (regexp-match?
+                   #rx#"^(?:#reader[(]lib\"read.ss\"\"wxme\"[)])?WXME" data)])
+      (make-response/full 200 "Okay" (current-seconds)
+        (cond [html? #"text/html"]
+              [wxme? #"application/data"]
+              [else  #"text/plain"])
+        (list
+         (make-header #"Content-Length"
+                      (string->bytes/latin-1
+                       (number->string (bytes-length data))))
+         (make-header #"Content-Disposition"
+                      (string->bytes/utf-8
+                       (format "~a; filename=~s"
+                               (if wxme? "attachment" "inline")
+                               (let-values ([(base name dir?) (split-path file)])
+                                 (path->string name))))))
+        (list data)))))
+
+(define (status-page user for-handin)
+  (log-line "Status access: ~s" user)
+  (hook 'status-login `([username ,(string->symbol user)]))
+  (if for-handin
+    (one-status-page user for-handin)
+    (all-status-page user)))
+
+(define (login-page for-handin errmsg)
+  (let* ([request
+          (send/suspend
+           (lambda (k)
+             (make-page
+              "Handin Status Login"
+              `(form ([action ,k] [method "post"])
+                 (table ([align "center"])
+                   (tr (td ([colspan "2"] [align "center"])
+                           (font ([color "red"]) ,(or errmsg 'nbsp))))
+                   (tr (td "Username")
+                       (td (input ([type "text"] [name "user"] [size "20"]
+                                   [value ""]))))
+                   (tr (td nbsp))
+                   (tr (td "Password")
+                       (td (input ([type "password"] [name "passwd"]
+                                   [size "20"] [value ""]))))
+                   (tr (td ([colspan "2"] [align "center"])
+                           (input ([type "submit"] [name "post"]
+                                   [value "Login"])))))))))]
+         [bindings  (request-bindings request)]
+         [user      (aget bindings 'user)]
+         [passwd    (aget bindings 'passwd)]
+         [user      (and user (clean-str user))]
+         [user-data (get-user-data user)])
+    (cond [(and user-data
+                (string? passwd)
+                (let ([pw (md5 passwd)])
+                  (or (equal? pw (car user-data))
+                      (equal? pw (get-conf 'master-password)))))
+           (status-page user for-handin)]
+          [else (login-page for-handin "Bad username or password")])))
+
+(define web-counter
+  (let ([sema (make-semaphore 1)] [count 0])
+    (lambda ()
+      (dynamic-wind
+        (lambda () (semaphore-wait sema))
+        (lambda () (set! count (add1 count)) (format "w~a" count))
+        (lambda () (semaphore-post sema))))))
+
+(define ((send-error msg) req)
+  `(html (head (meta [(http-equiv "refresh") (content "3;URL=/")])
+               (title ,msg))
+         (body ,msg "; " (a ([href "/"]) "restarting") " in 3 seconds.")))
+
+(define ((run-servlet port))
+  (define dir (string->path server-dir))
+  (serve/servlet
+   (lambda (request)
+     (parameterize ([current-session (web-counter)])
+       (login-page (aget (request-bindings request) 'handin) #f)))
+   #:port port #:listen-ip #f #:ssl? #t #:command-line? #t
+   #:servlet-path "/" #:servlet-regexp #rx""
+   #:server-root-path dir #:servlets-root dir
+   #:file-not-found-responder (send-error "File not found")
+   #:servlet-namespace '(handin-server/private/md5
+                         handin-server/private/logger
+                         handin-server/private/config
+                         handin-server/private/hooker
+                         handin-server/private/reloadable)
+   #:manager (make-threshold-LRU-manager
+              (send-error "Your session has expired") (* 12 1024 1024))
+   #:log-file (get-conf 'web-log-file)))
+
+(provide run)
+(define (run)
+  (cond [(get-conf 'https-port-number)
+         => (lambda (p)
+              (define t
+                (thread (lambda ()
+                          (dynamic-wind
+                            (lambda () (log-line "*** starting web server"))
+                            (run-servlet p)
+                            (lambda () (log-line "*** web server died!"))))))
+              (lambda () (break-thread t)))]
+        [else void]))
diff --git a/collects/net/scribblings/url.scrbl b/collects/net/scribblings/url.scrbl
index 43fa60828c..287c374e2c 100644
--- a/collects/net/scribblings/url.scrbl
+++ b/collects/net/scribblings/url.scrbl
@@ -44,7 +44,7 @@ re-exported by @schememodname[net/url].}
                 [query (listof (cons/c symbol? (or/c false/c string?)))]
                 [fragment (or/c false/c string?)])]{
 
-The basic structure for all URLs, hich is explained in RFC 3986
+The basic structure for all URLs, which is explained in RFC 3986
 @cite["RFC3986"]. The following diagram illustrates the parts:
 
 @verbatim[#:indent 2]|{
diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss
index cd6d48b8c9..925fa0040c 100644
--- a/collects/repos-time-stamp/stamp.ss
+++ b/collects/repos-time-stamp/stamp.ss
@@ -1 +1 @@
-#lang scheme/base (provide stamp) (define stamp "19nov2008")
+#lang scheme/base (provide stamp) (define stamp "20nov2008")
diff --git a/collects/tests/mzscheme/optimize.ss b/collects/tests/mzscheme/optimize.ss
index 0ed2853c66..98894a67c0 100644
--- a/collects/tests/mzscheme/optimize.ss
+++ b/collects/tests/mzscheme/optimize.ss
@@ -350,6 +350,9 @@
     (un0 '(1) 'list 1)
     (bin0 '(1 2) 'list 1 2)
     (tri0 '(1 2 3) 'list (lambda () 1) 2 3 void)
+    (un0 '1 'list* 1)
+    (bin0 '(1 . 2) 'list* 1 2)
+    (tri0 '(1 2 . 3) 'list* (lambda () 1) 2 3 void)
     (un0 '#&1 'box 1)
 
     (let ([test-setter
@@ -443,17 +446,19 @@
 	      (list a b c d e f))])
      10))
 
-(test-comp (normalize-depth '(let* ([i (cons 0 1)][j i]) j))
-	   (normalize-depth '(let* ([i (cons 0 1)]) i)))
+;; We use nonsense `display' and `write' where we used to use `cons' and
+;; `list', because the old ones now get optimized away:
+(test-comp (normalize-depth '(let* ([i (display 0 1)][j i]) j))
+	   (normalize-depth '(let* ([i (display 0 1)]) i)))
 
-(test-comp (normalize-depth '(let* ([i (cons 0 1)][j (list 2)][k (list 3)][g i]) g))
-	   (normalize-depth '(let* ([i (cons 0 1)][j (list 2)][k (list 3)]) i)))
+(test-comp (normalize-depth '(let* ([i (display 0 1)][j (write 2)][k (write 3)][g i]) g))
+	   (normalize-depth '(let* ([i (display 0 1)][j (write 2)][k (write 3)]) i)))
 
-(test-comp (normalize-depth '(let* ([i (cons 0 1)][j (list 2)][k (list 3)][g i][h g]) h))
-	   (normalize-depth '(let* ([i (cons 0 1)][j (list 2)][k (list 3)]) i)))
+(test-comp (normalize-depth '(let* ([i (display 0 1)][j (write 2)][k (write 3)][g i][h g]) h))
+	   (normalize-depth '(let* ([i (display 0 1)][j (write 2)][k (write 3)]) i)))
 
-(test-comp (normalize-depth '(let* ([i (cons 0 1)][g i][h (car g)][m h]) m))
-	   (normalize-depth '(let* ([i (cons 0 1)][h (car i)]) h)))
+(test-comp (normalize-depth '(let* ([i (display 0 1)][g i][h (car g)][m h]) m))
+	   (normalize-depth '(let* ([i (display 0 1)][h (car i)]) h)))
 
 ; (require #%kernel) ; 
 
@@ -685,6 +690,26 @@
               (define (q x)
                 (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ x 10))))))))))))))
 
+(let ([test-dropped
+       (lambda (cons-name . args)
+         (test-comp `(let ([x 5])
+                       (let ([y (,cons-name ,@args)])
+                         x))
+                    5))])
+  (test-dropped 'cons 1 2)
+  (test-dropped 'mcons 1 2)
+  (test-dropped 'box 1)
+  (let ([test-multi
+         (lambda (cons-name)
+           (test-dropped cons-name 1 2)
+           (test-dropped cons-name 1 2 3)
+           (test-dropped cons-name 1)
+           (test-dropped cons-name))])
+    (test-multi 'list)
+    (test-multi 'list*)
+    (test-multi 'vector)
+    (test-multi 'vector-immutable)))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Check bytecode verification of lifted functions
 
diff --git a/collects/web-server/template/examples/basic.html b/collects/tests/web-server/template/examples/basic.html
similarity index 100%
rename from collects/web-server/template/examples/basic.html
rename to collects/tests/web-server/template/examples/basic.html
diff --git a/collects/web-server/template/examples/if.html b/collects/tests/web-server/template/examples/if.html
similarity index 100%
rename from collects/web-server/template/examples/if.html
rename to collects/tests/web-server/template/examples/if.html
diff --git a/collects/web-server/template/examples/run.ss b/collects/tests/web-server/template/examples/run.ss
similarity index 100%
rename from collects/web-server/template/examples/run.ss
rename to collects/tests/web-server/template/examples/run.ss
diff --git a/collects/web-server/template/examples/static.html b/collects/tests/web-server/template/examples/static.html
similarity index 100%
rename from collects/web-server/template/examples/static.html
rename to collects/tests/web-server/template/examples/static.html
diff --git a/collects/texpict/utils.ss b/collects/texpict/utils.ss
index f787dd868f..ff0305dadc 100644
--- a/collects/texpict/utils.ss
+++ b/collects/texpict/utils.ss
@@ -286,9 +286,9 @@
             w
             h))))
   
-  (define (filled-rounded-rectangle w h [corner-radius 0.25] #:angle [angle 0])
+  (define (filled-rounded-rectangle w h [corner-radius -0.25] #:angle [angle 0])
     (let ([dc-path (new dc-path%)])
-      (send dc-path rounded-rectangle 0 0 w h (- corner-radius))
+      (send dc-path rounded-rectangle 0 0 w h corner-radius)
       (send dc-path rotate angle)
       (let-values ([(x y w h) (send dc-path get-bounding-box)])
         (dc (λ (dc dx dy) 
diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss
index 1bcfa78f87..641376322e 100644
--- a/collects/typed-scheme/private/base-env.ss
+++ b/collects/typed-scheme/private/base-env.ss
@@ -2,6 +2,7 @@
 
 (require
  scheme/list
+ scheme/tcp
  (only-in rnrs/lists-6 fold-left)
  '#%paramz
  (only-in '#%kernel [apply kernel:apply])
@@ -480,4 +481,16 @@
 [eof (-val eof)]
 [read-accept-reader (-Param B B)]
 
-[maybe-print-message (-String . -> . -Void)]
\ No newline at end of file
+[maybe-print-message (-String . -> . -Void)]
+
+;; scheme/tcp
+[tcp-listener? (make-pred-ty -TCP-Listener)]
+[tcp-abandon-port (-Port . -> . -Void)]
+[tcp-accept (-TCP-Listener . -> . (-values (list -Input-Port -Output-Port)) )]
+[tcp-accept/enable-break (-TCP-Listener . -> . (-values (list -Input-Port -Output-Port)) )]
+[tcp-accept-ready? (-TCP-Listener . -> . B )]
+[tcp-addresses (-Port . -> . (-values (list N N)))]
+[tcp-close (-TCP-Listener . -> . -Void )]
+[tcp-connect (-String -Integer . -> . (-values (list -Input-Port -Output-Port)))]
+[tcp-connect/enable-break (-String -Integer . -> . (-values (list -Input-Port -Output-Port)))]
+[tcp-listen (N . -> . -TCP-Listener)]
\ No newline at end of file
diff --git a/collects/typed-scheme/private/type-effect-convenience.ss b/collects/typed-scheme/private/type-effect-convenience.ss
index 6776fe5419..217e0c0c7d 100644
--- a/collects/typed-scheme/private/type-effect-convenience.ss
+++ b/collects/typed-scheme/private/type-effect-convenience.ss
@@ -12,7 +12,7 @@
          scheme/promise
          (for-syntax macro-debugger/stxclass/stxclass)
          (for-syntax scheme/base)
-         (for-template scheme/base scheme/contract))
+         (for-template scheme/base scheme/contract scheme/tcp))
 
 (provide (all-defined-out) 
          ;; these should all eventually go away
@@ -134,6 +134,7 @@
 (define -Namespace (make-Base 'Namespace #'namespace?))
 (define -Output-Port (make-Base 'Output-Port #'output-port?))
 (define -Input-Port (make-Base 'Input-Port #'input-port?))
+(define -TCP-Listener (make-Base 'TCP-Listener #'tcp-listener?))
 
 (define -Syntax make-Syntax)
 (define -HT make-Hashtable)
diff --git a/collects/typed/file/gif.ss b/collects/typed/file/gif.ss
new file mode 100644
index 0000000000..402c340692
--- /dev/null
+++ b/collects/typed/file/gif.ss
@@ -0,0 +1,16 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/opaque-type GIF-Stream gif-stream? file/gif)
+
+(require/typed/provide file/gif
+  [gif-start ( Output-Port Number Number Number (U #f (Listof (Vectorof Number))) -> Void )]
+  [gif-add-image ( GIF-Stream Number Number Number Number Boolean (U #f Number) String -> Void )]
+  [gif-add-control ( GIF-Stream Symbol Boolean Number (U #f Number) -> Void)]
+  [gif-add-loop-control ( GIF-Stream Number -> Void )]
+  [gif-add-comment ( GIF-Stream String -> Void )]
+  [gif-end ( GIF-Stream -> Void )]
+  [quantize ( String -> (values String (Listof (Vectorof Number)) (U #f (Vectorof Number))))])
+  
+(provide gif-stream? GIF-Stream)
diff --git a/collects/typed/framework/framework.ss b/collects/typed/framework/framework.ss
index fab2f91dff..513cfa1d29 100644
--- a/collects/typed/framework/framework.ss
+++ b/collects/typed/framework/framework.ss
@@ -1,6 +1,7 @@
 #lang typed-scheme
              
-(require (only-in typed/mred/mred dt require/typed/provide Font%))
+(require typed/private/utils
+         (only-in typed/mred/mred Font%))
 
 (dt Style-List% (Class () 
                        ()
diff --git a/collects/typed/mred/mred.ss b/collects/typed/mred/mred.ss
index 03f60efbd5..80984c28a8 100644
--- a/collects/typed/mred/mred.ss
+++ b/collects/typed/mred/mred.ss
@@ -1,14 +1,6 @@
 #lang typed-scheme
 
-(define-syntax-rule (dt nm t)
-  (begin (define-type-alias nm t) (provide nm)))
-
-(define-syntax-rule (require/typed/provide lib [nm t] ...)
-  (begin
-    (require/typed lib [nm t] ...)
-    (provide nm ...)))
-
-(provide dt require/typed/provide)
+(require typed/private/utils)
 
 (dt Bitmap% (Class (Number Number Boolean)
                    () 
diff --git a/collects/typed/net/base64.ss b/collects/typed/net/base64.ss
new file mode 100644
index 0000000000..13061e4ea5
--- /dev/null
+++ b/collects/typed/net/base64.ss
@@ -0,0 +1,13 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/typed/provide net/base64
+  [base64-encode-stream (case-lambda (Input-Port Output-Port -> Void)
+                                     (Input-Port Output-Port Bytes -> Void))]
+  [base64-decode-stream (Input-Port Output-Port -> Void)]
+  [base64-encode (Bytes -> Bytes)]
+  [base64-decode (Bytes -> Bytes)])
+
+(provide base64-encode-stream base64-decode-stream base64-encode base64-decode)
+  
\ No newline at end of file
diff --git a/collects/typed/net/cgi.ss b/collects/typed/net/cgi.ss
new file mode 100644
index 0000000000..7287e6f073
--- /dev/null
+++ b/collects/typed/net/cgi.ss
@@ -0,0 +1,27 @@
+#lang typed-scheme
+  
+(require typed/private/utils)
+
+(require-typed-struct cgi-error () net/cgi)
+(require-typed-struct incomplete-%-suffix  ([chars : (Listof Char)]) net/cgi) 
+(require-typed-struct invalid-%-suffix  ([char : Char]) net/cgi)
+  
+(require/typed/provide net/cgi
+  [get-bindings (-> (Listof (cons (U Symbol String) String)))]
+  [get-bindings/post (-> (Listof (Pair (U Symbol String) String)))]
+  [get-bindings/get (-> (Listof (Pair (U Symbol String) String)) )]
+  [output-http-headers (-> Void)]
+  [generate-html-output (case-lambda (String (Listof String) -> Void) 
+				     (String (Listof String) String String String String String -> Void))]
+  [generate-error-output ((Listof String) -> (U))]
+  [bindings-as-html ((Listof (cons (U Symbol String) String)) -> (Listof String))]
+  [extract-bindings ((U Symbol String) (Listof (cons (U Symbol String) String)) -> ( Listof  String))]
+  [extract-binding/single ((U Symbol String) (Listof (Pair (U Symbol String) String)) ->  String)]
+  [get-cgi-method (-> (U "GET" "POST"))]
+  [string->html (String -> String)]
+  [generate-link-text (String String -> String)])
+
+(provide
+ (struct-out cgi-error)
+ (struct-out incomplete-%-suffix)
+ (struct-out invalid-%-suffix))
\ No newline at end of file
diff --git a/collects/typed/net/cookie.ss b/collects/typed/net/cookie.ss
new file mode 100644
index 0000000000..f2ff60224c
--- /dev/null
+++ b/collects/typed/net/cookie.ss
@@ -0,0 +1,23 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/opaque-type Cookie cookie? net/cookie)
+
+(require/typed/provide net/cookie
+  [set-cookie (String String -> Cookie)]
+  [cookie:add-comment (Cookie String -> Cookie)]
+  [cookie:add-domain (Cookie String -> Cookie)]
+  [cookie:add-max-age (Cookie Number -> Cookie)]
+  [cookie:add-path (Cookie String -> Cookie)]
+  [cookie:secure (Cookie Boolean -> Cookie)]
+  [cookie:version (Cookie Number -> Cookie)]
+  
+  [print-cookie (Cookie -> String)]
+  
+  [get-cookie (String String -> (Listof String))]
+  [get-cookie/single (String String -> (Option String))])
+
+(require-typed-struct  cookie-error () net/cookie)
+
+(provide Cookie cookie? (struct-out cookie-error))
\ No newline at end of file
diff --git a/collects/typed/net/dns.ss b/collects/typed/net/dns.ss
new file mode 100644
index 0000000000..24ef679f81
--- /dev/null
+++ b/collects/typed/net/dns.ss
@@ -0,0 +1,10 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/typed/provide net/dns
+  [dns-get-address (String String -> String)]
+  [dns-get-name (String String -> String)]
+  [dns-get-mail-exchanger (String String -> String )]
+  [dns-find-nameserver (-> (Option String))])
+
diff --git a/collects/typed/net/ftp.ss b/collects/typed/net/ftp.ss
new file mode 100644
index 0000000000..041befc0d5
--- /dev/null
+++ b/collects/typed/net/ftp.ss
@@ -0,0 +1,16 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/opaque-type FTP-Connection ftp-connection? net/ftp)
+
+(require/typed/provide net/ftp
+  [ftp-cd (FTP-Connection String -> Void)]
+  [ftp-establish-connection (String Number String String -> FTP-Connection)]
+  [ftp-close-connection (FTP-Connection -> Void)]
+  [ftp-directory-list (FTP-Connection -> (Listof (List (U "-" "d" "l") String String)))]
+  [ftp-download-file (FTP-Connection Path String -> Void)]
+  [ftp-make-file-seconds (String -> Number)])
+
+(provide ftp-connection? FTP-Connection)
+
diff --git a/collects/typed/net/gifwrite.ss b/collects/typed/net/gifwrite.ss
new file mode 100644
index 0000000000..cfe9167c5b
--- /dev/null
+++ b/collects/typed/net/gifwrite.ss
@@ -0,0 +1,4 @@
+#lang typed-scheme
+
+(require typed/file/gif)
+(provide (all-from-out typed/file/gif))
diff --git a/collects/typed/net/head.ss b/collects/typed/net/head.ss
new file mode 100644
index 0000000000..958eea1ef7
--- /dev/null
+++ b/collects/typed/net/head.ss
@@ -0,0 +1,31 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/typed/provide net/head
+  [empty-header String]
+  [validate-header (String -> Void)]
+  [extract-field (Bytes (U Bytes String) -> (Option Bytes))]
+  [remove-field (String String -> String)]
+  [insert-field (String String String -> String)]
+  [replace-field (String String String -> String)]
+  [extract-all-fields ((U String Bytes) -> (Listof (cons (U String Bytes) (U Bytes String))))]
+  [append-headers (String String -> String)]
+  [standard-message-header (String (Listof String) (Listof String) (Listof String) String -> String)]
+  [data-lines->data ((Listof String) -> String)]
+  [extract-addresses (String Symbol -> (U (Listof String) (Listof (Listof String))))]
+  [assemble-address-field ((Listof String) -> String)])
+
+(provide
+ empty-header
+ validate-header
+ extract-field
+ remove-field
+ insert-field
+ replace-field
+ extract-all-fields
+ append-headers
+ standard-message-header
+ data-lines->data
+ extract-addresses
+ assemble-address-field)
\ No newline at end of file
diff --git a/collects/typed/net/imap.ss b/collects/typed/net/imap.ss
new file mode 100644
index 0000000000..a4639fad19
--- /dev/null
+++ b/collects/typed/net/imap.ss
@@ -0,0 +1,55 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/opaque-type IMAP-Connection imap-connection? net/imap)
+
+(define-type-alias bstring (U String Bytes))
+
+(require/typed/provide net/imap
+  [imap-port-number (Number -> Void)]   
+  
+  [imap-connect (String String String String -> (values IMAP-Connection Number Number))] 
+  [imap-connect* (Number Number String String String -> (values IMAP-Connection Number Number))]
+  [imap-disconnect (IMAP-Connection -> Void)]
+  [imap-force-disconnect (IMAP-Connection -> Void)]
+  [imap-reselect (IMAP-Connection String -> (values Number Number))]
+  [imap-examine (IMAP-Connection String -> (values Number Number))]
+  [imap-noop (IMAP-Connection -> (values Number Number))]
+  [imap-status (IMAP-Connection String (Listof Symbol) -> (Listof (Listof Number)))]
+  [imap-poll (IMAP-Connection -> Void)]
+  
+  [imap-new? (IMAP-Connection -> Boolean)]
+  [imap-messages (IMAP-Connection -> Number)]
+  [imap-recent (IMAP-Connection -> Number)]
+  [imap-uidnext (IMAP-Connection -> (Option Number))]
+  [imap-uidvalidity (IMAP-Connection -> (Option Number))]
+  [imap-unseen (IMAP-Connection -> (Option Number))]
+  [imap-reset-new! (IMAP-Connection -> Void)]
+  
+  [imap-get-expunges (IMAP-Connection -> (Listof Number))]
+  [imap-pending-expunges? (IMAP-Connection -> Boolean)]
+  [imap-get-updates (IMAP-Connection -> (Listof (cons Number (Listof (Pair Any Any)))))]
+  [imap-pending-updates? (IMAP-Connection -> Boolean)]
+  
+  [imap-get-messages 
+   (IMAP-Connection (Listof Number) Symbol -> (Listof (Listof (U Number String String (Listof Symbol)))))]
+  [imap-copy  (IMAP-Connection (Listof Number) String -> Void)]
+  [imap-append (IMAP-Connection String String -> Void)] 
+  [imap-store (IMAP-Connection Symbol (Listof Number) Symbol -> Void)]
+  [imap-flag->symbol (Symbol -> Symbol)]
+  [symbol->imap-flag (Symbol -> Symbol)]
+  [imap-expunge (IMAP-Connection -> Void)]
+  
+  [imap-mailbox-exists? (IMAP-Connection String -> Boolean)]
+  [imap-create-mailbox (IMAP-Connection String -> Void)]
+  
+  [imap-list-child-mailboxes 
+   (case-lambda (IMAP-Connection bstring -> (Listof (cons (Listof Symbol) (cons String '()))))
+                (IMAP-Connection bstring (Option bstring) -> (Listof (List (Listof Symbol) String))))]
+  [imap-mailbox-flags (IMAP-Connection String -> (Listof Symbol))]
+  [imap-get-hierarchy-delimiter (IMAP-Connection -> String)])
+
+(provide
+ imap-connection?
+ IMAP-Connection)
\ No newline at end of file
diff --git a/collects/typed/net/mime.ss b/collects/typed/net/mime.ss
new file mode 100644
index 0000000000..167f000335
--- /dev/null
+++ b/collects/typed/net/mime.ss
@@ -0,0 +1,71 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+;; -- basic mime structures --
+(require-typed-struct disposition
+                      ([type : Symbol] 
+                       [filename : String]
+                       [creation : String]
+                       [modification : String]
+                       [read : String]                                       
+                       [size : Number]
+                       [params : Any])
+                      net/mime)
+(require-typed-struct entity  ([type : (U Symbol String)] 
+                               [subtype : (U Symbol String)] 
+                               [charset : (U Symbol String)] 
+                               [encoding : Symbol]
+                               [disposition : disposition ]
+                               [params : (Listof (cons Symbol String))]
+                               [id : String]
+                               [description : String] 
+                               [other : String]
+                               [fields : Any]
+                               [parts : (Listof String) ]
+                               [body : (Output-Port -> Void)])
+                      net/mime)
+(require-typed-struct message 
+                      ([version : String] [entity :  entity] [fields : (Listof Symbol)])
+                      net/mime)
+
+
+;; -- exceptions raised --
+(require/typed mime-error? (Any -> Boolean : (Opaque mime-error?)) net/mime)
+(require/typed unexpected-termination? (Any -> Boolean :(Opaque unexpected-termination?)) net/mime)
+(require/typed unexpected-termination-msg ((Opaque unexpected-termination?) -> message) net/mime)
+(require/typed missing-multipart-boundary-parameter? (Any -> Boolean : (Opaque missing-multipart-boundary-parameter?)) net/mime)
+(require/typed malformed-multipart-entity? (Any -> Boolean : (Opaque malformed-multipart-entity?)) net/mime)
+(require/typed malformed-multipart-entity-msg ((Opaque malformed-multipart-entity?)-> message) net/mime)
+(require/typed empty-mechanism? (Any -> Boolean : (Opaque empty-mechanism?)) net/mime)
+(require/typed empty-type? (Any -> Boolean : (Opaque empty-type?)) net/mime)
+(require/typed empty-subtype? (Any -> Boolean : (Opaque empty-subtype?)) net/mime)
+(require/typed empty-disposition-type? (Any -> Boolean : (Opaque empty-disposition-type?)) net/mime)
+
+
+;; -- mime methods --
+(require/typed/provide net/mime
+  [mime-analyze ((U Bytes Input-Port) Any -> message)])
+
+(provide
+ ;; -- exceptions raised --
+ mime-error? 
+ unexpected-termination? 
+ unexpected-termination-msg
+ missing-multipart-boundary-parameter? 
+ malformed-multipart-entity?
+ malformed-multipart-entity-msg
+ empty-mechanism? 
+ empty-type? 
+ empty-subtype?
+ empty-disposition-type? 
+ 
+ ;; -- basic mime structures --
+ message 
+ entity
+ 
+ disposition
+ 
+ ;; -- mime methods --
+ mime-analyze
+)
+
diff --git a/collects/typed/net/nntp.ss b/collects/typed/net/nntp.ss
new file mode 100644
index 0000000000..04468077f1
--- /dev/null
+++ b/collects/typed/net/nntp.ss
@@ -0,0 +1,31 @@
+#lang typed-scheme
+  
+(require typed/private/utils)
+
+(require-typed-struct communicator ([sender : Number] [receiver : Number] [server : String] [port : Number])
+		      net/nntp)
+
+(require/typed/provide net/nntp  
+  [connect-to-server (case-lambda (String -> communicator) (String Number -> communicator))]
+  [disconnect-from-server (communicator -> Void)]
+  [authenticate-user  (communicator String String -> Void)]
+  [open-news-group (communicator String -> (values Number Number Number))]
+  [head-of-message  (communicator Number -> (Listof String))]
+  [body-of-message (communicator Number -> (Listof String))]
+  [newnews-since  (communicator Number -> (Listof String))]
+  [generic-message-command (communicator Number -> (Listof String))]
+  [make-desired-header  (String -> String)] ;;-> Regexp
+  [extract-desired-headers ((Listof String) (Listof String) -> (Listof String))]) ;;2nd: Of Regexp
+#|
+;; requires structure inheritance
+(require-typed-struct nntp ()]
+(require-typed-struct unexpected-response ([code : Number] [text : String])]
+(require-typed-struct bad-status-line ([line : String])]
+(require-typed-struct premature-close ([communicator : communicator])]
+(require-typed-struct bad-newsgroup-line ([line : String])]
+(require-typed-struct non-existent-group ([group : String])]
+(require-typed-struct article-not-in-group ([article : Number])]
+(require-typed-struct no-group-selected ()]
+(require-typed-struct article-not-found ([article : Number])]
+(require-typed-struct authentication-rejected ()]
+|#
diff --git a/collects/typed/net/pop3.ss b/collects/typed/net/pop3.ss
new file mode 100644
index 0000000000..8ecaa8f528
--- /dev/null
+++ b/collects/typed/net/pop3.ss
@@ -0,0 +1,38 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require-typed-struct communicator ([sender : Number] [receiver : Number] [server : String] [port : Number] [state : Symbol])net/pop3)
+
+(require/typed/provide net/pop3
+  [connect-to-server ( case-lambda (String -> (Opaque communicator?)) (String Number -> (Opaque communicator?)) )] 
+
+  [disconnect-from-server ( (Opaque communicator?) -> Void )]
+  [authenticate/plain-text ( String String (Opaque communicator?) -> Void )]
+  [get-mailbox-status ( (Opaque communicator?) -> (values Number Number) )]
+  [get-message/complete  ( (Opaque communicator?) Number -> (values (Listof String)(Listof String)) )]
+  [get-message/headers  ( (Opaque communicator?) Number -> (Listof String) )]
+  [get-message/body ( (Opaque communicator?) Number -> (Listof String) )]
+  [delete-message ( (Opaque communicator?) Number -> Void )]
+  [get-unique-id/single  ( (Opaque communicator?) Number -> String )]
+  [get-unique-id/all ( (Opaque communicator?) -> (Listof (cons Number String)) )]
+  
+  [make-desired-header  ( String -> String )];-> Regexp
+  [extract-desired-headers ( (Listof String)(Listof String)-> (Listof String) )];2nd:of Regexp
+  )
+(provide (struct-out communicator))
+
+#|
+(require-typed-struct pop3 ()]
+(require-typed-struct cannot-connect ()]
+(require-typed-struct username-rejected ()]
+(require-typed-struct password-rejected ()]
+(require-typed-struct not-ready-for-transaction ([ communicator : (Opaque communicator?) ])net/pop3) 
+(require-typed-struct not-given-headers ([ communicator : (Opaque communicator?) ] [message : String])]
+(require-typed-struct illegal-message-number ([communicator : (Opaque communicator?)] [message : String])]
+(require-typed-struct cannot-delete-message ([communicator : (Opaque communicator?)] [message : String])] 
+(require-typed-struct disconnect-not-quiet ([communicator : (Opaque communicator?)])]
+(require-typed-struct malformed-server-response ([communicator : (Opaque communicator?)])net/pop3) 
+|#
+
+  
\ No newline at end of file
diff --git a/collects/typed/net/qp.ss b/collects/typed/net/qp.ss
new file mode 100644
index 0000000000..092ccdde3a
--- /dev/null
+++ b/collects/typed/net/qp.ss
@@ -0,0 +1,10 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/typed/provide net/qp
+  [qp-encode ( String -> String )]
+  [qp-decode ( String -> String )]
+  [qp-encode-stream (case-lambda (Input-Port Output-Port -> Void) (Input-Port Output-Port String -> Void) )]
+  [qp-decode-stream ( Input-Port Output-Port -> Void )])
+  
\ No newline at end of file
diff --git a/collects/typed/net/sendmail.ss b/collects/typed/net/sendmail.ss
new file mode 100644
index 0000000000..1dd748d8be
--- /dev/null
+++ b/collects/typed/net/sendmail.ss
@@ -0,0 +1,12 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/typed/provide net/sendmail
+  [send-mail-message/port 
+   (String String (Listof String) (Listof String) (Listof String) String * -> Output-Port)]
+  [send-mail-message
+   (String String (Listof String) (Listof String) (Listof String) (Listof String) String * -> Output-Port)])
+  
+(provide send-mail-message/port send-mail-message #;no-mail-recipients)
+  
\ No newline at end of file
diff --git a/collects/typed/net/sendurl.ss b/collects/typed/net/sendurl.ss
new file mode 100644
index 0000000000..205096db36
--- /dev/null
+++ b/collects/typed/net/sendurl.ss
@@ -0,0 +1,9 @@
+#lang typed-scheme
+(require/typed net/sendurl
+	       [send-url (String -> Void)]
+	       [unix-browser-list (Listof Symbol)]
+	       [browser-preference? (String -> Boolean)]
+	       [external-browser  (-> (U Symbol #f (Pair String String)))])
+
+(provide send-url unix-browser-list browser-preference? external-browser)
+  
\ No newline at end of file
diff --git a/collects/typed/net/smtp.ss b/collects/typed/net/smtp.ss
new file mode 100644
index 0000000000..4923a4b116
--- /dev/null
+++ b/collects/typed/net/smtp.ss
@@ -0,0 +1,11 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/typed/provide net/smtp
+  [smtp-send-message (String String (Listof String) String (Listof String) -> Void)]
+  [smtp-sending-end-of-message (Parameter (-> Any))])
+  
+(provide smtp-send-message smtp-sending-end-of-message)
+  
+  
\ No newline at end of file
diff --git a/collects/typed/net/uri-codec.ss b/collects/typed/net/uri-codec.ss
new file mode 100644
index 0000000000..bfbc991191
--- /dev/null
+++ b/collects/typed/net/uri-codec.ss
@@ -0,0 +1,15 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/typed/provide net/uri-codec
+  [uri-encode ( String -> String )]
+  [uri-decode ( String -> String )]
+  
+  [form-urlencoded-encode ( String -> String )]
+  [form-urlencoded-decode ( String -> String )]
+  
+  [alist->form-urlencoded ( (Listof (cons Symbol String)) -> String )]
+  [form-urlencoded->alist ( String -> (Listof (cons Symbol String)) )]
+  [current-alist-separator-mode (Parameter Symbol)])
+    
\ No newline at end of file
diff --git a/collects/typed/net/url.ss b/collects/typed/net/url.ss
new file mode 100644
index 0000000000..86add4fef6
--- /dev/null
+++ b/collects/typed/net/url.ss
@@ -0,0 +1,59 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require-typed-struct path/param ([path : (U String 'up 'same)] [param : (Listof String)]) net/url)
+
+(require-typed-struct url ([scheme : (Option String)]
+                           [user : (Option String)]
+                           [host : (Option String)]
+                           [port : (Option Integer)]
+                           [path-absolute? : Boolean]
+                           [path : (Listof path/param)] 
+                           [query : (Listof (Pair Symbol (Option String)))]
+                           [fragment : (Option String)])
+                      net/url)
+
+(require/opaque-type URL-Exception url-exception? net/url)
+
+(define-type-alias PortT (case-lambda (url -> Input-Port) (url (Listof String)-> Input-Port)))
+(define-type-alias PortT/String (case-lambda (url String -> Input-Port) (url String (Listof String)-> Input-Port)))
+
+(require/typed/provide net/url
+  
+  [path->url (Path -> url)]
+  [url->path (case-lambda (url -> Path) (url (U 'unix 'windows) -> Path))]
+  
+  [file-url-path-convention-type (Parameter (U 'unix 'windows))]
+  
+  [get-pure-port PortT]  
+  [head-pure-port PortT]
+  [delete-pure-port PortT]
+  
+  [get-impure-port PortT]  
+  [head-impure-port PortT]  
+  [delete-impure-port PortT]
+  
+  [post-pure-port PortT/String]
+  [put-pure-port PortT/String]
+  
+  [post-impure-port PortT/String]  
+  [put-impure-port PortT/String]
+  
+  [display-pure-port (Input-Port -> Void)]
+  [purify-port (Input-Port -> String)]
+  
+  [call/input-url (case-lambda [url url (Input-Port -> Any) -> Any])] ;;FIXME - need polymorphism
+  
+  [current-proxy-servers (Parameter (Listof (List String String Integer)))]
+  
+  [netscape/string->url (String -> url)]
+  [string->url (String -> url)]
+  [url->string (url -> String)]
+  [combine-url/relative (url String -> url)])
+
+(provide
+ URL-Exception
+ url-exception?
+ (struct-out url)
+ (struct-out path/param))   
diff --git a/collects/typed/private/utils.ss b/collects/typed/private/utils.ss
new file mode 100644
index 0000000000..c1fdbea7f6
--- /dev/null
+++ b/collects/typed/private/utils.ss
@@ -0,0 +1,11 @@
+#lang typed-scheme
+
+(define-syntax-rule (dt nm t)
+  (begin (define-type-alias nm t) (provide nm)))
+
+(define-syntax-rule (require/typed/provide lib [nm t] ...)
+  (begin
+    (require/typed lib [nm t] ...)
+    (provide nm ...)))
+
+(provide dt require/typed/provide)
diff --git a/collects/web-server/dispatchers/dispatch-servlets.ss b/collects/web-server/dispatchers/dispatch-servlets.ss
index cf0147436f..a28932d4db 100644
--- a/collects/web-server/dispatchers/dispatch-servlets.ss
+++ b/collects/web-server/dispatchers/dispatch-servlets.ss
@@ -51,10 +51,6 @@
                                           #:responders-servlet (url? any/c . -> . response?))
             dispatcher/c)])
 
-;; default-server-instance-expiration-handler : (request -> response)
-(define (default-servlet-instance-expiration-handler req)
-  (next-dispatcher))
-
 (define (make url->servlet
               #:responders-servlet-loading [responders-servlet-loading servlet-loading-responder]
               #:responders-servlet [responders-servlet servlet-error-responder])
@@ -70,15 +66,6 @@
       (define response
         (with-handlers ([exn:fail:filesystem:exists?
                          (lambda (the-exn) (next-dispatcher))]
-                        [exn:fail:servlet-manager:no-instance?
-                         (lambda (the-exn)
-                           ((exn:fail:servlet-manager:no-instance-expiration-handler the-exn) req))]
-                        [exn:fail:servlet-manager:no-continuation?
-                         (lambda (the-exn)
-                           ((exn:fail:servlet-manager:no-continuation-expiration-handler the-exn) req))]
-                        [exn:fail:servlet:instance?
-                         (lambda (the-exn)
-                           (default-servlet-instance-expiration-handler req))]
                         [(lambda (x) #t)
                          (lambda (the-exn) (responders-servlet-loading uri the-exn))])
           (define the-servlet (url->servlet uri))
@@ -87,10 +74,7 @@
                          [current-directory (servlet-directory the-servlet)]
                          [current-namespace (servlet-namespace the-servlet)])
             (with-handlers ([(lambda (x) #t)
-                             (lambda (exn)
-                               (responders-servlet
-                                (request-uri req)
-                                exn))])
+                             (lambda (exn) (responders-servlet uri exn))])
               (call-with-continuation-barrier 
                (lambda ()
                  (call-with-continuation-prompt
diff --git a/collects/web-server/private/launch.ss b/collects/web-server/private/launch.ss
index c24473910c..6884af754f 100644
--- a/collects/web-server/private/launch.ss
+++ b/collects/web-server/private/launch.ss
@@ -18,7 +18,7 @@
         default)))
 
 (define ssl (make-parameter #f))
-(define port (make-parameter 80))
+(define port (make-parameter #f))
 
 (define configuration@
   (parse-command-line
@@ -27,7 +27,7 @@
    `((once-each
       [("--ssl")
        ,(lambda (flag)
-          (port 443)
+          (unless (port) (port 443))
           (ssl #t))
        ("Run with SSL using server-cert.pem and private-key.pem in the current directory, with 443 as the default port.")]
       [("-f" "--configuration-table")
@@ -41,7 +41,10 @@
        ("Use an alternate configuration table" "file-name")]
       [("-p" "--port")
        ,(lambda (flag the-port)
-          (port (string->number the-port)))
+          (let ([p (string->number the-port)])
+            (if (and (integer? p) (<= 1 p 65535))
+              (port p)
+              (error 'web-server "expecting a valid port number, got \"~a\"" the-port))))
        ("Use an alternate network port." "port")]
       [("-a" "--ip-address")
        ,(lambda (flag ip-address)
@@ -58,7 +61,7 @@
    (lambda (flags)
      (configuration-table->web-config@
       (extract-flag 'config flags default-configuration-table-path)
-      #:port (port)
+      #:port (or (port) 80)
       #:listen-ip (extract-flag 'ip-address flags #f)))
    '()))
 
diff --git a/collects/web-server/private/mime-types.ss b/collects/web-server/private/mime-types.ss
index 429953a88e..b129767d36 100644
--- a/collects/web-server/private/mime-types.ss
+++ b/collects/web-server/private/mime-types.ss
@@ -1,7 +1,7 @@
 #lang scheme/base
-(require mzlib/contract
-         mzlib/plt-match
-         mzlib/string)
+(require scheme/contract
+         scheme/match
+         scheme/promise)
 (require "util.ss"
          web-server/http)
 (provide/contract
@@ -17,13 +17,9 @@
         (match (read-line (current-input-port) 'any)
           [(? eof-object?)
            (void)]
-          [(regexp #"^([^\t ]+)[\t ]+(.+)$"
-                   (list s type exts))
-           (for-each (lambda (ext)
-                       (hash-set! MIME-TYPE-TABLE
-                                  (lowercase-symbol! ext)
-                                  type))
-                     (regexp-split #" " exts))
+          [(regexp #rx#"^([^\t ]+)[\t ]+(.+)$" (list _ type exts))
+           (for ([ext (in-list (regexp-split #" " exts))])
+             (hash-set! MIME-TYPE-TABLE (lowercase-symbol! ext) type))
            (loop)]
           [_
            (loop)]))))
@@ -36,12 +32,11 @@
 ;; 1. Can we determine the mime type based on file contents?
 ;; 2. Assuming that 7-bit ASCII is correct for mime-type
 (define (make-path->mime-type a-path)
-  (define MIME-TYPE-TABLE (read-mime-types a-path))
-  (define file-suffix-regexp (byte-regexp #".*\\.([^\\.]*$)"))
+  (define MIME-TYPE-TABLE (delay (read-mime-types a-path)))
   (lambda (path)
-    (match (regexp-match file-suffix-regexp (path->bytes path))
-      [(list path-bytes sffx)
-       (hash-ref MIME-TYPE-TABLE
+    (match (path->bytes path)
+      [(regexp #rx#".*\\.([^\\.]*$)" (list _ sffx))
+       (hash-ref (force MIME-TYPE-TABLE)
                  (lowercase-symbol! sffx)
-                 (lambda () TEXT/HTML-MIME-TYPE))]
+                 TEXT/HTML-MIME-TYPE)]
       [_ TEXT/HTML-MIME-TYPE])))
diff --git a/collects/web-server/private/servlet.ss b/collects/web-server/private/servlet.ss
index 392d740b75..482f394fff 100644
--- a/collects/web-server/private/servlet.ss
+++ b/collects/web-server/private/servlet.ss
@@ -4,7 +4,6 @@
          web-server/http)
 
 (define servlet-prompt (make-continuation-prompt-tag 'servlet))
-(define-struct (exn:fail:servlet:instance exn:fail) ())
 (define-struct servlet (custodian namespace manager directory handler)
   #:mutable)
 (define-struct execution-context (request))
@@ -18,9 +17,6 @@
 
 (provide/contract
  [servlet-prompt continuation-prompt-tag?]
- [struct (exn:fail:servlet:instance exn:fail)
-         ([message string?]
-          [continuation-marks continuation-mark-set?])]
  [struct servlet 
          ([custodian custodian?]
           [namespace namespace?]
diff --git a/collects/web-server/scribblings/servlet-env.scrbl b/collects/web-server/scribblings/servlet-env.scrbl
index 7b93592f84..f4eda42536 100644
--- a/collects/web-server/scribblings/servlet-env.scrbl
+++ b/collects/web-server/scribblings/servlet-env.scrbl
@@ -6,7 +6,10 @@
 @(require (for-label web-server/servlet-env
                      web-server/http
                      web-server/managers/lru
+                     web-server/private/util
+                     web-server/configuration/configuration-table
                      web-server/configuration/responders
+                     web-server/dispatchers/dispatch-log
                      scheme/list))
 
 @defmodule[web-server/servlet-env]{
@@ -82,12 +85,16 @@ If you want to use @scheme[serve/servlet] in a start up script for a Web server,
                         [#:launch-browser? launch-browser? boolean? (not command-line?)]
                         [#:quit? quit? boolean? (not command-line?)]
                         [#:banner? banner? boolean? (not command-line?)]
-                        [#:listen-ip listen-ip string? "127.0.0.1"]
+                        [#:listen-ip listen-ip (or/c false/c string?) "127.0.0.1"]
                         [#:port port number? 8000]
+                        [#:ssl? ssl? boolean? #f]
                         [#:servlet-path servlet-path string?
                                         "/servlets/standalone.ss"]
                         [#:servlet-regexp servlet-regexp regexp?
-                                          (regexp (format "^~a$" (regexp-quote servlet-path)))]
+                                          (regexp 
+                                           (format 
+                                            "^~a$"
+                                            (regexp-quote servlet-path)))]
                         [#:stateless? stateless? boolean? #f]
                         [#:manager manager manager? (make-threshold-LRU-manager #f (* 1024 1024 64))]
                         [#:servlet-namespace servlet-namespace (listof module-path?) empty]
@@ -96,9 +103,24 @@ If you want to use @scheme[serve/servlet] in a start up script for a Web server,
                         [#:servlets-root servlets-root path? (build-path server-root-path "htdocs")]
                         [#:servlet-current-directory servlet-current-directory path? servlets-root]
                         [#:file-not-found-responder file-not-found-responder
-                                                    (gen-file-not-found-responder (build-path server-root-path "conf" "not-found.html"))]
+                                                    (request? . -> . response?)
+                                                    (gen-file-not-found-responder 
+                                                     (build-path
+                                                      server-root-path
+                                                      "conf"
+                                                      "not-found.html"))]
                         [#:mime-types-path mime-types-path path?
-                                           (build-path server-root-path "mime.types")])
+                                           (let ([p (build-path
+                                                     server-root-path
+                                                     "mime.types")])
+                                             (if (file-exists? p)
+                                                 p
+                                                 (build-path
+                                                  (directory-part 
+                                                   default-configuration-table-path)
+                                                  "mime.types")))]
+                        [#:log-file log-file path? #f]
+                        [#:log-format log-format symbol? 'apache-default])
                        void]{
  This sets up and starts a fairly default server instance.
       
@@ -115,6 +137,9 @@ If you want to use @scheme[serve/servlet] in a start up script for a Web server,
  
  The server listens on @scheme[listen-ip] and port @scheme[port].
  
+ If @scheme[ssl?] is true, then the server runs in HTTPS mode with @filepath{<server-root-path>/server-cert.pem}
+ and @filepath{<server-root-path>/private-key.pem} as the certificates and private keys 
+ 
  The servlet is loaded with @scheme[manager]
  as its continuation manager. (The default manager limits the amount of memory to 64 MB and
  deals with memory pressure as discussed in the @scheme[make-threshold-LRU-manager] documentation.)
@@ -133,6 +158,9 @@ If you want to use @scheme[serve/servlet] in a start up script for a Web server,
  running from the command line, in which case the @scheme[command-line?] option controls similar options.
  
  MIME types are looked up at @scheme[mime-types-path].
+ 
+ If @scheme[log-file] is given, then it used to log requests using @scheme[log-format] as the format. Allowable formats
+ are those allowed by @scheme[log-format->format].
 }
 
 }
\ No newline at end of file
diff --git a/collects/web-server/servlet-env.ss b/collects/web-server/servlet-env.ss
index e6988ba34d..17166d313c 100644
--- a/collects/web-server/servlet-env.ss
+++ b/collects/web-server/servlet-env.ss
@@ -3,13 +3,17 @@
 #lang scheme/base
 (require (prefix-in net: net/sendurl)
          scheme/contract
-         scheme/list)
+         scheme/list
+         scheme/unit
+         net/tcp-unit
+         net/tcp-sig
+         net/ssl-tcp-unit)
 (require web-server/web-server
          web-server/managers/lru
          web-server/managers/manager
          web-server/private/servlet
          web-server/configuration/namespace
-         web-server/private/cache-table 
+         web-server/private/cache-table
          web-server/http
          web-server/private/util
          web-server/configuration/responders
@@ -18,11 +22,12 @@
          web-server/configuration/configuration-table
          web-server/servlet/setup
          (prefix-in lift: web-server/dispatchers/dispatch-lift)
-         (prefix-in fsmap: web-server/dispatchers/filesystem-map)         
+         (prefix-in fsmap: web-server/dispatchers/filesystem-map)
          (prefix-in sequencer: web-server/dispatchers/dispatch-sequencer)
          (prefix-in files: web-server/dispatchers/dispatch-files)
-         (prefix-in filter: web-server/dispatchers/dispatch-filter)         
-         (prefix-in servlets: web-server/dispatchers/dispatch-servlets))
+         (prefix-in filter: web-server/dispatchers/dispatch-filter)
+         (prefix-in servlets: web-server/dispatchers/dispatch-servlets)
+         (prefix-in log: web-server/dispatchers/dispatch-log))
 
 (define send-url (make-parameter net:send-url))
 
@@ -30,93 +35,117 @@
   (lift:make
    (lambda (request)
      (thread (lambda () (sleep 2) (semaphore-post sema)))
-     `(html
-       (head
-        (title "Server Stopped")
-        (link ([rel "stylesheet"] [href "/error.css"])))
-       (body
-        (div ([class "section"])
-             (div ([class "title"]) "Server Stopped")
-             (p "Return to DrScheme.")))))))
+     `(html (head (title "Server Stopped")
+              (link ([rel "stylesheet"] [href "/error.css"])))
+            (body (div ([class "section"])
+                    (div ([class "title"]) "Server Stopped")
+                    (p "Return to DrScheme.")))))))
 
 (provide/contract
  [serve/servlet (((request? . -> . response?))
                  (#:command-line? boolean?
-                                  #:launch-browser? boolean?
-                                  #:quit? boolean?
-                                  #:banner? boolean?
-                                  #:listen-ip string?
-                                  #:port number?
-                                  #:manager manager?
-                                  #:servlet-namespace (listof module-path?)
-                                  #:server-root-path path?
-                                  #:stateless? boolean?
-                                  #:extra-files-paths (listof path?)
-                                  #:servlets-root path?
-                                  #:file-not-found-responder (request? . -> . response?)
-                                  #:mime-types-path path?
-                                  #:servlet-path string?
-                                  #:servlet-regexp regexp?)
+                  #:launch-browser? boolean?
+                  #:quit? boolean?
+                  #:banner? boolean?
+                  #:listen-ip (or/c false/c string?)
+                  #:port number?
+                  #:ssl? boolean?
+                  #:manager manager?
+                  #:servlet-namespace (listof module-path?)
+                  #:server-root-path path?
+                  #:stateless? boolean?
+                  #:extra-files-paths (listof path?)
+                  #:servlets-root path?
+                  #:file-not-found-responder (request? . -> . response?)
+                  #:mime-types-path path?
+                  #:servlet-path string?
+                  #:servlet-regexp regexp?
+                  #:log-file (or/c false/c path?))
                  . ->* .
                  void)])
-(define (serve/servlet start 
-                       #:command-line?
-                       [command-line? #f]
-                       #:launch-browser?
-                       [launch-browser? (not command-line?)]
-                       #:quit?
-                       [quit? (not command-line?)]
-                       #:banner?
-                       [banner? (not command-line?)]
-                       
-                       #:listen-ip
-                       [listen-ip "127.0.0.1"]
-                       #:port
-                       [the-port 8000]
-                       
-                       #:manager
-                       [manager 
-                        (make-threshold-LRU-manager
-                         (lambda (request)
-                           `(html (head (title "Page Has Expired."))
-                                  (body (p "Sorry, this page has expired. Please go back."))))
-                         (* 64 1024 1024))]          
-                       
-                       #:servlet-path
-                       [servlet-path "/servlets/standalone.ss"]
-                       #:servlet-regexp
-                       [servlet-regexp (regexp (format "^~a$" (regexp-quote servlet-path)))]
-                       #:stateless? 
-                       [stateless? #f]
-                       
-                       #:servlet-namespace
-                       [servlet-namespace empty]
-                       #:server-root-path 
-                       [server-root-path (directory-part default-configuration-table-path)]
-                       #:extra-files-paths 
-                       [extra-files-paths (list (build-path server-root-path "htdocs"))]
-                       #:servlets-root
-                       [servlets-root (build-path server-root-path "htdocs")]
-                       #:servlet-current-directory
-                       [servlet-current-directory servlets-root]
-                       #:file-not-found-responder
-                       [file-not-found-responder (gen-file-not-found-responder (build-path server-root-path "conf" "not-found.html"))]
-                       #:mime-types-path
-                       [mime-types-path (build-path server-root-path "mime.types")])
+
+;; utility for conveniently chaining dispatchers
+(define (dispatcher-sequence . dispatchers)
+  (let loop ([ds dispatchers] [r '()])
+    (cond [(null? ds) (apply sequencer:make (reverse r))]
+          [(not (car ds))   (loop (cdr ds) r)]
+          [(list? (car ds)) (loop (append (car ds) (cdr ds)) r)]
+          [else (loop (cdr ds) (cons (car ds) r))])))
+
+(define (serve/servlet
+         start
+         #:command-line?
+         [command-line? #f]
+         #:launch-browser?
+         [launch-browser? (not command-line?)]
+         #:quit?
+         [quit? (not command-line?)]
+         #:banner?
+         [banner? (not command-line?)]
+
+         #:listen-ip
+         [listen-ip "127.0.0.1"]
+         #:port
+         [the-port 8000]
+         #:ssl?
+         [ssl? #f]
+
+         #:manager
+         [manager
+          (make-threshold-LRU-manager
+           (lambda (request)
+             `(html (head (title "Page Has Expired."))
+                    (body (p "Sorry, this page has expired. Please go back."))))
+           (* 64 1024 1024))]
+
+         #:servlet-path
+         [servlet-path "/servlets/standalone.ss"]
+         #:servlet-regexp
+         [servlet-regexp (regexp (format "^~a$" (regexp-quote servlet-path)))]
+         #:stateless?
+         [stateless? #f]
+
+         #:servlet-namespace
+         [servlet-namespace empty]
+         #:server-root-path
+         [server-root-path (directory-part default-configuration-table-path)]
+         #:extra-files-paths
+         [extra-files-paths (list (build-path server-root-path "htdocs"))]
+         #:servlets-root
+         [servlets-root (build-path server-root-path "htdocs")]
+         #:servlet-current-directory
+         [servlet-current-directory servlets-root]
+         #:file-not-found-responder
+         [file-not-found-responder
+          (gen-file-not-found-responder
+           (build-path server-root-path "conf" "not-found.html"))]
+         #:mime-types-path
+         [mime-types-path (let ([p (build-path server-root-path "mime.types")])
+                            (if (file-exists? p)
+                              p
+                              (build-path
+                               (directory-part default-configuration-table-path)
+                               "mime.types")))]
+
+         #:log-file
+         [log-file #f]
+         #:log-format
+         [log-format 'apache-default])
   (define standalone-url
-    (format "http://localhost:~a~a" the-port servlet-path))
+    (string-append (if ssl? "https" "http")
+                   "://localhost"
+                   (if (and (not ssl?) (= the-port 80))
+                     "" (format ":~a" the-port))
+                   servlet-path))
   (define make-servlet-namespace
-    (make-make-servlet-namespace
-     #:to-be-copied-module-specs servlet-namespace))
+    (make-make-servlet-namespace #:to-be-copied-module-specs servlet-namespace))
   (define sema (make-semaphore 0))
   (define servlet-box (box #f))
   (define dispatcher
-    (sequencer:make
-     (if quit?
-         (filter:make 
-          #rx"^/quit$"
-          (quit-server sema))
-         (lambda _ (next-dispatcher)))
+    (dispatcher-sequence
+     (and log-file (log:make #:format (log:log-format->format log-format)
+                             #:log-path log-file))
+     (and quit? (filter:make #rx"^/quit$" (quit-server sema)))
      (filter:make
       servlet-regexp
       (servlets:make
@@ -129,8 +158,8 @@
                                      #:additional-specs
                                      default-module-specs)])
                       (if stateless?
-                          (make-stateless.servlet servlet-current-directory start)
-                          (make-v2.servlet servlet-current-directory manager start)))])
+                        (make-stateless.servlet servlet-current-directory start)
+                        (make-v2.servlet servlet-current-directory manager start)))])
                (set-box! servlet-box servlet)
                servlet)))))
      (let-values ([(clear-cache! url->servlet)
@@ -142,35 +171,40 @@
                     (make-default-path->servlet
                      #:make-servlet-namespace make-servlet-namespace))])
        (servlets:make url->servlet))
-     (apply sequencer:make
-            (map (lambda (extra-files-path)
-                   (files:make 
-                    #:url->path (fsmap:make-url->path
-                                 extra-files-path)
-                    #:path->mime-type (make-path->mime-type mime-types-path)
-                    #:indices (list "index.html" "index.htm")))
-                 extra-files-paths))
-     (files:make 
-      #:url->path (fsmap:make-url->path 
-                   (build-path server-root-path "htdocs"))
-      #:path->mime-type (make-path->mime-type (build-path server-root-path "mime.types"))
+     (map (lambda (extra-files-path)
+            (files:make
+             #:url->path (fsmap:make-url->path extra-files-path)
+             #:path->mime-type (make-path->mime-type mime-types-path)
+             #:indices (list "index.html" "index.htm")))
+          extra-files-paths)
+     (files:make
+      #:url->path (fsmap:make-url->path (build-path server-root-path "htdocs"))
+      #:path->mime-type (make-path->mime-type mime-types-path)
       #:indices (list "index.html" "index.htm"))
      (lift:make file-not-found-responder)))
   (define shutdown-server
     (serve #:dispatch dispatcher
            #:listen-ip listen-ip
-           #:port the-port))
+           #:port the-port
+           #:tcp@ (if ssl?
+                    (let ()
+                      (define-unit-binding ssl-tcp@
+                        (make-ssl-tcp@
+                         (build-path server-root-path "server-cert.pem")
+                         (build-path server-root-path "private-key.pem")
+                         #f #f #f #f #f)
+                        (import) (export tcp^))
+                      ssl-tcp@)
+                    tcp@)))
   (when launch-browser?
     ((send-url) standalone-url #t))
   (when banner?
-    (printf "Your Web application is running at ~a.~n" standalone-url)
-    (printf "Click 'Stop' at any time to terminate the Web Server.~n"))
-  (with-handlers
-      ([exn:break?
-        (lambda (exn)
-          (when banner?
-            (printf "~nWeb Server stopped.~n"))
-          (shutdown-server))])
-    (semaphore-wait/enable-break sema))
-  ; We shouldn't get here, because nothing posts to the semaphore. But just in case...
-  (shutdown-server))
\ No newline at end of file
+    (printf "Your Web application is running at ~a.\n" standalone-url)
+    (printf "Click 'Stop' at any time to terminate the Web Server.\n"))
+  (let ([bye (lambda ()
+               (when banner? (printf "\nWeb Server stopped.\n"))
+               (shutdown-server))])
+    (with-handlers ([exn:break? (lambda (exn) (bye))])
+      (semaphore-wait/enable-break sema)
+      ;; We can get here if a /quit url is visited
+      (bye))))
diff --git a/collects/web-server/servlet/setup.ss b/collects/web-server/servlet/setup.ss
index 2cecb0b0d5..b3d85f1451 100644
--- a/collects/web-server/servlet/setup.ss
+++ b/collects/web-server/servlet/setup.ss
@@ -49,19 +49,26 @@
    (lambda (req)
      (define uri (request-uri req))
      
-     (define-values (instance-id handler)
-       (cond
-         [(continuation-url? uri)
-          => (match-lambda
-               [(list instance-id k-id salt)
-                (values instance-id
-                        (custodian-box-value ((manager-continuation-lookup manager) instance-id k-id salt)))])]
-         [else
-          (values ((manager-create-instance manager) (exit-handler))
-                  start)]))
-     
-     (parameterize ([current-servlet-instance-id instance-id])
-       (handler req)))))
+     (with-handlers ([exn:fail:servlet-manager:no-instance?
+                      (lambda (the-exn)
+                        ((exn:fail:servlet-manager:no-instance-expiration-handler the-exn) req))]
+                     [exn:fail:servlet-manager:no-continuation?
+                      (lambda (the-exn)
+                        ((exn:fail:servlet-manager:no-continuation-expiration-handler the-exn) req))])
+       
+       (define-values (instance-id handler)
+         (cond
+           [(continuation-url? uri)
+            => (match-lambda
+                 [(list instance-id k-id salt)
+                  (values instance-id
+                          (custodian-box-value ((manager-continuation-lookup manager) instance-id k-id salt)))])]
+           [else
+            (values ((manager-create-instance manager) (exit-handler))
+                    start)]))
+       
+       (parameterize ([current-servlet-instance-id instance-id])
+         (handler req))))))
 
 (define (make-stateless.servlet directory start)
   (define ses 
diff --git a/collects/web-server/web-server.ss b/collects/web-server/web-server.ss
index 3a293ad793..1491095d57 100644
--- a/collects/web-server/web-server.ss
+++ b/collects/web-server/web-server.ss
@@ -15,25 +15,25 @@
  [serve
   (->* (#:dispatch dispatcher/c)
        (#:tcp@ unit?
-               #:port number?
-               #:listen-ip (or/c false/c string?)
-               #:max-waiting number?
-               #:initial-connection-timeout number?)
+        #:port number?
+        #:listen-ip (or/c false/c string?)
+        #:max-waiting number?
+        #:initial-connection-timeout number?)
        (-> void))]
  [serve/ports
   (->* (#:dispatch dispatcher/c)
        (#:tcp@ unit?
-               #:ports (listof number?)
-               #:listen-ip (or/c false/c string?)
-               #:max-waiting number?
-               #:initial-connection-timeout number?)
+        #:ports (listof number?)
+        #:listen-ip (or/c false/c string?)
+        #:max-waiting number?
+        #:initial-connection-timeout number?)
        (-> void))]
  [serve/ips+ports
   (->* (#:dispatch dispatcher/c)
        (#:tcp@ unit?
-               #:ips+ports (listof (cons/c (or/c false/c string?) (listof number?)))
-               #:max-waiting number?
-               #:initial-connection-timeout number?)
+        #:ips+ports (listof (cons/c (or/c false/c string?) (listof number?)))
+        #:max-waiting number?
+        #:initial-connection-timeout number?)
        (-> void))]
  [do-not-return (-> void)]
  [serve/web-config@ ((unit?) (#:tcp@ unit?) . ->* . (-> void?))])
@@ -59,7 +59,7 @@
     dispatch-server@/tcp@
     (import dispatch-server-config^)
     (export dispatch-server^))
-  
+
   (serve))
 
 (define (serve/ports
diff --git a/doc/release-notes/drscheme/HISTORY.txt b/doc/release-notes/drscheme/HISTORY.txt
index 2ecc672274..6421c44f94 100644
--- a/doc/release-notes/drscheme/HISTORY.txt
+++ b/doc/release-notes/drscheme/HISTORY.txt
@@ -1,3 +1,16 @@
+------------------------------
+        Version 4.3
+------------------------------
+
+  . minor bug fixes
+
+------------------------------
+        Version 4.2
+------------------------------
+
+  . contract library's function contract 
+    combinatiors now preserve tail recursion.
+
 ------------------------------
         Version 4.1
 ------------------------------
diff --git a/doc/release-notes/stepper/HISTORY.txt b/doc/release-notes/stepper/HISTORY.txt
index b80dff5077..fe02426a99 100644
--- a/doc/release-notes/stepper/HISTORY.txt
+++ b/doc/release-notes/stepper/HISTORY.txt
@@ -1,6 +1,10 @@
 Stepper
 -------
 
+Changes for v4.1.3:
+
+Minor bug fixes.
+
 Changes for v4.1.2:
 
 None.
diff --git a/src/mred/wxme/wx_mpbrd.cxx b/src/mred/wxme/wx_mpbrd.cxx
index b038ab87f1..17f6bb9730 100644
--- a/src/mred/wxme/wx_mpbrd.cxx
+++ b/src/mred/wxme/wx_mpbrd.cxx
@@ -317,7 +317,6 @@ void wxMediaPasteboard::OnDefaultEvent(wxMouseEvent *event)
   if (!admin)
     return;
 
-  /* First, find clicked-on snip: */
   x = event->x;
   y = event->y;
   
diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c
index 1a169a3daa..1aff3b6e8a 100644
--- a/src/mzscheme/src/eval.c
+++ b/src/mzscheme/src/eval.c
@@ -889,8 +889,12 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
 	return 1;
       }
     }
-    /* (void <omittable> ...) */
-    if (SAME_OBJ(scheme_void_proc, app->args[0])) {
+    /* ({void,list,list*,vector,vector-immutable} <omittable> ...) */
+    if (SAME_OBJ(scheme_void_proc, app->args[0])
+        || SAME_OBJ(scheme_list_proc, app->args[0])
+        || SAME_OBJ(scheme_list_star_proc, app->args[0])
+        || SAME_OBJ(scheme_vector_proc, app->args[0])
+        || SAME_OBJ(scheme_vector_immutable_proc, app->args[0])) {
       note_match(1, vals, warn_info);
       if ((vals == 1) || (vals < 0)) {
         int i;
@@ -905,10 +909,15 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
   }
 
   if ((vtype == scheme_application2_type)) {
-    /* (values <omittable>) or (void <omittable>) */
+    /* ({values,void,list,list*,vector,vector-immutable,box} <omittable>) */
     Scheme_App2_Rec *app = (Scheme_App2_Rec *)o;
     if (SAME_OBJ(scheme_values_func, app->rator)
-        || SAME_OBJ(scheme_void_proc, app->rator)) {
+        || SAME_OBJ(scheme_void_proc, app->rator)
+        || SAME_OBJ(scheme_list_proc, app->rator)
+        || SAME_OBJ(scheme_list_star_proc, app->rator)
+        || SAME_OBJ(scheme_vector_proc, app->rator)
+        || SAME_OBJ(scheme_vector_immutable_proc, app->rator)
+        || SAME_OBJ(scheme_box_proc, app->rator)) {
       note_match(1, vals, warn_info);
       if ((vals == 1) || (vals < 0)) {
 	if (scheme_omittable_expr(app->rand, 1, fuel - 1, resolved, warn_info))
@@ -928,8 +937,14 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
 	  return 1;
       }
     }
-    /* (void <omittable> <omittable>) */
-    if (SAME_OBJ(scheme_void_proc, app->rator)) {
+    /* ({void,cons,list,list*,vector,vector-immutable) <omittable> <omittable>) */
+    if (SAME_OBJ(scheme_void_proc, app->rator)
+        || SAME_OBJ(scheme_cons_proc, app->rator)
+        || SAME_OBJ(scheme_mcons_proc, app->rator)
+        || SAME_OBJ(scheme_list_proc, app->rator)
+        || SAME_OBJ(scheme_list_star_proc, app->rator)
+        || SAME_OBJ(scheme_vector_proc, app->rator)
+        || SAME_OBJ(scheme_vector_immutable_proc, app->rator)) {
       note_match(1, vals, warn_info);
       if ((vals == 1) || (vals < 0)) {
 	if (scheme_omittable_expr(app->rand1, 1, fuel - 1, resolved, warn_info)
@@ -2507,7 +2522,8 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf
     }
   }
 
-  if (SAME_OBJ(scheme_values_func, app->rator)
+  if ((SAME_OBJ(scheme_values_func, app->rator)
+       || SAME_OBJ(scheme_list_star_proc, app->rator))
       && scheme_omittable_expr(app->rand, 1, -1, 0, info)) {
     info->preserves_marks = 1;
     info->single_result = 1;
diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c
index 0e04244bbe..3c4c239c2e 100644
--- a/src/mzscheme/src/jit.c
+++ b/src/mzscheme/src/jit.c
@@ -1256,8 +1256,7 @@ static void *malloc_double(void)
 #endif
 
 #ifdef CAN_INLINE_ALLOC
-static void *make_list_code;
-# define make_list make_list_code
+static void *make_list_code, *make_list_star_code;
 #else
 static Scheme_Object *make_list(long n)
 {
@@ -1270,6 +1269,17 @@ static Scheme_Object *make_list(long n)
 
   return l;
 }
+static Scheme_Object *make_list_star(long n)
+{
+  GC_CAN_IGNORE Scheme_Object **rs = MZ_RUNSTACK;
+  GC_CAN_IGNORE Scheme_Object *l = rs[--n];
+  
+  while (n--) {
+    l = cons(rs[n], l);
+  }
+
+  return l;
+}
 #endif
 
 #if !defined(CAN_INLINE_ALLOC)
@@ -4077,6 +4087,13 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
     } else if (IS_NAMED_PRIM(rator, "vector-immutable")
                || IS_NAMED_PRIM(rator, "vector")) {
       return generate_vector_alloc(jitter, rator, NULL, app, NULL);
+    } else if (IS_NAMED_PRIM(rator, "list*")) {
+      /* on a single argument, `list*' is identity */
+      mz_runstack_skipped(jitter, 1);
+      generate_non_tail(app->rand, jitter, 0, 1);
+      CHECK_LIMIT();
+      mz_runstack_unskipped(jitter, 1);
+      return 1;
     } else if (IS_NAMED_PRIM(rator, "list")) {
       mz_runstack_skipped(jitter, 1);
       generate_non_tail(app->rand, jitter, 0, 1);
@@ -4553,7 +4570,8 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
       (void)jit_movi_p(JIT_R0, scheme_void);
 
       return 1;
-    } else if (IS_NAMED_PRIM(rator, "cons")) {
+    } else if (IS_NAMED_PRIM(rator, "cons")
+               || IS_NAMED_PRIM(rator, "list*")) {
       LOG_IT(("inlined cons\n"));
 
       generate_two_args(app->rand1, app->rand2, jitter, 1);
@@ -4748,8 +4766,12 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
     } else if (IS_NAMED_PRIM(rator, "vector-immutable")
                || IS_NAMED_PRIM(rator, "vector")) {
       return generate_vector_alloc(jitter, rator, app, NULL, NULL);
-    } else if (IS_NAMED_PRIM(rator, "list")) {
+    } else if (IS_NAMED_PRIM(rator, "list")
+               || IS_NAMED_PRIM(rator, "list*")) {
       int c = app->num_args;
+      int star;
+
+      star = IS_NAMED_PRIM(rator, "list*");
 
       if (c)
         generate_app(app, NULL, c, jitter, 0, 0, 1);
@@ -4757,13 +4779,19 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
 
 #ifdef CAN_INLINE_ALLOC
       jit_movi_l(JIT_R2, c);
-      (void)jit_calli(make_list_code);
+      if (star)
+        (void)jit_calli(make_list_star_code);
+      else
+        (void)jit_calli(make_list_code);
 #else
       JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
       jit_movi_l(JIT_R0, c);
       mz_prepare(1);
       jit_pusharg_l(JIT_R0);
-      (void)mz_finish(make_list);
+      if (star)
+        (void)mz_finish(make_list_star);
+      else
+        (void)mz_finish(make_list);
       jit_retval(JIT_R0);
 #endif
 
@@ -7252,13 +7280,21 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
 #ifdef CAN_INLINE_ALLOC
   /* *** make_list_code *** */
   /* R2 has length, args are on runstack */
-  {
+  for (i = 0; i < 2; i++) {
     jit_insn *ref, *refnext;
 
-    make_list_code = jit_get_ip().ptr;  
+    if (i == 0)
+      make_list_code = jit_get_ip().ptr;  
+    else
+      make_list_star_code = jit_get_ip().ptr;  
     mz_prolog(JIT_R1);
     jit_lshi_l(JIT_R2, JIT_R2, JIT_LOG_WORD_SIZE);
-    (void)jit_movi_p(JIT_R0, &scheme_null);
+    if (i == 0)
+      (void)jit_movi_p(JIT_R0, &scheme_null);
+    else {
+      jit_subi_l(JIT_R2, JIT_R2, JIT_WORD_SIZE);
+      jit_ldxr_p(JIT_R0, JIT_RUNSTACK, JIT_R2);
+    }
 
     __START_SHORT_JUMPS__(1);
     ref = jit_beqi_l(jit_forward(), JIT_R2, 0);
diff --git a/src/mzscheme/src/list.c b/src/mzscheme/src/list.c
index 30254661a6..21d1d6d8df 100644
--- a/src/mzscheme/src/list.c
+++ b/src/mzscheme/src/list.c
@@ -27,7 +27,11 @@
 
 /* globals */
 Scheme_Object scheme_null[1];
+Scheme_Object *scheme_cons_proc;
+Scheme_Object *scheme_mcons_proc;
 Scheme_Object *scheme_list_proc;
+Scheme_Object *scheme_list_star_proc;
+Scheme_Object *scheme_box_proc;
 
 /* locals */
 static Scheme_Object *pair_p_prim (int argc, Scheme_Object *argv[]);
@@ -155,7 +159,9 @@ scheme_init_list (Scheme_Env *env)
   SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
   scheme_add_global_constant ("mpair?", p, env);
 
+  REGISTER_SO(scheme_cons_proc);
   p = scheme_make_noncm_prim(cons_prim, "cons", 2, 2);
+  scheme_cons_proc = p;
   SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
   scheme_add_global_constant ("cons", p, env);
 
@@ -167,7 +173,9 @@ scheme_init_list (Scheme_Env *env)
   SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
   scheme_add_global_constant ("cdr", p, env);
 
+  REGISTER_SO(scheme_mcons_proc);
   p = scheme_make_noncm_prim(mcons_prim, "mcons", 2, 2);
+  scheme_mcons_proc = p;
   SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
   scheme_add_global_constant ("mcons", p, env);
 
@@ -205,11 +213,14 @@ scheme_init_list (Scheme_Env *env)
                                 | SCHEME_PRIM_IS_NARY_INLINED);
   scheme_add_global_constant ("list", p, env);
 
-  scheme_add_global_constant ("list*",
-			      scheme_make_immed_prim(list_star_prim,
-						     "list*",
-						     1, -1),
-			      env);
+  REGISTER_SO(scheme_list_star_proc);
+  p = scheme_make_immed_prim(list_star_prim, "list*", 1, -1);
+  scheme_list_star_proc = p;
+  SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_UNARY_INLINED
+                                | SCHEME_PRIM_IS_BINARY_INLINED
+                                | SCHEME_PRIM_IS_NARY_INLINED);
+  scheme_add_global_constant ("list*", p, env);
+
   scheme_add_global_constant("immutable?",
 			     scheme_make_folding_prim(immutablep,
 						      "immutable?",
@@ -409,7 +420,9 @@ scheme_init_list (Scheme_Env *env)
                                                        1, 1, 1),
 			      env);
 
+  REGISTER_SO(scheme_box_proc);
   p = scheme_make_immed_prim(box, BOX, 1, 1);
+  scheme_box_proc = p;
   SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;  
   scheme_add_global_constant(BOX, p, env);
 
diff --git a/src/mzscheme/src/read.c b/src/mzscheme/src/read.c
index f80452e61e..473c2b1f15 100644
--- a/src/mzscheme/src/read.c
+++ b/src/mzscheme/src/read.c
@@ -4371,6 +4371,8 @@ static Scheme_Object *read_compact_k(void)
   return read_compact(port, p->ku.k.i1);
 }
 
+int dump_info = 0;
+
 static Scheme_Object *read_compact(CPort *port, int use_stack)
 {
 #define BLK_BUF_SIZE 32
@@ -4396,6 +4398,9 @@ static Scheme_Object *read_compact(CPort *port, int use_stack)
     ZO_CHECK(port->pos < port->size);
     ch = CP_GETC(port);
 
+    if (dump_info)
+      printf("%d %d %d\n", ch, port->pos, need_car); 
+
     switch(cpt_branch[ch]) {
     case CPT_ESCAPE:
       {
@@ -4451,6 +4456,8 @@ static Scheme_Object *read_compact(CPort *port, int use_stack)
     case CPT_SYMREF:
       l = read_compact_number(port);
       RANGE_CHECK(l, < port->symtab_size);
+      if (dump_info)
+        printf("%d\n", l);
       v = port->symtab[l];
       if (!v) {
         long save_pos = port->pos;
@@ -5261,6 +5268,7 @@ static Scheme_Object *read_compiled(Scheme_Object *port,
     len = symtabsize;
     for (j = 1; j < len; j++) {
       if (!symtab[j]) {
+        if (dump_info) printf("at %ld %ld\n", j, rp->pos); 
         v = read_compact(rp, 0);
         symtab[j] = v;
       } else {
diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h
index 1846ad86b3..9ea3f36d3a 100644
--- a/src/mzscheme/src/schpriv.h
+++ b/src/mzscheme/src/schpriv.h
@@ -260,7 +260,13 @@ void scheme_do_add_global_symbol(Scheme_Env *env, Scheme_Object *sym,
 extern Scheme_Object *scheme_values_func;
 extern Scheme_Object *scheme_procedure_p_proc;
 extern Scheme_Object *scheme_void_proc;
+extern Scheme_Object *scheme_cons_proc;
+extern Scheme_Object *scheme_mcons_proc;
 extern Scheme_Object *scheme_list_proc;
+extern Scheme_Object *scheme_list_star_proc;
+extern Scheme_Object *scheme_vector_proc;
+extern Scheme_Object *scheme_vector_immutable_proc;
+extern Scheme_Object *scheme_box_proc;
 extern Scheme_Object *scheme_call_with_values_proc;
 extern Scheme_Object *scheme_make_struct_type_proc;
 extern Scheme_Object *scheme_current_inspector_proc;
diff --git a/src/mzscheme/src/vector.c b/src/mzscheme/src/vector.c
index bf51aeae25..0d7ac3df36 100644
--- a/src/mzscheme/src/vector.c
+++ b/src/mzscheme/src/vector.c
@@ -25,6 +25,10 @@
 
 #include "schpriv.h"
 
+/* globals */
+Scheme_Object *scheme_vector_proc;
+Scheme_Object *scheme_vector_immutable_proc;
+
 /* locals */
 static Scheme_Object *vector_p (int argc, Scheme_Object *argv[]);
 static Scheme_Object *make_vector (int argc, Scheme_Object *argv[]);
@@ -53,13 +57,17 @@ scheme_init_vector (Scheme_Env *env)
 						    1, 2), 
 			     env);
   
+  REGISTER_SO(scheme_vector_proc);
   p = scheme_make_immed_prim(vector, "vector", 0, -1);
+  scheme_vector_proc = p;
   SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_UNARY_INLINED
                                 | SCHEME_PRIM_IS_BINARY_INLINED
                                 | SCHEME_PRIM_IS_NARY_INLINED);
   scheme_add_global_constant("vector", p, env);
 
+  REGISTER_SO(scheme_vector_immutable_proc);
   p = scheme_make_immed_prim(vector_immutable, "vector-immutable", 0, -1);
+  scheme_vector_immutable_proc = p;
   SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_UNARY_INLINED
                                 | SCHEME_PRIM_IS_BINARY_INLINED
                                 | SCHEME_PRIM_IS_NARY_INLINED);
diff --git a/src/wxmac/src/mac/wx_dccan2.cc b/src/wxmac/src/mac/wx_dccan2.cc
index cd46d06c0b..a64e91ef88 100644
--- a/src/wxmac/src/mac/wx_dccan2.cc
+++ b/src/wxmac/src/mac/wx_dccan2.cc
@@ -533,6 +533,32 @@ void wxCanvasDC::DrawPoint(double x, double y)
   if (!current_pen || current_pen->GetStyle() == wxTRANSPARENT)
     return;
 
+  if (anti_alias) {
+    double xx, yy;
+    CGContextRef cg;
+
+    SetCurrentDC(TRUE);
+    cg = GetCG();
+
+    CGContextSaveGState(cg);
+
+    xx = SmoothingXFormX(x);
+    yy = SmoothingXFormY(y);
+
+    CGContextMoveToPoint(cg, xx, yy);
+    CGContextAddLineToPoint(cg, xx, yy);
+    
+    wxMacSetCurrentTool(kPenTool);
+    CGContextStrokePath(cg);
+    wxMacSetCurrentTool(kNoTool);
+
+    CGContextRestoreGState(cg);
+
+    ReleaseCurrentDC();
+
+    return;
+  }
+
   SetCurrentDC();
   wxMacSetCurrentTool(kPenTool);
   wxMacDrawPoint(XLOG2DEV(x), YLOG2DEV(y));