Deplacement du parser de C-- ici.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@56 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

11 files changed, 746 insertions, 6 deletions

diff --git a/testasmcomp/Makefile b/testasmcomp/Makefile
index 141f7cfaaa..f4e707304a 100644
--- a/testasmcomp/Makefile
+++ b/testasmcomp/Makefile
@@ -1,12 +1,70 @@
 ARCH=alpha
 
-CODEGEN=../codegen
+include ../Makefile.config
+
+CAMLC=../boot/camlrun ../boot/camlc -I ../boot
+COMPFLAGS=$(INCLUDES)
+LINKFLAGS=
+CAMLYACC=../boot/camlyacc
+YACCFLAGS=
+CAMLLEX=../boot/camlrun ../boot/camllex
+CAMLDEP=../tools/camldep
+DEPFLAGS=$(INCLUDES)
+CAMLRUN=../boot/camlrun
+
+CODEGEN=./codegen
 ASFLAGS=-O2
 CFLAGS=-g
 
 PROGS=fib tak quicksort quicksort2 soli integr
 
-all: $(PROGS)
+all: codegen $(PROGS)
+
+INCLUDES=-I ../utils -I ../typing -I ../asmcomp
+
+OTHEROBJS=../utils/misc.cmo ../utils/tbl.cmo \
+  ../utils/clflags.cmo ../utils/config.cmo \
+  ../typing/ident.cmo ../typing/path.cmo ../typing/subst.cmo \
+  ../typing/predef.cmo ../typing/env.cmo \
+  ../bytecomp/lambda.cmo \
+  ../asmcomp/arch.cmo ../asmcomp/cmm.cmo ../asmcomp/printcmm.cmo \
+  ../asmcomp/clambda.cmo ../asmcomp/compilenv.cmo \
+  ../asmcomp/closure.cmo ../asmcomp/cmmgen.cmo \
+  ../asmcomp/reg.cmo ../asmcomp/mach.cmo ../asmcomp/proc.cmo \
+  ../asmcomp/printmach.cmo ../asmcomp/selection.cmo \
+  ../asmcomp/liveness.cmo ../asmcomp/spill.cmo ../asmcomp/split.cmo \
+  ../asmcomp/interf.cmo ../asmcomp/coloring.cmo ../asmcomp/reload.cmo \
+  ../asmcomp/linearize.cmo ../asmcomp/printlinear.cmo ../asmcomp/emitaux.cmo \
+  ../asmcomp/emit.cmo ../asmcomp/asmgen.cmo
+
+OBJS=parsecmmaux.cmo parsecmm.cmo lexcmm.cmo main.cmo
+
+codegen: $(OTHEROBJS) $(OBJS)
+	$(CAMLC) $(LINKFLAGS) -o codegen $(OTHEROBJS) $(OBJS)
+clean::
+	rm -f codegen
+
+# The parser
+
+parsecmm.mli parsecmm.ml: parsecmm.mly
+	$(CAMLYACC) $(YACCFLAGS) parsecmm.mly
+
+clean::
+	rm -f parsecmm.mli parsecmm.ml parsecmm.output
+
+beforedepend:: parsecmm.mli parsecmm.ml
+
+# The lexer
+
+lexcmm.ml: lexcmm.mll
+	$(CAMLLEX) lexcmm.mll
+
+clean::
+	rm -f lexcmm.ml
+
+beforedepend:: lexcmm.ml
+
+# The test programs
 
 fib: main.c fib.o $(ARCH).o
 	$(CC) $(CFLAGS) -o fib -DINT_INT -DFUN=fib main.c fib.o $(ARCH).o
@@ -39,16 +97,27 @@ tagged-integr: main.c tagged-integr.o $(ARCH).o
 	$(CC) $(CFLAGS) -o tagged-integr -DINT_FLOAT -DFUN=test main.c tagged-integr.o $(ARCH).o
 
 .SUFFIXES:
