## main.pkg - Driver routine ("main") for c-glue-maker.
## (C) 2004 The Fellowship of SML/NJ
## author: Matthias Blume (blume@tti-c.org)
# Compiled by:
# src/app/c-glue-maker/c-glue-maker.lib# See ../README for an overview, and
# ../c-glue-lib/doc/* for additional info.
# In this file, we digest the commandline switches,
# then call gen::gen with the digested switches
# plus the list of C sourcefiels to process.
package main {
#
stipulate
#
package re
=
regular_expression_matcher_g ( # regular_expression_matcher_g is from src/lib/regex/glue/regular-expression-matcher-g.pkg #
package p = awk_syntax; # awk_syntax is from src/lib/regex/front/awk-syntax.pkg package e = dfa_engine; # dfa_engine is from src/lib/regex/backend/dfa-engine.pkg );
stipulate
fun target (name, sizes, shift)
=
{ name, sizes, shift };
herein
default_target
=
target (
default_name::name,
default_sizes::sizes,
default_endian::shift
);
target_table
=
[ target ("sparc32-posix", sizes_sparc32::sizes, endian_big::shift ),
target ("intel32-posix", sizes_intel32::sizes, endian_little::shift),
target ("intel32-win32", sizes_intel32::sizes, endian_little::shift),
target ("pwrpc32-posix", sizes_pwrpc32::sizes, endian_little::shift)
# needs to be extended ...
];
end;
# sizes_sparc32 is from src/app/c-glue-maker/sizes-sparc32.pkg # sizes_intel32 is from src/app/c-glue-maker/sizes-intel32.pkg # sizes_pwrpc32 is from src/app/c-glue-maker/sizes-pwrpc32.pkg # list is from src/lib/std/src/list.pkg # string is from src/lib/std/string.pkg fun find_target target
=
case (list::find (fn x = target == x.name) target_table)
#
THE t => t;
NULL => raise exception FAIL (cat ["unknown target: " + target]);
esac;
fun main0 (arg0, args)
=
# 'arg0' is the program name, which we ignore.
#
# 'args' is the list of commandline arguments,
# which consists of switches ('-foo') followed
# by C sourcefile names.
#
# We eat the switches, then call gen::gen
# with the digested switch info plus the
# list of source files to process:
#
proc args
where
fun substitute (tmpl, opts, s, t) # Make %s %t %o substitutions
=
loop (string::explode tmpl, [])
where
fun loop ([], a) => string::implode (reverse a);
loop ('%' ! 's' ! l, a) => loop (l, push (s, a));
loop ('%' ! 't' ! l, a) => loop (l, push (t, a));
loop ('%' ! 'o' ! l, a) => loop (l, push (opts, a));
loop ( c ! l, a) => loop (l, c ! a);
end
also
fun push (x, a)
=
list::reverse_and_prepend (string::explode x, a);
end;
dir = REF "glue";
makelib_file = REF "glue.lib";
prefix = REF "";
gstem = REF "";
extra_members = REF [];
library_handle = REF "library::lib_handle";
asu = REF FALSE; # I think "asu" == "all struct union". FWIW.
width = REF NULL;
mythryl_opts = REF [];
noguid = REF TRUE;
target = REF default_target;
weight_request = REF NULL;
named_args = REF FALSE;
collect_enums = REF TRUE;
enum_constructors = REF FALSE;
cpp_options = REF "";
regexp = REF NULL;
# We're called with the list of non-switch
# commandline arguments, which is to say,
# with a list of C source files to process:
# winix is from src/lib/std/winix.pkg # string is from src/lib/std/string.pkg fun do_cfiles cfiles
=
{ fun preprocess_c_sourcefile cfile
=
{ ifile = winix::file::tmp_name ();
#
cpp_template
=
the_else (
winix::process::get_env "FFIGEN_CPP",
"gcc -E -U__GNUC__ %o %s > %t"
);
cpp = substitute (cpp_template, *cpp_options, cfile, ifile);
if (winix::process::system cpp != winix::process::success)
#
raise exception FAIL ("C-preprocessor failed: " + cpp);
fi;
ifile;
};
match
=
{ fun match_string scan_g s
=
{ n = size s;
fun getc i # Return i-th char from string 's', else NULL.
=
i < n ?? THE (string::get (s, i), i + 1)
:: NULL;
case (scan_g getc 0)
THE (x, k) => k == n;
NULL => FALSE;
esac;
};
case *regexp
NULL => fn _ = FALSE;
THE re => match_string (re::prefix re);
esac;
};
gen::gen { cfiles,
match,
preprocess_c_sourcefile,
dirname => *dir,
makelib_file => *makelib_file,
prefix => *prefix,
gensym_stem => *gstem,
extra_members => *extra_members,
library_handle => *library_handle,
all_su => *asu,
mythryl_options => reverse *mythryl_opts,
noguid => *noguid,
weightreq => *weight_request,
wid => the_else (*width, 75),
namedargs => *named_args,
collect_enums => *collect_enums,
enumcons => *enum_constructors,
target => *target
};
winix::process::success;
};
# Recognize options for cpp (the C pre-processor):
fun is_cpp_option option
=
size option > 2
and
string::get (option, 0) == '-'
and
char::contains "IDU" (string::get (option, 1));
fun note_cpp_option option
=
cpp_options := case *cpp_options
"" => option;
options => cat [options, " ", option];
esac;
# Process commandline switches, then
# call 'do_cfiles' on remaining commandline args,
# which will be the C source files to process:
#
fun proc ("-allSU" ! l) => { asu := TRUE; proc l; };
proc (("-width" | "-w") ! i ! l) => { width := int::from_string i; proc l; };
proc (("-mythryl-option" | "-opt") ! s ! l) => { mythryl_opts := s ! *mythryl_opts; proc l; };
proc ("-guids" ! l) => { noguid := FALSE; proc l; };
proc (("-target" | "-t") ! tg ! l) => { target := find_target tg; proc l; };
proc (("-light" | "-l") ! l) => { weight_request := THE FALSE; proc l; };
proc (("-heavy" | "-h") ! l) => { weight_request := THE TRUE; proc l; };
proc (("-namedargs" | "-na") ! l) => { named_args := TRUE; proc l; };
proc (("-libhandle" | "-lh") ! lh ! l) => { library_handle := lh; proc l; };
proc (("-prefix" | "-p") ! p ! l) => { prefix := p; proc l; };
proc (("-gensym" | "-g") ! g ! l) => { gstem := g; proc l; };
proc (("-dir" | "-d") ! d ! l) => { dir := d; proc l; };
proc (("-libfile" | "-m7") ! f ! l) => { makelib_file := f; proc l; };
proc ("-cppopt" ! opt ! l) => { note_cpp_option opt; proc l; };
proc ("-nocollect" ! l) => { collect_enums := FALSE; proc l; };
proc (("-ec" | "-enum-constructors") ! l) => { enum_constructors := TRUE; proc l; };
proc (("-include" | "-add") ! es ! l) => { extra_members := es ! *extra_members; proc l; };
proc (("-match" | "-m") ! re ! l) => { regexp := THE (re::compile_string re); proc l; };
proc ("--" ! cfiles) => do_cfiles cfiles;
proc ("-version" ! _)
=>
{ file::write (file::stdout, gen::version + "\n");
winix::process::exit 0;
};
proc (l0 as (option ! l))
=>
if (is_cpp_option option)
note_cpp_option option;
proc l;
else
do_cfiles l0;
fi;
proc cfiles
=>
do_cfiles cfiles;
end;
end; # fun main0
herein
fun print_history (h ! hs)
=>
{ file::write (file::stderr, cat ["\t", h, "\n"]);
print_history hs;
};
print_history []
=>
();
end;
fun main args
=
main0 args
except
exn = { file::write (file::stderr, exceptions::exception_message exn);
file::write (file::stderr, "\n");
print_history (lib7::exception_history exn);
winix::process::failure;
};
end; # stipulate
}; # pkg main