# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1262552314 18000
# Node ID 01b6c7144a444974fd089414d158b39341231dfe
# Parent  40d48a2b78a74489bef09dbed21cd63931b569cd
Deadlines

diff -r 40d48a2b78a7 -r 01b6c7144a44 include/urweb.h
--- a/include/urweb.h	Sun Jan 03 15:32:11 2010 -0500
+++ b/include/urweb.h	Sun Jan 03 15:58:34 2010 -0500
@@ -260,4 +260,9 @@
 extern size_t uw_messages_max, uw_clients_max, uw_headers_max, uw_page_max, uw_heap_max, uw_script_max;
 extern size_t uw_inputs_max, uw_cleanup_max, uw_subinputs_max, uw_deltas_max, uw_transactionals_max, uw_globals_max;
 
+extern int uw_time;
+
+void uw_set_deadline(uw_context, int);
+void uw_check_deadline(uw_context);
+
 #endif
diff -r 40d48a2b78a7 -r 01b6c7144a44 src/c/urweb.c
--- a/src/c/urweb.c	Sun Jan 03 15:32:11 2010 -0500
+++ b/src/c/urweb.c	Sun Jan 03 15:58:34 2010 -0500
@@ -9,6 +9,7 @@
 #include <stdarg.h>
 #include <assert.h>
 #include <ctype.h>
+#include <limits.h>
 #include <stdint.h>
 #include <sys/types.h>
 #include <sys/socket.h>
@@ -338,6 +339,8 @@
   app->client_init();
 }
 
+int uw_time = 0;
+
 
 // Single-request state
 
@@ -427,6 +430,8 @@
 
   char *current_url;
 
+  int deadline;
+
   char error_message[ERROR_BUF_LEN];
 };
 
@@ -484,6 +489,8 @@
 
   ctx->current_url = "";
 
+  ctx->deadline = INT_MAX;
+
   return ctx;
 }
 
@@ -3343,3 +3350,12 @@
 void uw_set_currentUrl(uw_context ctx, char *s) {
   ctx->current_url = s;
 }
+
+void uw_set_deadline(uw_context ctx, int n) {
+  ctx->deadline = n;
+}
+
+void uw_check_deadline(uw_context ctx) {
+  if (uw_time > ctx->deadline)
+    uw_error(ctx, FATAL, "Maximum running time exceeded");
+}
diff -r 40d48a2b78a7 -r 01b6c7144a44 src/cjr_print.sml
--- a/src/cjr_print.sml	Sun Jan 03 15:32:11 2010 -0500
+++ b/src/cjr_print.sml	Sun Jan 03 15:58:34 2010 -0500
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2009, Adam Chlipala
+(* Copyright (c) 2008-2010, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -1685,6 +1685,13 @@
                      string "acc;",
                      newline,
                      newline,
+
+                     if Settings.getDeadlines () then
+                         box [string "uw_check_deadline(ctx);",
+                              newline]
+                     else
+                         box [],
+
                      p_list_sepi (box []) (fn i =>
                                            fn (proj, t) =>
                                               box [string "__uwr_r_",
@@ -1934,7 +1941,7 @@
 
 and p_exp env = p_exp' false env
 
-fun p_fun env (fx, n, args, ran, e) =
+fun p_fun isRec env (fx, n, args, ran, e) =
     let
         val nargs = length args
         val env' = foldl (fn ((x, dom), env) => E.pushERel env x dom) env args
@@ -1954,6 +1961,11 @@
              space,
              string "{",
              newline,
+             if isRec andalso Settings.getDeadlines () then
+                 box [string "uw_check_deadline(ctx);",
+                      newline]
+             else
+                 box [],
              box [string "return(",
                   p_exp env' e,
                   string ");"],
@@ -2060,7 +2072,7 @@
              space,
              p_exp env e,
              string ";"]
-      | DFun vi => p_fun env vi
+      | DFun vi => p_fun false env vi
       | DFunRec vis =>
         let
             val env = E.declBinds env dAll
@@ -2077,7 +2089,7 @@
                                                         (fn (_, dom) => p_typ env dom) args,
                                              string ");"]) vis,
                  newline,
-                 p_list_sep newline (p_fun env) vis,
+                 p_list_sep newline (p_fun true env) vis,
                  newline]
         end
       | DTable (x, _, pk, csts) => box [string "/* SQL table ",
diff -r 40d48a2b78a7 -r 01b6c7144a44 src/settings.sig
--- a/src/settings.sig	Sun Jan 03 15:32:11 2010 -0500
+++ b/src/settings.sig	Sun Jan 03 15:58:34 2010 -0500
@@ -187,4 +187,7 @@
     val setStaticLinking : bool -> unit
     val getStaticLinking : unit -> bool
 
+    val setDeadlines : bool -> unit
+    val getDeadlines : unit -> bool
+
 end
diff -r 40d48a2b78a7 -r 01b6c7144a44 src/settings.sml
--- a/src/settings.sml	Sun Jan 03 15:32:11 2010 -0500
+++ b/src/settings.sml	Sun Jan 03 15:58:34 2010 -0500
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2009, Adam Chlipala
+(* Copyright (c) 2008-2010, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -436,4 +436,8 @@
 fun setStaticLinking b = staticLinking := b
 fun getStaticLinking () = !staticLinking
 
+val deadlines = ref false
+fun setDeadlines b = deadlines := b
+fun getDeadlines () = !deadlines
+
 end