-.SUFFIXES: .cmm .c .o .asm
+.SUFFIXES: .cmm .c .o .asm .ml .mli .cmo .cmi
+
+.ml.cmo:
+	$(CAMLC) $(COMPFLAGS) -c $<
+
+.mli.cmi:
+	$(CAMLC) $(COMPFLAGS) -c $<
 
 .cmm.o:
-	cslrun $(CODEGEN) $*.cmm > $*.s
+	$(CAMLRUN) $(CODEGEN) $*.cmm > $*.s
 	$(AS) $(ASFLAGS) -o $*.o $*.s
 
 .asm.o:
 	$(AS) $(ASFLAGS) -o $*.o $*.asm
 
-clean:
-	rm -f *.s *.o *~ $(PROGS)
+clean::
+	rm -f *.cm[io] *.s *.o *~ $(PROGS)
 
 fib.o tak.o quicksort.o quicksort2.o integr.o soli.o: $(CODEGEN)
+
+depend: beforedepend
+	$(CAMLDEP) $(DEPFLAGS) *.mli *.ml > .depend
+
+include .depend
diff --git a/testasmcomp/lexcmm.mli b/testasmcomp/lexcmm.mli
new file mode 100644
index 0000000000..f9fe6afadf
--- /dev/null
+++ b/testasmcomp/lexcmm.mli
@@ -0,0 +1,10 @@
+val token: Lexing.lexbuf -> Parsecmm.token
+
+type error =
+    Illegal_character
+  | Unterminated_comment
+  | Unterminated_string
+
+exception Error of error
+
+val report_error: Lexing.lexbuf -> error -> unit
diff --git a/testasmcomp/lexcmm.mll b/testasmcomp/lexcmm.mll
new file mode 100644
index 0000000000..9414d83667
--- /dev/null
+++ b/testasmcomp/lexcmm.mll
@@ -0,0 +1,210 @@
+{
+open Parsecmm
+
+type error =
+    Illegal_character
+  | Unterminated_comment
+  | Unterminated_string
+
+exception Error of error
+
+(* For nested comments *)
+
+let comment_depth = ref 0
+
+(* The table of keywords *)
+
+let keyword_table =
+  Misc.create_hashtable 149 [
+    "addr", ADDR;
+    "align", ALIGN;
+    "alloc", ALLOC;
+    "and", AND;
+    "app", APPLY;
+    "assign", ASSIGN;
+    "byte", BYTE;
+    "case", CASE;
+    "catch", CATCH;
+    "exit", EXIT;
+    "extcall", EXTCALL;
+    "float", FLOAT;
+    "floatofint", FLOATOFINT;
+    "function", FUNCTION;
+    "half", HALF;
+    "if", IF;
+    "int", INT;
+    "intoffloat", INTOFFLOAT;
+    "string", KSTRING;
+    "let", LET;
+    "load", LOAD;
+    "mod", MODI;
+    "modify", MODIFY;
+    "or", OR;
+    "proj", PROJ;
+    "raise", RAISE;
+    "seq", SEQ;
+    "signed", SIGNED;
+    "skip", SKIP;
+    "store", STORE;
+    "switch", SWITCH;
+    "try", TRY;
+    "unit", UNIT;
+    "unsigned", UNSIGNED;
+    "while", WHILE;
+    "with", WITH;
+    "xor", XOR;
+    "addraref", ADDRAREF;
+    "intaref", INTAREF;
+    "floataref", FLOATAREF;
+    "addraset", ADDRASET;
+    "intaset", INTASET;
+    "floataset", FLOATASET
+]
+
+(* To buffer string literals *)
+
+let initial_string_buffer = String.create 256
+let string_buff = ref initial_string_buffer
+let string_index = ref 0
+
+let reset_string_buffer () =
+  string_buff := initial_string_buffer;
+  string_index := 0
+
+let store_string_char c =
+  if !string_index >= String.length (!string_buff) then begin
+    let new_buff = String.create (String.length (!string_buff) * 2) in
+      String.blit (!string_buff) 0 new_buff 0 (String.length (!string_buff));
+      string_buff := new_buff
+  end;
+  String.unsafe_set (!string_buff) (!string_index) c;
+  incr string_index
+
+let get_stored_string () =
+  let s = String.sub (!string_buff) 0 (!string_index) in
+  string_buff := initial_string_buffer;
+  s
+
+(* To translate escape sequences *)
+
+let char_for_backslash = function
+    'n' -> '\010'
+  | 'r' -> '\013'
+  | 'b' -> '\008'
+  | 't' -> '\009'
+  | c   -> c
+
+let char_for_decimal_code lexbuf i =
+  Char.chr(100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) +
+               10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) +
+                    (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48))
+
+(* Error report *)
+
+let report_error lexbuf msg =
+  prerr_string "Lexical error around character ";
+  prerr_int (Lexing.lexeme_start lexbuf);
+  match msg with
+    Illegal_character ->
+      prerr_string ": illegal character"
+  | Unterminated_comment ->
+      prerr_string ": unterminated comment"
+  | Unterminated_string ->
+      prerr_string ": unterminated string"
+
+}
+
+rule token = parse
+    [' ' '\010' '\013' '\009' '\012'] +
+      { token lexbuf }
+  | "+a" { ADDA }
+  | "+f" { ADDF }
+  | "+" { ADDI }
+  | ">>s" { ASR }
+  | ":" { COLON }
+  | "/f" { DIVF }
+  | "/" { DIVI }
+  | eof { EOF }
+  | "==a" { EQA }
+  | "==f" { EQF }
+  | "==" { EQI }
+  | ">=a" { GEA }
+  | ">=f" { GEF }
+  | ">=" { GEI }
+  | ">a" { GTA }
+  | ">f" { GTF }
+  | ">" { GTI }
+  | "[" { LBRACKET }
+  | "<=a" { LEA }
+  | "<=f" { LEF }
+  | "<=" { LEI }
+  | "(" { LPAREN }
+  | "<<" { LSL }
+  | ">>u" { LSR }
+  | "<a" { LTA }
+  | "<f" { LTF }
+  | "<" { LTI }
+  | "*f" { MULF }
+  | "*" { MULI }
+  | "!=a" { NEA }
+  | "!=f" { NEF }
+  | "!=" { NEI }
+  | "]" { RBRACKET }
+  | ")" { RPAREN }
+  | "*" { STAR }
+  | "-a" { SUBA }
+  | "-f" { SUBF }
+  | "-" { SUBI }
+  | '-'? (['0'-'9']+ | "0x" ['0'-'9' 'a'-'f' 'A'-'F']+
+                     | "0o" ['0'-'7']+ | "0b" ['0'-'1']+)
+      { INTCONST(int_of_string(Lexing.lexeme lexbuf)) }
+  | '-'? ['0'-'9']+ 'a'
+      { let s = Lexing.lexeme lexbuf in
+        POINTER(int_of_string(String.sub s 0 (String.length s - 1))) }
+  | ['0'-'9']+ ('.' ['0'-'9']*)? (['e' 'E'] ['+' '-']? ['0'-'9']+)?
+      { FLOATCONST(Lexing.lexeme lexbuf) }
+  | ['A'-'Z' 'a'-'z' '\223'-'\246' '\248'-'\255' ]
+    (['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255'
+      '\'' '0'-'9' ]) *
+      { let s = Lexing.lexeme lexbuf in
+        try
+          Hashtbl.find keyword_table s
+        with Not_found ->
+          IDENT s }
+  | "\""
+      { reset_string_buffer();
+        string lexbuf;
+        STRING (get_stored_string()) }
+  | "(*"
+      { comment_depth := 1;
+        comment lexbuf;
+        token lexbuf }
+  | _ { raise(Error(Illegal_character)) }
+
+and comment = parse
+    "(*"
+      { comment_depth := succ !comment_depth; comment lexbuf }
+  | "*)"
+      { comment_depth := pred !comment_depth;
+        if !comment_depth > 0 then comment lexbuf }
+  | eof
+      { raise (Error(Unterminated_comment)) }
+  | _
+      { comment lexbuf }
+
+and string = parse
+    '"'
+      { () }
+  | '\\' [' ' '\010' '\013' '\009' '\026' '\012'] +
+      { string lexbuf }
+  | '\\' ['\\' '"' 'n' 't' 'b' 'r']
+      { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
+        string lexbuf }
+  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
+      { store_string_char(char_for_decimal_code lexbuf 1);
+         string lexbuf }
+  | eof
+      { raise (Error(Unterminated_string)) }
+  | _
+      { store_string_char(Lexing.lexeme_char lexbuf 0);
+        string lexbuf }
diff --git a/testasmcomp/main.ml b/testasmcomp/main.ml
new file mode 100644
index 0000000000..90f7af5ed7
--- /dev/null
+++ b/testasmcomp/main.ml
@@ -0,0 +1,39 @@
+let compile_file filename =
+  let ic = open_in filename in
+  let lb = Lexing.from_channel ic in
+  try
+    while true do
+      Asmgen.compile_phrase(Parsecmm.phrase Lexcmm.token lb)
+    done
+  with
+      End_of_file ->
+        close_in ic
+    | Lexcmm.Error msg ->
+        close_in ic; Lexcmm.report_error lb msg
+    | Parsing.Parse_error ->
+        close_in ic;
+        prerr_string "Syntax error near character ";
+        prerr_int (Lexing.lexeme_start lb);
+        prerr_newline()
+    | Parsecmmaux.Error msg ->
+        close_in ic; Parsecmmaux.report_error msg
+    | x ->
+        close_in ic; raise x
+
+let main() =
+  Arg.parse
+    ["-dcmm", Arg.Unit(fun () -> Clflags.dump_cmm := true);
+     "-dsel", Arg.Unit(fun () -> Clflags.dump_selection := true);
+     "-dlive", Arg.Unit(fun () -> Clflags.dump_live := true;
+                                  Printmach.print_live := true);
+     "-dspill", Arg.Unit(fun () -> Clflags.dump_spill := true);
+     "-dsplit", Arg.Unit(fun () -> Clflags.dump_split := true);
+     "-dinterf", Arg.Unit(fun () -> Clflags.dump_interf := true);
+     "-dprefer", Arg.Unit(fun () -> Clflags.dump_prefer := true);
+     "-dalloc", Arg.Unit(fun () -> Clflags.dump_regalloc := true);
+     "-dreload", Arg.Unit(fun () -> Clflags.dump_reload := true);
+     "-dlinear", Arg.Unit(fun () -> Clflags.dump_linear := true)]
+    compile_file
+
+let _ = Printexc.catch main (); exit 0
+
diff --git a/testasmcomp/parsecmm.mly b/testasmcomp/parsecmm.mly
new file mode 100644
index 0000000000..aa7d4ddb19
--- /dev/null
+++ b/testasmcomp/parsecmm.mly
@@ -0,0 +1,297 @@
+/* A simple parser for C-- */
+
+%{
+open Cmm
+open Parsecmmaux
+
+let rec make_letdef def body =
+  match def with
+    [] -> body
+  | (id, def) :: rem ->
+      unbind_ident id;
+      Clet(id, def, make_letdef rem body)
+
+let make_switch n selector caselist =
+  let index = Array.new n 0 in
+  let casev = Array.of_list caselist in
+  let actv = Array.new (Array.length casev) Cexit in
+  for i = 0 to Array.length casev - 1 do
+    let (posl, e) = casev.(i) in
+    List.iter (fun pos -> index.(pos) <- i) posl;
+    actv.(i) <- e
+  done;
+  Cswitch(selector, index, actv)
+
+let access_array base numelt size =
+  match numelt with
+    Cconst_int 0 -> base
+  | Cconst_int n -> Cop(Cadda, [base; Cconst_int(n * size)])
+  | _ -> Cop(Cadda, [base;
+                     Cop(Clsl, [numelt; Cconst_int(Misc.log2 size)])])
+
+%}
+
+%token ADDA
+%token ADDF
+%token ADDI
+%token ADDR
+%token ALIGN
+%token ALLOC
+%token AND
+%token APPLY
+%token ASR
+%token ASSIGN
+%token BYTE
+%token CASE
+%token CATCH
+%token COLON
+%token DIVF
+%token DIVI
+%token EOF
+%token EQA
+%token EQF
+%token EQI
+%token EXIT
+%token EXTCALL
+%token FLOAT
+%token <string> FLOATCONST
+%token FLOATOFINT
+%token FUNCTION
+%token GEA
+%token GEF
+%token GEI
+%token GTA
+%token GTF
+%token GTI
+%token HALF
+%token <string> IDENT
+%token IF
+%token INT
+%token <int> INTCONST
+%token INTOFFLOAT
+%token KSTRING
+%token LBRACKET
+%token LEA
+%token LEF
+%token LEI
+%token LET
+%token LOAD
+%token LPAREN
+%token LSL
+%token LSR
+%token LTA
+%token LTF
+%token LTI
+%token MODI
+%token MODIFY
+%token MULF
+%token MULI
+%token NEA
+%token NEF
+%token NEI
+%token OR
+%token <int> POINTER
+%token PROJ
+%token RAISE
+%token RBRACKET
+%token RPAREN
+%token SEQ
+%token SIGNED
+%token SKIP
+%token STAR
+%token STORE
+%token <string> STRING
+%token SUBA
+%token SUBF
+%token SUBI
+%token SWITCH
+%token TRY
+%token UNIT
+%token UNSIGNED
+%token WHILE
+%token WITH
+%token XOR
+%token ADDRAREF
+%token INTAREF
+%token FLOATAREF
+%token ADDRASET
+%token INTASET
+%token FLOATASET
+
+%start phrase
+%type <Cmm.phrase> phrase
+
+%%
+
+phrase:
+    fundecl     { Cfunction $1 }
+  | datadecl    { Cdata $1 }
+  | EOF         { raise End_of_file }
+;
+fundecl:
+    LPAREN FUNCTION STRING LPAREN params RPAREN sequence RPAREN
+      { List.iter (fun (id, ty) -> unbind_ident id) $5;
+        {fun_name = $3; fun_args = $5; fun_body = $7; fun_fast = true} }
+;
+params:
+    oneparam params     { $1 :: $2 }
+  | /**/                { [] }
+;
+oneparam:
+    IDENT COLON machtype { (bind_ident $1, $3) }
+;
+machtype:
+    UNIT                        { [||] }
+  | componentlist               { Array.of_list(List.rev $1) }
+;
+component:
+    ADDR                        { Addr }
+  | INT                         { Int }
+  | FLOAT                       { Float }
+;
+componentlist:
+    component                    { [$1] }
+  | componentlist STAR component { $3 :: $1 }
+;
+expr:
+    INTCONST    { Cconst_int $1 }
+  | FLOATCONST  { Cconst_float $1 }
+  | STRING      { Cconst_symbol $1 }
+  | POINTER     { Cconst_pointer $1 }
+  | IDENT       { Cvar(find_ident $1) }
+  | LPAREN LET letdef sequence RPAREN { make_letdef $3 $4 }
+  | LPAREN ASSIGN IDENT expr RPAREN { Cassign(find_ident $3, $4) }
+  | LBRACKET exprlist RBRACKET { Ctuple(List.rev $2) }
+  | LPAREN APPLY expr expr machtype RPAREN { Cop(Capply $5, [$3; $4]) }
+  | LPAREN EXTCALL STRING expr machtype RPAREN { Cop(Cextcall($3, $5), [$4]) }
+  | LPAREN LOAD expr machtype RPAREN { Cop(Cload $4, [$3]) }
+  | LPAREN unaryop expr RPAREN { Cop($2, [$3]) }
+  | LPAREN binaryop expr expr RPAREN { Cop($2, [$3; $4]) }
+  | LPAREN SEQ sequence RPAREN { $3 }
+  | LPAREN IF expr expr expr RPAREN { Cifthenelse($3, $4, $5) }
+  | LPAREN SWITCH INTCONST expr caselist RPAREN { make_switch $3 $4 $5 }
+  | LPAREN WHILE expr sequence RPAREN
+      { Ccatch(Cloop(Cifthenelse($3, $4, Cexit)), Ctuple []) }
+  | LPAREN CATCH sequence WITH sequence RPAREN { Ccatch($3, $5) }
+  | EXIT        { Cexit }
+  | LPAREN TRY sequence WITH bind_ident sequence RPAREN
+                { unbind_ident $5; Ctrywith($3, $5, $6) }
+  | LPAREN ADDRAREF expr expr RPAREN
+      { Cop(Cload typ_addr, [access_array $3 $4 Arch.size_addr]) }
+  | LPAREN INTAREF expr expr RPAREN
+      { Cop(Cload typ_int, [access_array $3 $4 Arch.size_int]) }
+  | LPAREN FLOATAREF expr expr RPAREN
+      { Cop(Cload typ_float, [access_array $3 $4 Arch.size_float]) }
+  | LPAREN ADDRASET expr expr expr RPAREN
+      { Cop(Cstore, [access_array $3 $4 Arch.size_addr; $5]) }
+  | LPAREN INTASET expr expr expr RPAREN
+      { Cop(Cstore, [access_array $3 $4 Arch.size_int; $5]) }
+  | LPAREN FLOATASET expr expr expr RPAREN
+      { Cop(Cstore, [access_array $3 $4 Arch.size_float; $5]) }
+;
+exprlist:
+    exprlist expr               { $2 :: $1 }
+  | /**/                        { [] }
+;
+letdef:
+    oneletdef                   { [$1] }
+  | LPAREN letdefmult RPAREN    { $2 }
+;
+letdefmult:
+    /**/                        { [] }
+  | oneletdef letdefmult        { $1 :: $2 }
+;
+oneletdef:
+    IDENT expr                  { (bind_ident $1, $2) }
+;
+chunk:
+    UNSIGNED BYTE               { Byte_unsigned }
+  | SIGNED BYTE                 { Byte_signed }
+  | UNSIGNED HALF               { Sixteen_unsigned }
+  | SIGNED HALF                 { Sixteen_signed }
+;
+unaryop:
+    PROJ INTCONST               { Cproj($2, 1) }
+  | PROJ INTCONST SUBI INTCONST { Cproj($2, $4 - $2 - 1) }
+  | LOAD chunk                  { Cloadchunk $2 }
+  | ALLOC                       { Calloc }
+  | MODIFY                      { Cmodify }
+  | FLOATOFINT                  { Cfloatofint }
+  | INTOFFLOAT                  { Cintoffloat }
+  | RAISE                       { Craise }
+;
+binaryop:
+    STORE                       { Cstore }
+  | STORE chunk                 { Cstorechunk $2 }
+  | ADDI                        { Caddi }
+  | SUBI                        { Csubi }
+  | MULI                        { Cmuli }
+  | DIVI                        { Cdivi }
+  | MODI                        { Cmodi }
+  | AND                         { Cand }
+  | OR                          { Cor }
+  | XOR                         { Cxor }
+  | LSL                         { Clsl }
+  | LSR                         { Clsr }
+  | ASR                         { Casr }
+  | EQI                         { Ccmpi Ceq }
+  | NEI                         { Ccmpi Cne }
+  | LTI                         { Ccmpi Clt }
+  | LEI                         { Ccmpi Cle }
+  | GTI                         { Ccmpi Cgt }
+  | GEI                         { Ccmpi Cge }
+  | ADDA                        { Cadda }
+  | SUBA                        { Csuba }
+  | EQA                         { Ccmpa Ceq }
+  | NEA                         { Ccmpa Cne }
+  | LTA                         { Ccmpa Clt }
+  | LEA                         { Ccmpa Cle }
+  | GTA                         { Ccmpa Cgt }
+  | GEA                         { Ccmpa Cge }
+  | ADDF                        { Caddf }
+  | SUBF                        { Csubf }
+  | MULF                        { Cmulf }
+  | DIVF                        { Cdivf }
+  | EQF                         { Ccmpf Ceq }
+  | NEF                         { Ccmpf Cne }
+  | LTF                         { Ccmpf Clt }
+  | LEF                         { Ccmpf Cle }
+  | GTF                         { Ccmpf Cgt }
+  | GEF                         { Ccmpf Cge }
+;
+sequence:
+    expr sequence               { Csequence($1, $2) }
+  | expr                        { $1 }
+;
+caselist:
+    onecase sequence caselist   { ($1, $2) :: $3 }
+  | /**/                        { [] }
+;
+onecase:
+    CASE INTCONST COLON onecase { $2 :: $4 }
+  | CASE INTCONST COLON         { [$2] }
+;
+bind_ident:
+    IDENT                       { bind_ident $1 }
+;
+datadecl:
+    LPAREN datalist RPAREN      { List.rev $2 }
+;
+datalist:
+    datalist dataitem           { $2 :: $1 }
+  | /**/                        { [] }
+;
+dataitem:
+    STRING COLON                { Cdefine_symbol $1 }
+  | INTCONST COLON              { Cdefine_label $1 }
+  | BYTE INTCONST               { Cint8 $2 }
+  | HALF INTCONST               { Cint16 $2 }
+  | INT INTCONST                { Cint $2 }
+  | FLOAT FLOATCONST            { Cfloat $2 }
+  | ADDR STRING                 { Csymbol_address $2 }
+  | ADDR INTCONST               { Clabel_address $2 }
+  | KSTRING STRING              { Cstring $2 }
+  | SKIP INTCONST               { Cskip $2 }
+  | ALIGN INTCONST              { Calign $2 }
+;
+
diff --git a/testasmcomp/parsecmmaux.ml b/testasmcomp/parsecmmaux.ml
new file mode 100644
index 0000000000..d41d2b71cc
--- /dev/null
+++ b/testasmcomp/parsecmmaux.ml
@@ -0,0 +1,26 @@
+(* Auxiliary functions for parsing *)
+
+type error =
+    Unbound of string
+
+exception Error of error
+
+let tbl_ident = (Hashtbl.new 57 : (string, Ident.t) Hashtbl.t)
+
+let bind_ident s =
+  let id = Ident.new s in
+  Hashtbl.add tbl_ident s id;
+  id
+
+let find_ident s =
+  try
+    Hashtbl.find tbl_ident s
+  with Not_found ->
+    raise(Error(Unbound s))
+
+let unbind_ident id =
+  Hashtbl.remove tbl_ident (Ident.name id)
+
+let report_error = function
+    Unbound s ->
+      prerr_string "Unbound identifier "; prerr_string s; prerr_endline "."
diff --git a/testasmcomp/parsecmmaux.mli b/testasmcomp/parsecmmaux.mli
new file mode 100644
index 0000000000..c7920803ae
--- /dev/null
+++ b/testasmcomp/parsecmmaux.mli
@@ -0,0 +1,12 @@
+(* Auxiliary functions for parsing *)
+
+val bind_ident: string -> Ident.t
+val find_ident: string -> Ident.t
+val unbind_ident: Ident.t -> unit
+
+type error =
+    Unbound of string
+
+exception Error of error
+
+val report_error: error -> unit
diff --git a/testasmcomp/tagged-fib.cmm b/testasmcomp/tagged-fib.cmm
new file mode 100644
index 0000000000..ee099ed5d3
--- /dev/null
+++ b/testasmcomp/tagged-fib.cmm
@@ -0,0 +1,5 @@
+(function "fib" (n: int)
+  (if (< n 5)
+      3
+    (-  (+ (app "fib" (- n 2) int) (app "fib" (- n 4) int)) 1)))
+
diff --git a/testasmcomp/tagged-integr.cmm b/testasmcomp/tagged-integr.cmm
new file mode 100644
index 0000000000..314c7b3a4b
--- /dev/null
+++ b/testasmcomp/tagged-integr.cmm
@@ -0,0 +1,31 @@
+("res_square": skip 8)
+("h": skip 8)
+("x": skip 8)
+("s": skip 8)
+("res_integr": skip 8)
+
+(function "square" (x: addr)
+   (let r "res_square"
+        (store r ( *f (load x float) (load x float)))
+        r))
+
+(function "integr" (f: addr low: addr high: addr n: int)
+  (let (h "h" x "x" s "s" i n)
+    (store h (/f (-f (load high float) (load low float)) (floatofint n)))
+    (store x (load low float))
+    (store s 0.0)
+    (while (> i 0)
+      (store s (+f (load s float) (load (app f x addr) float)))
+      (store x (+f (load x float) (load h float)))
+      (assign i (- i 1)))
+    (store "res_integr" ( *f (load s float) (load h float)))
+    "res_integr"))
+
+("low": skip 8)
+("hi": skip 8)
+
+(function "test" (n: int)
+  (store "low" 0.0)
+  (store "hi" 1.0)
+  (load (app "integr" ["square" "low" "hi" n] addr) float))
+
diff --git a/testasmcomp/tagged-quicksort.cmm b/testasmcomp/tagged-quicksort.cmm
new file mode 100644
index 0000000000..62008ab3e3
--- /dev/null
+++ b/testasmcomp/tagged-quicksort.cmm
@@ -0,0 +1,32 @@
+(function "quick" (lo: int hi: int a: addr)
+  (if (< lo hi)
+      (let (i lo
+            j hi
+            pivot (addraref a (>>s hi 1)))
+        (while (< i j)
+          (catch
+              (while 1
+                (if (>= i hi) exit [])
+                (if (> (addraref a (>>s i 1)) pivot) exit [])
+                (assign i (+ i 2)))
+           with [])
+          (catch
+              (while 1
+                (if (<= j lo) exit [])
+                (if (< (addraref a (>>s j 1)) pivot) exit [])
+                (assign j (- j 2)))
+           with [])
+          (if (< i j)
+              (let temp (addraref a (>>s i 1))
+                   (addraset a (>>s i 1) (addraref a (>>s j 1)))
+                   (addraset a (>>s j 1) temp))
+            []))
+        (let temp (addraref a (>>s i 1))
+             (addraset a (>>s i 1) (addraref a (>>s hi 1)))
+             (addraset a (>>s hi 1) temp))
+        (app "quick" [lo (- i 2) a] unit)
+        (app "quick" [(+ i 2) hi a] unit))
+    []))
+
+(function "quicksort" (lo: int hi: int a: addr)
+   (app "quick" [(+ (<< lo 1) 1) (+ (<< hi 1) 1) a] unit))
diff --git a/testasmcomp/tagged-tak.cmm b/testasmcomp/tagged-tak.cmm
new file mode 100644
index 0000000000..a24fa9dd37
--- /dev/null
+++ b/testasmcomp/tagged-tak.cmm
@@ -0,0 +1,9 @@
+(function "tak" (x:int y:int z:int)
+  (if (> x y)
+      (app "tak" [(app "tak" [(- x 2) y z] int)
+                  (app "tak" [(- y 2) z x] int)
+                  (app "tak" [(- z 2) x y] int)] int)
+      z))
+
+(function "takmain" (dummy: int)
+   (app "tak" [37 25 13] int))