From 9d77ffe6d5958e4b9be21a92dfae17985f0c61c9 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 6 Mar 2018 18:33:49 -0700
Subject: [PATCH] avoid crashes while reading ill-formed bytecode

---
 racket/src/racket/src/compile.c | 23 +++++++++++++++++++----
 racket/src/racket/src/read.c    | 20 ++++++++++++++------
 racket/src/racket/src/salloc.c  |  2 +-
 3 files changed, 34 insertions(+), 11 deletions(-)

diff --git a/racket/src/racket/src/compile.c b/racket/src/racket/src/compile.c
index 31e57a4a1a..b0793ff451 100644
--- a/racket/src/racket/src/compile.c
+++ b/racket/src/racket/src/compile.c
@@ -1233,11 +1233,26 @@ static Scheme_Object *begin0_compile (Scheme_Object *form, Scheme_Comp_Env *env)
   return do_begin_compile("begin0", form, env, 1);
 }
 
-Scheme_Sequence *scheme_malloc_sequence(int count)
+static Scheme_Sequence *malloc_big_sequence(int count)
 {
-  return (Scheme_Sequence *)scheme_malloc_tagged(sizeof(Scheme_Sequence)
-						 + (count - mzFLEX_DELTA) 
-						 * sizeof(Scheme_Object *));
+  intptr_t sz;
+  Scheme_Sequence *seq;
+
+  sz = scheme_check_overflow((count - mzFLEX_DELTA), sizeof(Scheme_Object *), sizeof(Scheme_Sequence));
+  seq = (Scheme_Sequence *)scheme_malloc_fail_ok(scheme_malloc_tagged, sz);
+  if (!seq) scheme_signal_error("out of memory allocating sequence bytecode");
+
+  return seq;
+}
+
+Scheme_Sequence *scheme_malloc_sequence(int count) XFORM_ASSERT_NO_CONVERSION
+{
+  if (count < 4096)
+    return (Scheme_Sequence *)scheme_malloc_tagged(sizeof(Scheme_Sequence)
+                                                   + (count - mzFLEX_DELTA) 
+                                                   * sizeof(Scheme_Object *));
+  else
+    return malloc_big_sequence(count);
 }
 
 Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt, int resolved)
diff --git a/racket/src/racket/src/read.c b/racket/src/racket/src/read.c
index ff5db3e052..4b9796b25f 100644
--- a/racket/src/racket/src/read.c
+++ b/racket/src/racket/src/read.c
@@ -2810,7 +2810,7 @@ static Scheme_Object *read_compact(CPort *port, int use_stack)
         if ((depth < 0) || (pos < 0))
           scheme_ill_formed_code(port);
 
-        return scheme_make_toplevel(depth, pos, flags);
+        return scheme_make_toplevel(depth, pos, flags & SCHEME_TOPLEVEL_FLAGS_MASK);
       }
       break;
     case CPT_LOCAL:
@@ -3101,10 +3101,17 @@ static Scheme_Object *read_compact(CPort *port, int use_stack)
 
             count = read_compact_number(port);
             if (count < 0) scheme_ill_formed_code(port);
-        
-            cl = (Scheme_Case_Lambda *)
-              scheme_malloc_tagged(sizeof(Scheme_Case_Lambda)
-                                   + (count - mzFLEX_DELTA) * sizeof(Scheme_Object *));
+
+            if (count < 4096)
+              cl = (Scheme_Case_Lambda *)scheme_malloc_tagged(sizeof(Scheme_Case_Lambda)
+                                                              + (count - mzFLEX_DELTA) * sizeof(Scheme_Object *));
+            else {
+              intptr_t sz;
+              sz = scheme_check_overflow((count - mzFLEX_DELTA), sizeof(Scheme_Object *), sizeof(Scheme_Case_Lambda));
+              cl = (Scheme_Case_Lambda *)scheme_malloc_fail_ok(scheme_malloc_tagged, sz);
+              if (!cl) scheme_signal_error("out of memory allocating procedure bytecode");
+            }
+
             cl->so.type = scheme_case_lambda_sequence_type;
             cl->count = count;
 
@@ -3347,12 +3354,13 @@ static Scheme_Object *read_compact(CPort *port, int use_stack)
       break;
     case CPT_SMALL_APPLICATION_START:
       {
-	int c, i;
+	int c, i, start;
 	Scheme_App_Rec *a;
 
 	c = (ch - CPT_SMALL_APPLICATION_START) + 1;
 
 	a = scheme_malloc_application(c);
+        start = port->start[port->pos];
 	for (i = 0; i < c; i++) {
 	  v = read_compact(port, 1);
 	  a->args[i] = v;
diff --git a/racket/src/racket/src/salloc.c b/racket/src/racket/src/salloc.c
index 7d20162aae..9bb8bc2943 100644
--- a/racket/src/racket/src/salloc.c
+++ b/racket/src/racket/src/salloc.c
@@ -710,7 +710,7 @@ intptr_t scheme_check_overflow(intptr_t n, intptr_t m, intptr_t a)
 {
   intptr_t v;
 
-  v = (n * m) + a;
+  v = (intptr_t)(((uintptr_t)n * (uintptr_t)m) + (uintptr_t)a);
   if ((v < n) || (v < m) || (v < a) || (((v - a) / n) != m))
     scheme_signal_error("allocation size overflow");