Commit 56f4e849 authored by mb0's avatar mb0

Merge upstream.

parent e7421a30
......@@ -9,7 +9,7 @@ end = struct
structure FV = FreeVars
structure FI = FunInfo
structure Map = SymMap
structure Set = SymSet
structure Set = FreeVars.Set
structure Clos = Closure.Stmt
val closure = Atom.atom "env"
......
......@@ -53,13 +53,7 @@ structure PrettyC = struct
in
seq [str "__INVOKE", i n, args (f::xs)]
end
fun fastinvoke (f, xs) =
let
val n = List.length xs
val i = str o Int.toString
in
seq [str "__CALL", i n, args (f::xs)]
end
fun fastinvoke (f, xs) = seq [str "__FCALL", args (f::xs)]
end
structure C0Templates = struct
......@@ -100,6 +94,7 @@ structure C = struct
fun codegen spec =
let
open Layout Pretty
val () = Mangle.reset()
val clos = Spec.get#declarations spec
val exports = Spec.get#exports spec
fun exported f =
......
......@@ -56,6 +56,16 @@ __obj __add (__obj A, __obj B) {
return (x);
}
__obj __sub (__obj A, __obj B) {
__word a = A->z.value;
__word b = B->z.value;
__LOCAL0(x);
__INT_BEGIN(x);
__INT_INIT(a - b);
__INT_END(x);
return (x);
}
/* FIXME */
__obj __sx (__obj x) {
__LOCAL0(y);
......@@ -185,7 +195,7 @@ __obj __runWithState (__obj (*f)(__obj,__obj), __obj s) {
__CLOSURE_BEGIN(envK,1)
__CLOSURE_ADD(k);
__CLOSURE_END(envK,1);
return (__CALL2(f,envK,s));
return (__FCALL(f,envK,s));
}
__obj __eval (__obj (*f)(__obj,__obj), __char* blob, __word sz) {
......@@ -226,7 +236,8 @@ __obj __cont (__obj env, __obj f) {
__CLOSURE_BEGIN(envK,1)
__CLOSURE_ADD(k);
__CLOSURE_END(envK,1);
return (__INVOKE2(f,envK,s));
__LOCAL(ff,__CLOSURE_REF(f,0));
return (__INVOKE3(ff,f,envK,s));
}
__obj __translate (__obj (*f)(__obj,__obj), __obj insn) {
......@@ -239,10 +250,11 @@ __obj __translate (__obj (*f)(__obj,__obj), __obj insn) {
__LABEL_END(k);
__LOCAL0(envK);
__CLOSURE_BEGIN(envK,2)
__CLOSURE_ADD(k);
__CLOSURE_ADD(s);
__CLOSURE_ADD(k);
__CLOSURE_END(envK,2);
return (__CALL2(f,envK,insn));
__LOCAL(ss, __FCALL(f,envK,insn));
return (__RECORD_SELECT(ss,___1));
}
const __char* __fieldName (__word i) {
......
......@@ -37,24 +37,7 @@
#define __INVOKE7(o, closure, u, v, w, x, y, z)\
((__obj(*)(__obj,__obj,__obj,__obj,__obj,__obj,__obj))((o)->label.f))(closure, u, v, w, x, y, z)
#define __CALL1(f,x)\
f(x)
#define __CALL2(f,x,y)\
f(x,y)
#define __CALL3(f,x,y,z)\
f(x,y,z)
#define __CALL4(f,w,x,y,z)\
f(w,x,y,z)
#define __CALL5(f,v,w,x,y,z)\
f(v,w,x,y,z)
#define __CALL6(f,u,v,w,x,y,z)\
f(u,v,w,x,y,z)
#define __CALL7(f,t,u,v,w,x,y,z)\
f(t,u,v,w,x,y,z)
#define __CALL8(f,s,t,u,v,w,x,y,z)\
f(s,t,u,v,w,x,y,z)
#define __CALL9(f,r,s,t,u,v,w,x,y,z)\
f(r,s,t,u,v,w,x,y,z)
#define __FCALL(f,...) f(__VA_ARGS__)
/** ## Integers */
......@@ -393,6 +376,7 @@ __obj __and(__obj,__obj);
__obj __sx(__obj);
__obj __zx(__obj);
__obj __add(__obj,__obj);
__obj __sub(__obj,__obj);
__obj __raise(__obj);
__obj __not(__obj);
__obj __isNil(__obj);
......
......@@ -8,9 +8,14 @@ structure Mangle = struct
val variables = SymbolTables.varTable
val fields = SymbolTables.fieldTable
val constructors = SymbolTables.conTable
val names = ref Map.empty : string Map.map ref
val revnames = ref Map.empty : string Map.map ref
val stamp = ref 0
fun reset () =
(names := Map.empty
;revnames := Map.empty
;stamp := 0)
fun getStringOfPrim sym = Atom.toString (VI.getAtom(!variables, sym))
......
......@@ -57,6 +57,7 @@ structure JS0 = struct
fun codegen cpsSpec =
let
val () = Mangle.reset()
fun id s = Id.fromString (Mangle.apply s)
fun field f = PropertyName.fromString (Mangle.applyField f)
fun fieldId f = Id.fromString (Mangle.applyField f)
......
......@@ -26,6 +26,9 @@ structure Pretty = struct
fun symset item t =
L.listex "{" "}" ";"
(List.map item (SymSet.listItems t))
fun symlistset item t =
L.listex "{" "}" ";"
(List.map item (SymListSet.listItems t))
fun pretty layout = Layout.print (layout, print)
fun prettyTo (os, layout) = Layout.print (layout, fn s => TextIO.output (os, s))
end
......@@ -216,7 +216,7 @@ end
(* Currently `FreeVars` is br0k3n considering mutually recursive functions *)
structure FreeVars = struct
structure Map = SymMap
structure Set = SymSet
structure Set = SymListSet
type t = Set.set Map.map
val freevars = ref Map.empty : t ref
......@@ -386,7 +386,7 @@ structure FreeVars = struct
fun layout () =
Pretty.symmap
{key=CPS.PP.var,
item=Pretty.symset CPS.PP.var} (!freevars)
item=Pretty.symlistset CPS.PP.var} (!freevars)
fun dump () = Pretty.prettyTo(TextIO.stdOut, layout())
end
......
......@@ -44,6 +44,7 @@ end = struct
val raisee = get "raise"
val return = get "return"
val add = get "+"
val sub = get "-"
val sx = get "sx"
val zx = get "zx"
......@@ -77,6 +78,18 @@ end = struct
(add, [a, b], body)
end
(* val - a b = %sub(a,b) *)
val sub =
let
val a = fresh "a"
val b = fresh "b"
val primSub = get "%sub"
val body = PRI (primSub, [a, b])
in
(sub, [a, b], body)
end
(* val and a b = %and(a,b) *)
val andd =
let
......@@ -164,7 +177,18 @@ end = struct
(unconsume, [s], body)
end
in
[slice, consume, unconsume, andd, not, ==, concat, raisee, add, sx, zx]
[slice,
consume,
unconsume,
andd,
not,
==,
concat,
raisee,
add,
sx,
zx,
sub]
end
end
......
......@@ -2,6 +2,18 @@
(**
* ## Inlining of decode patterns.
*)
structure VarAux = struct
val variables = SymbolTables.varTable
fun atomOf x = VarInfo.getAtom (!variables, x)
fun get s = VarInfo.lookup (!variables, Atom.atom s)
fun find s = VarInfo.find (!variables, Atom.atom s)
fun fresh variable = let
val (tab, sym) =
VarInfo.fresh (!variables, variable)
in
sym before SymbolTables.varTable := tab
end
end
structure ASTSubst = struct
val empty = SymMap.empty
......@@ -19,8 +31,8 @@ structure ASTSubst = struct
fun copy x =
let
val name = Aux.atomOf x
val x' = Aux.fresh name
val name = VarAux.atomOf x
val x' = VarAux.fresh name
in
x'
end
......
......@@ -41,8 +41,10 @@ group is
../../semantic/primitives.sml
../../semantic/resolve-symbols.sml
../../semantic/resolve-type-info.sml
../../spec/core.sml
../../spec/spec.sml
../../desugar/desugar-control.sml
../../desugar/desugared-tree.sml
../../desugar/split-declarations.sml
......@@ -53,16 +55,19 @@ group is
../../desugar/desugar-decode-syntax.sml
../../desugar/desugar-monadic-sequences.sml
../../desugar/desugar.sml
../../cps/cps.sml
../../cps/cps-control.sml
../../cps/from-core.sml
../../cps/cps-opt.sml
../../cps/mk-cps-pass.sml
../../cps/cps-passes.sml
../../closure/closure.sml
../../closure/closure-control.sml
../../closure/from-cps.sml
../../closure/closure-passes.sml
../../codegen/codegen-control.sml
../../codegen/codegen-mangle.sml
../../codegen/c0/c0.sml
......
......@@ -6,7 +6,6 @@
| KW_in ("in")
| KW_do ("do")
| KW_export ("export")
| KW_div ("div")
| KW_else ("else")
| KW_end ("end")
| KW_if ("if")
......@@ -230,7 +229,6 @@ AExp
MExp
: SelectExp
(( "*" => (mark PT.MARKinfixop (FULL_SPAN, PT.OPinfixop Op.times))
| "div" => (mark PT.MARKinfixop (FULL_SPAN, PT.OPinfixop Op.div))
| "%" => (mark PT.MARKinfixop (FULL_SPAN, PT.OPinfixop Op.mod))
) ApplyExp =>
(SR, SelectExp))* =>
......
......@@ -47,13 +47,12 @@ SpecTokens = struct
| KW_if
| KW_end
| KW_else
| KW_div
| KW_export
| KW_do
| KW_in
| KW_case
val allToks = [EOF, WILD, COLON, BAR, SEMI, COMMA, TILDE, SLASH, TIMES, MINUS, PLUS, CONCAT, RCB, LCB, RB, LB, RP, LP, DOT, TICK, EQ, BIND, SELECT, WITH, KW_or, KW_and, KW_type, KW_then, KW_raise, KW_granularity, KW_of, KW_mod, KW_val, KW_let, KW_if, KW_end, KW_else, KW_div, KW_export, KW_do, KW_in, KW_case]
val allToks = [EOF, WILD, COLON, BAR, SEMI, COMMA, TILDE, SLASH, TIMES, MINUS, PLUS, CONCAT, RCB, LCB, RB, LB, RP, LP, DOT, TICK, EQ, BIND, SELECT, WITH, KW_or, KW_and, KW_type, KW_then, KW_raise, KW_granularity, KW_of, KW_mod, KW_val, KW_let, KW_if, KW_end, KW_else, KW_export, KW_do, KW_in, KW_case]
fun toString tok =
(case (tok)
......@@ -103,7 +102,6 @@ SpecTokens = struct
| (KW_if) => "if"
| (KW_end) => "end"
| (KW_else) => "else"
| (KW_div) => "div"
| (KW_export) => "export"
| (KW_do) => "do"
| (KW_in) => "in"
......@@ -157,7 +155,6 @@ SpecTokens = struct
| (KW_if) => false
| (KW_end) => false
| (KW_else) => false
| (KW_div) => false
| (KW_export) => false
| (KW_do) => false
| (KW_in) => false
......@@ -333,9 +330,7 @@ fun AExp_PROD_1_ACT (SR, MExp, SR_SPAN : (Lex.pos * Lex.pos), MExp_SPAN : (Lex.p
mark PT.MARKexp (FULL_SPAN, mkLBinExp (MExp, SR)))
fun MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_1_ACT (TIMES, SelectExp, TIMES_SPAN : (Lex.pos * Lex.pos), SelectExp_SPAN : (Lex.pos * Lex.pos), FULL_SPAN : (Lex.pos * Lex.pos)) =
( mark PT.MARKinfixop (FULL_SPAN, PT.OPinfixop Op.times))
fun MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_2_ACT (SelectExp, KW_div, SelectExp_SPAN : (Lex.pos * Lex.pos), KW_div_SPAN : (Lex.pos * Lex.pos), FULL_SPAN : (Lex.pos * Lex.pos)) =
( mark PT.MARKinfixop (FULL_SPAN, PT.OPinfixop Op.div))
fun MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_3_ACT (SelectExp, KW_mod, SelectExp_SPAN : (Lex.pos * Lex.pos), KW_mod_SPAN : (Lex.pos * Lex.pos), FULL_SPAN : (Lex.pos * Lex.pos)) =
fun MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_2_ACT (SelectExp, KW_mod, SelectExp_SPAN : (Lex.pos * Lex.pos), KW_mod_SPAN : (Lex.pos * Lex.pos), FULL_SPAN : (Lex.pos * Lex.pos)) =
( mark PT.MARKinfixop (FULL_SPAN, PT.OPinfixop Op.mod))
fun MExp_PROD_1_SUBRULE_1_PROD_1_ACT (SR, SelectExp, ApplyExp, SR_SPAN : (Lex.pos * Lex.pos), SelectExp_SPAN : (Lex.pos * Lex.pos), ApplyExp_SPAN : (Lex.pos * Lex.pos), FULL_SPAN : (Lex.pos * Lex.pos)) =
(
......@@ -614,10 +609,6 @@ fun matchKW_else strm = (case (lex(strm))
of (Tok.KW_else, span, strm') => ((), span, strm')
| _ => fail()
(* end case *))
fun matchKW_div strm = (case (lex(strm))
of (Tok.KW_div, span, strm') => ((), span, strm')
| _ => fail()
(* end case *))
fun matchKW_export strm = (case (lex(strm))
of (Tok.KW_export, span, strm') => ((), span, strm')
| _ => fail()
......@@ -947,8 +938,7 @@ and MonadicExp_NT (strm) = let
(case (lex(strm))
of (Tok.ID(_), _, strm') =>
(case (lex(strm'))
of (Tok.KW_div, _, strm') => MonadicExp_PROD_1(strm)
| (Tok.KW_end, _, strm') => MonadicExp_PROD_1(strm)
of (Tok.KW_end, _, strm') => MonadicExp_PROD_1(strm)
| (Tok.KW_let, _, strm') => MonadicExp_PROD_1(strm)
| (Tok.KW_mod, _, strm') => MonadicExp_PROD_1(strm)
| (Tok.KW_and, _, strm') => MonadicExp_PROD_1(strm)
......@@ -1117,27 +1107,18 @@ and MExp_NT (strm) = let
FULL_SPAN, strm')
end
fun MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_2 (strm) = let
val (KW_div_RES, KW_div_SPAN, strm') = matchKW_div(strm)
val FULL_SPAN = (#1(KW_div_SPAN), #2(KW_div_SPAN))
in
(UserCode.MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_2_ACT (SelectExp_RES, KW_div_RES, SelectExp_SPAN : (Lex.pos * Lex.pos), KW_div_SPAN : (Lex.pos * Lex.pos), FULL_SPAN : (Lex.pos * Lex.pos)),
FULL_SPAN, strm')
end
fun MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_3 (strm) = let
val (KW_mod_RES, KW_mod_SPAN, strm') = matchKW_mod(strm)
val FULL_SPAN = (#1(KW_mod_SPAN), #2(KW_mod_SPAN))
in
(UserCode.MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_3_ACT (SelectExp_RES, KW_mod_RES, SelectExp_SPAN : (Lex.pos * Lex.pos), KW_mod_SPAN : (Lex.pos * Lex.pos), FULL_SPAN : (Lex.pos * Lex.pos)),
(UserCode.MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_2_ACT (SelectExp_RES, KW_mod_RES, SelectExp_SPAN : (Lex.pos * Lex.pos), KW_mod_SPAN : (Lex.pos * Lex.pos), FULL_SPAN : (Lex.pos * Lex.pos)),
FULL_SPAN, strm')
end
in
(case (lex(strm))
of (Tok.KW_mod, _, strm') =>
MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_3(strm)
MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_2(strm)
| (Tok.TIMES, _, strm') =>
MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_1(strm)
| (Tok.KW_div, _, strm') =>
MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_2(strm)
| _ => fail()
(* end case *))
end
......@@ -1151,8 +1132,7 @@ and MExp_NT (strm) = let
FULL_SPAN, strm')
end
fun MExp_PROD_1_SUBRULE_1_PRED (strm) = (case (lex(strm))
of (Tok.KW_div, _, strm') => true
| (Tok.KW_mod, _, strm') => true
of (Tok.KW_mod, _, strm') => true
| (Tok.TIMES, _, strm') => true
| _ => false
(* end case *))
......
......@@ -97,7 +97,6 @@
<INITIAL>"end" => (T.KW_end);
<INITIAL>"do" => (T.KW_do);
<INITIAL>"in" => (T.KW_in);
<INITIAL>"div" => (T.KW_div);
<INITIAL>"andalso" => (T.KW_and);
<INITIAL>"orelse" => (T.KW_or);
<INITIAL>"<-" => (T.BIND);
......
This diff is collapsed.
......@@ -42,7 +42,7 @@ end
structure SymbolTable :> SymbolTableSig = struct
val concisePrint : bool = true
val concisePrint : bool = false
structure SymbolTable = IntRedBlackMap
structure Reverse = AtomRedBlackMap
......@@ -185,6 +185,7 @@ end
structure SymMap = RedBlackMapFn(ord_symid)
structure SymSet = RedBlackSetFn(ord_symid)
structure SymListSet = ListSetFn(ord_symid)
structure SpanMap = RedBlackMapFn(struct
type ord_key = Error.span
......
This diff is collapsed.
granularity = 8
export = / decode
export = decode
# Optional arguments
#
......
all: ccmp ccli cxedcmp
all: cmusl-cli
ccmp:
gcc -O2 -Wall -static -I. -I../.. -I../../resources/xed/xed2-intel64/include -L../../resources/xed/xed2-intel64/lib -Wfatal-errors cmp.c ../../dis.c pretty.c -lbfd -liberty -ldl -lz -lxed -DRELAXEDFATAL -o cmp
cxedcmp:
gcc -O2 -Wall -Wfatal-errors -static -I. -I../.. -I../../resources/xed/xed2-intel64/include -L../../resources/xed/xed2-intel64/lib xed-cmp.c ../../dis.c pretty.c -lbfd -liberty -ldl -lz -lxed -DRELAXEDFATAL -o xed-cmp
gcc -O2 -Wall -Wfatal-errors -static -I. -I../.. -I../../resources/xed/xed2-intel64/include -L../../resources/xed/xed2-intel64/lib xed-cmp.c pretty.c ../../dis.c -lbfd -liberty -ldl -lz -lxed -DRELAXEDFATAL -o xed-cmp
ccli:
gcc -O2 -Wall -static -I. -I../.. -Wfatal-errors cli.c ../../dis.c pretty.c -DRELAXEDFATAL -o cli
gcc -pipe -O2 -Wall -static -I. -I../.. -Wfatal-errors cli.c pretty.c ../../dis.c -DRELAXEDFATAL -o cli
cmusl-cli:
/usr/musl/bin/musl-gcc -pipe -O2 -Wall -static -I. -I../.. -Wfatal-errors cli.c pretty.c ../../dis.c -DRELAXEDFATAL -o musl-cli
ccli-println:
gcc -O2 -Wall -static -I. -I../.. -Wfatal-errors cli-println.c ../../dis.c -DRELAXEDFATAL -o cli-println
......@@ -4,7 +4,7 @@
int main (int argc, char** argv) {
__char blob[15];
char fmt[128];
char fmt[1024];
__word sz = 15;
__obj insn,semantics;
int i,c;
......@@ -22,10 +22,11 @@ int main (int argc, char** argv) {
if (___isNil(insn))
__fatal("decode failed");
else {
prettyln(insn,fmt,128);
prettyln(insn,fmt,1024);
puts(fmt);
semantics = __translate(__translate__,insn);
__println(semantics);
prettyln(semantics,fmt,1024);
puts(fmt);
}
return (1);
}
......
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment