diff options
| -rw-r--r-- | include/urweb/urweb.h | 3 | ||||
| -rw-r--r-- | src/c/urweb.c | 30 | ||||
| -rw-r--r-- | src/cjr_print.sml | 29 | ||||
| -rw-r--r-- | tests/longConst.ur | 12 | ||||
| -rw-r--r-- | tests/longConst.urp | 2 |
5 files changed, 62 insertions, 14 deletions
diff --git a/include/urweb/urweb.h b/include/urweb/urweb.h index 7320eb12..21c8bc88 100644 --- a/include/urweb/urweb.h +++ b/include/urweb/urweb.h @@ -360,4 +360,7 @@ uw_Basis_string uw_Basis_atom(uw_context, uw_Basis_string); uw_Basis_string uw_Basis_css_url(uw_context, uw_Basis_string); uw_Basis_string uw_Basis_property(uw_context, uw_Basis_string); +void uw_begin_initializing(uw_context); +void uw_end_initializing(uw_context); + #endif diff --git a/src/c/urweb.c b/src/c/urweb.c index 802a1620..d0b6987c 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -465,6 +465,8 @@ struct uw_context { unsigned nextId; + int amInitializing; + char error_message[ERROR_BUF_LEN]; }; @@ -536,6 +538,8 @@ uw_context uw_init(int id, void *logger_data, uw_logger log_debug) { ctx->nextId = 0; + ctx->amInitializing = 0; + return ctx; } @@ -613,6 +617,7 @@ void uw_reset_keep_error_message(uw_context ctx) { ctx->script_header = ""; ctx->queryString = NULL; ctx->nextId = 0; + ctx->amInitializing = 0; } void uw_reset_keep_request(uw_context ctx) { @@ -1204,14 +1209,31 @@ void uw_set_heap_front(uw_context ctx, char *fr) { ctx->heap.front = fr; } +void uw_begin_initializing(uw_context ctx) { + ctx->amInitializing = 1; +} + +void uw_end_initializing(uw_context ctx) { + ctx->amInitializing = 0; +} + void *uw_malloc(uw_context ctx, size_t len) { void *result; - uw_check_heap(ctx, len); + if (ctx->amInitializing) { + result = malloc(len); - result = ctx->heap.front; - ctx->heap.front += len; - return result; + if (result) + return result; + else + uw_error(ctx, FATAL, "uw_malloc: malloc() returns 0"); + } else { + uw_check_heap(ctx, len); + + result = ctx->heap.front; + ctx->heap.front += len; + return result; + } } void uw_begin_region(uw_context ctx) { diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 5c087fe0..c7be5526 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -2320,6 +2320,8 @@ fun p_fun isRec env (fx, n, args, ran, e) = string "}"] end +val global_initializers : Print.PD.pp_desc list ref = ref [] + fun p_decl env (dAll as (d, _) : decl) = case d of DStruct (n, xts) => @@ -2414,14 +2416,15 @@ fun p_decl env (dAll as (d, _) : decl) = | DDatatypeForward _ => box [] | DVal (x, n, t, e) => - box [p_typ env t, - space, - string ("__uwn_" ^ ident x ^ "_" ^ Int.toString n), - space, - string "=", - space, - p_exp env e, - string ";"] + (global_initializers := box [string ("__uwn_" ^ ident x ^ "_" ^ Int.toString n), + space, + string "=", + space, + p_exp env e, + string ";"] :: !global_initializers; + box [p_typ env t, + space, + string ("__uwn_" ^ ident x ^ "_" ^ Int.toString n ^ ";")]) | DFun vi => p_fun false env vi | DFunRec vis => let @@ -2565,7 +2568,8 @@ fun p_file env (ds, ps) = unurlifies := IS.empty; urlifies := IS.empty; urlifiesL := IS.empty; - self := NONE) + self := NONE; + global_initializers := []) val (pds, env) = ListUtil.foldlMap (fn (d, env) => let @@ -3474,7 +3478,12 @@ fun p_file env (ds, ps) = newline, string "static void uw_initializer(uw_context ctx) {", newline, - box [p_list_sep (box []) (fn (x1, x2, e) => box [string "({", + box [string "uw_begin_initializing(ctx);", + newline, + p_list_sep newline (fn x => x) (rev (!global_initializers)), + string "uw_end_initializing(ctx);", + newline, + p_list_sep (box []) (fn (x1, x2, e) => box [string "({", newline, string "uw_unit __uwr_", string x1, diff --git a/tests/longConst.ur b/tests/longConst.ur new file mode 100644 index 00000000..d81e2ad9 --- /dev/null +++ b/tests/longConst.ur @@ -0,0 +1,12 @@ +val ls = 1 :: 2 :: 3 :: 4 :: 5 :: 6 + :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 + :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 + :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 + :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 + :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 + :: [] + +fun main () : transaction page = return <xml><body> + {List.mapX txt ls}<br/> + {List.mapX txt ls} +</body></xml> diff --git a/tests/longConst.urp b/tests/longConst.urp new file mode 100644 index 00000000..0710a6fa --- /dev/null +++ b/tests/longConst.urp @@ -0,0 +1,2 @@ +$/list +longConst |