Mercurial > urweb

comparison src/compiler.sml @ 502:8875ff2e85dc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Profiling support
author Adam Chlipala <adamc@hcoop.net>
date Thu, 20 Nov 2008 12:16:30 -0500
parents 5521bb0b4014
children 65d8541c130b
comparison
equal deleted inserted replaced
501:7ef4b2911b09 502:8875ff2e85dc
39 prefix : string, 39 prefix : string,
40 database : string option, 40 database : string option,
41 sources : string list, 41 sources : string list,
42 exe : string, 42 exe : string,
43 sql : string option, 43 sql : string option,
44 debug : bool 44 debug : bool,
45 profile : bool
45 } 46 }
46 47
47 type ('src, 'dst) phase = { 48 type ('src, 'dst) phase = {
48 func : 'src -> 'dst, 49 func : 'src -> 'dst,
49 print : 'dst -> Print.PD.pp_desc 50 print : 'dst -> Print.PD.pp_desc
197 | _ => absyn 198 | _ => absyn
198 end 199 end
199 handle LrParser.ParseError => [], 200 handle LrParser.ParseError => [],
200 print = SourcePrint.p_file} 201 print = SourcePrint.p_file}
201 202
202 fun p_job {prefix, database, exe, sql, sources, debug} = 203 fun p_job {prefix, database, exe, sql, sources, debug, profile} =
203 let 204 let
204 open Print.PD 205 open Print.PD
205 open Print 206 open Print
206 in 207 in
207 box [if debug then 208 box [if debug then
208 box [string "DEBUG", newline] 209 box [string "DEBUG", newline]
210 else
211 box [],
212 if profile then
213 box [string "PROFILE", newline]
209 else 214 else
210 box [], 215 box [],
211 case database of 216 case database of
212 NONE => string "No database." 217 NONE => string "No database."
213 | SOME db => string ("Database: " ^ db), 218 | SOME db => string ("Database: " ^ db),
258 end 263 end
259 in 264 in
260 readSources acc 265 readSources acc
261 end 266 end
262 267
263 fun finish (prefix, database, exe, sql, debug, sources) = 268 fun finish (prefix, database, exe, sql, debug, profile, sources) =
264 {prefix = Option.getOpt (prefix, "/"), 269 {prefix = Option.getOpt (prefix, "/"),
265 database = database, 270 database = database,
266 exe = Option.getOpt (exe, OS.Path.joinBaseExt {base = OS.Path.base filename, 271 exe = Option.getOpt (exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
267 ext = SOME "exe"}), 272 ext = SOME "exe"}),
268 sql = sql, 273 sql = sql,
269 debug = debug, 274 debug = debug,
275 profile = profile,
270 sources = sources} 276 sources = sources}
271 277
272 fun read (prefix, database, exe, sql, debug) = 278 fun read (prefix, database, exe, sql, debug, profile) =
273 case TextIO.inputLine inf of 279 case TextIO.inputLine inf of
274 NONE => finish (prefix, database, exe, sql, debug, []) 280 NONE => finish (prefix, database, exe, sql, debug, profile, [])
275 | SOME "\n" => finish (prefix, database, exe, sql, debug, readSources []) 281 | SOME "\n" => finish (prefix, database, exe, sql, debug, profile, readSources [])
276 | SOME line => 282 | SOME line =>
277 let 283 let
278 val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line) 284 val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line)
279 val cmd = Substring.string (trim cmd) 285 val cmd = Substring.string (trim cmd)
280 val arg = Substring.string (trim arg) 286 val arg = Substring.string (trim arg)
282 case cmd of 288 case cmd of
283 "prefix" => 289 "prefix" =>
284 (case prefix of 290 (case prefix of
285 NONE => () 291 NONE => ()
286 | SOME _ => ErrorMsg.error "Duplicate 'prefix' directive"; 292 | SOME _ => ErrorMsg.error "Duplicate 'prefix' directive";
287 read (SOME arg, database, exe, sql, debug)) 293 read (SOME arg, database, exe, sql, debug, profile))
288 | "database" => 294 | "database" =>
289 (case database of 295 (case database of
290 NONE => () 296 NONE => ()
291 | SOME _ => ErrorMsg.error "Duplicate 'database' directive"; 297 | SOME _ => ErrorMsg.error "Duplicate 'database' directive";
292 read (prefix, SOME arg, exe, sql, debug)) 298 read (prefix, SOME arg, exe, sql, debug, profile))
293 | "exe" => 299 | "exe" =>
294 (case exe of 300 (case exe of
295 NONE => () 301 NONE => ()
296 | SOME _ => ErrorMsg.error "Duplicate 'exe' directive"; 302 | SOME _ => ErrorMsg.error "Duplicate 'exe' directive";
297 read (prefix, database, SOME (relify arg), sql, debug)) 303 read (prefix, database, SOME (relify arg), sql, debug, profile))
298 | "sql" => 304 | "sql" =>
299 (case sql of 305 (case sql of
300 NONE => () 306 NONE => ()
301 | SOME _ => ErrorMsg.error "Duplicate 'sql' directive"; 307 | SOME _ => ErrorMsg.error "Duplicate 'sql' directive";
302 read (prefix, database, exe, SOME (relify arg), debug)) 308 read (prefix, database, exe, SOME (relify arg), debug, profile))
303 | "debug" => read (prefix, database, exe, sql, true) 309 | "debug" => read (prefix, database, exe, sql, true, profile)
310 | "profile" => read (prefix, database, exe, sql, debug, true)
304 | _ => (ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'"); 311 | _ => (ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
305 read (prefix, database, exe, sql, debug)) 312 read (prefix, database, exe, sql, debug, profile))
306 end 313 end
307 314
308 val job = read (NONE, NONE, NONE, NONE, false) 315 val job = read (NONE, NONE, NONE, NONE, false, false)
309 in 316 in
310 TextIO.closeIn inf; 317 TextIO.closeIn inf;
311 Monoize.urlPrefix := #prefix job; 318 Monoize.urlPrefix := #prefix job;
312 job 319 job
313 end, 320 end,
542 print = CjrPrint.p_sql CjrEnv.empty 549 print = CjrPrint.p_sql CjrEnv.empty
543 } 550 }
544 551
545 val toSqlify = transform sqlify "sqlify" o toMono_opt2 552 val toSqlify = transform sqlify "sqlify" o toMono_opt2
546 553
547 fun compileC {cname, oname, ename, libs} = 554 fun compileC {cname, oname, ename, libs, profile} =
548 let 555 let
549 val urweb_o = clibFile "urweb.o" 556 val urweb_o = clibFile "urweb.o"
550 val driver_o = clibFile "driver.o" 557 val driver_o = clibFile "driver.o"
551 558
552 val compile = "gcc " ^ Config.gccArgs ^ " -Wstrict-prototypes -Werror -O3 -I include -c " ^ cname ^ " -o " ^ oname 559 val compile = "gcc " ^ Config.gccArgs ^ " -Wstrict-prototypes -Werror -O3 -I include -c " ^ cname ^ " -o " ^ oname
553 val link = "gcc -Werror -O3 -lm -pthread " ^ libs ^ " " ^ urweb_o ^ " " ^ oname ^ " " ^ driver_o ^ " -o " ^ ename 560 val link = "gcc -Werror -O3 -lm -pthread " ^ libs ^ " " ^ urweb_o ^ " " ^ oname ^ " " ^ driver_o ^ " -o " ^ ename
561
562 val (compile, link) =
563 if profile then
564 (compile ^ " -pg", link ^ " -pg")
565 else
566 (compile, link)
554 in 567 in
555 if not (OS.Process.isSuccess (OS.Process.system compile)) then 568 if not (OS.Process.isSuccess (OS.Process.system compile)) then
556 print "C compilation failed\n" 569 print "C compilation failed\n"
557 else if not (OS.Process.isSuccess (OS.Process.system link)) then 570 else if not (OS.Process.isSuccess (OS.Process.system link)) then
558 print "C linking failed\n" 571 print "C linking failed\n"
613 in 626 in
614 Print.fprint s (CjrPrint.p_sql CjrEnv.empty file); 627 Print.fprint s (CjrPrint.p_sql CjrEnv.empty file);
615 TextIO.closeOut outf 628 TextIO.closeOut outf
616 end; 629 end;
617 630
618 compileC {cname = cname, oname = oname, ename = ename, libs = libs}; 631 compileC {cname = cname, oname = oname, ename = ename, libs = libs, profile = #profile job};
619 632
620 cleanup () 633 cleanup ()
621 end 634 end
622 handle ex => (((cleanup ()) handle _ => ()); raise ex) 635 handle ex => (((cleanup ()) handle _ => ()); raise ex)
623 end 636 end