summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-11-20 12:16:30 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-11-20 12:16:30 -0500
commit0363434b9bbdea2e3ab9c432036941c0557ab62c (patch)
tree2a5822346670938e7d1be8b131e9a0b7d3959408 /src
parenta01f4dd530689d29ac7518bb9a8d19b919ef76ac (diff)
Profiling support
Diffstat (limited to 'src')
-rw-r--r--src/c/driver.c11
-rw-r--r--src/compiler.sig5
-rw-r--r--src/compiler.sml43
-rw-r--r--src/demo.sml3
4 files changed, 43 insertions, 19 deletions
diff --git a/src/c/driver.c b/src/c/driver.c
index f80361b1..ce0d194e 100644
--- a/src/c/driver.c
+++ b/src/c/driver.c
@@ -1,10 +1,12 @@
#include <stdio.h>
#include <string.h>
+#include <stdlib.h>
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <unistd.h>
+#include <signal.h>
#include <pthread.h>
@@ -297,6 +299,11 @@ static void help(char *cmd) {
printf("Usage: %s [-p <port>] [-t <thread-count>]\n", cmd);
}
+static void sigint(int signum) {
+ printf("Exiting....\n");
+ exit(0);
+}
+
int main(int argc, char *argv[]) {
// The skeleton for this function comes from Beej's sockets tutorial.
int sockfd; // listen on sock_fd
@@ -304,7 +311,9 @@ int main(int argc, char *argv[]) {
struct sockaddr_in their_addr; // connector's address information
int sin_size, yes = 1;
int uw_port = 8080, nthreads = 1, i, *names, opt;
-
+
+ signal(SIGINT, sigint);
+
while ((opt = getopt(argc, argv, "hp:t:")) != -1) {
switch (opt) {
case '?':
diff --git a/src/compiler.sig b/src/compiler.sig
index 2bed20f9..af086675 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -35,10 +35,11 @@ signature COMPILER = sig
sources : string list,
exe : string,
sql : string option,
- debug : bool
+ debug : bool,
+ profile : bool
}
val compile : string -> unit
- val compileC : {cname : string, oname : string, ename : string, libs : string} -> unit
+ val compileC : {cname : string, oname : string, ename : string, libs : string, profile : bool} -> unit
type ('src, 'dst) phase
type ('src, 'dst) transform
diff --git a/src/compiler.sml b/src/compiler.sml
index b2f8f91c..6a6c4391 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -41,7 +41,8 @@ type job = {
sources : string list,
exe : string,
sql : string option,
- debug : bool
+ debug : bool,
+ profile : bool
}
type ('src, 'dst) phase = {
@@ -199,7 +200,7 @@ val parseUr = {
handle LrParser.ParseError => [],
print = SourcePrint.p_file}
-fun p_job {prefix, database, exe, sql, sources, debug} =
+fun p_job {prefix, database, exe, sql, sources, debug, profile} =
let
open Print.PD
open Print
@@ -208,6 +209,10 @@ fun p_job {prefix, database, exe, sql, sources, debug} =
box [string "DEBUG", newline]
else
box [],
+ if profile then
+ box [string "PROFILE", newline]
+ else
+ box [],
case database of
NONE => string "No database."
| SOME db => string ("Database: " ^ db),
@@ -260,19 +265,20 @@ val parseUrp = {
readSources acc
end
- fun finish (prefix, database, exe, sql, debug, sources) =
+ fun finish (prefix, database, exe, sql, debug, profile, sources) =
{prefix = Option.getOpt (prefix, "/"),
database = database,
exe = Option.getOpt (exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
ext = SOME "exe"}),
sql = sql,
debug = debug,
+ profile = profile,
sources = sources}
- fun read (prefix, database, exe, sql, debug) =
+ fun read (prefix, database, exe, sql, debug, profile) =
case TextIO.inputLine inf of
- NONE => finish (prefix, database, exe, sql, debug, [])
- | SOME "\n" => finish (prefix, database, exe, sql, debug, readSources [])
+ NONE => finish (prefix, database, exe, sql, debug, profile, [])
+ | SOME "\n" => finish (prefix, database, exe, sql, debug, profile, readSources [])
| SOME line =>
let
val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line)
@@ -284,28 +290,29 @@ val parseUrp = {
(case prefix of
NONE => ()
| SOME _ => ErrorMsg.error "Duplicate 'prefix' directive";
- read (SOME arg, database, exe, sql, debug))
+ read (SOME arg, database, exe, sql, debug, profile))
| "database" =>
(case database of
NONE => ()
| SOME _ => ErrorMsg.error "Duplicate 'database' directive";
- read (prefix, SOME arg, exe, sql, debug))
+ read (prefix, SOME arg, exe, sql, debug, profile))
| "exe" =>
(case exe of
NONE => ()
| SOME _ => ErrorMsg.error "Duplicate 'exe' directive";
- read (prefix, database, SOME (relify arg), sql, debug))
+ read (prefix, database, SOME (relify arg), sql, debug, profile))
| "sql" =>
(case sql of
NONE => ()
| SOME _ => ErrorMsg.error "Duplicate 'sql' directive";
- read (prefix, database, exe, SOME (relify arg), debug))
- | "debug" => read (prefix, database, exe, sql, true)
+ read (prefix, database, exe, SOME (relify arg), debug, profile))
+ | "debug" => read (prefix, database, exe, sql, true, profile)
+ | "profile" => read (prefix, database, exe, sql, debug, true)
| _ => (ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
- read (prefix, database, exe, sql, debug))
+ read (prefix, database, exe, sql, debug, profile))
end
- val job = read (NONE, NONE, NONE, NONE, false)
+ val job = read (NONE, NONE, NONE, NONE, false, false)
in
TextIO.closeIn inf;
Monoize.urlPrefix := #prefix job;
@@ -544,13 +551,19 @@ val sqlify = {
val toSqlify = transform sqlify "sqlify" o toMono_opt2
-fun compileC {cname, oname, ename, libs} =
+fun compileC {cname, oname, ename, libs, profile} =
let
val urweb_o = clibFile "urweb.o"
val driver_o = clibFile "driver.o"
val compile = "gcc " ^ Config.gccArgs ^ " -Wstrict-prototypes -Werror -O3 -I include -c " ^ cname ^ " -o " ^ oname
val link = "gcc -Werror -O3 -lm -pthread " ^ libs ^ " " ^ urweb_o ^ " " ^ oname ^ " " ^ driver_o ^ " -o " ^ ename
+
+ val (compile, link) =
+ if profile then
+ (compile ^ " -pg", link ^ " -pg")
+ else
+ (compile, link)
in
if not (OS.Process.isSuccess (OS.Process.system compile)) then
print "C compilation failed\n"
@@ -615,7 +628,7 @@ fun compile job =
TextIO.closeOut outf
end;
- compileC {cname = cname, oname = oname, ename = ename, libs = libs};
+ compileC {cname = cname, oname = oname, ename = ename, libs = libs, profile = #profile job};
cleanup ()
end
diff --git a/src/demo.sml b/src/demo.sml
index 580cd21f..4f0cb52e 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -92,7 +92,8 @@ fun make {prefix, dirname, guided} =
file = "demo.exe"},
sql = SOME (OS.Path.joinDirFile {dir = dirname,
file = "demo.sql"}),
- debug = false
+ debug = false,
+ profile = false
}
val parse = Compiler.run (Compiler.transform Compiler.parseUrp "Demo parseUrp")