diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/c/urweb.c | 16 | ||||
| -rw-r--r-- | src/cjr_print.sml | 20 | ||||
| -rw-r--r-- | src/settings.sig | 3 | ||||
| -rw-r--r-- | src/settings.sml | 6 |
4 files changed, 40 insertions, 5 deletions
diff --git a/src/c/urweb.c b/src/c/urweb.c index a76497bb..27831011 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -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 @@ void uw_app_init(uw_app *app) { app->client_init(); } +int uw_time = 0; + // Single-request state @@ -427,6 +430,8 @@ struct uw_context { char *current_url; + int deadline; + char error_message[ERROR_BUF_LEN]; }; @@ -484,6 +489,8 @@ uw_context uw_init() { ctx->current_url = ""; + ctx->deadline = INT_MAX; + return ctx; } @@ -3343,3 +3350,12 @@ uw_Basis_string uw_Basis_currentUrl(uw_context ctx) { 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 --git a/src/cjr_print.sml b/src/cjr_print.sml index faf5f7b2..360ecb5c 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -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 @@ fun p_exp' par env (e, loc) = 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 @@ fun p_exp' par env (e, loc) = 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 @@ fun p_fun env (fx, n, args, ran, e) = 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 @@ fun p_decl env (dAll as (d, _) : decl) = 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 @@ fun p_decl env (dAll as (d, _) : decl) = (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 --git a/src/settings.sig b/src/settings.sig index 12182ae6..f3a4379e 100644 --- a/src/settings.sig +++ b/src/settings.sig @@ -187,4 +187,7 @@ signature SETTINGS = sig val setStaticLinking : bool -> unit val getStaticLinking : unit -> bool + val setDeadlines : bool -> unit + val getDeadlines : unit -> bool + end diff --git a/src/settings.sml b/src/settings.sml index 03b7fd6d..5edfb3ff 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -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 @@ val staticLinking = ref false fun setStaticLinking b = staticLinking := b fun getStaticLinking () = !staticLinking +val deadlines = ref false +fun setDeadlines b = deadlines := b +fun getDeadlines () = !deadlines + end |