Commit c879e6d5 authored by Julian Kranz's avatar Julian Kranz

Merge

parents 3a3a6b8a 143c12db
......@@ -149,7 +149,7 @@ RUNTIME = $(srcdir)/detail/codegen/c0/runtime.h \
$(MLANTLR) $<
GDSLC = $(abspath $(CURDIR)/gdslc$(EXEEXT))
GDSLC_DEP = gdslc$(EXEEXT)
GDSLC_DEP = gdslc$(EXEEXT) detail/codegen/c1/runtime.c detail/codegen/c1/runtime.h
# the decoders
......
......@@ -58,7 +58,8 @@ structure C1 = struct
closureToFun : SymbolTable.symid SymMap.map,
recordMapping : Atom.atom AtomMap.map,
allocFuncs : int AtomMap.map ref,
preDeclEmit : Layout.t list ref }
preDeclEmit : Layout.t list ref,
stateType : Imp.vtype ref }
fun isVOIDvtype VOIDvtype = true
| isVOIDvtype _ = false
......@@ -196,7 +197,8 @@ structure C1 = struct
closureToFun = #closureToFun s,
allocFuncs = #allocFuncs s,
recordMapping = #recordMapping s,
preDeclEmit = #preDeclEmit s } : state
preDeclEmit = #preDeclEmit s,
stateType = #stateType s } : state
end
fun registerSymbol (sym,s : state) = regSym (sym, !SymbolTables.varTable, s)
fun registerFSymbol (sym,s : state) = regSym (sym, !SymbolTables.fieldTable, s)
......@@ -213,7 +215,8 @@ structure C1 = struct
closureToFun = #closureToFun s,
allocFuncs = #allocFuncs s,
recordMapping = #recordMapping s,
preDeclEmit = #preDeclEmit s } : state
preDeclEmit = #preDeclEmit s,
stateType = #stateType s } : state
fun par arg = seq [str "(", arg, str ")"]
fun list (lp,arg,xs,rp) = [str lp, seq (separate (map arg xs, ",")), str rp]
......@@ -651,6 +654,17 @@ structure C1 = struct
]
and emitExp s (IDexp sym) = emitSym s sym
| emitExp s (PRIexp (SETSTATEprim,_,
[UPDATEexp (rs,t as RECORDvtype (boxed,fsTys),fs,PRIexp (GETSTATEprim,_,[]))])) =
let
val _ = #stateType s := t
fun setField (f,e) =
seq [
str "s->state", str (if boxed then "->" else "."),
emitFieldSym s f, str " = ", emitExp s e, str ";"]
in
align (map setField fs)
end
| emitExp s (PRIexp (f,t,es)) = (case t of
FUNvtype (_,_,args) => emitPrim s (f,es,args)
| _ => emitPrim s (f,es,[])
......@@ -688,6 +702,23 @@ structure C1 = struct
else
seq [emitExp s e, str ".", emitFieldSym s f]
| emitExp s (SELECTexp (rs,t,f,e)) = seq [emitSelect s f, fArgs [str (getFieldTag f), emitExp s e]]
| emitExp s (UPDATEexp (rs,OBJvtype,fs,e)) =
let
val recStripped =
seq [
str "del_fields",
fArgs [
seq (str "(field_tag_t[])" :: list ("{",str o Int.toString o SymbolTable.toInt o #1, fs, "}")),
str (Int.toString (length fs)),
emitExp s e]]
fun recAdd ((f,e),layout) =
align [
seq [emitAddField s f, str "(s,", str (getFieldTag f), str ",", emitExp s e, str ","],
indent 2 (seq [layout, str ")"])]
in
foldl recAdd recStripped fs
end
| emitExp s (UPDATEexp (rs,_,fs,e)) = raise CodeGenBug (* we can't copy a C struct and set a field as a C expression *)
| emitExp s (LITexp (t,VEClit pat)) =
let
fun genNum (c,acc) = IntInf.fromInt 2*acc+(if c= #"1" then 1 else 0)
......@@ -986,7 +1017,8 @@ structure C1 = struct
closureToFun = closureToFunMap,
allocFuncs = ref AtomMap.empty,
recordMapping = recordMapping,
preDeclEmit = ref []
preDeclEmit = ref [],
stateType = ref OBJvtype
} : state
val s = registerSymbol (stateSym, s)
val s = foldl registerSymbol s (map getDeclName ds)
......@@ -1003,7 +1035,8 @@ structure C1 = struct
closureToFun = #closureToFun s,
allocFuncs = #allocFuncs s,
recordMapping = #recordMapping s,
preDeclEmit = #preDeclEmit s
preDeclEmit = #preDeclEmit s,
stateType = #stateType s
} : state
val funDeclsPublic = map (emitDecl s)
(List.filter (fn d => SymSet.member(exports, getDeclName d)) ds)
......@@ -1027,9 +1060,7 @@ structure C1 = struct
map (str o Atom.toString o #1)
(ListMergeSort.sort (fn ((_,i1),(_,i2)) => i1>i2)
(AtomMap.listItemsi (!(#allocFuncs s))))
val fields = []
val constructorNames = str ""
val fieldNames = str ""
val state = emitType s (SOME "state", !(#stateType s))
val _ =
C1Templates.expandHeader outputName [
......@@ -1047,8 +1078,7 @@ structure C1 = struct
C1Templates.mkHook ("renamings", align renamings),
C1Templates.mkHook ("records", align (genRecordDecl s true)),
C1Templates.mkHook ("exports", align funDeclsPublic),
C1Templates.mkHook ("tagnames", align constructors),
C1Templates.mkHook ("fields", align fields)
C1Templates.mkHook ("tagnames", align constructors)
]
val _ =
C1Templates.expandRuntime outputName [
......@@ -1067,7 +1097,7 @@ structure C1 = struct
C1Templates.mkHook ("destroy", str (prefix ^ "destroy")),
C1Templates.mkHook ("alloc_funcs", align recAllocFuncs),
C1Templates.mkHook ("records", align (genRecordDecl s false)),
C1Templates.mkHook ("fieldnames", fieldNames),
C1Templates.mkHook ("state_type", indent 2 state),
C1Templates.mkHook ("prototypes", align funDeclsPrivate),
C1Templates.mkHook ("functions", align funs)
]
......
/* vim:ts=2:sw=2:expandtab */
/* vim:set ts=2:set sw=2:set expandtab: */
@I-am-a-template-so-edit-me@
@include-prefix@
#include <string.h>
#include <stdio.h>
/* generated declarations for records with fixed fields */
@records@
struct state {
char* heap_base; /* the beginning of the heap */
char* heap_limit; /* first byte beyond the heap buffer */
char* heap; /* current top of the heap */
obj_t state; /* a heap pointer to the current monadic state */
@state_type@
; /* the current monadic state */
char* ip_base; /* beginning of code buffer */
char* ip_limit; /* first byte beyond the code buffer */
char* ip; /* current pointer into the buffer */
......@@ -65,7 +70,6 @@ void
s->heap_base = heap;
s->heap = heap+sizeof(char*);
s->heap_limit = heap+CHUNK_SIZE;
s->state = 0;
};
size_t
......@@ -91,10 +95,6 @@ static inline void* MALLOC_ATTR alloc(state_t s, size_t bytes) {
return res;
};
/* generated declarations for records with fixed fields */
@records@
#define GEN_ALLOC(type) \
static inline type ## _t* alloc_ ## type (state_t s, type ## _t v) { \
type ## _t* res = alloc(s, sizeof(type ## _t));\
......@@ -367,18 +367,17 @@ done:
int_t alloc_max = 0;
while (gdsl_get_ip_offset(s)<buf_size) {
uint64_t ofs = gdsl_get_ip_offset(s);
if (setjmp(*gdsl_err_tgt(s))==0) {
if (argc>1) {
#if defined(gdsl_translateBlock) && defined(gdsl_rreil_pretty)
obj_t rreil = gdsl_translateBlock(s);
obj_t rreil = gdsl_translateBlock(s, gdsl_config_default(s));
obj_t res = gdsl_rreil_pretty(s,rreil);
string_t str = gdsl_merge_rope(s,res);
fputs(str,stdout);
#endif
} else {
#if defined(gdsl_decode) && defined(gdsl_pretty)
obj_t instr = gdsl_decode(s);
obj_t instr = gdsl_decode(s, gdsl_config_default(s));
obj_t res = gdsl_pretty(s,instr);
string_t str = gdsl_merge_rope(s,res);
fputs(str,stdout);
......@@ -387,7 +386,7 @@ done:
} else {
fputs("exception: ",stdout);
fputs(gdsl_get_error_message(s),stdout);
consume8(s);
if (gdsl_get_ip_offset(s)<buf_size) consume8(s);
}
fputs("\n",stdout);
int_t size = gdsl_heap_residency(s);
......
/* vim:ts=2:sw=2:expandtab */
/* vim:set ts=2:set sw=2:set expandtab: */
@I-am-a-template-so-edit-me@
#ifndef __GDSL_RUNTIME_H
#define __GDSL_RUNTIME_H
......
......@@ -166,28 +166,43 @@ end = struct
case SymbolTable.find (tab, name) of
NONE =>
let
val arg = Atom.atom ("arg_of_" ^ Atom.toString name)
val (tab, sym) = SymbolTable.fresh (tab, name)
val (tab, sym') = SymbolTable.fresh (tab, arg)
val (tab, symArg) = SymbolTable.fresh (tab, Atom.atom "recArg")
val (tab, symRes) = SymbolTable.fresh (tab, Atom.atom "recRes")
val (tab, symDummy) = SymbolTable.fresh (tab, Atom.atom "recSym")
val _ = SymbolTables.varTable := tab
val _ = app (addField s) fields
val argsTy = map (fn _ => OBJvtype) fields
fun genArgs f =
let
val _ = addField s f
val arg = Atom.atom (SymbolTable.getString (ftab,f) ^ "_val")
val tab = !SymbolTables.varTable
val (tab, sym) = SymbolTable.fresh (tab,arg)
val _ = SymbolTables.varTable := tab
in
sym
end
val args = map genArgs fields
val argsTy = map (fn _ => OBJvtype) args
val fType = FUNvtype (OBJvtype, false, argsTy @ [OBJvtype])
val fTypeCl = FUNvtype (OBJvtype, false, [OBJvtype])
val fieldsExps = ListPair.zipEq (fields, map IDexp args)
val body = BASICblock ([],[ASSIGNstmt (SOME symRes,
UPDATEexp (symDummy, OBJvtype, fieldsExps, IDexp symArg))])
val fArgs = map (fn arg => (OBJvtype,arg)) (args @ [symArg])
val _ = addDecl s
(UPDATEdecl { updateName = sym,
updateArg = sym',
updateFields = fields,
updateType = fType })
(FUNCdecl { funcClosure = [],
funcType = fType,
funcName = sym,
funcArgs = fArgs,
funcBody = body,
funcRes = symRes })
val clSym = getClosureSym (s,sym)
val _ = addDecl s (CLOSUREdecl {
closureName = clSym,
closureArgs = argsTy,
closureDelegate = sym,
closureDelArgs = [(OBJvtype,sym')],
closureDelArgs = [(OBJvtype,symArg)],
closureRetTy = OBJvtype
})
in
......
This diff is collapsed.
......@@ -149,6 +149,7 @@ structure Imp = struct
| INVOKEexp of vtype * exp * exp list (* callee is a closure, type is that of exp *)
| RECORDexp of rec_sym * vtype * (sym * exp) list
| SELECTexp of rec_sym * vtype * sym * exp (* type is that of the record exp *)
| UPDATEexp of rec_sym * vtype * (sym * exp) list * exp (* type is that of the record exp *)
| LITexp of vtype * lit
| BOXexp of vtype * exp
| UNBOXexp of vtype * exp
......@@ -259,6 +260,8 @@ structure Imp = struct
| exp (INVOKEexp (t,f,es)) = seq (vtype t :: space :: str "*" :: exp f :: args ("(",exp,es,")"))
| exp (RECORDexp (_,t,fs)) = seq (vtype t :: space :: args ("{",field,fs,"}"))
| exp (SELECTexp (_,t,f,e)) = seq [str "(", vtype t, str ")", exp e, space, str ".", fld f]
| exp (UPDATEexp (_,t,fs,e)) =
seq ([vtype t] @ args ("[",field,fs,"]") @ [str "(", exp e, str ")"])
| exp (LITexp l) = lit l
| exp (BOXexp (t,e)) = seq [str "box[", vtype t, str "](", exp e, str ")"]
| exp (UNBOXexp (t,e)) = seq [str "unbox[", vtype t, str "](", exp e, str ")"]
......
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