diff options
95 files changed, 497 insertions, 5120 deletions
@@ -38,9 +38,6 @@ arm/SelectOp.v arm/SelectLong.v backend/SelectDiv.v backend/SplitLong.v -backend/CMlexer.ml -backend/CMparser.ml -backend/CMparser.mli cparser/Parser.v cparser/Lexer.ml cparser/pre_parser.ml @@ -53,7 +50,6 @@ cparser/handcrafted.messages.raw cparser/deLexer cparser/tests/generated/*.c cparser/tests/generated/*.err -backend/CMparser.automaton lib/Readconfig.ml lib/Tokenize.ml lib/Responsefile.ml @@ -1,3 +1,12 @@ +- Removed the compilation of '.cm' files written in Cminor concrete syntax. + + +Release 3.0.1, 2017-02-14 +========================= + +- Ported to Coq 8.6. + + Release 3.0, 2017-02-10 ======================= @@ -36,11 +36,6 @@ option) any later version: cfrontend/Ctyping.v backend/Cminor.v - backend/CMlexer.mli - backend/CMlexer.mll - backend/CMparser.mly - backend/CMtypecheck.ml - backend/CMtypecheck.mli arm/Archi.v ia32/Archi.v @@ -29,7 +29,7 @@ RECDIRS=lib common $(ARCHDIRS) backend cfrontend driver flocq exportclight cpars COQINCLUDES=$(foreach d, $(RECDIRS), -R $(d) compcert.$(d)) -COQC="$(COQBIN)coqc" -q $(COQINCLUDES) +COQC="$(COQBIN)coqc" -q $(COQINCLUDES) $(COQCOPTS) COQDEP="$(COQBIN)coqdep" $(COQINCLUDES) COQDOC="$(COQBIN)coqdoc" COQEXEC="$(COQBIN)coqtop" $(COQINCLUDES) -batch -load-vernac-source @@ -147,6 +147,9 @@ endif proof: $(FILES:.v=.vo) +# Turn off some warnings for compiling Flocq +flocq/%.vo: COQCOPTS+=-w -deprecated-implicit-arguments + extraction: extraction/STAMP extraction/STAMP: $(FILES:.v=.vo) extraction/extraction.v $(ARCH)/extractionMachdep.v diff --git a/Makefile.extr b/Makefile.extr index fb19dd00..a1c2ef7c 100644 --- a/Makefile.extr +++ b/Makefile.extr @@ -54,8 +54,6 @@ extraction/%.cmx: WARNINGS +=-w -20-27-32..34-39-41-44..45 extraction/%.cmo: WARNINGS +=-w -20-27-32..34-39-41-44..45 cparser/pre_parser.cmx: WARNINGS += -w -41 cparser/pre_parser.cmo: WARNINGS += -w -41 -backend/CMparser.cmx: WARNINGS += -w -41 -backend/CMparser.cmo: WARNINGS += -w -41 COMPFLAGS+=-g $(INCLUDES) $(MENHIR_INCLUDES) $(WARNINGS) @@ -74,10 +72,9 @@ OCAMLDEP=ocamldep$(DOTOPT) -slash $(INCLUDES) OCAMLLEX=ocamllex -q MODORDER=tools/modorder .depend.extr -PARSERS=backend/CMparser.mly cparser/pre_parser.mly -LEXERS=backend/CMlexer.mll cparser/Lexer.mll \ - lib/Tokenize.mll lib/Readconfig.mll \ - lib/Responsefile.mll +PARSERS=cparser/pre_parser.mly +LEXERS=cparser/Lexer.mll lib/Tokenize.mll \ + lib/Readconfig.mll lib/Responsefile.mll LIBS=str.cmxa unix.cmxa $(MENHIR_LIBS) LIBS_BYTE=$(patsubst %.cmxa,%.cma,$(patsubst %.cmx,%.cmo,$(LIBS))) @@ -132,7 +129,6 @@ clean: rm -f $(EXECUTABLES) rm -f $(GENERATED) for d in $(DIRS); do rm -f $$d/*.cm[iotx] $$d/*cmti $$d/*.o; done - rm -f backend/CMparser.automaton $(MAKE) -C cparser clean # Generation of .depend.extr @@ -1,3 +1,3 @@ -version=3.0 +version=3.0.1 buildnr= tag= @@ -84,8 +84,8 @@ Module Pregmap := EMap(PregEq). (** Conventional names for stack pointer ([SP]) and return address ([RA]) *) -Notation "'SP'" := IR13 (only parsing). -Notation "'RA'" := IR14 (only parsing). +Notation "'SP'" := IR13 (only parsing) : asm. +Notation "'RA'" := IR14 (only parsing) : asm. (** The instruction set. Most instructions correspond exactly to actual instructions of the ARM processor. See the ARM @@ -294,8 +294,10 @@ Definition program := AST.program fundef unit. Definition regset := Pregmap.t val. Definition genv := Genv.t fundef unit. -Notation "a # b" := (a b) (at level 1, only parsing). -Notation "a # b <- c" := (Pregmap.set b c a) (at level 1, b at next level). +Notation "a # b" := (a b) (at level 1, only parsing) : asm. +Notation "a # b <- c" := (Pregmap.set b c a) (at level 1, b at next level) : asm. + +Open Scope asm. (** Undefining some registers *) diff --git a/arm/Asmgen.v b/arm/Asmgen.v index bbfad3c9..e7a3b4fa 100644 --- a/arm/Asmgen.v +++ b/arm/Asmgen.v @@ -23,8 +23,8 @@ Require Import Mach. Require Import Asm. Require Import Compopts. -Open Local Scope string_scope. -Open Local Scope error_monad_scope. +Local Open Scope string_scope. +Local Open Scope error_monad_scope. (** Extracting integer or float registers. *) diff --git a/arm/Asmgenproof.v b/arm/Asmgenproof.v index ade121c5..09c20d5c 100644 --- a/arm/Asmgenproof.v +++ b/arm/Asmgenproof.v @@ -852,8 +852,10 @@ Opaque loadind. - (* internal function *) exploit functions_translated; eauto. intros [tf [A B]]. monadInv B. generalize EQ; intros EQ'. monadInv EQ'. - destruct (zlt Ptrofs.max_unsigned (list_length_z (fn_code x0))); inversion EQ1. clear EQ1. + destruct (zlt Ptrofs.max_unsigned (list_length_z (fn_code x0))); inversion EQ1. clear EQ1. subst x0. monadInv EQ0. + set (tfbody := Pallocframe (fn_stacksize f) (fn_link_ofs f) :: Pstr IR14 IR13 (SOimm (Ptrofs.to_int (fn_retaddr_ofs f))) :: x0) in *. + set (tf := {| fn_sig := Mach.fn_sig f; fn_code := tfbody |}) in *. unfold store_stack in *. exploit Mem.alloc_extends. eauto. eauto. apply Zle_refl. apply Zle_refl. intros [m1' [C D]]. @@ -865,12 +867,10 @@ Opaque loadind. set (rs2 := nextinstr (rs0#IR12 <- (parent_sp s) #IR13 <- (Vptr stk Ptrofs.zero))). set (rs3 := nextinstr rs2). assert (EXEC_PROLOGUE: - exec_straight tge x - (fn_code x) rs0 m' - x1 rs3 m3'). - replace (fn_code x) - with (Pallocframe (fn_stacksize f) (fn_link_ofs f) :: Pstr IR14 IR13 (SOimm (Ptrofs.to_int (fn_retaddr_ofs f))) :: x1) - by (rewrite <- H5; auto). + exec_straight tge tf + (fn_code tf) rs0 m' + x0 rs3 m3'). + change (fn_code tf) with tfbody; unfold tfbody. apply exec_straight_two with rs2 m2'. unfold exec_instr. rewrite C. fold sp. rewrite <- (sp_val _ _ _ AG). unfold Tptr, chunk_of_type, Archi.ptr64 in F. rewrite F. auto. @@ -884,7 +884,7 @@ Opaque loadind. econstructor; eauto. change (rs3 PC) with (Val.offset_ptr (Val.offset_ptr (rs0 PC) Ptrofs.one) Ptrofs.one). rewrite ATPC. simpl. constructor; eauto. - subst x. eapply code_tail_next_int. omega. + eapply code_tail_next_int. omega. eapply code_tail_next_int. omega. constructor. unfold rs3, rs2. apply agree_nextinstr. apply agree_nextinstr. diff --git a/arm/SelectOp.vp b/arm/SelectOp.vp index 80a5d753..3d4e8661 100644 --- a/arm/SelectOp.vp +++ b/arm/SelectOp.vp @@ -44,7 +44,7 @@ Require Import Floats. Require Import Op. Require Import CminorSel. -Open Local Scope cminorsel_scope. +Local Open Scope cminorsel_scope. (** ** Constants **) diff --git a/arm/SelectOpproof.v b/arm/SelectOpproof.v index e520b3cf..dd194498 100644 --- a/arm/SelectOpproof.v +++ b/arm/SelectOpproof.v @@ -25,7 +25,7 @@ Require Import Op. Require Import CminorSel. Require Import SelectOp. -Open Local Scope cminorsel_scope. +Local Open Scope cminorsel_scope. Local Transparent Archi.ptr64. (** * Useful lemmas and tactics *) diff --git a/backend/CMlexer.mli b/backend/CMlexer.mli deleted file mode 100644 index c6afb72c..00000000 --- a/backend/CMlexer.mli +++ /dev/null @@ -1,17 +0,0 @@ -(* *********************************************************************) -(* *) -(* The Compcert verified compiler *) -(* *) -(* Xavier Leroy, INRIA Paris-Rocquencourt *) -(* *) -(* Copyright Institut National de Recherche en Informatique et en *) -(* Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU General Public License as published by *) -(* the Free Software Foundation, either version 2 of the License, or *) -(* (at your option) any later version. This file is also distributed *) -(* under the terms of the INRIA Non-Commercial License Agreement. *) -(* *) -(* *********************************************************************) - -val token: Lexing.lexbuf -> CMparser.token -exception Error of string diff --git a/backend/CMlexer.mll b/backend/CMlexer.mll deleted file mode 100644 index 65f244b5..00000000 --- a/backend/CMlexer.mll +++ /dev/null @@ -1,180 +0,0 @@ -(* *********************************************************************) -(* *) -(* The Compcert verified compiler *) -(* *) -(* Xavier Leroy, INRIA Paris-Rocquencourt *) -(* *) -(* Copyright Institut National de Recherche en Informatique et en *) -(* Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU General Public License as published by *) -(* the Free Software Foundation, either version 2 of the License, or *) -(* (at your option) any later version. This file is also distributed *) -(* under the terms of the INRIA Non-Commercial License Agreement. *) -(* *) -(* *********************************************************************) - -{ -open CMparser -exception Error of string -} - -let blank = [' ' '\009' '\012' '\010' '\013'] -let floatlit = - ("-"? (['0'-'9'] ['0'-'9' '_']* - ('.' ['0'-'9' '_']* )? - (['e' 'E'] ['+' '-']? ['0'-'9'] ['0'-'9' '_']*)? )) | "inf" | "nan" -let ident = ['A'-'Z' 'a'-'z' '_'] ['A'-'Z' 'a'-'z' '_' '$' '0'-'9']* -let qident = '\'' [ ^ '\'' ]+ '\'' -let temp = "$" ['1'-'9'] ['0'-'9']* -let intlit = "-"? ( ['0'-'9']+ | "0x" ['0'-'9' 'a'-'f' 'A'-'F']+ - | "0o" ['0'-'7']+ | "0b" ['0'-'1']+ ) -let stringlit = "\"" [ ^ '"' ] * '"' - -rule token = parse - | blank + { token lexbuf } - | "/*" { comment lexbuf; token lexbuf } - | "absf" { ABSF } - | "&" { AMPERSAND } - | "&l" { AMPERSANDL } - | "!" { BANG } - | "!=" { BANGEQUAL } - | "!=f" { BANGEQUALF } - | "!=l" { BANGEQUALL } - | "!=lu" { BANGEQUALLU } - | "!=u" { BANGEQUALU } - | "|" { BAR } - | "|l" { BARL } - | "builtin" { BUILTIN } - | "^" { CARET } - | "^l" { CARETL } - | "case" { CASE } - | ":" { COLON } - | "," { COMMA } - | "default" { DEFAULT } - | "else" { ELSE } - | "=" { EQUAL } - | "==" { EQUALEQUAL } - | "==f" { EQUALEQUALF } - | "==l" { EQUALEQUALL } - | "==lu" { EQUALEQUALLU } - | "==u" { EQUALEQUALU } - | "exit" { EXIT } - | "extern" { EXTERN } - | "float" { FLOAT } - | "float32" { FLOAT32 } - | "float64" { FLOAT64 } - | "floatofint" { FLOATOFINT } - | "floatofintu" { FLOATOFINTU } - | "floatoflong" { FLOATOFLONG } - | "floatoflongu" { FLOATOFLONGU } - | "goto" { GOTO } - | ">" { GREATER } - | ">f" { GREATERF } - | ">l" { GREATERL } - | ">lu" { GREATERLU } - | ">u" { GREATERU } - | ">=" { GREATEREQUAL } - | ">=f" { GREATEREQUALF } - | ">=l" { GREATEREQUALL } - | ">=lu" { GREATEREQUALLU } - | ">=u" { GREATEREQUALU } - | ">>" { GREATERGREATER } - | ">>u" { GREATERGREATERU } - | ">>l" { GREATERGREATERL } - | ">>lu" { GREATERGREATERLU } - | "if" { IF } - | "int" { INT } - | "int16" { INT16 } - | "int16s" { INT16S } - | "int16u" { INT16U } - | "int32" { INT32 } - | "int64" { INT64 } - | "int8" { INT8 } - | "int8s" { INT8S } - | "int8u" { INT8U } - | "intoffloat" { INTOFFLOAT } - | "intuoffloat" { INTUOFFLOAT } - | "intoflong" { INTOFLONG } - | "{" { LBRACE } - | "{{" { LBRACELBRACE } - | "[" { LBRACKET } - | "<" { LESS } - | "<u" { LESSU } - | "<l" { LESSL } - | "<lu" { LESSLU } - | "<f" { LESSF } - | "<=" { LESSEQUAL } - | "<=u" { LESSEQUALU } - | "<=f" { LESSEQUALF } - | "<=l" { LESSEQUALL } - | "<=lu" { LESSEQUALLU } - | "<<" { LESSLESS } - | "<<l" { LESSLESSL } - | "long" { LONG } - | "longofint" { LONGOFINT } - | "longofintu" { LONGOFINTU } - | "longoffloat" { LONGOFFLOAT } - | "longuoffloat" { LONGUOFFLOAT } - | "loop" { LOOP } - | "(" { LPAREN } - | "match" { MATCH } - | "-" { MINUS } - | "->" { MINUSGREATER } - | "-f" { MINUSF } - | "-s" { MINUSS } - | "-l" { MINUSL } - | "%" { PERCENT } - | "%l" { PERCENTL } - | "%lu" { PERCENTLU } - | "%u" { PERCENTU } - | "+" { PLUS } - | "+f" { PLUSF } - | "+s" { PLUSS } - | "+l" { PLUSL } - | "}" { RBRACE } - | "}}" { RBRACERBRACE } - | "]" { RBRACKET } - | "readonly" { READONLY } - | "return" { RETURN } - | "runtime" { RUNTIME } - | ")" { RPAREN } - | ";" { SEMICOLON } - | "/" { SLASH } - | "/f" { SLASHF } - | "/s" { SLASHS } - | "/l" { SLASHL } - | "/lu" { SLASHLU } - | "/u" { SLASHU } - | "single" { SINGLE } - | "singleofint" { SINGLEOFINT } - | "stack" { STACK } - | "*" { STAR } - | "*f" { STARF } - | "*s" { STARS } - | "*l" { STARL } - | "switch" { SWITCH } - | "switchl" { SWITCHL } - | "tailcall" { TAILCALL } - | "~" { TILDE } - | "~l" { TILDEL } - | "var" { VAR } - | "void" { VOID } - | "volatile" { VOLATILE } - | "while" { WHILE } - - | intlit"LL" { let s = Lexing.lexeme lexbuf in - LONGLIT(Int64.of_string(String.sub s 0 (String.length s - 2))) } - | intlit { INTLIT(Int32.of_string(Lexing.lexeme lexbuf)) } - | floatlit { FLOATLIT(float_of_string(Lexing.lexeme lexbuf)) } - | stringlit { let s = Lexing.lexeme lexbuf in - STRINGLIT(String.sub s 1 (String.length s - 2)) } - | ident | temp { IDENT(Lexing.lexeme lexbuf) } - | qident { let s = Lexing.lexeme lexbuf in - IDENT(String.sub s 1 (String.length s - 2)) } - | eof { EOF } - | _ { raise(Error("illegal character `" ^ Char.escaped (Lexing.lexeme_char lexbuf 0) ^ "'")) } - -and comment = parse - "*/" { () } - | eof { raise(Error "unterminated comment") } - | _ { comment lexbuf } diff --git a/backend/CMparser.mly b/backend/CMparser.mly deleted file mode 100644 index 64943f0b..00000000 --- a/backend/CMparser.mly +++ /dev/null @@ -1,732 +0,0 @@ -/* *********************************************************************/ -/* */ -/* The Compcert verified compiler */ -/* */ -/* Xavier Leroy, INRIA Paris-Rocquencourt */ -/* */ -/* Copyright Institut National de Recherche en Informatique et en */ -/* Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU General Public License as published by */ -/* the Free Software Foundation, either version 2 of the License, or */ -/* (at your option) any later version. This file is also distributed */ -/* under the terms of the INRIA Non-Commercial License Agreement. */ -/* */ -/* *********************************************************************/ - -/* Note that this compiles a superset of the language defined by the AST, - including function calls in expressions, matches, while statements, etc. */ - -%{ -open Datatypes -open Camlcoq -open BinNums -open Integers -open AST -open Cminor - -(** Parsing external functions *) - -type ef_token = - | EFT_tok of string - | EFT_int of int32 - | EFT_string of string - | EFT_chunk of memory_chunk - -let mkef sg toks = - match toks with - | [EFT_tok "extern"; EFT_string s] -> - EF_external(coqstring_of_camlstring s, sg) - | [EFT_tok "builtin"; EFT_string s] -> - EF_builtin(coqstring_of_camlstring s, sg) - | [EFT_tok "runtime"; EFT_string s] -> - EF_runtime(coqstring_of_camlstring s, sg) - | [EFT_tok "volatile"; EFT_tok "load"; EFT_chunk c] -> - EF_vload c - | [EFT_tok "volatile"; EFT_tok "store"; EFT_chunk c] -> - EF_vstore c - | [EFT_tok "malloc"] -> - EF_malloc - | [EFT_tok "free"] -> - EF_free - | [EFT_tok "memcpy"; EFT_tok "size"; EFT_int sz; EFT_tok "align"; EFT_int al] -> - EF_memcpy(Z.of_sint32 sz, Z.of_sint32 al) - | [EFT_tok "annot"; EFT_string txt] -> - EF_annot(coqstring_of_camlstring txt, sg.sig_args) - | [EFT_tok "annot_val"; EFT_string txt] -> - if sg.sig_args = [] then raise Parsing.Parse_error; - EF_annot_val(coqstring_of_camlstring txt, List.hd sg.sig_args) - | [EFT_tok "inline_asm"; EFT_string txt] -> - EF_inline_asm(coqstring_of_camlstring txt, sg, []) - | _ -> - raise Parsing.Parse_error - -(** Naming function calls in expressions *) - -type rexpr = - | Rvar of ident - | Rconst of constant - | Runop of unary_operation * rexpr - | Rbinop of binary_operation * rexpr * rexpr - | Rload of memory_chunk * rexpr - | Rcall of signature * rexpr * rexpr list - | Rbuiltin of signature * ef_token list * rexpr list - -let temp_counter = ref 0 - -let temporaries = ref [] - -let mktemp () = - incr temp_counter; - let n = Printf.sprintf "__t%d" !temp_counter in - let id = intern_string n in - temporaries := id :: !temporaries; - id - -let convert_accu = ref [] - -let rec convert_rexpr = function - | Rvar id -> Evar id - | Rconst c -> Econst c - | Runop(op, e1) -> Eunop(op, convert_rexpr e1) - | Rbinop(op, e1, e2) -> - let c1 = convert_rexpr e1 in - let c2 = convert_rexpr e2 in - Ebinop(op, c1, c2) - | Rload(chunk, e1) -> Eload(chunk, convert_rexpr e1) - | Rcall(sg, e1, el) -> - let c1 = convert_rexpr e1 in - let cl = convert_rexpr_list el in - let t = mktemp() in - convert_accu := Scall(Some t, sg, c1, cl) :: !convert_accu; - Evar t - | Rbuiltin(sg, pef, el) -> - let ef = mkef sg pef in - let cl = convert_rexpr_list el in - let t = mktemp() in - convert_accu := Sbuiltin(Some t, ef, cl) :: !convert_accu; - Evar t - -and convert_rexpr_list = function - | [] -> [] - | e1 :: el -> - let c1 = convert_rexpr e1 in - let cl = convert_rexpr_list el in - c1 :: cl - -let rec prepend_seq stmts last = - match stmts with - | [] -> last - | s1 :: sl -> prepend_seq sl (Sseq(s1, last)) - -let mkeval e = - convert_accu := []; - match e with - | Rcall(sg, e1, el) -> - let c1 = convert_rexpr e1 in - let cl = convert_rexpr_list el in - prepend_seq !convert_accu (Scall(None, sg, c1, cl)) - | Rbuiltin(sg, pef, el) -> - let ef = mkef sg pef in - let cl = convert_rexpr_list el in - prepend_seq !convert_accu (Sbuiltin(None, ef, cl)) - | _ -> - ignore (convert_rexpr e); - prepend_seq !convert_accu Sskip - -let mkassign id e = - convert_accu := []; - match e with - | Rcall(sg, e1, el) -> - let c1 = convert_rexpr e1 in - let cl = convert_rexpr_list el in - prepend_seq !convert_accu (Scall(Some id, sg, c1, cl)) - | Rbuiltin(sg, pef, el) -> - let ef = mkef sg pef in - let cl = convert_rexpr_list el in - prepend_seq !convert_accu (Sbuiltin(Some id, ef, cl)) - | _ -> - let c = convert_rexpr e in - prepend_seq !convert_accu (Sassign(id, c)) - -let mkstore chunk e1 e2 = - convert_accu := []; - let c1 = convert_rexpr e1 in - let c2 = convert_rexpr e2 in - prepend_seq !convert_accu (Sstore(chunk, c1, c2)) - -let mkifthenelse e s1 s2 = - convert_accu := []; - let c = convert_rexpr e in - prepend_seq !convert_accu (Sifthenelse(c, s1, s2)) - -let mkreturn_some e = - convert_accu := []; - let c = convert_rexpr e in - prepend_seq !convert_accu (Sreturn (Some c)) - -let mktailcall sg e1 el = - convert_accu := []; - let c1 = convert_rexpr e1 in - let cl = convert_rexpr_list el in - prepend_seq !convert_accu (Stailcall(sg, c1, cl)) - -let mkwhile expr body = - Sblock (Sloop (mkifthenelse expr body (Sexit O))) - -(** Other constructors *) - -let intconst n = - Rconst(Ointconst(coqint_of_camlint n)) - -let longconst n = - Rconst(Olongconst(coqint_of_camlint64 n)) - -let exitnum n = Nat.of_int32 n - -let mkswitch islong convert expr (cases, dfl) = - convert_accu := []; - let c = convert_rexpr expr in - let rec mktable = function - | [] -> [] - | (key, exit) :: rem -> - (convert key, exitnum exit) :: mktable rem in - prepend_seq !convert_accu (Sswitch(islong, c, mktable cases, exitnum dfl)) - -(*** - match (a) { case 0: s0; case 1: s1; case 2: s2; } ---> - - block { - block { - block { - block { - switch(a) { case 0: exit 0; case 1: exit 1; default: exit 2; } - }; s0; exit 2; - }; s1; exit 1; - }; s2; - } - - Note that matches are assumed to be exhaustive -***) - -let mkmatch_aux expr cases = - let ncases = List.length cases in - let rec mktable n = function - | [] -> assert false - | [key, action] -> [] - | (key, action) :: rem -> - (coqint_of_camlint key, Nat.of_int n) - :: mktable (n + 1) rem in - let sw = - Sswitch(false, expr, mktable 0 cases, Nat.of_int (ncases - 1)) in - let rec mkblocks body n = function - | [] -> assert false - | [key, action] -> - Sblock(Sseq(body, action)) - | (key, action) :: rem -> - mkblocks - (Sblock(Sseq(body, Sseq(action, Sexit (Nat.of_int n))))) - (n - 1) - rem in - mkblocks (Sblock sw) (ncases - 1) cases - -let mkmatch expr cases = - convert_accu := []; - let c = convert_rexpr expr in - let s = - match cases with - | [] -> Sskip (* ??? *) - | [key, action] -> action - | _ -> mkmatch_aux c cases in - prepend_seq !convert_accu s - -%} - -%token ABSF -%token AMPERSAND -%token AMPERSANDL -%token BANG -%token BANGEQUAL -%token BANGEQUALF -%token BANGEQUALU -%token BANGEQUALL -%token BANGEQUALLU -%token BAR -%token BARL -%token BUILTIN -%token CARET -%token CARETL -%token CASE -%token COLON -%token COMMA -%token DEFAULT -%token ELSE -%token EQUAL -%token EQUALEQUAL -%token EQUALEQUALF -%token EQUALEQUALU -%token EQUALEQUALL -%token EQUALEQUALLU -%token EOF -%token EXIT -%token EXTERN -%token FLOAT -%token FLOAT32 -%token FLOAT64 -%token <float> FLOATLIT -%token FLOATOFINT -%token FLOATOFINTU -%token FLOATOFLONG -%token FLOATOFLONGU -%token GOTO -%token GREATER -%token GREATERF -%token GREATERU -%token GREATERL -%token GREATERLU -%token GREATEREQUAL -%token GREATEREQUALF -%token GREATEREQUALU -%token GREATEREQUALL -%token GREATEREQUALLU -%token GREATERGREATER -%token GREATERGREATERU -%token GREATERGREATERL -%token GREATERGREATERLU -%token <string> IDENT -%token IF -%token INT -%token INT16 -%token INT16S -%token INT16U -%token INT32 -%token INT64 -%token INT8 -%token INT8S -%token INT8U -%token <int32> INTLIT -%token INTOFFLOAT -%token INTUOFFLOAT -%token INTOFLONG -%token LBRACE -%token LBRACELBRACE -%token LBRACKET -%token LESS -%token LESSU -%token LESSF -%token LESSL -%token LESSLU -%token LESSEQUAL -%token LESSEQUALU -%token LESSEQUALF -%token LESSEQUALL -%token LESSEQUALLU -%token LESSLESS -%token LESSLESSL -%token LONG -%token <int64> LONGLIT -%token LONGOFINT -%token LONGOFINTU -%token LONGOFFLOAT -%token LONGUOFFLOAT -%token LOOP -%token LPAREN -%token MATCH -%token MINUS -%token MINUSF -%token MINUSS -%token MINUSL -%token MINUSGREATER -%token PERCENT -%token PERCENTU -%token PERCENTL -%token PERCENTLU -%token PLUS -%token PLUSF -%token PLUSS -%token PLUSL -%token RBRACE -%token RBRACERBRACE -%token RBRACKET -%token READONLY -%token RETURN -%token RPAREN -%token RUNTIME -%token SEMICOLON -%token SINGLE -%token SINGLEOFINT -%token SLASH -%token SLASHF -%token SLASHS -%token SLASHU -%token SLASHL -%token SLASHLU -%token STACK -%token STAR -%token STARF -%token STARS -%token STARL -%token <string> STRINGLIT -%token SWITCH -%token SWITCHL -%token TILDE -%token TILDEL -%token TAILCALL -%token VAR -%token VOID -%token VOLATILE -%token WHILE - -/* Precedences from low to high */ -%nonassoc p_THEN -%nonassoc ELSE -%left BAR BARL -%left CARET CARETL -%left AMPERSAND AMPERSANDL -%left EQUALEQUAL BANGEQUAL LESS LESSEQUAL GREATER GREATEREQUAL EQUALEQUALU BANGEQUALU LESSU LESSEQUALU GREATERU GREATEREQUALU EQUALEQUALF BANGEQUALF LESSF LESSEQUALF GREATERF GREATEREQUALF EQUALEQUALL BANGEQUALL LESSL LESSEQUALL GREATERL GREATEREQUALL EQUALEQUALLU BANGEQUALLU LESSLU LESSEQUALLU GREATERLU GREATEREQUALLU -%left LESSLESS GREATERGREATER GREATERGREATERU LESSLESSL GREATERGREATERL GREATERGREATERLU -%left PLUS PLUSF PLUSS PLUSL MINUS MINUSF MINUSS MINUSL -%left STAR SLASH PERCENT STARF STARS SLASHF SLASHS SLASHU PERCENTU STARL SLASHL SLASHLU PERCENTL PERCENTLU -%nonassoc BANG TILDE TILDEL p_uminus ABSF INTOFFLOAT INTUOFFLOAT FLOATOFINT FLOATOFINTU SINGLEOFINT INT8S INT8U INT16S INT16U FLOAT32 FLOAT64 INTOFLONG LONGOFINT LONGOFINTU LONGOFFLOAT LONGUOFFLOAT FLOATOFLONG FLOATOFLONGU -%left LPAREN - -/* Entry point */ - -%start prog -%type <Cminor.program> prog - -%% - -/* Programs */ - -prog: - EQUAL STRINGLIT global_declarations EOF - { { prog_defs = List.rev $3; - prog_public = List.map fst $3; (* FIXME *) - prog_main = intern_string $2; } } - -| global_declarations EOF - { { prog_defs = List.rev $1; - prog_public = List.map fst $1; (* FIXME *) - prog_main = intern_string "main" } } -; - -global_declarations: - /* empty */ { [] } - | global_declarations global_declaration { $2 :: $1 } -; - -global_declaration: - proc - { $1 } - | VAR STRINGLIT LBRACKET INTLIT RBRACKET /* old style */ - { (intern_string $2, - Gvar{gvar_info = (); gvar_init = [Init_space(Z.of_sint32 $4)]; - gvar_readonly = false; gvar_volatile = false}) } - | VAR STRINGLIT is_readonly is_volatile LBRACE init_data_list RBRACE - { (intern_string $2, - Gvar{gvar_info = (); gvar_init = List.rev $6; - gvar_readonly = $3; gvar_volatile = $4; } ) } -; - -is_readonly: - /* empty */ { false } - | READONLY { true } - -is_volatile: - /* empty */ { false } - | VOLATILE { true } - -init_data_list: - /* empty */ { [] } - | init_data_list_1 { $1 } - ; - -init_data_list_1: - init_data { [$1] } - | init_data_list_1 COMMA init_data { $3 :: $1 } - ; - -init_data: - INT8 INTLIT { Init_int8 (coqint_of_camlint $2) } - | INT16 INTLIT { Init_int16 (coqint_of_camlint $2) } - | INT32 INTLIT { Init_int32 (coqint_of_camlint $2) } - | INT INTLIT { Init_int32 (coqint_of_camlint $2) } - | INTLIT { Init_int32 (coqint_of_camlint $1) } - | LONGLIT { Init_int64 (coqint_of_camlint64 $1) } - | INT64 LONGLIT { Init_int64 (coqint_of_camlint64 $2) } - | FLOAT32 FLOATLIT { Init_float32 (coqfloat_of_camlfloat $2) } - | FLOAT64 FLOATLIT { Init_float64 (coqfloat_of_camlfloat $2) } - | FLOAT FLOATLIT { Init_float64 (coqfloat_of_camlfloat $2) } - | FLOATLIT { Init_float64 (coqfloat_of_camlfloat $1) } - | LBRACKET INTLIT RBRACKET { Init_space (Z.of_sint32 $2) } - | INTLIT LPAREN STRINGLIT RPAREN { Init_addrof (intern_string $3, coqint_of_camlint $1) } - ; - -/* Procedures */ - -proc: - STRINGLIT LPAREN parameters RPAREN COLON signature - LBRACE - stack_declaration - var_declarations - stmt_list - RBRACE - { let tmp = !temporaries in - temporaries := []; - temp_counter := 0; - (intern_string $1, - Gfun(Internal { fn_sig = $6; - fn_params = List.rev $3; - fn_vars = List.rev (tmp @ $9); - fn_stackspace = $8; - fn_body = $10 })) } - | EXTERN STRINGLIT COLON signature - { (intern_string $2, Gfun(External(EF_external(coqstring_of_camlstring $2,$4)))) } - | EXTERN STRINGLIT EQUAL eftoks COLON signature - { (intern_string $2, Gfun(External(mkef $6 $4))) } -; - -signature: - type_ - { {sig_args = []; sig_res = Some $1; sig_cc = cc_default} } - | VOID - { {sig_args = []; sig_res = None; sig_cc = cc_default} } - | type_ MINUSGREATER signature - { let s = $3 in {s with sig_args = $1 :: s.sig_args} } -; - -parameters: - /* empty */ { [] } - | parameter_list { $1 } -; - -parameter_list: - IDENT { intern_string $1 :: [] } - | parameter_list COMMA IDENT { intern_string $3 :: $1 } -; - -stack_declaration: - /* empty */ { Z0 } - | STACK INTLIT SEMICOLON { Z.of_sint32 $2 } -; - -var_declarations: - /* empty */ { [] } - | var_declarations var_declaration { $2 @ $1 } -; - -var_declaration: - VAR parameter_list SEMICOLON { $2 } -; - -/* Statements */ - -stmt: - expr SEMICOLON { mkeval $1 } - | IDENT EQUAL expr SEMICOLON { mkassign (intern_string $1) $3 } - | memory_chunk LBRACKET expr RBRACKET EQUAL expr SEMICOLON - { mkstore $1 $3 $6 } - | IF LPAREN expr RPAREN stmts ELSE stmts { mkifthenelse $3 $5 $7 } - | IF LPAREN expr RPAREN stmts %prec p_THEN { mkifthenelse $3 $5 Sskip } - | LOOP stmts { Sloop($2) } - | LBRACELBRACE stmt_list RBRACERBRACE { Sblock($2) } - | EXIT SEMICOLON { Sexit O } - | EXIT INTLIT SEMICOLON { Sexit (exitnum $2) } - | RETURN SEMICOLON { Sreturn None } - | RETURN expr SEMICOLON { mkreturn_some $2 } - | SWITCH LPAREN expr RPAREN LBRACE switch_cases RBRACE - { mkswitch false Z.of_uint32 $3 $6 } - | SWITCHL LPAREN expr RPAREN LBRACE switchl_cases RBRACE - { mkswitch true Z.of_uint64 $3 $6 } - | MATCH LPAREN expr RPAREN LBRACE match_cases RBRACE - { mkmatch $3 $6 } - | TAILCALL expr LPAREN expr_list RPAREN COLON signature SEMICOLON - { mktailcall $7 $2 $4 } - | WHILE LPAREN expr RPAREN stmts { mkwhile $3 $5 } - | IDENT COLON stmts { Slabel (intern_string $1,$3) } - | GOTO IDENT SEMICOLON { Sgoto(intern_string $2) } -; - -stmts: - LBRACE stmt_list RBRACE { $2 } - | stmt { $1 } -; - -stmt_list: - /* empty */ { Sskip } - | stmt stmt_list { Sseq($1, $2) } -; - -switch_cases: - DEFAULT COLON EXIT INTLIT SEMICOLON - { ([], $4) } - | CASE INTLIT COLON EXIT INTLIT SEMICOLON switch_cases - { let (cases, dfl) = $7 in (($2, $5) :: cases, dfl) } -; - -switchl_cases: - DEFAULT COLON EXIT INTLIT SEMICOLON - { ([], $4) } - | CASE LONGLIT COLON EXIT INTLIT SEMICOLON switchl_cases - { let (cases, dfl) = $7 in (($2, $5) :: cases, dfl) } -; - -match_cases: - /* empty */ { [] } - | CASE INTLIT COLON stmt_list match_cases { ($2, $4) :: $5 } -; - -/* Expressions */ - -expr: - LPAREN expr RPAREN { $2 } - | IDENT { Rvar(intern_string $1) } - | INTLIT { intconst $1 } - | LONGLIT { longconst $1 } - | FLOATLIT { Rconst(Ofloatconst (coqfloat_of_camlfloat $1)) } - | STRINGLIT { Rconst(Oaddrsymbol(intern_string $1, Int.zero)) } - | AMPERSAND INTLIT { Rconst(Oaddrstack(coqint_of_camlint $2)) } - | MINUS expr %prec p_uminus { Runop(Onegint, $2) } - | MINUSF expr %prec p_uminus { Runop(Onegf, $2) } - | MINUSS expr %prec p_uminus { Runop(Onegfs, $2) } - | ABSF expr { Runop(Oabsf, $2) } - | INTOFFLOAT expr { Runop(Ointoffloat, $2) } - | INTUOFFLOAT expr { Runop(Ointuoffloat, $2) } - | FLOATOFINT expr { Runop(Ofloatofint, $2) } - | SINGLEOFINT expr { Runop(Osingleofint, $2) } - | FLOATOFINTU expr { Runop(Ofloatofintu, $2) } - | TILDE expr { Runop(Onotint, $2) } - | BANG expr { Rbinop(Ocmpu Ceq, $2, intconst 0l) } - | INT8S expr { Runop(Ocast8signed, $2) } - | INT8U expr { Runop(Ocast8unsigned, $2) } - | INT16S expr { Runop(Ocast16signed, $2) } - | INT16U expr { Runop(Ocast16unsigned, $2) } - | FLOAT32 expr { Runop(Osingleoffloat, $2) } - | FLOAT64 expr { Runop(Ofloatofsingle, $2) } - | MINUSL expr %prec p_uminus { Runop(Onegl, $2) } - | TILDEL expr { Runop(Onotl, $2) } - | INTOFLONG expr { Runop(Ointoflong, $2) } - | LONGOFINT expr { Runop(Olongofint, $2) } - | LONGOFINTU expr { Runop(Olongofintu, $2) } - | LONGOFFLOAT expr { Runop(Olongoffloat, $2) } - | LONGUOFFLOAT expr { Runop(Olonguoffloat, $2) } - | FLOATOFLONG expr { Runop(Ofloatoflong, $2) } - | FLOATOFLONGU expr { Runop(Ofloatoflongu, $2) } - | expr PLUS expr { Rbinop(Oadd, $1, $3) } - | expr MINUS expr { Rbinop(Osub, $1, $3) } - | expr STAR expr { Rbinop(Omul, $1, $3) } - | expr SLASH expr { Rbinop(Odiv, $1, $3) } - | expr PERCENT expr { Rbinop(Omod, $1, $3) } - | expr SLASHU expr { Rbinop(Odivu, $1, $3) } - | expr PERCENTU expr { Rbinop(Omodu, $1, $3) } - | expr AMPERSAND expr { Rbinop(Oand, $1, $3) } - | expr BAR expr { Rbinop(Oor, $1, $3) } - | expr CARET expr { Rbinop(Oxor, $1, $3) } - | expr LESSLESS expr { Rbinop(Oshl, $1, $3) } - | expr GREATERGREATER expr { Rbinop(Oshr, $1, $3) } - | expr GREATERGREATERU expr { Rbinop(Oshru, $1, $3) } - | expr PLUSL expr { Rbinop(Oaddl, $1, $3) } - | expr MINUSL expr { Rbinop(Osubl, $1, $3) } - | expr STARL expr { Rbinop(Omull, $1, $3) } - | expr SLASHL expr { Rbinop(Odivl, $1, $3) } - | expr PERCENTL expr { Rbinop(Omodl, $1, $3) } - | expr SLASHLU expr { Rbinop(Odivlu, $1, $3) } - | expr PERCENTLU expr { Rbinop(Omodlu, $1, $3) } - | expr AMPERSANDL expr { Rbinop(Oandl, $1, $3) } - | expr BARL expr { Rbinop(Oorl, $1, $3) } - | expr CARETL expr { Rbinop(Oxorl, $1, $3) } - | expr LESSLESSL expr { Rbinop(Oshll, $1, $3) } - | expr GREATERGREATERL expr { Rbinop(Oshrl, $1, $3) } - | expr GREATERGREATERLU expr { Rbinop(Oshrlu, $1, $3) } - | expr PLUSF expr { Rbinop(Oaddf, $1, $3) } - | expr PLUSS expr { Rbinop(Oaddfs, $1, $3) } - | expr MINUSF expr { Rbinop(Osubf, $1, $3) } - | expr MINUSS expr { Rbinop(Osubfs, $1, $3) } - | expr STARF expr { Rbinop(Omulf, $1, $3) } - | expr STARS expr { Rbinop(Omulfs, $1, $3) } - | expr SLASHF expr { Rbinop(Odivf, $1, $3) } - | expr SLASHS expr { Rbinop(Odivfs, $1, $3) } - | expr EQUALEQUAL expr { Rbinop(Ocmp Ceq, $1, $3) } - | expr BANGEQUAL expr { Rbinop(Ocmp Cne, $1, $3) } - | expr LESS expr { Rbinop(Ocmp Clt, $1, $3) } - | expr LESSEQUAL expr { Rbinop(Ocmp Cle, $1, $3) } - | expr GREATER expr { Rbinop(Ocmp Cgt, $1, $3) } - | expr GREATEREQUAL expr { Rbinop(Ocmp Cge, $1, $3) } - | expr EQUALEQUALU expr { Rbinop(Ocmpu Ceq, $1, $3) } - | expr BANGEQUALU expr { Rbinop(Ocmpu Cne, $1, $3) } - | expr LESSU expr { Rbinop(Ocmpu Clt, $1, $3) } - | expr LESSEQUALU expr { Rbinop(Ocmpu Cle, $1, $3) } - | expr GREATERU expr { Rbinop(Ocmpu Cgt, $1, $3) } - | expr GREATEREQUALU expr { Rbinop(Ocmpu Cge, $1, $3) } - | expr EQUALEQUALL expr { Rbinop(Ocmpl Ceq, $1, $3) } - | expr BANGEQUALL expr { Rbinop(Ocmpl Cne, $1, $3) } - | expr LESSL expr { Rbinop(Ocmpl Clt, $1, $3) } - | expr LESSEQUALL expr { Rbinop(Ocmpl Cle, $1, $3) } - | expr GREATERL expr { Rbinop(Ocmpl Cgt, $1, $3) } - | expr GREATEREQUALL expr { Rbinop(Ocmpl Cge, $1, $3) } - | expr EQUALEQUALLU expr { Rbinop(Ocmplu Ceq, $1, $3) } - | expr BANGEQUALLU expr { Rbinop(Ocmplu Cne, $1, $3) } - | expr LESSLU expr { Rbinop(Ocmplu Clt, $1, $3) } - | expr LESSEQUALLU expr { Rbinop(Ocmplu Cle, $1, $3) } - | expr GREATERLU expr { Rbinop(Ocmplu Cgt, $1, $3) } - | expr GREATEREQUALLU expr { Rbinop(Ocmplu Cge, $1, $3) } - | expr EQUALEQUALF expr { Rbinop(Ocmpf Ceq, $1, $3) } - | expr BANGEQUALF expr { Rbinop(Ocmpf Cne, $1, $3) } - | expr LESSF expr { Rbinop(Ocmpf Clt, $1, $3) } - | expr LESSEQUALF expr { Rbinop(Ocmpf Cle, $1, $3) } - | expr GREATERF expr { Rbinop(Ocmpf Cgt, $1, $3) } - | expr GREATEREQUALF expr { Rbinop(Ocmpf Cge, $1, $3) } - | memory_chunk LBRACKET expr RBRACKET { Rload($1, $3) } - | expr LPAREN expr_list RPAREN COLON signature{ Rcall($6, $1, $3) } - | BUILTIN eftoks LPAREN expr_list RPAREN COLON signature{ Rbuiltin($7, $2, $4) } -; - -expr_list: - /* empty */ { [] } - | expr_list_1 { $1 } -; - -expr_list_1: - expr { $1 :: [] } - | expr COMMA expr_list_1 { $1 :: $3 } -; - -memory_chunk: - INT8S { Mint8signed } - | INT8U { Mint8unsigned } - | INT16S { Mint16signed } - | INT16U { Mint16unsigned } - | INT32 { Mint32 } - | INT64 { Mint64 } - | INT { Mint32 } - | FLOAT32 { Mfloat32 } - | FLOAT64 { Mfloat64 } - | FLOAT { Mfloat64 } -; - -/* Types */ - -type_: - INT { Tint } - | FLOAT { Tfloat } - | LONG { Tlong } - | SINGLE { Tsingle } -; - -/* External functions */ - -eftok: - IDENT { EFT_tok $1 } - | STRINGLIT { EFT_string $1 } - | INTLIT { EFT_int $1 } - | VOLATILE { EFT_tok "volatile" } - | EXTERN { EFT_tok "extern" } - | BUILTIN { EFT_tok "builtin" } - | RUNTIME { EFT_tok "runtime" } - | memory_chunk { EFT_chunk $1 } -; - -eftoks: - eftok eftoks { $1 :: $2 } - | /*empty*/ { [] } -; diff --git a/backend/CMtypecheck.ml b/backend/CMtypecheck.ml deleted file mode 100644 index cd0d25dc..00000000 --- a/backend/CMtypecheck.ml +++ /dev/null @@ -1,350 +0,0 @@ -(* *********************************************************************) -(* *) -(* The Compcert verified compiler *) -(* *) -(* Xavier Leroy, INRIA Paris-Rocquencourt *) -(* *) -(* Copyright Institut National de Recherche en Informatique et en *) -(* Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU General Public License as published by *) -(* the Free Software Foundation, either version 2 of the License, or *) -(* (at your option) any later version. This file is also distributed *) -(* under the terms of the INRIA Non-Commercial License Agreement. *) -(* *) -(* *********************************************************************) - -(* A type-checker for Cminor *) - -(* FIXME: proper support for type Tsingle *) - -open Printf -open Camlcoq -open AST -open PrintAST -open Cminor - -exception Error of string - -type ty = Base of typ | Var of ty option ref - -let newvar () = Var (ref None) -let tint = Base Tint -let tfloat = Base Tfloat -let tlong = Base Tlong -let tsingle = Base Tsingle -let tany32 = Base Tany32 -let tany64 = Base Tany64 - -let ty_of_typ = function - | Tint -> tint - | Tfloat -> tfloat - | Tlong -> tlong - | Tsingle -> tsingle - | Tany32 -> tany32 - | Tany64 -> tany64 - -let ty_of_sig_args tyl = List.map ty_of_typ tyl - -let rec repr t = - match t with - | Base _ -> t - | Var r -> match !r with None -> t | Some t' -> repr t' - -let unify t1 t2 = - match (repr t1, repr t2) with - | Base b1, Base b2 -> - if b1 <> b2 then - raise (Error (sprintf "Expected type %s, actual type %s\n" - (name_of_type b1) (name_of_type b2))) - | Base b, Var r -> r := Some (Base b) - | Var r, Base b -> r := Some (Base b) - | Var r1, Var r2 -> if r1 != r2 then r1 := Some (Var r2) - -let unify_list l1 l2 = - let ll1 = List.length l1 and ll2 = List.length l2 in - if ll1 <> ll2 then - raise (Error (sprintf "Arity mismatch: expected %d, actual %d\n" ll1 ll2)); - List.iter2 unify l1 l2 - -let type_var env id = - try - List.assoc id env - with Not_found -> - raise (Error (sprintf "Unbound variable %s\n" (extern_atom id))) - -let type_constant = function - | Ointconst _ -> tint - | Ofloatconst _ -> tfloat - | Osingleconst _ -> tsingle - | Olongconst _ -> tlong - | Oaddrsymbol _ -> tint - | Oaddrstack _ -> tint - -let type_unary_operation = function - | Ocast8signed -> tint, tint - | Ocast16signed -> tint, tint - | Ocast8unsigned -> tint, tint - | Ocast16unsigned -> tint, tint - | Onegint -> tint, tint - | Onotint -> tint, tint - | Onegf -> tfloat, tfloat - | Oabsf -> tfloat, tfloat - | Onegfs -> tsingle, tsingle - | Oabsfs -> tsingle, tsingle - | Osingleoffloat -> tfloat, tsingle - | Ofloatofsingle -> tsingle, tfloat - | Ointoffloat -> tfloat, tint - | Ointuoffloat -> tfloat, tint - | Ofloatofint -> tint, tfloat - | Ofloatofintu -> tint, tfloat - | Ointofsingle -> tsingle, tint - | Ointuofsingle -> tsingle, tint - | Osingleofint -> tint, tsingle - | Osingleofintu -> tint, tsingle - | Onegl -> tlong, tlong - | Onotl -> tlong, tlong - | Ointoflong -> tlong, tint - | Olongofint -> tint, tlong - | Olongofintu -> tint, tlong - | Olongoffloat -> tfloat, tlong - | Olonguoffloat -> tfloat, tlong - | Ofloatoflong -> tlong, tfloat - | Ofloatoflongu -> tlong, tfloat - | Olongofsingle -> tsingle, tlong - | Olonguofsingle -> tsingle, tlong - | Osingleoflong -> tlong, tfloat - | Osingleoflongu -> tlong, tfloat - -let type_binary_operation = function - | Oadd -> tint, tint, tint - | Osub -> tint, tint, tint - | Omul -> tint, tint, tint - | Odiv -> tint, tint, tint - | Odivu -> tint, tint, tint - | Omod -> tint, tint, tint - | Omodu -> tint, tint, tint - | Oand -> tint, tint, tint - | Oor -> tint, tint, tint - | Oxor -> tint, tint, tint - | Oshl -> tint, tint, tint - | Oshr -> tint, tint, tint - | Oshru -> tint, tint, tint - | Oaddf -> tfloat, tfloat, tfloat - | Osubf -> tfloat, tfloat, tfloat - | Omulf -> tfloat, tfloat, tfloat - | Odivf -> tfloat, tfloat, tfloat - | Oaddfs -> tsingle, tsingle, tsingle - | Osubfs -> tsingle, tsingle, tsingle - | Omulfs -> tsingle, tsingle, tsingle - | Odivfs -> tsingle, tsingle, tsingle - | Oaddl -> tlong, tlong, tlong - | Osubl -> tlong, tlong, tlong - | Omull -> tlong, tlong, tlong - | Odivl -> tlong, tlong, tlong - | Odivlu -> tlong, tlong, tlong - | Omodl -> tlong, tlong, tlong - | Omodlu -> tlong, tlong, tlong - | Oandl -> tlong, tlong, tlong - | Oorl -> tlong, tlong, tlong - | Oxorl -> tlong, tlong, tlong - | Oshll -> tlong, tint, tlong - | Oshrl -> tlong, tint, tlong - | Oshrlu -> tlong, tint, tlong - | Ocmp _ -> tint, tint, tint - | Ocmpu _ -> tint, tint, tint - | Ocmpf _ -> tfloat, tfloat, tint - | Ocmpfs _ -> tsingle, tsingle, tint - | Ocmpl _ -> tlong, tlong, tint - | Ocmplu _ -> tlong, tlong, tint - -let name_of_unary_operation = PrintCminor.name_of_unop - -let name_of_binary_operation = PrintCminor.name_of_binop - -let type_chunk = function - | Mint8signed -> tint - | Mint8unsigned -> tint - | Mint16signed -> tint - | Mint16unsigned -> tint - | Mint32 -> tint - | Mint64 -> tlong - | Mfloat32 -> tsingle - | Mfloat64 -> tfloat - | Many32 -> tany32 - | Many64 -> tany64 - -let name_of_chunk = PrintAST.name_of_chunk - -let rec type_expr env lenv e = - match e with - | Evar id -> - type_var env id - | Econst cst -> - type_constant cst - | Eunop(op, e1) -> - let te1 = type_expr env lenv e1 in - let (targ, tres) = type_unary_operation op in - begin try - unify targ te1 - with Error s -> - raise (Error (sprintf "In application of operator %s:\n%s" - (name_of_unary_operation op) s)) - end; - tres - | Ebinop(op, e1, e2) -> - let te1 = type_expr env lenv e1 in - let te2 = type_expr env lenv e2 in - let (targ1, targ2, tres) = type_binary_operation op in - begin try - unify targ1 te1; unify targ2 te2 - with Error s -> - raise (Error (sprintf "In application of operator %s:\n%s" - (name_of_binary_operation op) s)) - end; - tres - | Eload(chunk, e) -> - let te = type_expr env lenv e in - begin try - unify tint te - with Error s -> - raise (Error (sprintf "In load %s:\n%s" - (name_of_chunk chunk) s)) - end; - type_chunk chunk - -and type_exprlist env lenv el = - match el with - | [] -> [] - | e1 :: et -> - let te1 = type_expr env lenv e1 in - let tet = type_exprlist env lenv et in - (te1 :: tet) - -and type_condexpr env lenv e = - let te = type_expr env lenv e in - begin try - unify tint te - with Error s -> - raise (Error (sprintf "In condition:\n%s" s)) - end - -let rec type_stmt env blk ret s = - match s with - | Sskip -> () - | Sassign(id, e1) -> - let tid = type_var env id in - let te1 = type_expr env [] e1 in - begin try - unify tid te1 - with Error s -> - raise (Error (sprintf "In assignment to %s:\n%s" (extern_atom id) s)) - end - | Sstore(chunk, e1, e2) -> - let te1 = type_expr env [] e1 in - let te2 = type_expr env [] e2 in - begin try - unify tint te1; - unify (type_chunk chunk) te2 - with Error s -> - raise (Error (sprintf "In store %s:\n%s" - (name_of_chunk chunk) s)) - end - | Scall(optid, sg, e1, el) -> - let te1 = type_expr env [] e1 in - let tel = type_exprlist env [] el in - begin try - unify tint te1; - unify_list (ty_of_sig_args sg.sig_args) tel; - let ty_res = - match sg.sig_res with - | None -> tint (*???*) - | Some t -> ty_of_typ t in - begin match optid with - | None -> () - | Some id -> unify (type_var env id) ty_res - end - with Error s -> - raise (Error (sprintf "In call:\n%s" s)) - end - | Sbuiltin(optid, ef, el) -> - let sg = ef_sig ef in - let tel = type_exprlist env [] el in - begin try - unify_list (ty_of_sig_args sg.sig_args) tel; - let ty_res = - match sg.sig_res with - | None -> tint (*???*) - | Some t -> ty_of_typ t in - begin match optid with - | None -> () - | Some id -> unify (type_var env id) ty_res - end - with Error s -> - raise (Error (sprintf "In builtin call:\n%s" s)) - end - | Sseq(s1, s2) -> - type_stmt env blk ret s1; - type_stmt env blk ret s2 - | Sifthenelse(ce, s1, s2) -> - type_condexpr env [] ce; - type_stmt env blk ret s1; - type_stmt env blk ret s2 - | Sloop s1 -> - type_stmt env blk ret s1 - | Sblock s1 -> - type_stmt env (blk + 1) ret s1 - | Sexit n -> - if Nat.to_int n >= blk then - raise (Error (sprintf "Bad exit(%d)\n" (Nat.to_int n))) - | Sswitch(islong, e, cases, deflt) -> - unify (type_expr env [] e) (if islong then tlong else tint) - | Sreturn None -> - begin match ret with - | None -> () - | Some tret -> raise (Error ("return without argument")) - end - | Sreturn (Some e) -> - begin match ret with - | None -> raise (Error "return with argument") - | Some tret -> - begin try - unify (type_expr env [] e) (ty_of_typ tret) - with Error s -> - raise (Error (sprintf "In return:\n%s" s)) - end - end - | Stailcall(sg, e1, el) -> - let te1 = type_expr env [] e1 in - let tel = type_exprlist env [] el in - begin try - unify tint te1; - unify_list (ty_of_sig_args sg.sig_args) tel - with Error s -> - raise (Error (sprintf "In tail call:\n%s" s)) - end - | Slabel(lbl, s1) -> - type_stmt env blk ret s1 - | Sgoto lbl -> - () - -let rec env_of_vars idl = - match idl with - | [] -> [] - | id1 :: idt -> (id1, newvar()) :: env_of_vars idt - -let type_function id f = - try - type_stmt - (env_of_vars f.fn_vars @ env_of_vars f.fn_params) - 0 f.fn_sig.sig_res f.fn_body - with Error s -> - raise (Error (sprintf "In function %s:\n%s" (extern_atom id) s)) - -let type_globdef (id, gd) = - match gd with - | Gfun(Internal f) -> type_function id f - | Gfun(External ef) -> () - | Gvar v -> () - -let type_program p = - List.iter type_globdef p.prog_defs; p diff --git a/backend/Deadcodeproof.v b/backend/Deadcodeproof.v index 52f1f112..fa402e9f 100644 --- a/backend/Deadcodeproof.v +++ b/backend/Deadcodeproof.v @@ -978,7 +978,8 @@ Ltac UseTransfer := eapply match_succ_states; eauto. simpl; auto. destruct res; auto. apply eagree_set_undef; auto. eapply magree_storebytes_left; eauto. - exploit aaddr_arg_sound; eauto. + clear H3. + exploit aaddr_arg_sound; eauto. intros (bc & A & B & C). intros. eapply nlive_contains; eauto. erewrite Mem.loadbytes_length in H0 by eauto. diff --git a/backend/Inliningproof.v b/backend/Inliningproof.v index d06fa997..d5d7e033 100644 --- a/backend/Inliningproof.v +++ b/backend/Inliningproof.v @@ -1171,11 +1171,11 @@ Proof. rewrite <- SP in MS0. eapply match_stacks_invariant; eauto. intros. destruct (eq_block b1 stk). - subst b1. rewrite D in H8; inv H8. subst b2. eelim Plt_strict; eauto. + subst b1. rewrite D in H8; inv H8. eelim Plt_strict; eauto. rewrite E in H8; auto. intros. exploit Mem.perm_alloc_inv. eexact H. eauto. destruct (eq_block b1 stk); intros; auto. - subst b1. rewrite D in H8; inv H8. subst b2. eelim Plt_strict; eauto. + subst b1. rewrite D in H8; inv H8. eelim Plt_strict; eauto. intros. eapply Mem.perm_alloc_1; eauto. intros. exploit Mem.perm_alloc_inv. eexact A. eauto. rewrite dec_eq_false; auto. diff --git a/backend/NeedDomain.v b/backend/NeedDomain.v index a53040f9..8e8b9c0b 100644 --- a/backend/NeedDomain.v +++ b/backend/NeedDomain.v @@ -1255,8 +1255,8 @@ Proof. split; simpl; auto; intros. rewrite PTree.gsspec in H6. destruct (peq id0 id). + inv H6. destruct H3. congruence. destruct gl!id as [iv0|] eqn:NG. - rewrite ISet.In_add. intros [P|P]. omega. eelim GL; eauto. - rewrite ISet.In_interval. omega. + unfold iv'; rewrite ISet.In_add. intros [P|P]. omega. eelim GL; eauto. + unfold iv'; rewrite ISet.In_interval. omega. + eauto. - (* Stk ofs *) split; simpl; auto; intros. destruct H3. diff --git a/backend/RTLgen.v b/backend/RTLgen.v index 11da630b..cfbf57d6 100644 --- a/backend/RTLgen.v +++ b/backend/RTLgen.v @@ -107,8 +107,8 @@ Inductive res (A: Type) (s: state): Type := | Error: Errors.errmsg -> res A s | OK: A -> forall (s': state), state_incr s s' -> res A s. -Implicit Arguments OK [A s]. -Implicit Arguments Error [A s]. +Arguments OK [A s]. +Arguments Error [A s]. Definition mon (A: Type) : Type := forall (s: state), res A s. diff --git a/backend/RTLgenproof.v b/backend/RTLgenproof.v index ace822fd..b635fd58 100644 --- a/backend/RTLgenproof.v +++ b/backend/RTLgenproof.v @@ -1082,7 +1082,7 @@ End CORRECTNESS_EXPR. (** ** Measure over CminorSel states *) -Open Local Scope nat_scope. +Local Open Scope nat_scope. Fixpoint size_stmt (s: stmt) : nat := match s with diff --git a/backend/Registers.v b/backend/Registers.v index cfe8427b..622cddfe 100644 --- a/backend/Registers.v +++ b/backend/Registers.v @@ -61,9 +61,11 @@ Definition regmap_setres | _ => rs end. -Notation "a # b" := (Regmap.get b a) (at level 1). -Notation "a ## b" := (List.map (fun r => Regmap.get r a) b) (at level 1). -Notation "a # b <- c" := (Regmap.set b c a) (at level 1, b at next level). +Notation "a # b" := (Regmap.get b a) (at level 1) : rtl. +Notation "a ## b" := (List.map (fun r => Regmap.get r a) b) (at level 1) : rtl. +Notation "a # b <- c" := (Regmap.set b c a) (at level 1, b at next level) : rtl. + +Open Scope rtl. (** Pointwise "less defined than" relation between register maps. *) diff --git a/backend/SelectDiv.vp b/backend/SelectDiv.vp index 5cc66322..dc85fb25 100644 --- a/backend/SelectDiv.vp +++ b/backend/SelectDiv.vp @@ -17,7 +17,7 @@ Require Import Compopts. Require Import AST Integers Floats. Require Import Op CminorSel SelectOp SplitLong SelectLong. -Open Local Scope cminorsel_scope. +Local Open Scope cminorsel_scope. (** We try to turn divisions by a constant into a multiplication by a pseudo-inverse of the divisor. The approach is described in diff --git a/backend/SelectDivproof.v b/backend/SelectDivproof.v index 3180a55d..2ca30e52 100644 --- a/backend/SelectDivproof.v +++ b/backend/SelectDivproof.v @@ -17,7 +17,7 @@ Require Import AST Integers Floats Values Memory Globalenvs Events. Require Import Cminor Op CminorSel. Require Import SelectOp SelectOpproof SplitLong SplitLongproof SelectLong SelectLongproof SelectDiv. -Open Local Scope cminorsel_scope. +Local Open Scope cminorsel_scope. (** * Main approximation theorems *) diff --git a/backend/SplitLongproof.v b/backend/SplitLongproof.v index 8c8dea2f..3b1eaa6b 100644 --- a/backend/SplitLongproof.v +++ b/backend/SplitLongproof.v @@ -18,8 +18,8 @@ Require Import AST Errors Integers Floats. Require Import Values Memory Globalenvs Events Cminor Op CminorSel. Require Import SelectOp SelectOpproof SplitLong. -Open Local Scope cminorsel_scope. -Open Local Scope string_scope. +Local Open Scope cminorsel_scope. +Local Open Scope string_scope. (** * Axiomatization of the helper functions *) diff --git a/backend/Stacking.v b/backend/Stacking.v index 700025c2..f51848f2 100644 --- a/backend/Stacking.v +++ b/backend/Stacking.v @@ -169,7 +169,7 @@ Definition transl_code Definition transl_body (f: Linear.function) (fe: frame_env) := save_callee_save fe (transl_code fe f.(Linear.fn_code)). -Open Local Scope string_scope. +Local Open Scope string_scope. Definition transf_function (f: Linear.function) : res Mach.function := let fe := make_env (function_bounds f) in diff --git a/backend/Unusedglobproof.v b/backend/Unusedglobproof.v index 7e9c3ca0..c79ae4fd 100644 --- a/backend/Unusedglobproof.v +++ b/backend/Unusedglobproof.v @@ -1015,7 +1015,7 @@ Proof. { rewrite STK, TSTK. apply match_stacks_incr with j; auto. intros. destruct (eq_block b1 stk). - subst b1. rewrite F in H1; inv H1. subst b2. split; apply Ple_refl. + subst b1. rewrite F in H1; inv H1. split; apply Ple_refl. rewrite G in H1 by auto. congruence. } econstructor; split. eapply exec_function_internal; eauto. diff --git a/cfrontend/Cexec.v b/cfrontend/Cexec.v index 4dcf2a47..a9ffcd3d 100644 --- a/cfrontend/Cexec.v +++ b/cfrontend/Cexec.v @@ -130,8 +130,8 @@ Definition val_of_eventval (ev: eventval) (t: typ) : option val := Ltac mydestr := match goal with - | [ |- None = Some _ -> _ ] => intro X; discriminate - | [ |- Some _ = Some _ -> _ ] => intro X; inv X + | [ |- None = Some _ -> _ ] => let X := fresh "X" in intro X; discriminate + | [ |- Some _ = Some _ -> _ ] => let X := fresh "X" in intro X; inv X | [ |- match ?x with Some _ => _ | None => _ end = Some _ -> _ ] => destruct x eqn:?; mydestr | [ |- match ?x with true => _ | false => _ end = Some _ -> _ ] => destruct x eqn:?; mydestr | [ |- match ?x with left _ => _ | right _ => _ end = Some _ -> _ ] => destruct x; mydestr @@ -2038,12 +2038,14 @@ Definition do_step (w: world) (s: state) : list transition := Ltac myinv := match goal with - | [ |- In _ nil -> _ ] => intro X; elim X + | [ |- In _ nil -> _ ] => let X := fresh "X" in intro X; elim X | [ |- In _ (ret _ _) -> _ ] => + let X := fresh "X" in intro X; elim X; clear X; - [intro EQ; unfold ret in EQ; inv EQ; myinv | myinv] + [let EQ := fresh "EQ" in intro EQ; unfold ret in EQ; inv EQ; myinv | myinv] | [ |- In _ (_ :: nil) -> _ ] => - intro X; elim X; clear X; [intro EQ; inv EQ; myinv | myinv] + let X := fresh "X" in + intro X; elim X; clear X; [let EQ := fresh "EQ" in intro EQ; inv EQ; myinv | myinv] | [ |- In _ (match ?x with Some _ => _ | None => _ end) -> _ ] => destruct x eqn:?; myinv | [ |- In _ (match ?x with false => _ | true => _ end) -> _ ] => destruct x eqn:?; myinv | [ |- In _ (match ?x with left _ => _ | right _ => _ end) -> _ ] => destruct x; myinv diff --git a/cfrontend/Cminorgenproof.v b/cfrontend/Cminorgenproof.v index ea1bc89c..a6d58f17 100644 --- a/cfrontend/Cminorgenproof.v +++ b/cfrontend/Cminorgenproof.v @@ -20,7 +20,7 @@ Require Import AST Linking. Require Import Values Memory Events Globalenvs Smallstep. Require Import Csharpminor Switch Cminor Cminorgen. -Open Local Scope error_monad_scope. +Local Open Scope error_monad_scope. Definition match_prog (p: Csharpminor.program) (tp: Cminor.program) := match_program (fun cu f tf => transl_fundef f = OK tf) eq p tp. diff --git a/cfrontend/Cshmgen.v b/cfrontend/Cshmgen.v index aeb31fe2..792a73f9 100644 --- a/cfrontend/Cshmgen.v +++ b/cfrontend/Cshmgen.v @@ -24,8 +24,8 @@ Require Import Coqlib Maps Errors Integers Floats. Require Import AST Linking. Require Import Ctypes Cop Clight Cminor Csharpminor. -Open Local Scope string_scope. -Open Local Scope error_monad_scope. +Local Open Scope string_scope. +Local Open Scope error_monad_scope. (** * Csharpminor constructors *) diff --git a/cfrontend/Ctypes.v b/cfrontend/Ctypes.v index 0794743d..8d6cdb24 100644 --- a/cfrontend/Ctypes.v +++ b/cfrontend/Ctypes.v @@ -1064,7 +1064,7 @@ Proof. destruct (complete_members env m) eqn:C; simplify_eq EQ. clear EQ; intros EQ. rewrite PTree.gsspec. intros [A|A]; auto. destruct (peq id id0); auto. - inv A. rewrite <- H1; auto. + inv A. rewrite <- H0; auto. } intros. exploit REC; eauto. rewrite PTree.gempty. intuition congruence. Qed. @@ -1519,7 +1519,7 @@ Local Transparent Linker_program. - intros. exploit link_match_fundef; eauto. intros (tf & A & B). exists tf; auto. - intros. Local Transparent Linker_types. - simpl in *. destruct (type_eq v1 v2); inv H4. subst v tv2. exists tv1; rewrite dec_eq_true; auto. + simpl in *. destruct (type_eq v1 v2); inv H4. exists v; rewrite dec_eq_true; auto. - eauto. - eauto. - eauto. diff --git a/cfrontend/SimplExpr.v b/cfrontend/SimplExpr.v index 71b67f67..8725edd1 100644 --- a/cfrontend/SimplExpr.v +++ b/cfrontend/SimplExpr.v @@ -38,8 +38,8 @@ Inductive result (A: Type) (g: generator) : Type := | Err: Errors.errmsg -> result A g | Res: A -> forall (g': generator), Ple (gen_next g) (gen_next g') -> result A g. -Implicit Arguments Err [A g]. -Implicit Arguments Res [A g]. +Arguments Err [A g]. +Arguments Res [A g]. Definition mon (A: Type) := forall (g: generator), result A g. diff --git a/common/AST.v b/common/AST.v index e6fdec3c..34f29bb3 100644 --- a/common/AST.v +++ b/common/AST.v @@ -260,8 +260,8 @@ Inductive globdef (F V: Type) : Type := | Gfun (f: F) | Gvar (v: globvar V). -Implicit Arguments Gfun [F V]. -Implicit Arguments Gvar [F V]. +Arguments Gfun [F V]. +Arguments Gvar [F V]. Record program (F V: Type) : Type := mkprogram { prog_defs: list (ident * globdef F V); @@ -530,7 +530,7 @@ Inductive fundef (F: Type): Type := | Internal: F -> fundef F | External: external_function -> fundef F. -Implicit Arguments External [F]. +Arguments External [F]. Section TRANSF_FUNDEF. diff --git a/common/Errors.v b/common/Errors.v index 338d777d..28933313 100644 --- a/common/Errors.v +++ b/common/Errors.v @@ -47,7 +47,7 @@ Inductive res (A: Type) : Type := | OK: A -> res A | Error: errmsg -> res A. -Implicit Arguments Error [A]. +Arguments Error [A]. (** To automate the propagation of errors, we use a monadic style with the following [bind] operation. *) @@ -104,7 +104,7 @@ Notation "'assertion' A ; B" := (if A then B else assertion_failed) (** This is the familiar monadic map iterator. *) -Open Local Scope error_monad_scope. +Local Open Scope error_monad_scope. Fixpoint mmap (A B: Type) (f: A -> res B) (l: list A) {struct l} : res (list B) := match l with diff --git a/common/Memory.v b/common/Memory.v index d0cbe8a0..764fdc26 100644 --- a/common/Memory.v +++ b/common/Memory.v @@ -96,7 +96,7 @@ Proof. intros; red; intros. subst b'. contradiction. Qed. -Hint Local Resolve valid_not_valid_diff: mem. +Local Hint Resolve valid_not_valid_diff: mem. (** Permissions *) @@ -111,7 +111,7 @@ Proof. eapply perm_order_trans; eauto. Qed. -Hint Local Resolve perm_implies: mem. +Local Hint Resolve perm_implies: mem. Theorem perm_cur_max: forall m b ofs p, perm m b ofs Cur p -> perm m b ofs Max p. @@ -138,7 +138,7 @@ Proof. intros. destruct k; auto. apply perm_cur_max. auto. Qed. -Hint Local Resolve perm_cur perm_max: mem. +Local Hint Resolve perm_cur perm_max: mem. Theorem perm_valid_block: forall m b ofs k p, perm m b ofs k p -> valid_block m b. @@ -152,7 +152,7 @@ Proof. contradiction. Qed. -Hint Local Resolve perm_valid_block: mem. +Local Hint Resolve perm_valid_block: mem. Remark perm_order_dec: forall p1 p2, {perm_order p1 p2} + {~perm_order p1 p2}. @@ -199,7 +199,7 @@ Proof. unfold range_perm; intros; eauto with mem. Qed. -Hint Local Resolve range_perm_implies range_perm_cur range_perm_max: mem. +Local Hint Resolve range_perm_implies range_perm_cur range_perm_max: mem. Lemma range_perm_dec: forall m b lo hi k p, {range_perm m b lo hi k p} + {~ range_perm m b lo hi k p}. @@ -244,7 +244,7 @@ Proof. eapply valid_access_implies; eauto. constructor. Qed. -Hint Local Resolve valid_access_implies: mem. +Local Hint Resolve valid_access_implies: mem. Theorem valid_access_valid_block: forall m chunk b ofs, @@ -257,7 +257,7 @@ Proof. eauto with mem. Qed. -Hint Local Resolve valid_access_valid_block: mem. +Local Hint Resolve valid_access_valid_block: mem. Lemma valid_access_perm: forall m chunk b ofs k p, @@ -671,7 +671,7 @@ Proof. congruence. Qed. -Hint Local Resolve load_valid_access valid_access_load: mem. +Local Hint Resolve load_valid_access valid_access_load: mem. Theorem load_type: forall m chunk b ofs v, @@ -957,7 +957,7 @@ Proof. contradiction. Defined. -Hint Local Resolve valid_access_store: mem. +Local Hint Resolve valid_access_store: mem. Section STORE. Variable chunk: memory_chunk. @@ -3378,8 +3378,6 @@ Proof. apply perm_cur_max. apply (H1 (Ptrofs.unsigned ofs2)). omega. Qed. -Require Intv. - Theorem disjoint_or_equal_inject: forall f m m' b1 b1' delta1 b2 b2' delta2 ofs1 ofs2 sz, inject f m m' -> @@ -407,15 +407,15 @@ missingtools=false echo "Testing Coq... " | tr -d '\n' coq_ver=$(${COQBIN}coqc -v 2>/dev/null | sed -n -e 's/The Coq Proof Assistant, version \([^ ]*\).*$/\1/p') case "$coq_ver" in - 8.5pl2|8.5pl3) + 8.6) echo "version $coq_ver -- good!";; ?.*) echo "version $coq_ver -- UNSUPPORTED" - echo "Error: CompCert requires Coq version 8.5pl2." + echo "Error: CompCert requires Coq version 8.6." missingtools=true;; *) echo "NOT FOUND" - echo "Error: make sure Coq version 8.5pl2 is installed." + echo "Error: make sure Coq version 8.6 is installed." missingtools=true;; esac @@ -448,7 +448,7 @@ else ocaml_opt_comp=false fi -MENHIR_REQUIRED=20160303 +MENHIR_REQUIRED=20161201 echo "Testing Menhir... " | tr -d '\n' menhir_ver=`menhir --version 2>/dev/null | sed -n -e 's/^.*version \([0-9]*\).*$/\1/p'` case "$menhir_ver" in diff --git a/cparser/Cflow.ml b/cparser/Cflow.ml new file mode 100644 index 00000000..f5408c15 --- /dev/null +++ b/cparser/Cflow.ml @@ -0,0 +1,248 @@ +(* *********************************************************************) +(* *) +(* The Compcert verified compiler *) +(* *) +(* Xavier Leroy, INRIA Paris-Rocquencourt *) +(* *) +(* Copyright Institut National de Recherche en Informatique et en *) +(* Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU General Public License as published by *) +(* the Free Software Foundation, either version 2 of the License, or *) +(* (at your option) any later version. This file is also distributed *) +(* under the terms of the INRIA Non-Commercial License Agreement. *) +(* *) +(* *********************************************************************) + +(* A simple control flow analysis for C statements. + Main purpose: emit warnings for non-void functions that fall through, + and for _Noreturn functions that can return. *) + +open C +open Cutil + +module StringSet = Set.Make(String) + +(* Statements are abstracted as "flow transformers": + functions from possible inputs to possible outcomes. + Possible inputs are: + - start normally at the beginning of the statement + - start at a "case" or "default" label because of an enclosing switch + - start at a named label because of a "goto" + Possible outputs are: + - terminate normally and fall through + - terminate early on "break" + - terminate early on "continue" + - terminate early on "return" + - terminate early on "goto" to a label +*) + +type flow = inflow -> outflow + +and inflow = { + inormal: bool; (* start normally at beginning of statement *) + iswitch: bool; (* start at any "case" or "default" label *) + igoto: StringSet.t; (* start at one of the goto labels in the set *) +} + +and outflow = { + onormal: bool; (* terminates normally by falling through *) + obreak: bool; (* terminates early by "break" *) + ocontinue: bool; (* terminates early by "continue" *) + oreturn: bool; (* terminates early by "return" *) + ogoto: StringSet.t (* terminates early by "goto" *) + (* to one of the labels in the set *) +} + +(* The l.u.b. of two out flows *) + +let join o1 o2 = + { onormal = o1.onormal || o2.onormal; + obreak = o1.obreak || o2.obreak; + ocontinue = o1.ocontinue || o2.ocontinue; + oreturn = o1.oreturn || o2.oreturn; + ogoto = StringSet.union o1.ogoto o2.ogoto } + +(* Some elementary flows *) + +let normal : flow = fun i -> + { onormal = i.inormal; + obreak = false; ocontinue = false; oreturn = false; + ogoto = StringSet.empty } + +let break : flow = fun i -> + { obreak = i.inormal; + onormal = false; ocontinue = false; oreturn = false; + ogoto = StringSet.empty } + +let continue : flow = fun i -> + { ocontinue = i.inormal; + onormal = false; obreak = false; oreturn = false; + ogoto = StringSet.empty } + +let return : flow = fun i -> + { oreturn = i.inormal; + onormal = false; obreak = false; ocontinue = false; + ogoto = StringSet.empty } + +let goto lbl : flow = fun i -> + { onormal = false; obreak = false; ocontinue = false; oreturn = false; + ogoto = if i.inormal then StringSet.singleton lbl else StringSet.empty } + +let noflow : flow = fun i -> + { onormal = false; obreak = false; ocontinue = false; oreturn = false; + ogoto = StringSet.empty } + +(* Some flow transformers *) + +(* Sequential composition *) + +let seq (s1: flow) (s2: flow) : flow = fun i -> + let o1 = s1 i in + let o2 = s2 {i with inormal = o1.onormal} in + { onormal = o2.onormal; + obreak = o1.obreak || o2.obreak; + ocontinue = o1.ocontinue || o2.ocontinue; + oreturn = o1.oreturn || o2.oreturn; + ogoto = StringSet.union o1.ogoto o2.ogoto } + +(* Nondeterministic choice *) + +let either (s1: flow) (s2: flow) : flow = fun i -> + join (s1 i) (s2 i) + +(* If-then-else, with special cases for conditions that are always true + or always false. *) + +let resolve_test env e = + match Ceval.integer_expr env e with + | None -> None + | Some n -> Some (n <> 0L) + +let if_ env e (s1: flow) (s2: flow) : flow = + match resolve_test env e with + | Some true -> s1 + | Some false -> s2 + | None -> either s1 s2 + +(* Convert "continue" into "fallthrough". Typically applied to a loop body. *) + +let catch_continue (s: flow) : flow = fun i -> + let o = s i in + { o with onormal = o.onormal || o.ocontinue; ocontinue = false} + +(* Convert "continue" into "fallthrough". Typically applied to a loop. *) + +let catch_break (s: flow) : flow = fun i -> + let o = s i in + { o with onormal = o.onormal || o.obreak; obreak = false} + +(* Statements labeled with a goto label *) + +let label lbl (s: flow) : flow = fun i -> + s { i with inormal = i.inormal || StringSet.mem lbl i.igoto } + +(* For "case" and "default" labeled statements, we assume they can be + entered normally as soon as the nearest enclosing "switch" can be + entered normally. *) + +let case (s: flow) : flow = fun i -> + s { i with inormal = i.inormal || i.iswitch } + +let switch (s: flow) : flow = fun i -> + s { i with inormal = false; iswitch = i.inormal } + +(* This is the flow for an infinite loop with body [s]. + There is no fallthrough exit, but all other exits from [s] are preserved. *) + +let loop (s: flow) : flow = fun i -> + let o = s i in + if o.onormal && not i.inormal then + (* Corner case: on the first iteration, [s] was not entered normally, + but it exits by fallthrough. Then on the next iteration [s] is + entered normally. So, we need to recompute the flow of [s] + assuming it is entered normally. *) + s { i with inormal = true} + else + (* In all other cases, iterating [s] once more does not produce new + exits that we did not compute on the first iteration. Just remove + the fallthrough exit. *) + { o with onormal = false } + +(* This is the main analysis function. Given a C statement [s] it returns + a flow that overapproximates the behavior of [s]. *) + +let rec outcomes env s : flow = + match s.sdesc with + | Sskip -> + normal + | Sdo {edesc = ECall(fn, args)} -> + if find_custom_attributes ["noreturn"; "__noreturn__"] + (attributes_of_type env fn.etyp) = [] + then normal else noflow + | Sdo e -> + normal + | Sseq(s1, s2) -> + seq (outcomes env s1) (outcomes env s2) + | Sif(e, s1, s2) -> + if_ env e (outcomes env s1) (outcomes env s2) + | Swhile(e, s) -> + catch_break ( + loop ( + if_ env e + (catch_continue (outcomes env s)) (* e is true: execute body [s] *) + break)) (* e is false: exit loop *) + | Sdowhile(s, e) -> + catch_break ( + loop ( + seq (catch_continue (outcomes env s)) (* do the body *) + (if_ env e normal break))) (* then continue or break *) + | Sfor(s1, e, s2, s3) -> + seq (outcomes env s1) (* initialization, runs once *) + (catch_break ( + loop ( + if_ env e (* e is true: do body, do next *) + (seq (catch_continue (outcomes env s2)) (outcomes env s3)) + break))) (* e is false: exit loop *) + | Sbreak -> + break + | Scontinue -> + continue + | Sswitch(e, s) -> + catch_break (switch (outcomes env s)) + | Slabeled(Slabel lbl, s) -> + label lbl (outcomes env s) + | Slabeled((Scase _ | Sdefault), s) -> + case (outcomes env s) + | Sgoto lbl -> + goto lbl + | Sreturn opte -> + return + | Sblock sl -> + outcomes_block env sl + | Sdecl dcl -> + normal + | Sasm _ -> + normal + +and outcomes_block env sl = + match sl with + | [] -> + normal + | s1 :: sl -> + seq (outcomes env s1) (outcomes_block env sl) + +(* This is the entry point in this module. Given the body of a function, + estimate if and how this function can return. *) + +let function_returns env body = + (* Iterate [outcomes] until all gotos are accounted for *) + let rec fixpoint i = + let o = outcomes env body i in + if StringSet.subset o.ogoto i.igoto + then o + else fixpoint { i with igoto = StringSet.union i.igoto o.ogoto } in + let o = + fixpoint { inormal = true; iswitch = false; igoto = StringSet.empty } in + (* First boolean is: function can return + Second boolean is: function can return by fall-through *) + (o.onormal || o.oreturn, o.onormal) diff --git a/backend/CMtypecheck.mli b/cparser/Cflow.mli index 44c76544..0de245ae 100644 --- a/backend/CMtypecheck.mli +++ b/cparser/Cflow.mli @@ -13,7 +13,12 @@ (* *) (* *********************************************************************) -exception Error of string - -val type_program: Cminor.program -> Cminor.program +(* A simple control flow analysis for C statements. + Main purpose: emit warnings for _Noreturn functions. *) +val function_returns: Env.t -> C.stmt -> bool * bool + (** Given a function body, returns two Booleans: + - the first says whether the function can return + - the second says whether the function can return by falling through + the end of its body. + Both are over-approximations. *) diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml index 2334966c..18088be7 100644 --- a/cparser/Cutil.ml +++ b/cparser/Cutil.ml @@ -1179,24 +1179,3 @@ let rec subst_stmt phi s = List.map subst_asm_operand inputs, clob) } - -let contains_return s = - let rec aux s = - match s.sdesc with - | Sskip - | Sbreak - | Scontinue - | Sdo _ - | Sdecl _ - | Sasm _ - | Sgoto _ -> false - | Sif(_, s1, s2) - | Sseq(s1, s2) -> aux s1 || aux s2 - | Sswitch (_, s) - | Slabeled (_, s) - | Swhile (_, s) - | Sdowhile(s, _ ) -> aux s - | Sfor(s1, _ , s2, s3) -> aux s1 || aux s2 || aux s3 - | Sreturn _ -> true - | Sblock sl -> List.fold_left (fun acc s -> acc || aux s) false sl in - aux s diff --git a/cparser/Cutil.mli b/cparser/Cutil.mli index 9d053717..a1b9cd26 100644 --- a/cparser/Cutil.mli +++ b/cparser/Cutil.mli @@ -285,8 +285,3 @@ val subst_expr: exp IdentMap.t -> exp -> exp val subst_init: exp IdentMap.t -> init -> init val subst_decl: exp IdentMap.t -> decl -> decl val subst_stmt: exp IdentMap.t -> stmt -> stmt - -(* Statement properties *) - -val contains_return: stmt -> bool - (* Does the stmt contain a return. *) diff --git a/cparser/Elab.ml b/cparser/Elab.ml index ea85ad04..eb9ff560 100644 --- a/cparser/Elab.ml +++ b/cparser/Elab.ml @@ -2329,18 +2329,30 @@ let elab_fundef env spec name defs body loc = (Gdecl(Storage_static, func_id, func_ty, Some func_init)); (* Elaborate function body *) let body1 = !elab_funbody_f ty_ret vararg env3 body in - (* Special treatment of the "main" function *) + (* Analyse it for returns *) + let (can_return, can_fallthrough) = Cflow.function_returns env3 body1 in + (* Special treatment of the "main" function. *) let body2 = if s = "main" then begin match unroll env ty_ret with | TInt(IInt, []) -> - (* Add implicit "return 0;" at end of function body *) - sseq no_loc body1 - {sdesc = Sreturn(Some(intconst 0L IInt)); sloc = no_loc} + (* Add implicit "return 0;" at end of function body, unless + this control point is unreachable, e.g. function already + returns in all cases. *) + if can_fallthrough then + sseq no_loc body1 + {sdesc = Sreturn(Some(intconst 0L IInt)); sloc = no_loc} + else body1 | _ -> warning loc Main_return_type "return type of 'main' should be 'int'"; body1 - end else body1 in + end else begin + (* For non-"main" functions, warn if the body can fall through + and the return type is not "void". *) + if can_fallthrough && not (is_void_type env ty_ret) then + warning loc Return_type "control reaches end of non-void function"; + body1 + end in (* Add the extra declarations if any *) let body3 = if extra_decls = [] then body2 else begin @@ -2352,7 +2364,7 @@ let elab_fundef env spec name defs body loc = if noret then warning loc Celeven_extension "_Noreturn functions are a C11 extension"; if (noret || find_custom_attributes ["noreturn"; "__noreturn__"] attr <> []) - && contains_return body1 then + && can_return then warning loc Invalid_noreturn "function '%s' declared 'noreturn' should not return" s; (* Build and emit function definition *) let fn = diff --git a/cparser/validator/Automaton.v b/cparser/validator/Automaton.v index 98ab1246..fc995298 100644 --- a/cparser/validator/Automaton.v +++ b/cparser/validator/Automaton.v @@ -102,9 +102,9 @@ Module Types(Import Init:AutInit). T term = last_symb_of_non_init_state s -> lookahead_action term | Reduce_act: production -> lookahead_action term | Fail_act: lookahead_action term. - Implicit Arguments Shift_act [term]. - Implicit Arguments Reduce_act [term]. - Implicit Arguments Fail_act [term]. + Arguments Shift_act [term]. + Arguments Reduce_act [term]. + Arguments Fail_act [term]. Inductive action := | Default_reduce_act: production -> action diff --git a/cparser/validator/Interpreter.v b/cparser/validator/Interpreter.v index a24362f8..4ac02693 100644 --- a/cparser/validator/Interpreter.v +++ b/cparser/validator/Interpreter.v @@ -26,8 +26,8 @@ Inductive result (A:Type) := | Err: result A | OK: A -> result A. -Implicit Arguments Err [A]. -Implicit Arguments OK [A]. +Arguments Err [A]. +Arguments OK [A]. Definition bind {A B: Type} (f: result A) (g: A -> result B): result B := match f with diff --git a/driver/Compiler.v b/driver/Compiler.v index dd752aca..5ced13e1 100644 --- a/driver/Compiler.v +++ b/driver/Compiler.v @@ -80,7 +80,7 @@ Parameter print_RTL: Z -> RTL.program -> unit. Parameter print_LTL: LTL.program -> unit. Parameter print_Mach: Mach.program -> unit. -Open Local Scope string_scope. +Local Open Scope string_scope. (** * Composing the translation passes *) diff --git a/driver/Driver.ml b/driver/Driver.ml index 9d5ed3b3..b68331a6 100755..100644 --- a/driver/Driver.ml +++ b/driver/Driver.ml @@ -19,8 +19,6 @@ open Frontend open Assembler open Linker -let dump_options = ref false - (* Optional sdump suffix *) let sdump_suffix = ref ".json" let sdump_folder = ref "" @@ -76,49 +74,6 @@ let compile_c_file sourcename ifile ofile = let ast = parse_c_file sourcename ifile in compile_c_ast sourcename ast ofile -(* From Cminor to asm *) - -let compile_cminor_file ifile ofile = - (* Prepare to dump RTL, Mach, etc, if requested *) - let set_dest dst opt ext = - dst := if !opt then Some (output_filename ifile ".cm" ext) - else None in - set_dest PrintRTL.destination option_drtl ".rtl"; - set_dest Regalloc.destination_alloctrace option_dalloctrace ".alloctrace"; - set_dest PrintLTL.destination option_dltl ".ltl"; - set_dest PrintMach.destination option_dmach ".mach"; - Sections.initialize(); - let ic = open_in ifile in - let lb = Lexing.from_channel ic in - (* Parse cminor *) - let cm = - try CMtypecheck.type_program (CMparser.prog CMlexer.token lb) - with Parsing.Parse_error -> - eprintf "File %s, character %d: Syntax error\n" - ifile (Lexing.lexeme_start lb); - exit 2 - | CMlexer.Error msg -> - eprintf "File %s, character %d: %s\n" - ifile (Lexing.lexeme_start lb) msg; - exit 2 - | CMtypecheck.Error msg -> - eprintf "File %s, type-checking error:\n%s" - ifile msg; - exit 2 in - (* Convert to Asm *) - let asm = - match Compiler.apply_partial - (Compiler.transf_cminor_program cm) - Asmexpand.expand_program with - | Errors.OK asm -> - asm - | Errors.Error msg -> - eprintf "%s: %a" ifile print_error msg; - exit 2 in - (* Print Asm in text form *) - let oc = open_out ofile in - PrintAsm.print_program oc asm; - close_out oc (* Processing of a .c file *) @@ -160,8 +115,6 @@ let process_c_file sourcename = if not !option_dasm then safe_remove asmname; objname end in - if !dump_options then - Optionsprinter.print (output_filename sourcename ".c" ".opt.json") !stdlib_path; name end @@ -176,8 +129,6 @@ let process_i_file sourcename = end else if !option_S then begin compile_c_file sourcename sourcename (output_filename ~final:true sourcename ".c" ".s"); - if !dump_options then - Optionsprinter.print (output_filename sourcename ".c" ".opt.json") !stdlib_path; "" end else begin let asmname = @@ -188,32 +139,9 @@ let process_i_file sourcename = let objname = output_filename ~final: !option_c sourcename ".c" ".o" in assemble asmname objname; if not !option_dasm then safe_remove asmname; - if !dump_options then - Optionsprinter.print (output_filename sourcename ".c" ".opt.json") !stdlib_path; objname end -(* Processing of a .cm file *) - -let process_cminor_file sourcename = - ensure_inputfile_exists sourcename; - if !option_S then begin - compile_cminor_file sourcename - (output_filename ~final:true sourcename ".cm" ".s"); - "" - end else begin - let asmname = - if !option_dasm - then output_filename sourcename ".cm" ".s" - else Filename.temp_file "compcert" ".s" in - compile_cminor_file sourcename asmname; - let objname = output_filename ~final: !option_c sourcename ".cm" ".o" in - assemble asmname objname; - if not !option_dasm then safe_remove asmname; - if !dump_options then - Optionsprinter.print (output_filename sourcename ".cm" ".opt.json") !stdlib_path; - objname - end (* Processing of .S and .s files *) @@ -269,7 +197,6 @@ let usage_string = Recognized source files: .c C source file .i or .p C source file that should not be preprocessed - .cm Cminor source file .s Assembly file .S or .sx Assembly file that must be preprocessed .o Object file @@ -329,7 +256,6 @@ Code generation options: (use -fno-<opt> to turn off -f<opt>) -dasm Save generated assembly in <file>.s -dall Save all generated intermediate files in <file>.<ext> -sdump Save info for post-linking validation in <file>.json - -doptions Save the compiler configurations in <file>.opt.json General options: -stdlib <dir> Set the path of the Compcert run-time library -v Print external commands before invoking them @@ -450,12 +376,10 @@ let cmdline_actions = option_drtl := true; option_dalloctrace := true; option_dmach := true; - option_dasm := true; - dump_options:=true); + option_dasm := true); Exact "-sdump", Set option_sdump; Exact "-sdump-suffix", String (fun s -> option_sdump := true; sdump_suffix:= s); Exact "-sdump-folder", String (fun s -> sdump_folder := s); - Exact "-doptions", Set dump_options; (* General options *) Exact "-v", Set option_v; Exact "-stdlib", String(fun s -> stdlib_path := s); @@ -498,8 +422,6 @@ let cmdline_actions = push_action process_i_file s; incr num_source_files; incr num_input_files); Suffix ".p", Self (fun s -> push_action process_i_file s; incr num_source_files; incr num_input_files); - Suffix ".cm", Self (fun s -> - push_action process_cminor_file s; incr num_source_files; incr num_input_files); Suffix ".s", Self (fun s -> push_action process_s_file s; incr num_source_files; incr num_input_files); Suffix ".S", Self (fun s -> diff --git a/driver/Optionsprinter.ml b/driver/Optionsprinter.ml deleted file mode 100644 index 00b5f5ec..00000000 --- a/driver/Optionsprinter.ml +++ /dev/null @@ -1,141 +0,0 @@ -(* *********************************************************************) -(* *) -(* The Compcert verified compiler *) -(* *) -(* Bernhard Schommer, AbsInt Angewandte Informatik GmbH *) -(* *) -(* AbsInt Angewandte Informatik GmbH. All rights reserved. This file *) -(* is distributed under the terms of the INRIA Non-Commercial *) -(* License Agreement. *) -(* *) -(* *********************************************************************) - -open Clflags -open Json -open Machine -open Printf - -let print_list oc name l = - p_jmember oc name (p_jarray p_jstring) l - -let print_clflags oc = - fprintf oc "{"; - print_list oc "prepro_options" !prepro_options; - print_list oc "linker_options" !linker_options; - print_list oc "assembler_options" !assembler_options; - p_jmember oc "flongdouble" p_jbool !option_flongdouble; - p_jmember oc "fstruct_passing" p_jbool !option_fstruct_passing; - p_jmember oc "fbitfields" p_jbool !option_fbitfields; - p_jmember oc "fvarag_calls" p_jbool !option_fvararg_calls; - p_jmember oc "funprototyped" p_jbool !option_funprototyped; - p_jmember oc "fpacked_structs" p_jbool !option_fpacked_structs; - p_jmember oc "ffpu" p_jbool !option_ffpu; - p_jmember oc "ffloatconstprop" p_jint !option_ffloatconstprop; - p_jmember oc "ftailcalls" p_jbool !option_ftailcalls; - p_jmember oc "fconstprop" p_jbool !option_fconstprop; - p_jmember oc "fcse" p_jbool !option_fcse; - p_jmember oc "fredundance" p_jbool !option_fredundancy; - p_jmember oc "falignfunctions" (p_jopt p_jint) !option_falignfunctions; - p_jmember oc "falignbranchtargets" p_jint !option_falignbranchtargets; - p_jmember oc "faligncondbranchs" p_jint !option_faligncondbranchs; - p_jmember oc "finline_asm" p_jbool !option_finline_asm; - p_jmember oc "mthumb" p_jbool !option_mthumb; - p_jmember oc "Osize" p_jbool !option_Osize; - p_jmember oc "dprepro" p_jbool !option_dprepro; - p_jmember oc "dparse" p_jbool !option_dparse; - p_jmember oc "dcmedium" p_jbool !option_dcmedium; - p_jmember oc "dclight" p_jbool !option_dclight; - p_jmember oc "dcminor" p_jbool !option_dcminor; - p_jmember oc "drtl" p_jbool !option_drtl; - p_jmember oc "dltl" p_jbool !option_dltl; - p_jmember oc "dalloctrace" p_jbool !option_dalloctrace; - p_jmember oc "dmach" p_jbool !option_dmach; - p_jmember oc "dasm" p_jbool !option_dasm; - p_jmember oc "sdump" p_jbool !option_sdump; - p_jmember oc "g" p_jbool !option_g; - p_jmember oc "gdwarf" p_jint !option_gdwarf; - p_jmember oc "gdepth" p_jint !option_gdepth; - p_jmember oc "o" (p_jopt p_jstring) !option_o; - p_jmember oc "E" p_jbool !option_E; - p_jmember oc "S" p_jbool !option_S; - p_jmember oc "c" p_jbool !option_c; - p_jmember oc "v" p_jbool !option_v; - p_jmember oc "interp" p_jbool !option_interp; - p_jmember oc "small_data" p_jint !option_small_data; - p_jmember oc "small_data" p_jint !option_small_const; - p_jmember oc "timings" p_jbool !option_timings; - fprintf oc "\n}" - -let print_struct_passing_style oc = function - | Configuration.SP_ref_callee -> p_jstring oc "SP_ref_callee" - | Configuration.SP_ref_caller -> p_jstring oc "SP_ref_caller" - | Configuration.SP_split_args -> p_jstring oc "SP_split_args" - -let print_struct_return_style oc = function - | Configuration.SR_int1248 -> p_jstring oc "SR_int1248" - | Configuration.SR_int1to4 -> p_jstring oc "SR_int1to4" - | Configuration.SR_int1to8 -> p_jstring oc "SR_int1to8" - | Configuration.SR_ref -> p_jstring oc "SR_ref" - -let print_configurations oc lib_path = - fprintf oc "{"; - p_jmember oc "arch" p_jstring Configuration.arch; - p_jmember oc "model" p_jstring Configuration.model; - p_jmember oc "abi" p_jstring Configuration.abi; - p_jmember oc "system" p_jstring Configuration.abi; - print_list oc "prepro" Configuration.prepro; - print_list oc "asm" Configuration.asm; - print_list oc "linker" Configuration.linker; - p_jmember oc "asm_supports_cfi" p_jbool Configuration.asm_supports_cfi; - p_jmember oc "stdlib_path" p_jstring lib_path; - p_jmember oc "has_runtime_lib" p_jbool Configuration.has_runtime_lib; - p_jmember oc "has_standard_headers" p_jbool Configuration.has_standard_headers; - p_jmember oc "struct_passing_style" print_struct_passing_style Configuration.struct_passing_style; - p_jmember oc "struct_return_style" print_struct_return_style Configuration.struct_return_style; - fprintf oc "\n}" - -let print_machine oc = - fprintf oc "{"; - p_jmember oc "name" p_jstring !config.name; - p_jmember oc "char_signed" p_jbool !config.char_signed; - p_jmember oc "sizeof_ptr" p_jint !config.sizeof_ptr; - p_jmember oc "sizeof_short" p_jint !config.sizeof_short; - p_jmember oc "sizeof_int" p_jint !config.sizeof_int; - p_jmember oc "sizeof_long" p_jint !config.sizeof_long; - p_jmember oc "sizeof_longlong" p_jint !config.sizeof_longlong; - p_jmember oc "sizeof_float" p_jint !config.sizeof_float; - p_jmember oc "sizeof_double" p_jint !config.sizeof_double; - p_jmember oc "sizeof_longdouble" p_jint !config.sizeof_longdouble; - p_jmember oc "sizeof_void" (p_jopt p_jint) !config.sizeof_void; - p_jmember oc "sizeof_fun" (p_jopt p_jint) !config.sizeof_fun; - p_jmember oc "sizeof_wchar" p_jint !config.sizeof_wchar; - p_jmember oc "wchar_signed" p_jbool !config.wchar_signed; - p_jmember oc "sizeof_size_t" p_jint !config.sizeof_size_t; - p_jmember oc "sizeof_ptrdiff_t" p_jint !config.sizeof_ptrdiff_t; - p_jmember oc "alignof_ptr" p_jint !config.alignof_ptr; - p_jmember oc "alignof_short" p_jint !config.alignof_short; - p_jmember oc "alignof_int" p_jint !config.alignof_int; - p_jmember oc "alignof_long" p_jint !config.alignof_long; - p_jmember oc "alignof_longlong" p_jint !config.alignof_longlong; - p_jmember oc "alignof_float" p_jint !config.alignof_float; - p_jmember oc "alignof_double" p_jint !config.alignof_double; - p_jmember oc "alignof_longdouble" p_jint !config.alignof_longdouble; - p_jmember oc "alignof_void" (p_jopt p_jint) !config.alignof_void; - p_jmember oc "alignof_fun" (p_jopt p_jint) !config.alignof_fun; - p_jmember oc "bigendian" p_jbool !config.bigendian; - p_jmember oc "bitfields_msb_first" p_jbool !config.bitfields_msb_first; - p_jmember oc "supports_unaligned_accesses" p_jbool !config.supports_unaligned_accesses; - fprintf oc "\n}" - -let print file stdlib = - let oc = open_out file in - fprintf oc "{"; - p_jmember oc "Version" p_jstring Version.version; - p_jmember oc "Buildnr" p_jstring Version.buildnr; - p_jmember oc "Tag" p_jstring Version.tag; - p_jmember oc "Cwd" p_jstring (Sys.getcwd ()); - fprintf oc "%a:%t" p_jstring "Clflags" print_clflags; - p_jmember oc "Configurations" print_configurations stdlib; - fprintf oc "%a:%t" p_jstring "Machine" print_machine; - fprintf oc "}"; - close_out oc diff --git a/flocq/Appli/Fappli_IEEE.v b/flocq/Appli/Fappli_IEEE.v index 23999a50..6400304b 100644 --- a/flocq/Appli/Fappli_IEEE.v +++ b/flocq/Appli/Fappli_IEEE.v @@ -415,8 +415,7 @@ Theorem is_finite_Bopp : forall opp_nan x, is_finite (Bopp opp_nan x) = is_finite x. Proof. -intros opp_nan [| | |] ; try easy. -intros s pl. +intros opp_nan [| |s pl|] ; try easy. simpl. now case opp_nan. Qed. @@ -445,8 +444,7 @@ Theorem is_finite_Babs : forall abs_nan x, is_finite (Babs abs_nan x) = is_finite x. Proof. - intros abs_nan [| | |] ; try easy. - intros s pl. + intros abs_nan [| |s pl|] ; try easy. simpl. now case abs_nan. Qed. diff --git a/flocq/Calc/Fcalc_round.v b/flocq/Calc/Fcalc_round.v index 19652d08..86422247 100644 --- a/flocq/Calc/Fcalc_round.v +++ b/flocq/Calc/Fcalc_round.v @@ -646,8 +646,9 @@ case Zlt_bool_spec ; intros Hk. (* *) unfold truncate_aux. rewrite Fx at 1. -unshelve refine (let H := _ in conj _ H). +assert (H: (e + k)%Z = canonic_exp beta fexp x). unfold k. ring. +refine (conj _ H). rewrite <- H. apply F2R_eq_compat. replace (scaled_mantissa beta fexp x) with (Z2R (Zfloor (scaled_mantissa beta fexp x))). diff --git a/flocq/Core/Fcore_Raux.v b/flocq/Core/Fcore_Raux.v index d728e0ba..939002cf 100644 --- a/flocq/Core/Fcore_Raux.v +++ b/flocq/Core/Fcore_Raux.v @@ -1673,7 +1673,7 @@ Qed. (** Another well-used function for having the logarithm of a real number x to the base #β# *) Record ln_beta_prop x := { ln_beta_val :> Z ; - _ : (x <> 0)%R -> (bpow (ln_beta_val - 1)%Z <= Rabs x < bpow ln_beta_val)%R + _ : (x <> 0)%R -> (bpow (ln_beta_val - 1)%Z <= Rabs x < bpow ln_beta_val)%R }. Definition ln_beta : diff --git a/flocq/Core/Fcore_digits.v b/flocq/Core/Fcore_digits.v index d40c1a09..53743035 100644 --- a/flocq/Core/Fcore_digits.v +++ b/flocq/Core/Fcore_digits.v @@ -853,7 +853,7 @@ Proof. intros n Zn. rewrite <- (Zdigits_abs n). assert (Hn: (0 < Zabs n)%Z). -destruct n ; try easy. +destruct n ; [|easy|easy]. now elim Zn. destruct (Zabs n) as [|p|p] ; try easy ; clear. simpl. diff --git a/flocq/Core/Fcore_generic_fmt.v b/flocq/Core/Fcore_generic_fmt.v index bac65b9d..21e51890 100644 --- a/flocq/Core/Fcore_generic_fmt.v +++ b/flocq/Core/Fcore_generic_fmt.v @@ -136,9 +136,9 @@ Proof. intros e He. apply generic_format_bpow. destruct (Zle_lt_or_eq _ _ He). -now apply valid_exp. +now apply valid_exp_. rewrite <- H. -apply valid_exp_. +apply valid_exp. rewrite H. apply Zle_refl. Qed. @@ -604,107 +604,6 @@ Qed. Definition round x := F2R (Float beta (rnd (scaled_mantissa x)) (canonic_exp x)). -Theorem round_le_pos : - forall x y, (0 < x)%R -> (x <= y)%R -> (round x <= round y)%R. -Proof. -intros x y Hx Hxy. -unfold round, scaled_mantissa, canonic_exp. -destruct (ln_beta beta x) as (ex, Hex). simpl. -destruct (ln_beta beta y) as (ey, Hey). simpl. -specialize (Hex (Rgt_not_eq _ _ Hx)). -specialize (Hey (Rgt_not_eq _ _ (Rlt_le_trans _ _ _ Hx Hxy))). -rewrite Rabs_pos_eq in Hex. -2: now apply Rlt_le. -rewrite Rabs_pos_eq in Hey. -2: apply Rle_trans with (2:=Hxy); now apply Rlt_le. -assert (He: (ex <= ey)%Z). -cut (ex - 1 < ey)%Z. omega. -apply (lt_bpow beta). -apply Rle_lt_trans with (1 := proj1 Hex). -apply Rle_lt_trans with (1 := Hxy). -apply Hey. -destruct (Zle_or_lt ey (fexp ey)) as [Hy1|Hy1]. -rewrite (proj2 (proj2 (valid_exp ey) Hy1) ex). -apply F2R_le_compat. -apply Zrnd_le. -apply Rmult_le_compat_r. -apply bpow_ge_0. -exact Hxy. -now apply Zle_trans with ey. -destruct (Zle_lt_or_eq _ _ He) as [He'|He']. -destruct (Zle_or_lt ey (fexp ex)) as [Hx2|Hx2]. -rewrite (proj2 (proj2 (valid_exp ex) (Zle_trans _ _ _ He Hx2)) ey Hx2). -apply F2R_le_compat. -apply Zrnd_le. -apply Rmult_le_compat_r. -apply bpow_ge_0. -exact Hxy. -apply Rle_trans with (F2R (Float beta (rnd (bpow (ey - 1) * bpow (- fexp ey))) (fexp ey))). -rewrite <- bpow_plus. -rewrite <- (Z2R_Zpower beta (ey - 1 + -fexp ey)). 2: omega. -rewrite Zrnd_Z2R. -destruct (Zle_or_lt ex (fexp ex)) as [Hx1|Hx1]. -apply Rle_trans with (F2R (Float beta 1 (fexp ex))). -apply F2R_le_compat. -rewrite <- (Zrnd_Z2R 1). -apply Zrnd_le. -apply Rlt_le. -exact (proj2 (mantissa_small_pos _ _ Hex Hx1)). -unfold F2R. simpl. -rewrite Z2R_Zpower. 2: omega. -rewrite <- bpow_plus, Rmult_1_l. -apply bpow_le. -omega. -apply Rle_trans with (F2R (Float beta (rnd (bpow ex * bpow (- fexp ex))) (fexp ex))). -apply F2R_le_compat. -apply Zrnd_le. -apply Rmult_le_compat_r. -apply bpow_ge_0. -apply Rlt_le. -apply Hex. -rewrite <- bpow_plus. -rewrite <- Z2R_Zpower. 2: omega. -rewrite Zrnd_Z2R. -unfold F2R. simpl. -rewrite 2!Z2R_Zpower ; try omega. -rewrite <- 2!bpow_plus. -apply bpow_le. -omega. -apply F2R_le_compat. -apply Zrnd_le. -apply Rmult_le_compat_r. -apply bpow_ge_0. -apply Hey. -rewrite He'. -apply F2R_le_compat. -apply Zrnd_le. -apply Rmult_le_compat_r. -apply bpow_ge_0. -exact Hxy. -Qed. - -Theorem round_generic : - forall x, - generic_format x -> - round x = x. -Proof. -intros x Hx. -unfold round. -rewrite scaled_mantissa_generic with (1 := Hx). -rewrite Zrnd_Z2R. -now apply sym_eq. -Qed. - -Theorem round_0 : - round 0 = R0. -Proof. -unfold round, scaled_mantissa. -rewrite Rmult_0_l. -fold (Z2R 0). -rewrite Zrnd_Z2R. -apply F2R_0. -Qed. - Theorem round_bounded_large_pos : forall x ex, (fexp ex < ex)%Z -> @@ -792,6 +691,74 @@ refine (let H := _ in conj (proj1 H) (Rlt_le _ _ (proj2 H))). now apply mantissa_small_pos. Qed. +Theorem round_le_pos : + forall x y, (0 < x)%R -> (x <= y)%R -> (round x <= round y)%R. +Proof. +intros x y Hx Hxy. +destruct (ln_beta beta x) as [ex Hex]. +destruct (ln_beta beta y) as [ey Hey]. +specialize (Hex (Rgt_not_eq _ _ Hx)). +specialize (Hey (Rgt_not_eq _ _ (Rlt_le_trans _ _ _ Hx Hxy))). +rewrite Rabs_pos_eq in Hex. +2: now apply Rlt_le. +rewrite Rabs_pos_eq in Hey. +2: apply Rle_trans with (2:=Hxy); now apply Rlt_le. +assert (He: (ex <= ey)%Z). + apply bpow_lt_bpow with beta. + apply Rle_lt_trans with (1 := proj1 Hex). + now apply Rle_lt_trans with y. +assert (Heq: fexp ex = fexp ey -> (round x <= round y)%R). + intros H. + unfold round, scaled_mantissa, canonic_exp. + rewrite ln_beta_unique_pos with (1 := Hex). + rewrite ln_beta_unique_pos with (1 := Hey). + rewrite H. + apply F2R_le_compat. + apply Zrnd_le. + apply Rmult_le_compat_r with (2 := Hxy). + apply bpow_ge_0. +destruct (Zle_or_lt ey (fexp ey)) as [Hy1|Hy1]. + apply Heq. + apply valid_exp with (1 := Hy1). + now apply Zle_trans with ey. +destruct (Zle_lt_or_eq _ _ He) as [He'|He']. +2: now apply Heq, f_equal. +apply Rle_trans with (bpow (ey - 1)). +2: now apply round_bounded_large_pos. +destruct (Zle_or_lt ex (fexp ex)) as [Hx1|Hx1]. + destruct (round_bounded_small_pos _ _ Hx1 Hex) as [-> | ->]. + apply bpow_ge_0. + apply bpow_le. + apply valid_exp, proj2 in Hx1. + specialize (Hx1 ey). + omega. +apply Rle_trans with (bpow ex). +now apply round_bounded_large_pos. +apply bpow_le. +now apply Z.lt_le_pred. +Qed. + +Theorem round_generic : + forall x, + generic_format x -> + round x = x. +Proof. +intros x Hx. +unfold round. +rewrite scaled_mantissa_generic with (1 := Hx). +rewrite Zrnd_Z2R. +now apply sym_eq. +Qed. + +Theorem round_0 : + round 0 = R0. +Proof. +unfold round, scaled_mantissa. +rewrite Rmult_0_l. +fold (Z2R 0). +rewrite Zrnd_Z2R. +apply F2R_0. +Qed. Theorem exp_small_round_0_pos : forall x ex, @@ -807,9 +774,6 @@ apply bpow_gt_0. apply (round_bounded_large_pos); assumption. Qed. - - - Theorem generic_format_round_pos : forall x, (0 < x)%R -> @@ -832,14 +796,11 @@ destruct (Rle_or_lt (bpow ex) (round x)) as [Hr|Hr]. rewrite <- (Rle_antisym _ _ Hr Hr2). apply generic_format_bpow. now apply valid_exp. -assert (Hr' := conj Hr1 Hr). -unfold generic_format, scaled_mantissa. -rewrite (canonic_exp_fexp_pos _ _ Hr'). -unfold round, scaled_mantissa. +apply generic_format_F2R. +intros _. +rewrite (canonic_exp_fexp_pos (F2R _) _ (conj Hr1 Hr)). rewrite (canonic_exp_fexp_pos _ _ Hex). -unfold F2R at 3. simpl. -rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_r, Rmult_1_r. -now rewrite Ztrunc_Z2R. +now apply Zeq_le. Qed. End Fcore_generic_round_pos. diff --git a/flocq/Core/Fcore_rnd.v b/flocq/Core/Fcore_rnd.v index 171c27fc..e5091684 100644 --- a/flocq/Core/Fcore_rnd.v +++ b/flocq/Core/Fcore_rnd.v @@ -275,15 +275,13 @@ Theorem Only_DN_or_UP : F f -> (fd <= f <= fu)%R -> f = fd \/ f = fu. Proof. -intros F x fd fu f Hd Hu Hf ([Hdf|Hdf], Hfu). -2 : now left. -destruct Hfu. -2 : now right. -destruct (Rle_or_lt x f). -elim Rlt_not_le with (1 := H). +intros F x fd fu f Hd Hu Hf [Hdf Hfu]. +destruct (Rle_or_lt x f) ; [right|left]. +apply Rle_antisym with (1 := Hfu). now apply Hu. -elim Rlt_not_le with (1 := Hdf). -apply Hd ; auto with real. +apply Rlt_le in H. +apply Rle_antisym with (2 := Hdf). +now apply Hd. Qed. Theorem Rnd_ZR_abs : diff --git a/flocq/Core/Fcore_ulp.v b/flocq/Core/Fcore_ulp.v index 1c27de31..28d2bc35 100644 --- a/flocq/Core/Fcore_ulp.v +++ b/flocq/Core/Fcore_ulp.v @@ -35,6 +35,7 @@ Variable fexp : Z -> Z. (** Definition and basic properties about the minimal exponent, when it exists *) Lemma Z_le_dec_aux: forall x y : Z, (x <= y)%Z \/ ~ (x <= y)%Z. +Proof. intros. destruct (Z_le_dec x y). now left. @@ -158,8 +159,7 @@ rewrite ulp_neq_0. unfold F2R; simpl. apply Rmult_le_compat_r. apply bpow_ge_0. -replace 1%R with (Z2R (Zsucc 0)) by reflexivity. -apply Z2R_le. +apply (Z2R_le (Zsucc 0)). apply Zlt_le_succ. apply F2R_gt_0_reg with beta (canonic_exp beta fexp x). now rewrite <- Fx. @@ -206,6 +206,7 @@ Qed. Theorem ulp_bpow : forall e, ulp (bpow e) = bpow (fexp (e + 1)). +Proof. intros e. rewrite ulp_neq_0. apply f_equal. diff --git a/flocq/Flocq_version.v b/flocq/Flocq_version.v index c391f590..b01a08f9 100644 --- a/flocq/Flocq_version.v +++ b/flocq/Flocq_version.v @@ -29,4 +29,4 @@ Definition Flocq_version := Eval vm_compute in parse t major (minor * 10 + N_of_ascii h - N_of_ascii "0"%char)%N | Empty_string => (major * 100 + minor)%N end in - parse "2.5.0"%string N0 N0. + parse "2.5.2"%string N0 N0. diff --git a/lib/Axioms.v b/lib/Axioms.v index 6ae8669a..fdc89920 100644 --- a/lib/Axioms.v +++ b/lib/Axioms.v @@ -39,15 +39,13 @@ Proof @FunctionalExtensionality.functional_extensionality. is an alias for [functional_extensionality]. *) Lemma extensionality: - forall (A B: Type) (f g : A -> B), (forall x, f x = g x) -> f = g. + forall {A B: Type} (f g : A -> B), (forall x, f x = g x) -> f = g. Proof @functional_extensionality. -Implicit Arguments extensionality. - (** * Proof irrelevance *) (** We also use proof irrelevance. *) Axiom proof_irr: ClassicalFacts.proof_irrelevance. -Implicit Arguments proof_irr. +Arguments proof_irr [A]. diff --git a/lib/Lattice.v b/lib/Lattice.v index 4455e22f..6eebca99 100644 --- a/lib/Lattice.v +++ b/lib/Lattice.v @@ -56,7 +56,7 @@ End SEMILATTICE. Module Type SEMILATTICE_WITH_TOP. - Include Type SEMILATTICE. + Include SEMILATTICE. Parameter top: t. Axiom ge_top: forall x, ge top x. @@ -190,8 +190,8 @@ Module PTree <: TREE. | Leaf : tree A | Node : tree A -> option A -> tree A -> tree A. - Implicit Arguments Leaf [A]. - Implicit Arguments Node [A]. + Arguments Leaf [A]. + Arguments Node [A]. Scheme tree_ind := Induction for tree Sort Prop. Definition t := tree. diff --git a/powerpc/Asm.v b/powerpc/Asm.v index 3c269083..cc554eb1 100644 --- a/powerpc/Asm.v +++ b/powerpc/Asm.v @@ -87,8 +87,8 @@ Module Pregmap := EMap(PregEq). (** Conventional names for stack pointer ([SP]) and return address ([RA]) *) -Notation "'SP'" := GPR1 (only parsing). -Notation "'RA'" := LR (only parsing). +Notation "'SP'" := GPR1 (only parsing) : asm. +Notation "'RA'" := LR (only parsing) : asm. (** Symbolic constants. Immediate operands to an arithmetic instruction or an indexed memory access can be either integer literals, @@ -385,8 +385,10 @@ Definition program := AST.program fundef unit. Definition regset := Pregmap.t val. Definition genv := Genv.t fundef unit. -Notation "a # b" := (a b) (at level 1, only parsing). -Notation "a # b <- c" := (Pregmap.set b c a) (at level 1, b at next level). +Notation "a # b" := (a b) (at level 1, only parsing) : asm. +Notation "a # b <- c" := (Pregmap.set b c a) (at level 1, b at next level) : asm. + +Open Scope asm. (** Undefining some registers *) diff --git a/powerpc/Asmgen.v b/powerpc/Asmgen.v index 799d208e..fc04b15d 100644 --- a/powerpc/Asmgen.v +++ b/powerpc/Asmgen.v @@ -22,8 +22,8 @@ Require Import Locations. Require Import Mach. Require Import Asm. -Open Local Scope string_scope. -Open Local Scope error_monad_scope. +Local Open Scope string_scope. +Local Open Scope error_monad_scope. (** The code generation functions take advantage of several characteristics of the [Mach] code generated by earlier passes of the diff --git a/powerpc/Asmgenproof.v b/powerpc/Asmgenproof.v index 447a53a0..6f0390b9 100644 --- a/powerpc/Asmgenproof.v +++ b/powerpc/Asmgenproof.v @@ -876,7 +876,7 @@ Local Transparent destroyed_by_jumptable. - (* internal function *) exploit functions_translated; eauto. intros [tf [A B]]. monadInv B. generalize EQ; intros EQ'. monadInv EQ'. - destruct (zlt Ptrofs.max_unsigned (list_length_z x0.(fn_code))); inversion EQ1. clear EQ1. + destruct (zlt Ptrofs.max_unsigned (list_length_z x0.(fn_code))); inversion EQ1. clear EQ1. subst x0. unfold store_stack in *. exploit Mem.alloc_extends. eauto. eauto. apply Zle_refl. apply Zle_refl. intros [m1' [C D]]. @@ -887,15 +887,23 @@ Local Transparent destroyed_by_jumptable. intros [m3' [P Q]]. (* Execution of function prologue *) monadInv EQ0. rewrite transl_code'_transl_code in EQ1. + set (tfbody := Pallocframe (fn_stacksize f) (fn_link_ofs f) + (fn_retaddr_ofs f) + :: Pmflr GPR0 + :: Pstw GPR0 (Cint (Ptrofs.to_int (fn_retaddr_ofs f))) + GPR1 + :: Pcfi_rel_offset + (Ptrofs.to_int (fn_retaddr_ofs f)) :: x0) in *. + set (tf := {| fn_sig := Mach.fn_sig f; fn_code := tfbody |}) in *. set (rs2 := nextinstr (rs0#GPR1 <- sp #GPR0 <- Vundef)). set (rs3 := nextinstr (rs2#GPR0 <- (rs0#LR))). set (rs4 := nextinstr rs3). set (rs5 := nextinstr rs4). assert (EXEC_PROLOGUE: - exec_straight tge x - x.(fn_code) rs0 m' - x1 rs5 m3'). - rewrite <- H5 at 2. simpl. + exec_straight tge tf + tf.(fn_code) rs0 m' + x0 rs5 m3'). + change (fn_code tf) with tfbody; unfold tfbody. apply exec_straight_step with rs2 m2'. unfold exec_instr. rewrite C. fold sp. rewrite <- (sp_val _ _ _ AG). rewrite F. auto. auto. @@ -911,7 +919,6 @@ Local Transparent destroyed_by_jumptable. econstructor; eauto. change (rs5 PC) with (Val.offset_ptr (Val.offset_ptr (Val.offset_ptr (Val.offset_ptr (rs0 PC) Ptrofs.one) Ptrofs.one) Ptrofs.one) Ptrofs.one). rewrite ATPC. simpl. constructor; eauto. - subst x; simpl in g. unfold fn_code. eapply code_tail_next_int. omega. eapply code_tail_next_int. omega. eapply code_tail_next_int. omega. diff --git a/powerpc/SelectOp.vp b/powerpc/SelectOp.vp index 79f05295..b5e3ed7e 100644 --- a/powerpc/SelectOp.vp +++ b/powerpc/SelectOp.vp @@ -44,7 +44,7 @@ Require Import Floats. Require Import Op. Require Import CminorSel. -Open Local Scope cminorsel_scope. +Local Open Scope cminorsel_scope. (** ** Constants **) diff --git a/powerpc/SelectOpproof.v b/powerpc/SelectOpproof.v index e31e847a..548fbce2 100644 --- a/powerpc/SelectOpproof.v +++ b/powerpc/SelectOpproof.v @@ -26,7 +26,7 @@ Require Import Op. Require Import CminorSel. Require Import SelectOp. -Open Local Scope cminorsel_scope. +Local Open Scope cminorsel_scope. Local Transparent Archi.ptr64. (** * Useful lemmas and tactics *) diff --git a/test/c/Makefile b/test/c/Makefile index c0794ff3..5979dfd4 100644 --- a/test/c/Makefile +++ b/test/c/Makefile @@ -56,17 +56,6 @@ bench: echo -n "$$i: "; $(TIME) ./$$i.compcert; \ done -cminor_roundtrip: - @for i in $(PROGS); do \ - $(CCOMP) -dcminor -S $$i.c; \ - cp $$i.cm $$i.1.cm; \ - $(CCOMP) -dcminor -S $$i.cm; \ - if cmp -s $$i.1.cm $$i.cm; \ - then echo "$$i: round trip passed"; rm -f $$i.1.cm $$i.cm; \ - else echo "$$i: round trip FAILED"; diff -u $$i.1.cm $$i.cm; \ - fi; \ - done - clean: rm -f *.compcert *.gcc rm -f *.compcert.c *.light.c *.parsed.c *.s *.o *.sdump *~ diff --git a/test/cminor/Makefile b/test/cminor/Makefile deleted file mode 100644 index a66bcc6d..00000000 --- a/test/cminor/Makefile +++ /dev/null @@ -1,107 +0,0 @@ -include ../../Makefile.config - -CCOMP=../../ccomp -FLAGS=-S -CPP=cpp -P -AS=$(CASM) -CFLAGS=-g -ASFLAGS= - -PROGS=fib integr qsort fft sha1 aes almabench manyargs lists \ - stopcopy marksweep switchtbl conversions - -all_s: $(PROGS:%=%.s) - -all: $(PROGS) - -$(PROGS:%=%.s): $(CCOMP) - -fib: fib.o mainfib.o - $(CC) $(CFLAGS) -o fib fib.o mainfib.o -clean:: - rm -f fib - -integr: integr.o mainintegr.o - $(CC) $(CFLAGS) -o integr integr.o mainintegr.o -clean:: - rm -f integr - -qsort: qsort.o mainqsort.o - $(CC) $(CFLAGS) -o qsort qsort.o mainqsort.o -clean:: - rm -f qsort - -fft: fft.o mainfft.o - $(CC) $(CFLAGS) -o fft fft.o mainfft.o -lm -clean:: - rm -f fft - -sha1: sha1.o mainsha1.o - $(CC) $(CFLAGS) -o sha1 sha1.o mainsha1.o -clean:: - rm -f sha1 sha1.cm - -aes: aes.o mainaes.o - $(CC) $(CFLAGS) -o aes aes.o mainaes.o -clean:: - rm -f aes aes.cm - -almabench: almabench.o mainalmabench.o - $(CC) $(CFLAGS) -o almabench almabench.o mainalmabench.o -lm -clean:: - rm -f almabench almabench.cm - -manyargs: manyargs.o mainmanyargs.o - $(CC) $(CFLAGS) -o manyargs manyargs.o mainmanyargs.o -clean:: - rm -f manyargs - -lists: lists.o mainlists.o - $(CC) $(CFLAGS) -o lists lists.o mainlists.o -L../../runtime -lcompcert -clean:: - rm -f lists - -stopcopy: stopcopy.o maingc.o - $(CC) $(CFLAGS) -o stopcopy stopcopy.o maingc.o $(LIBMATH) -clean:: - rm -f stopcopy - -marksweep: marksweep.o maingc.o marksweepcheck.o - $(CC) $(CFLAGS) -o marksweep marksweep.o maingc.o marksweepcheck.o $(LIBMATH) -clean:: - rm -f marksweep - -switchtbl: switchtbl.o mainswitchtbl.o - $(CC) $(CFLAGS) -o switchtbl switchtbl.o mainswitchtbl.o -clean:: - rm -f switchtbl - -conversions: conversions.o mainconversions.o - $(CC) $(CFLAGS) -o conversions conversions.o mainconversions.o -clean:: - rm -f conversions - -.SUFFIXES: - -.SUFFIXES: .cmp .cm .s .o .c .S - -.cmp.s: - $(CPP) $*.cmp > $*.cm - $(CCOMP) $(FLAGS) $*.cm - -.cm.s: - $(CCOMP) $(FLAGS) $*.cm - -.c.o: - $(CC) $(CFLAGS) -c $< - -.s.o: - $(AS) $(ASFLAGS) -o $*.o $< - -.S.o: - $(AS) $(ASFLAGS) -o $*.o $< - -.SECONDARY: $(PROGS:%=%.s) - -clean:: - rm -f *.s *.o *~ diff --git a/test/cminor/aes.cmp b/test/cminor/aes.cmp deleted file mode 100644 index 050c4966..00000000 --- a/test/cminor/aes.cmp +++ /dev/null @@ -1,381 +0,0 @@ -/* AES cipher. To be preprocessed with cpp -P. */ - -#if defined(__ppc__) || defined(__PPC__) || defined(__ARMEB__) -#define ARCH_BIG_ENDIAN -#elif defined(__i386__) || defined(__x86_64__) || defined(__ARMEL__) -#undef ARCH_BIG_ENDIAN -#else -#error "unknown endianness" -#endif - -#ifdef ARCH_BIG_ENDIAN -#define GETU32(pt) int32[pt] -#define PUTU32(ct,st) int32[ct] = st -#else -#error "this test is not available yet in little-endian" -#endif - -#define rk(n) int32[rk_ + (n) * 4] -#define Te0(n) int32["Te0" + (n) * 4] -#define Te1(n) int32["Te1" + (n) * 4] -#define Te2(n) int32["Te2" + (n) * 4] -#define Te3(n) int32["Te3" + (n) * 4] -#define Te4(n) int32["Te4" + (n) * 4] -#define Td0(n) int32["Td0" + (n) * 4] -#define Td1(n) int32["Td1" + (n) * 4] -#define Td2(n) int32["Td2" + (n) * 4] -#define Td3(n) int32["Td3" + (n) * 4] -#define Td4(n) int32["Td4" + (n) * 4] -#define rcon(n) int32["rcon" + (n) * 4] - -/** - * Expand the cipher key into the encryption key schedule. - * - * @return the number of rounds for the given cipher key size. - */ -"rijndaelKeySetupEnc"(rk_, cipherKey, keyBits) : int -> int -> int -> int -{ - var i, temp; - i = 0; - - rk(0) = GETU32(cipherKey ); - rk(1) = GETU32(cipherKey + 4); - rk(2) = GETU32(cipherKey + 8); - rk(3) = GETU32(cipherKey + 12); - if (keyBits == 128) { - {{ loop { - temp = rk(3); - rk(4) = rk(0) ^ - (Te4((temp >>u 16) & 0xff) & 0xff000000) ^ - (Te4((temp >>u 8) & 0xff) & 0x00ff0000) ^ - (Te4((temp ) & 0xff) & 0x0000ff00) ^ - (Te4((temp >>u 24) ) & 0x000000ff) ^ - rcon(i); - rk(5) = rk(1) ^ rk(4); - rk(6) = rk(2) ^ rk(5); - rk(7) = rk(3) ^ rk(6); - i = i + 1; - if (i == 10) { - return 10; - } - rk_ = rk_ + 4 * 4; - } }} - } - rk(4) = GETU32(cipherKey + 16); - rk(5) = GETU32(cipherKey + 20); - if (keyBits == 192) { - {{ loop { - temp = rk( 5); - rk( 6) = rk( 0) ^ - (Te4((temp >>u 16) & 0xff) & 0xff000000) ^ - (Te4((temp >>u 8) & 0xff) & 0x00ff0000) ^ - (Te4((temp ) & 0xff) & 0x0000ff00) ^ - (Te4((temp >>u 24) ) & 0x000000ff) ^ - rcon(i); - rk( 7) = rk( 1) ^ rk( 6); - rk( 8) = rk( 2) ^ rk( 7); - rk( 9) = rk( 3) ^ rk( 8); - i = i + 1; - if (i == 8) { - return 12; - } - rk(10) = rk( 4) ^ rk( 9); - rk(11) = rk( 5) ^ rk(10); - rk_ = rk_ + 6 * 4; - } }} - } - rk(6) = GETU32(cipherKey + 24); - rk(7) = GETU32(cipherKey + 28); - if (keyBits == 256) { - {{ loop { - temp = rk( 7); - rk( 8) = rk( 0) ^ - (Te4((temp >>u 16) & 0xff) & 0xff000000) ^ - (Te4((temp >>u 8) & 0xff) & 0x00ff0000) ^ - (Te4((temp ) & 0xff) & 0x0000ff00) ^ - (Te4((temp >>u 24) ) & 0x000000ff) ^ - rcon(i); - rk( 9) = rk( 1) ^ rk( 8); - rk(10) = rk( 2) ^ rk( 9); - rk(11) = rk( 3) ^ rk(10); - i = i + 1; - if (i == 7) { - return 14; - } - temp = rk(11); - rk(12) = rk( 4) ^ - (Te4((temp >>u 24) ) & 0xff000000) ^ - (Te4((temp >>u 16) & 0xff) & 0x00ff0000) ^ - (Te4((temp >>u 8) & 0xff) & 0x0000ff00) ^ - (Te4((temp ) & 0xff) & 0x000000ff); - rk(13) = rk( 5) ^ rk(12); - rk(14) = rk( 6) ^ rk(13); - rk(15) = rk( 7) ^ rk(14); - - rk_ = rk_ + 8 * 4; - } }} - } - return 0; -} - -/** - * Expand the cipher key into the decryption key schedule. - * - * @return the number of rounds for the given cipher key size. - */ -"rijndaelKeySetupDec"(rk_, cipherKey, keyBits) : int -> int -> int -> int -{ - var Nr, i, j, temp; - - /* expand the cipher key: */ - Nr = "rijndaelKeySetupEnc"(rk_, cipherKey, keyBits) : int -> int -> int -> int; - /* invert the order of the round keys: */ - i = 0; j = 4 * Nr; - {{ loop { - if (! (i < j)) exit; - temp = rk(i ); rk(i ) = rk(j ); rk(j ) = temp; - temp = rk(i + 1); rk(i + 1) = rk(j + 1); rk(j + 1) = temp; - temp = rk(i + 2); rk(i + 2) = rk(j + 2); rk(j + 2) = temp; - temp = rk(i + 3); rk(i + 3) = rk(j + 3); rk(j + 3) = temp; - i = i + 4; - j = j - 4; - } }} - /* apply the inverse MixColumn transform to all round keys but the first and the last: */ - i = 1; - {{ loop { - if (! (i < Nr)) exit; - rk_ = rk_ + 4 * 4; - rk(0) = - Td0(Te4((rk(0) >>u 24) ) & 0xff) ^ - Td1(Te4((rk(0) >>u 16) & 0xff) & 0xff) ^ - Td2(Te4((rk(0) >>u 8) & 0xff) & 0xff) ^ - Td3(Te4((rk(0) ) & 0xff) & 0xff); - rk(1) = - Td0(Te4((rk(1) >>u 24) ) & 0xff) ^ - Td1(Te4((rk(1) >>u 16) & 0xff) & 0xff) ^ - Td2(Te4((rk(1) >>u 8) & 0xff) & 0xff) ^ - Td3(Te4((rk(1) ) & 0xff) & 0xff); - rk(2) = - Td0(Te4((rk(2) >>u 24) ) & 0xff) ^ - Td1(Te4((rk(2) >>u 16) & 0xff) & 0xff) ^ - Td2(Te4((rk(2) >>u 8) & 0xff) & 0xff) ^ - Td3(Te4((rk(2) ) & 0xff) & 0xff); - rk(3) = - Td0(Te4((rk(3) >>u 24) ) & 0xff) ^ - Td1(Te4((rk(3) >>u 16) & 0xff) & 0xff) ^ - Td2(Te4((rk(3) >>u 8) & 0xff) & 0xff) ^ - Td3(Te4((rk(3) ) & 0xff) & 0xff); - i = i + 1; - } }} - return Nr; -} - -"rijndaelEncrypt"(rk_, Nr, pt, ct): int -> int -> int -> int -> void -{ - var s0, s1, s2, s3, t0, t1, t2, t3, r; - - /* - * map byte array block to cipher state - * and add initial round key: - */ - s0 = GETU32(pt ) ^ rk(0); - s1 = GETU32(pt + 4) ^ rk(1); - s2 = GETU32(pt + 8) ^ rk(2); - s3 = GETU32(pt + 12) ^ rk(3); - /* - * Nr - 1 full rounds: - */ - r = Nr >>u 1; - {{ loop { - t0 = - Te0((s0 >>u 24) ) ^ - Te1((s1 >>u 16) & 0xff) ^ - Te2((s2 >>u 8) & 0xff) ^ - Te3((s3 ) & 0xff) ^ - rk(4); - t1 = - Te0((s1 >>u 24) ) ^ - Te1((s2 >>u 16) & 0xff) ^ - Te2((s3 >>u 8) & 0xff) ^ - Te3((s0 ) & 0xff) ^ - rk(5); - t2 = - Te0((s2 >>u 24) ) ^ - Te1((s3 >>u 16) & 0xff) ^ - Te2((s0 >>u 8) & 0xff) ^ - Te3((s1 ) & 0xff) ^ - rk(6); - t3 = - Te0((s3 >>u 24) ) ^ - Te1((s0 >>u 16) & 0xff) ^ - Te2((s1 >>u 8) & 0xff) ^ - Te3((s2 ) & 0xff) ^ - rk(7); - - rk_ = rk_ + 8 * 4; - r = r - 1; - if (r == 0) exit; - - s0 = - Te0((t0 >>u 24) ) ^ - Te1((t1 >>u 16) & 0xff) ^ - Te2((t2 >>u 8) & 0xff) ^ - Te3((t3 ) & 0xff) ^ - rk(0); - s1 = - Te0((t1 >>u 24) ) ^ - Te1((t2 >>u 16) & 0xff) ^ - Te2((t3 >>u 8) & 0xff) ^ - Te3((t0 ) & 0xff) ^ - rk(1); - s2 = - Te0((t2 >>u 24) ) ^ - Te1((t3 >>u 16) & 0xff) ^ - Te2((t0 >>u 8) & 0xff) ^ - Te3((t1 ) & 0xff) ^ - rk(2); - s3 = - Te0((t3 >>u 24) ) ^ - Te1((t0 >>u 16) & 0xff) ^ - Te2((t1 >>u 8) & 0xff) ^ - Te3((t2 ) & 0xff) ^ - rk(3); - } }} - /* - * apply last round and - * map cipher state to byte array block: - */ - s0 = - (Te4((t0 >>u 24) ) & 0xff000000) ^ - (Te4((t1 >>u 16) & 0xff) & 0x00ff0000) ^ - (Te4((t2 >>u 8) & 0xff) & 0x0000ff00) ^ - (Te4((t3 ) & 0xff) & 0x000000ff) ^ - rk(0); - PUTU32(ct , s0); - s1 = - (Te4((t1 >>u 24) ) & 0xff000000) ^ - (Te4((t2 >>u 16) & 0xff) & 0x00ff0000) ^ - (Te4((t3 >>u 8) & 0xff) & 0x0000ff00) ^ - (Te4((t0 ) & 0xff) & 0x000000ff) ^ - rk(1); - PUTU32(ct + 4, s1); - s2 = - (Te4((t2 >>u 24) ) & 0xff000000) ^ - (Te4((t3 >>u 16) & 0xff) & 0x00ff0000) ^ - (Te4((t0 >>u 8) & 0xff) & 0x0000ff00) ^ - (Te4((t1 ) & 0xff) & 0x000000ff) ^ - rk(2); - PUTU32(ct + 8, s2); - s3 = - (Te4((t3 >>u 24) ) & 0xff000000) ^ - (Te4((t0 >>u 16) & 0xff) & 0x00ff0000) ^ - (Te4((t1 >>u 8) & 0xff) & 0x0000ff00) ^ - (Te4((t2 ) & 0xff) & 0x000000ff) ^ - rk(3); - PUTU32(ct + 12, s3); -} - -"rijndaelDecrypt"(rk_, Nr, ct, pt) : int -> int -> int -> int -> void -{ - var s0, s1, s2, s3, t0, t1, t2, t3, r; - - /* - * map byte array block to cipher state - * and add initial round key: - */ - s0 = GETU32(ct ) ^ rk(0); - s1 = GETU32(ct + 4) ^ rk(1); - s2 = GETU32(ct + 8) ^ rk(2); - s3 = GETU32(ct + 12) ^ rk(3); - /* - * Nr - 1 full rounds: - */ - r = Nr >>u 1; - {{ loop { - t0 = - Td0((s0 >>u 24) ) ^ - Td1((s3 >>u 16) & 0xff) ^ - Td2((s2 >>u 8) & 0xff) ^ - Td3((s1 ) & 0xff) ^ - rk(4); - t1 = - Td0((s1 >>u 24) ) ^ - Td1((s0 >>u 16) & 0xff) ^ - Td2((s3 >>u 8) & 0xff) ^ - Td3((s2 ) & 0xff) ^ - rk(5); - t2 = - Td0((s2 >>u 24) ) ^ - Td1((s1 >>u 16) & 0xff) ^ - Td2((s0 >>u 8) & 0xff) ^ - Td3((s3 ) & 0xff) ^ - rk(6); - t3 = - Td0((s3 >>u 24) ) ^ - Td1((s2 >>u 16) & 0xff) ^ - Td2((s1 >>u 8) & 0xff) ^ - Td3((s0 ) & 0xff) ^ - rk(7); - - rk_ = rk_ + 8 * 4; - r = r - 1; - if (r == 0) exit; - - s0 = - Td0((t0 >>u 24) ) ^ - Td1((t3 >>u 16) & 0xff) ^ - Td2((t2 >>u 8) & 0xff) ^ - Td3((t1 ) & 0xff) ^ - rk(0); - s1 = - Td0((t1 >>u 24) ) ^ - Td1((t0 >>u 16) & 0xff) ^ - Td2((t3 >>u 8) & 0xff) ^ - Td3((t2 ) & 0xff) ^ - rk(1); - s2 = - Td0((t2 >>u 24) ) ^ - Td1((t1 >>u 16) & 0xff) ^ - Td2((t0 >>u 8) & 0xff) ^ - Td3((t3 ) & 0xff) ^ - rk(2); - s3 = - Td0((t3 >>u 24) ) ^ - Td1((t2 >>u 16) & 0xff) ^ - Td2((t1 >>u 8) & 0xff) ^ - Td3((t0 ) & 0xff) ^ - rk(3); - } }} - /* - * apply last round and - * map cipher state to byte array block: - */ - s0 = - (Td4((t0 >>u 24) ) & 0xff000000) ^ - (Td4((t3 >>u 16) & 0xff) & 0x00ff0000) ^ - (Td4((t2 >>u 8) & 0xff) & 0x0000ff00) ^ - (Td4((t1 ) & 0xff) & 0x000000ff) ^ - rk(0); - PUTU32(pt , s0); - s1 = - (Td4((t1 >>u 24) ) & 0xff000000) ^ - (Td4((t0 >>u 16) & 0xff) & 0x00ff0000) ^ - (Td4((t3 >>u 8) & 0xff) & 0x0000ff00) ^ - (Td4((t2 ) & 0xff) & 0x000000ff) ^ - rk(1); - PUTU32(pt + 4, s1); - s2 = - (Td4((t2 >>u 24) ) & 0xff000000) ^ - (Td4((t1 >>u 16) & 0xff) & 0x00ff0000) ^ - (Td4((t0 >>u 8) & 0xff) & 0x0000ff00) ^ - (Td4((t3 ) & 0xff) & 0x000000ff) ^ - rk(2); - PUTU32(pt + 8, s2); - s3 = - (Td4((t3 >>u 24) ) & 0xff000000) ^ - (Td4((t2 >>u 16) & 0xff) & 0x00ff0000) ^ - (Td4((t1 >>u 8) & 0xff) & 0x0000ff00) ^ - (Td4((t0 ) & 0xff) & 0x000000ff) ^ - rk(3); - PUTU32(pt + 12, s3); -} diff --git a/test/cminor/almabench.cmp b/test/cminor/almabench.cmp deleted file mode 100644 index caedf8b0..00000000 --- a/test/cminor/almabench.cmp +++ /dev/null @@ -1,169 +0,0 @@ -#define PI 3.14159265358979323846 -#define J2000 2451545.0 -#define JCENTURY 36525.0 -#define JMILLENIA 365250.0 -#define TWOPI (2.0 *f PI) -#define A2R (PI /f 648000.0) -#define R2H (12.0 /f PI) -#define R2D (180.0 /f PI) -#define GAUSSK 0.01720209895 -#define TEST_LOOPS 20 -#define TEST_LENGTH 36525 -#define sineps 0.3977771559319137 -#define coseps 0.9174820620691818 - -/* Access to tables */ -#define amas(n) float64["amas" + (n) * 8] -#define a(x,y) float64["a" + ((x) * 24 + (y) * 8)] -#define dlm(x,y) float64["dlm" + ((x) * 24 + (y) * 8)] -#define e(x,y) float64["e" + ((x) * 24 + (y) * 8)] -#define pi(x,y) float64["pi" + ((x) * 24 + (y) * 8)] -#define dinc(x,y) float64["dinc" + ((x) * 24 + (y) * 8)] -#define omega(x,y) float64["omega" + ((x) * 24 + (y) * 8)] -#define kp(x,y) float64["kp" + ((x) * 72 + (y) * 8)] -#define ca(x,y) float64["ca" + ((x) * 72 + (y) * 8)] -#define sa(x,y) float64["sa" + ((x) * 72 + (y) * 8)] -#define kq(x,y) float64["kq" + ((x) * 80 + (y) * 8)] -#define cl(x,y) float64["cl" + ((x) * 80 + (y) * 8)] -#define sl(x,y) float64["sl" + ((x) * 80 + (y) * 8)] - -/* Function calls */ - -extern "cos": float -> float -extern "sin": float -> float -extern "atan2": float -> float -> float -extern "asin": float -> float -extern "sqrt": float -> float -extern "fmod": float -> float -> float - -#define cos(x) ("cos"(x): float -> float) -#define sin(x) ("sin"(x): float -> float) -#define atan2(x,y) ("atan2"(x,y): float -> float -> float) -#define asin(x) ("asin"(x): float -> float) -#define sqrt(x) ("sqrt"(x): float -> float) -#define fmod(x,y) ("fmod"(x,y): float -> float -> float) -#define anpm(x) ("anpm"(x) : float -> float) - -"anpm"(a): float -> float -{ - var w, t; - w = fmod(a,TWOPI); - if (absf(w) >=f PI) { - if (a <f 0.0) { t = -f TWOPI; } else { t = TWOPI; } - w = w -f t; - } - return w; -} - -"planetpv" (epoch_, np, pv_): int -> int -> int -> void -{ -#define epoch(x) float64[epoch_ + (x) * 8] -#define pv(x,y) float64[pv_ + (x) * 24 + (y) * 8] - - var i, j, k; - var t, da, dl, de, dp, di; - var doh, dmu, arga, argl, am; - var ae, dae, ae2, at, r, v; - var si2, xq, xp, tl, xsw; - var xcw, xm2, xf, ci2, xms, xmc; - var xpxq2, x, y, z; - - t = ((epoch(0) -f J2000) +f epoch(1)) /f JMILLENIA; - - da = a(np,0) +f (a(np,1) +f a(np,2) *f t ) *f t; - dl = (3600.0 *f dlm(np,0) +f (dlm(np,1) +f dlm(np,2) *f t ) *f t ) *f A2R; - de = e(np,0) +f (e(np,1) +f e(np,2) *f t ) *f t; - dp = anpm((3600.0 *f pi(np,0) +f (pi(np,1) +f pi(np,2) *f t ) *f t ) *f A2R ); - di = (3600.0 *f dinc(np,0) +f (dinc(np,1) +f dinc(np,2) *f t ) *f t ) *f A2R; - doh = anpm((3600.0 *f omega(np,0) +f (omega(np,1) +f omega(np,2) *f t ) *f t ) *f A2R ); - - dmu = 0.35953620 *f t; - - k = 0; - {{ loop { - if (! (k < 8)) exit; - arga = kp(np,k) *f dmu; - argl = kq(np,k) *f dmu; - da = da +f (ca(np,k) *f cos(arga) +f sa(np,k) *f sin(arga)) *f 0.0000001; - dl = dl +f (cl(np,k) *f cos(argl) +f sl(np,k) *f sin(argl)) *f 0.0000001; - k = k + 1; - } }} - - arga = kp(np,8) *f dmu; - da = da +f t *f (ca(np,8) *f cos(arga) +f sa(np,8) *f sin(arga)) *f 0.0000001; - - k = 8; - {{ loop { - if (! (k <= 9)) exit; - argl = kq(np,k) *f dmu; - dl = dl +f t *f ( cl(np,k) *f cos(argl) +f sl(np,k) *f sin(argl) ) *f 0.0000001; - k = k + 1; - } }} - - dl = "fmod"(dl,TWOPI) : float -> float -> float; - - am = dl -f dp; - ae = am +f de *f sin(am); - k = 0; - - {{ loop { - dae = (am -f ae +f de *f sin(ae)) /f (1.0 -f de *f cos(ae)); - ae = ae +f dae; - k = k + 1; - - if (k >= 10) exit; - if (absf(dae) <f 1e-12) exit; - } }} - - ae2 = ae /f 2.0; - at = 2.0 *f atan2(sqrt((1.0 +f de) /f (1.0 -f de)) *f sin(ae2), cos(ae2)); - - r = da *f (1.0 -f de *f cos(ae)); - v = GAUSSK *f sqrt((1.0 +f 1.0 /f amas(np) ) /f (da *f da *f da)); - - si2 = sin(di /f 2.0); - xq = si2 *f cos(doh); - xp = si2 *f sin(doh); - tl = at +f dp; - xsw = sin(tl); - xcw = cos(tl); - xm2 = 2.0 *f (xp *f xcw -f xq *f xsw ); - xf = da /f sqrt(1.0 -f de *f de); - ci2 = cos(di /f 2.0); - xms = (de *f sin(dp) +f xsw) *f xf; - xmc = (de *f cos(dp) +f xcw) *f xf; - xpxq2 = 2.0 *f xp *f xq; - - x = r *f (xcw -f xm2 *f xp); - y = r *f (xsw +f xm2 *f xq); - z = r *f (-f xm2 *f ci2); - - pv(0,0) = x; - pv(0,1) = y *f coseps -f z *f sineps; - pv(0,2) = y *f sineps +f z *f coseps; - - x = v *f ((-f 1.0 +f 2.0 *f xp *f xp) *f xms +f xpxq2 *f xmc); - y = v *f (( 1.0 -f 2.0 *f xq *f xq ) *f xmc -f xpxq2 *f xms); - z = v *f (2.0 *f ci2 *f (xp *f xms +f xq *f xmc)); - - pv(1,0) = x; - pv(1,1) = y *f coseps -f z *f sineps; - pv(1,2) = y *f sineps +f z *f coseps; - -#undef epoch -#undef pv -} - -"radecdist"(state_, rdd_): int -> int -> void -{ -#define state(x,y) float64[state_ + (x) * 24 + (y) * 8] -#define rdd(x) float64[rdd_ + (x) * 8] - - rdd(2) = sqrt(state(0,0) *f state(0,0) +f state(0,1) *f state(0,1) +f state(0,2) *f state(0,2)); - rdd(0) = atan2(state(0,1), state(0,0)) *f R2H; - if (rdd(0) <f 0.0) rdd(0) = rdd(0) +f 24.0; - rdd(1) = asin(state(0,2) /f rdd(2)) *f R2D; - -#undef state -#undef rdd -} diff --git a/test/cminor/conversions.cm b/test/cminor/conversions.cm deleted file mode 100644 index e0998bf0..00000000 --- a/test/cminor/conversions.cm +++ /dev/null @@ -1,19 +0,0 @@ -"intoffloat" (r, x): int -> int -> void -{ - int32[r] = intoffloat(float64[x]); -} - -"intuoffloat" (r, x): int -> int -> void -{ - int32[r] = intuoffloat(float64[x]); -} - -"floatofint" (r, x): int -> int -> void -{ - float64[r] = floatofint(int32[x]); -} - -"floatofintu" (r, x): int -> int -> void -{ - float64[r] = floatofintu(int32[x]); -} diff --git a/test/cminor/fft.cm b/test/cminor/fft.cm deleted file mode 100644 index ed3b1034..00000000 --- a/test/cminor/fft.cm +++ /dev/null @@ -1,152 +0,0 @@ -/********************************************************/ -/* A Duhamel-Hollman split-radix dif fft */ -/* Ref: Electronics Letters, Jan. 5, 1984 */ -/* Complex input and output data in arrays x and y */ -/* Length is n. */ -/********************************************************/ - -extern "cos" : float -> float -extern "sin" : float -> float - -"dfft"(x, y, np): int /*float ptr*/ -> int /*float ptr*/ -> int -> int -{ - var px, py, /*float ptr*/ - i, j, k, m, n, i0, i1, i2, i3, is, id, n1, n2, n4, a, e, a3, /*int*/ - cc1, ss1, cc3, ss3, r1, r2, s1, s2, s3, xt, tpi /*float*/; - - px = x - 8; - py = y - 8; - i = 2; - m = 1; - - {{ loop { - if (! (i < np)) exit; - i = i+i; - m = m+1; - } }} - - n = i; - - if (n != np) - { - i = np + 1; - {{ loop { - if (! (i <= n)) exit; - float64[px + i*8] = 0.0; - float64[py + i*8] = 0.0; - i = i + 1; - } }} - } - - n2 = n+n; - tpi = 2.0 *f 3.14159265358979323846; - k = 1; - {{ loop { - if (! (k <= m - 1)) exit; - n2 = n2 / 2; - n4 = n2 / 4; - e = tpi /f floatofint(n2); - a = 0.0; - - j = 1; - {{ loop { - if (! (j <= n4)) exit; - cc1 = "cos"(a) : float -> float; - ss1 = "sin"(a) : float -> float; - a3 = 3.0 *f a; - cc3 = "cos"(a3) : float -> float; - ss3 = "sin"(a3) : float -> float; - a = e *f floatofint(j); - is = j; - id = 2 * n2; - - {{ loop { - if (! ( is < n )) exit; - i0 = is; - {{ loop { - /* DEBUG "trace"(); */ - if (! (i0 <= n - 1)) exit; - i1 = i0 + n4; /*DEBUG "print_int"(i1); */ - i2 = i1 + n4; /*DEBUG "print_int"(i2); */ - i3 = i2 + n4; /*DEBUG "print_int"(i3); */ - r1 = float64[px+i0*8] -f float64[px+i2*8]; - /* DEBUG "print_float"(r1); */ - float64[px+i0*8] = float64[px+i0*8] +f float64[px+i2*8]; - r2 = float64[px+i1*8] -f float64[px+i3*8]; - /* DEBUG "print_float"(r2); */ - float64[px+i1*8] = float64[px+i1*8] +f float64[px+i3*8]; - s1 = float64[py+i0*8] -f float64[py+i2*8]; - /* DEBUG "print_float"(s1); */ - float64[py+i0*8] = float64[py+i0*8] +f float64[py+i2*8]; - s2 = float64[py+i1*8] -f float64[py+i3*8]; - /* DEBUG "print_float"(s2); */ - float64[py+i1*8] = float64[py+i1*8] +f float64[py+i3*8]; - s3 = r1 -f s2; r1 = r1 +f s2; - s2 = r2 -f s1; r2 = r2 +f s1; - float64[px+i2*8] = (r1 *f cc1) -f (s2 *f ss1); - float64[py+i2*8] = (-f s2 *f cc1) -f (r1 *f ss1); - float64[px+i3*8] = (s3 *f cc3) +f (r2 *f ss3); - float64[py+i3*8] = (r2 *f cc3) -f (s3 *f ss3); - i0 = i0 + id; - } }} - is = 2 * id - n2 + j; - id = 4 * id; - } }} - j = j + 1; - } }} - k = k + 1; - } }} - -/************************************/ -/* Last stage, length=2 butterfly */ -/************************************/ - is = 1; - id = 4; - - {{ loop { - if (! ( is < n)) exit; - i0 = is; - {{ loop { - if (! (i0 <= n)) exit; - i1 = i0 + 1; - r1 = float64[px+i0*8]; - float64[px+i0*8] = r1 +f float64[px+i1*8]; - float64[px+i1*8] = r1 -f float64[px+i1*8]; - r1 = float64[py+i0*8]; - float64[py+i0*8] = r1 +f float64[py+i1*8]; - float64[py+i1*8] = r1 -f float64[py+i1*8]; - i0 = i0 + id; - } }} - is = 2*id - 1; - id = 4 * id; - } }} - -/*************************/ -/* Bit reverse counter */ -/*************************/ - j = 1; - n1 = n - 1; - - i = 1; - {{ loop { - if (! (i <= n1)) exit; - if (i < j) { - xt = float64[px+j*8]; - float64[px+j*8] = float64[px+i*8]; - float64[px+i*8] = xt; - xt = float64[py+j*8]; - float64[py+j*8] = float64[py+i*8]; - float64[py+i*8] = xt; - } - k = n / 2; - {{ loop { - if (! (k < j)) exit; - j = j - k; - k = k / 2; - } }} - j = j + k; - i = i + 1; - } }} - - return(n); -} diff --git a/test/cminor/fib.cm b/test/cminor/fib.cm deleted file mode 100644 index 42fbdd6e..00000000 --- a/test/cminor/fib.cm +++ /dev/null @@ -1,7 +0,0 @@ -"fib"(n): int -> int -{ - if (n < 2) - return 1; - else - return "fib"(n - 1) : int -> int + "fib"(n - 2) : int -> int; -} diff --git a/test/cminor/integr.cm b/test/cminor/integr.cm deleted file mode 100644 index 28f0a1de..00000000 --- a/test/cminor/integr.cm +++ /dev/null @@ -1,25 +0,0 @@ -"square" (x): float -> float -{ - return x *f x; -} - -"integr"(f, low, high, n): int -> float -> float -> int -> float -{ - var h, x, s, i; - h = (high -f low) /f floatofint n; - x = low; - s = 0.0; - i = n; - {{ loop { - if (! (i > 0)) exit; - s = s +f (f(x): float -> float); - x = x +f h; - i = i - 1; - } }} - return s *f h; -} - -"test"(n) : int -> float -{ - return "integr"("square", 0.0, 1.0, n): int -> float -> float -> int -> float; -} diff --git a/test/cminor/lists.cm b/test/cminor/lists.cm deleted file mode 100644 index 6007f3ce..00000000 --- a/test/cminor/lists.cm +++ /dev/null @@ -1,29 +0,0 @@ -/* List manipulations */ - -extern "malloc" : int -> int - -"buildlist"(n): int -> int -{ - var b; - - if (n < 0) return 0; - b = "malloc"(8) : int -> int; - int32[b] = n; - int32[b+4] = "buildlist"(n - 1) : int -> int; - return b; -} - -"reverselist"(l): int -> int -{ - var r, r2; - r = 0; - loop { - if (l == 0) return r; - r2 = "malloc"(8) : int -> int; - int32[r2] = int32[l]; - int32[r2+4] = r; - r = r2; - l = int32[l+4]; - } -} - diff --git a/test/cminor/mainaes.c b/test/cminor/mainaes.c deleted file mode 100644 index 7c658c75..00000000 --- a/test/cminor/mainaes.c +++ /dev/null @@ -1,739 +0,0 @@ -#include <stdio.h> -#include <string.h> -#include <stdlib.h> - -typedef unsigned char u8; -typedef unsigned short u16; -typedef unsigned int u32; -#define MAXNR 14 - -extern int rijndaelKeySetupEnc(u32 rk[/*4*(Nr + 1)*/], const u8 cipherKey[], int keyBits); -extern int rijndaelKeySetupDec(u32 rk[/*4*(Nr + 1)*/], const u8 cipherKey[], int keyBits); -extern void rijndaelEncrypt(const u32 rk[/*4*(Nr + 1)*/], int Nr, const u8 pt[16], u8 ct[16]); -extern void rijndaelDecrypt(const u32 rk[/*4*(Nr + 1)*/], int Nr, const u8 ct[16], u8 pt[16]); - -const u32 Te0[256] = { - 0xc66363a5U, 0xf87c7c84U, 0xee777799U, 0xf67b7b8dU, - 0xfff2f20dU, 0xd66b6bbdU, 0xde6f6fb1U, 0x91c5c554U, - 0x60303050U, 0x02010103U, 0xce6767a9U, 0x562b2b7dU, - 0xe7fefe19U, 0xb5d7d762U, 0x4dababe6U, 0xec76769aU, - 0x8fcaca45U, 0x1f82829dU, 0x89c9c940U, 0xfa7d7d87U, - 0xeffafa15U, 0xb25959ebU, 0x8e4747c9U, 0xfbf0f00bU, - 0x41adadecU, 0xb3d4d467U, 0x5fa2a2fdU, 0x45afafeaU, - 0x239c9cbfU, 0x53a4a4f7U, 0xe4727296U, 0x9bc0c05bU, - 0x75b7b7c2U, 0xe1fdfd1cU, 0x3d9393aeU, 0x4c26266aU, - 0x6c36365aU, 0x7e3f3f41U, 0xf5f7f702U, 0x83cccc4fU, - 0x6834345cU, 0x51a5a5f4U, 0xd1e5e534U, 0xf9f1f108U, - 0xe2717193U, 0xabd8d873U, 0x62313153U, 0x2a15153fU, - 0x0804040cU, 0x95c7c752U, 0x46232365U, 0x9dc3c35eU, - 0x30181828U, 0x379696a1U, 0x0a05050fU, 0x2f9a9ab5U, - 0x0e070709U, 0x24121236U, 0x1b80809bU, 0xdfe2e23dU, - 0xcdebeb26U, 0x4e272769U, 0x7fb2b2cdU, 0xea75759fU, - 0x1209091bU, 0x1d83839eU, 0x582c2c74U, 0x341a1a2eU, - 0x361b1b2dU, 0xdc6e6eb2U, 0xb45a5aeeU, 0x5ba0a0fbU, - 0xa45252f6U, 0x763b3b4dU, 0xb7d6d661U, 0x7db3b3ceU, - 0x5229297bU, 0xdde3e33eU, 0x5e2f2f71U, 0x13848497U, - 0xa65353f5U, 0xb9d1d168U, 0x00000000U, 0xc1eded2cU, - 0x40202060U, 0xe3fcfc1fU, 0x79b1b1c8U, 0xb65b5bedU, - 0xd46a6abeU, 0x8dcbcb46U, 0x67bebed9U, 0x7239394bU, - 0x944a4adeU, 0x984c4cd4U, 0xb05858e8U, 0x85cfcf4aU, - 0xbbd0d06bU, 0xc5efef2aU, 0x4faaaae5U, 0xedfbfb16U, - 0x864343c5U, 0x9a4d4dd7U, 0x66333355U, 0x11858594U, - 0x8a4545cfU, 0xe9f9f910U, 0x04020206U, 0xfe7f7f81U, - 0xa05050f0U, 0x783c3c44U, 0x259f9fbaU, 0x4ba8a8e3U, - 0xa25151f3U, 0x5da3a3feU, 0x804040c0U, 0x058f8f8aU, - 0x3f9292adU, 0x219d9dbcU, 0x70383848U, 0xf1f5f504U, - 0x63bcbcdfU, 0x77b6b6c1U, 0xafdada75U, 0x42212163U, - 0x20101030U, 0xe5ffff1aU, 0xfdf3f30eU, 0xbfd2d26dU, - 0x81cdcd4cU, 0x180c0c14U, 0x26131335U, 0xc3ecec2fU, - 0xbe5f5fe1U, 0x359797a2U, 0x884444ccU, 0x2e171739U, - 0x93c4c457U, 0x55a7a7f2U, 0xfc7e7e82U, 0x7a3d3d47U, - 0xc86464acU, 0xba5d5de7U, 0x3219192bU, 0xe6737395U, - 0xc06060a0U, 0x19818198U, 0x9e4f4fd1U, 0xa3dcdc7fU, - 0x44222266U, 0x542a2a7eU, 0x3b9090abU, 0x0b888883U, - 0x8c4646caU, 0xc7eeee29U, 0x6bb8b8d3U, 0x2814143cU, - 0xa7dede79U, 0xbc5e5ee2U, 0x160b0b1dU, 0xaddbdb76U, - 0xdbe0e03bU, 0x64323256U, 0x743a3a4eU, 0x140a0a1eU, - 0x924949dbU, 0x0c06060aU, 0x4824246cU, 0xb85c5ce4U, - 0x9fc2c25dU, 0xbdd3d36eU, 0x43acacefU, 0xc46262a6U, - 0x399191a8U, 0x319595a4U, 0xd3e4e437U, 0xf279798bU, - 0xd5e7e732U, 0x8bc8c843U, 0x6e373759U, 0xda6d6db7U, - 0x018d8d8cU, 0xb1d5d564U, 0x9c4e4ed2U, 0x49a9a9e0U, - 0xd86c6cb4U, 0xac5656faU, 0xf3f4f407U, 0xcfeaea25U, - 0xca6565afU, 0xf47a7a8eU, 0x47aeaee9U, 0x10080818U, - 0x6fbabad5U, 0xf0787888U, 0x4a25256fU, 0x5c2e2e72U, - 0x381c1c24U, 0x57a6a6f1U, 0x73b4b4c7U, 0x97c6c651U, - 0xcbe8e823U, 0xa1dddd7cU, 0xe874749cU, 0x3e1f1f21U, - 0x964b4bddU, 0x61bdbddcU, 0x0d8b8b86U, 0x0f8a8a85U, - 0xe0707090U, 0x7c3e3e42U, 0x71b5b5c4U, 0xcc6666aaU, - 0x904848d8U, 0x06030305U, 0xf7f6f601U, 0x1c0e0e12U, - 0xc26161a3U, 0x6a35355fU, 0xae5757f9U, 0x69b9b9d0U, - 0x17868691U, 0x99c1c158U, 0x3a1d1d27U, 0x279e9eb9U, - 0xd9e1e138U, 0xebf8f813U, 0x2b9898b3U, 0x22111133U, - 0xd26969bbU, 0xa9d9d970U, 0x078e8e89U, 0x339494a7U, - 0x2d9b9bb6U, 0x3c1e1e22U, 0x15878792U, 0xc9e9e920U, - 0x87cece49U, 0xaa5555ffU, 0x50282878U, 0xa5dfdf7aU, - 0x038c8c8fU, 0x59a1a1f8U, 0x09898980U, 0x1a0d0d17U, - 0x65bfbfdaU, 0xd7e6e631U, 0x844242c6U, 0xd06868b8U, - 0x824141c3U, 0x299999b0U, 0x5a2d2d77U, 0x1e0f0f11U, - 0x7bb0b0cbU, 0xa85454fcU, 0x6dbbbbd6U, 0x2c16163aU, -}; -const u32 Te1[256] = { - 0xa5c66363U, 0x84f87c7cU, 0x99ee7777U, 0x8df67b7bU, - 0x0dfff2f2U, 0xbdd66b6bU, 0xb1de6f6fU, 0x5491c5c5U, - 0x50603030U, 0x03020101U, 0xa9ce6767U, 0x7d562b2bU, - 0x19e7fefeU, 0x62b5d7d7U, 0xe64dababU, 0x9aec7676U, - 0x458fcacaU, 0x9d1f8282U, 0x4089c9c9U, 0x87fa7d7dU, - 0x15effafaU, 0xebb25959U, 0xc98e4747U, 0x0bfbf0f0U, - 0xec41adadU, 0x67b3d4d4U, 0xfd5fa2a2U, 0xea45afafU, - 0xbf239c9cU, 0xf753a4a4U, 0x96e47272U, 0x5b9bc0c0U, - 0xc275b7b7U, 0x1ce1fdfdU, 0xae3d9393U, 0x6a4c2626U, - 0x5a6c3636U, 0x417e3f3fU, 0x02f5f7f7U, 0x4f83ccccU, - 0x5c683434U, 0xf451a5a5U, 0x34d1e5e5U, 0x08f9f1f1U, - 0x93e27171U, 0x73abd8d8U, 0x53623131U, 0x3f2a1515U, - 0x0c080404U, 0x5295c7c7U, 0x65462323U, 0x5e9dc3c3U, - 0x28301818U, 0xa1379696U, 0x0f0a0505U, 0xb52f9a9aU, - 0x090e0707U, 0x36241212U, 0x9b1b8080U, 0x3ddfe2e2U, - 0x26cdebebU, 0x694e2727U, 0xcd7fb2b2U, 0x9fea7575U, - 0x1b120909U, 0x9e1d8383U, 0x74582c2cU, 0x2e341a1aU, - 0x2d361b1bU, 0xb2dc6e6eU, 0xeeb45a5aU, 0xfb5ba0a0U, - 0xf6a45252U, 0x4d763b3bU, 0x61b7d6d6U, 0xce7db3b3U, - 0x7b522929U, 0x3edde3e3U, 0x715e2f2fU, 0x97138484U, - 0xf5a65353U, 0x68b9d1d1U, 0x00000000U, 0x2cc1ededU, - 0x60402020U, 0x1fe3fcfcU, 0xc879b1b1U, 0xedb65b5bU, - 0xbed46a6aU, 0x468dcbcbU, 0xd967bebeU, 0x4b723939U, - 0xde944a4aU, 0xd4984c4cU, 0xe8b05858U, 0x4a85cfcfU, - 0x6bbbd0d0U, 0x2ac5efefU, 0xe54faaaaU, 0x16edfbfbU, - 0xc5864343U, 0xd79a4d4dU, 0x55663333U, 0x94118585U, - 0xcf8a4545U, 0x10e9f9f9U, 0x06040202U, 0x81fe7f7fU, - 0xf0a05050U, 0x44783c3cU, 0xba259f9fU, 0xe34ba8a8U, - 0xf3a25151U, 0xfe5da3a3U, 0xc0804040U, 0x8a058f8fU, - 0xad3f9292U, 0xbc219d9dU, 0x48703838U, 0x04f1f5f5U, - 0xdf63bcbcU, 0xc177b6b6U, 0x75afdadaU, 0x63422121U, - 0x30201010U, 0x1ae5ffffU, 0x0efdf3f3U, 0x6dbfd2d2U, - 0x4c81cdcdU, 0x14180c0cU, 0x35261313U, 0x2fc3ececU, - 0xe1be5f5fU, 0xa2359797U, 0xcc884444U, 0x392e1717U, - 0x5793c4c4U, 0xf255a7a7U, 0x82fc7e7eU, 0x477a3d3dU, - 0xacc86464U, 0xe7ba5d5dU, 0x2b321919U, 0x95e67373U, - 0xa0c06060U, 0x98198181U, 0xd19e4f4fU, 0x7fa3dcdcU, - 0x66442222U, 0x7e542a2aU, 0xab3b9090U, 0x830b8888U, - 0xca8c4646U, 0x29c7eeeeU, 0xd36bb8b8U, 0x3c281414U, - 0x79a7dedeU, 0xe2bc5e5eU, 0x1d160b0bU, 0x76addbdbU, - 0x3bdbe0e0U, 0x56643232U, 0x4e743a3aU, 0x1e140a0aU, - 0xdb924949U, 0x0a0c0606U, 0x6c482424U, 0xe4b85c5cU, - 0x5d9fc2c2U, 0x6ebdd3d3U, 0xef43acacU, 0xa6c46262U, - 0xa8399191U, 0xa4319595U, 0x37d3e4e4U, 0x8bf27979U, - 0x32d5e7e7U, 0x438bc8c8U, 0x596e3737U, 0xb7da6d6dU, - 0x8c018d8dU, 0x64b1d5d5U, 0xd29c4e4eU, 0xe049a9a9U, - 0xb4d86c6cU, 0xfaac5656U, 0x07f3f4f4U, 0x25cfeaeaU, - 0xafca6565U, 0x8ef47a7aU, 0xe947aeaeU, 0x18100808U, - 0xd56fbabaU, 0x88f07878U, 0x6f4a2525U, 0x725c2e2eU, - 0x24381c1cU, 0xf157a6a6U, 0xc773b4b4U, 0x5197c6c6U, - 0x23cbe8e8U, 0x7ca1ddddU, 0x9ce87474U, 0x213e1f1fU, - 0xdd964b4bU, 0xdc61bdbdU, 0x860d8b8bU, 0x850f8a8aU, - 0x90e07070U, 0x427c3e3eU, 0xc471b5b5U, 0xaacc6666U, - 0xd8904848U, 0x05060303U, 0x01f7f6f6U, 0x121c0e0eU, - 0xa3c26161U, 0x5f6a3535U, 0xf9ae5757U, 0xd069b9b9U, - 0x91178686U, 0x5899c1c1U, 0x273a1d1dU, 0xb9279e9eU, - 0x38d9e1e1U, 0x13ebf8f8U, 0xb32b9898U, 0x33221111U, - 0xbbd26969U, 0x70a9d9d9U, 0x89078e8eU, 0xa7339494U, - 0xb62d9b9bU, 0x223c1e1eU, 0x92158787U, 0x20c9e9e9U, - 0x4987ceceU, 0xffaa5555U, 0x78502828U, 0x7aa5dfdfU, - 0x8f038c8cU, 0xf859a1a1U, 0x80098989U, 0x171a0d0dU, - 0xda65bfbfU, 0x31d7e6e6U, 0xc6844242U, 0xb8d06868U, - 0xc3824141U, 0xb0299999U, 0x775a2d2dU, 0x111e0f0fU, - 0xcb7bb0b0U, 0xfca85454U, 0xd66dbbbbU, 0x3a2c1616U, -}; -const u32 Te2[256] = { - 0x63a5c663U, 0x7c84f87cU, 0x7799ee77U, 0x7b8df67bU, - 0xf20dfff2U, 0x6bbdd66bU, 0x6fb1de6fU, 0xc55491c5U, - 0x30506030U, 0x01030201U, 0x67a9ce67U, 0x2b7d562bU, - 0xfe19e7feU, 0xd762b5d7U, 0xabe64dabU, 0x769aec76U, - 0xca458fcaU, 0x829d1f82U, 0xc94089c9U, 0x7d87fa7dU, - 0xfa15effaU, 0x59ebb259U, 0x47c98e47U, 0xf00bfbf0U, - 0xadec41adU, 0xd467b3d4U, 0xa2fd5fa2U, 0xafea45afU, - 0x9cbf239cU, 0xa4f753a4U, 0x7296e472U, 0xc05b9bc0U, - 0xb7c275b7U, 0xfd1ce1fdU, 0x93ae3d93U, 0x266a4c26U, - 0x365a6c36U, 0x3f417e3fU, 0xf702f5f7U, 0xcc4f83ccU, - 0x345c6834U, 0xa5f451a5U, 0xe534d1e5U, 0xf108f9f1U, - 0x7193e271U, 0xd873abd8U, 0x31536231U, 0x153f2a15U, - 0x040c0804U, 0xc75295c7U, 0x23654623U, 0xc35e9dc3U, - 0x18283018U, 0x96a13796U, 0x050f0a05U, 0x9ab52f9aU, - 0x07090e07U, 0x12362412U, 0x809b1b80U, 0xe23ddfe2U, - 0xeb26cdebU, 0x27694e27U, 0xb2cd7fb2U, 0x759fea75U, - 0x091b1209U, 0x839e1d83U, 0x2c74582cU, 0x1a2e341aU, - 0x1b2d361bU, 0x6eb2dc6eU, 0x5aeeb45aU, 0xa0fb5ba0U, - 0x52f6a452U, 0x3b4d763bU, 0xd661b7d6U, 0xb3ce7db3U, - 0x297b5229U, 0xe33edde3U, 0x2f715e2fU, 0x84971384U, - 0x53f5a653U, 0xd168b9d1U, 0x00000000U, 0xed2cc1edU, - 0x20604020U, 0xfc1fe3fcU, 0xb1c879b1U, 0x5bedb65bU, - 0x6abed46aU, 0xcb468dcbU, 0xbed967beU, 0x394b7239U, - 0x4ade944aU, 0x4cd4984cU, 0x58e8b058U, 0xcf4a85cfU, - 0xd06bbbd0U, 0xef2ac5efU, 0xaae54faaU, 0xfb16edfbU, - 0x43c58643U, 0x4dd79a4dU, 0x33556633U, 0x85941185U, - 0x45cf8a45U, 0xf910e9f9U, 0x02060402U, 0x7f81fe7fU, - 0x50f0a050U, 0x3c44783cU, 0x9fba259fU, 0xa8e34ba8U, - 0x51f3a251U, 0xa3fe5da3U, 0x40c08040U, 0x8f8a058fU, - 0x92ad3f92U, 0x9dbc219dU, 0x38487038U, 0xf504f1f5U, - 0xbcdf63bcU, 0xb6c177b6U, 0xda75afdaU, 0x21634221U, - 0x10302010U, 0xff1ae5ffU, 0xf30efdf3U, 0xd26dbfd2U, - 0xcd4c81cdU, 0x0c14180cU, 0x13352613U, 0xec2fc3ecU, - 0x5fe1be5fU, 0x97a23597U, 0x44cc8844U, 0x17392e17U, - 0xc45793c4U, 0xa7f255a7U, 0x7e82fc7eU, 0x3d477a3dU, - 0x64acc864U, 0x5de7ba5dU, 0x192b3219U, 0x7395e673U, - 0x60a0c060U, 0x81981981U, 0x4fd19e4fU, 0xdc7fa3dcU, - 0x22664422U, 0x2a7e542aU, 0x90ab3b90U, 0x88830b88U, - 0x46ca8c46U, 0xee29c7eeU, 0xb8d36bb8U, 0x143c2814U, - 0xde79a7deU, 0x5ee2bc5eU, 0x0b1d160bU, 0xdb76addbU, - 0xe03bdbe0U, 0x32566432U, 0x3a4e743aU, 0x0a1e140aU, - 0x49db9249U, 0x060a0c06U, 0x246c4824U, 0x5ce4b85cU, - 0xc25d9fc2U, 0xd36ebdd3U, 0xacef43acU, 0x62a6c462U, - 0x91a83991U, 0x95a43195U, 0xe437d3e4U, 0x798bf279U, - 0xe732d5e7U, 0xc8438bc8U, 0x37596e37U, 0x6db7da6dU, - 0x8d8c018dU, 0xd564b1d5U, 0x4ed29c4eU, 0xa9e049a9U, - 0x6cb4d86cU, 0x56faac56U, 0xf407f3f4U, 0xea25cfeaU, - 0x65afca65U, 0x7a8ef47aU, 0xaee947aeU, 0x08181008U, - 0xbad56fbaU, 0x7888f078U, 0x256f4a25U, 0x2e725c2eU, - 0x1c24381cU, 0xa6f157a6U, 0xb4c773b4U, 0xc65197c6U, - 0xe823cbe8U, 0xdd7ca1ddU, 0x749ce874U, 0x1f213e1fU, - 0x4bdd964bU, 0xbddc61bdU, 0x8b860d8bU, 0x8a850f8aU, - 0x7090e070U, 0x3e427c3eU, 0xb5c471b5U, 0x66aacc66U, - 0x48d89048U, 0x03050603U, 0xf601f7f6U, 0x0e121c0eU, - 0x61a3c261U, 0x355f6a35U, 0x57f9ae57U, 0xb9d069b9U, - 0x86911786U, 0xc15899c1U, 0x1d273a1dU, 0x9eb9279eU, - 0xe138d9e1U, 0xf813ebf8U, 0x98b32b98U, 0x11332211U, - 0x69bbd269U, 0xd970a9d9U, 0x8e89078eU, 0x94a73394U, - 0x9bb62d9bU, 0x1e223c1eU, 0x87921587U, 0xe920c9e9U, - 0xce4987ceU, 0x55ffaa55U, 0x28785028U, 0xdf7aa5dfU, - 0x8c8f038cU, 0xa1f859a1U, 0x89800989U, 0x0d171a0dU, - 0xbfda65bfU, 0xe631d7e6U, 0x42c68442U, 0x68b8d068U, - 0x41c38241U, 0x99b02999U, 0x2d775a2dU, 0x0f111e0fU, - 0xb0cb7bb0U, 0x54fca854U, 0xbbd66dbbU, 0x163a2c16U, -}; -const u32 Te3[256] = { - - 0x6363a5c6U, 0x7c7c84f8U, 0x777799eeU, 0x7b7b8df6U, - 0xf2f20dffU, 0x6b6bbdd6U, 0x6f6fb1deU, 0xc5c55491U, - 0x30305060U, 0x01010302U, 0x6767a9ceU, 0x2b2b7d56U, - 0xfefe19e7U, 0xd7d762b5U, 0xababe64dU, 0x76769aecU, - 0xcaca458fU, 0x82829d1fU, 0xc9c94089U, 0x7d7d87faU, - 0xfafa15efU, 0x5959ebb2U, 0x4747c98eU, 0xf0f00bfbU, - 0xadadec41U, 0xd4d467b3U, 0xa2a2fd5fU, 0xafafea45U, - 0x9c9cbf23U, 0xa4a4f753U, 0x727296e4U, 0xc0c05b9bU, - 0xb7b7c275U, 0xfdfd1ce1U, 0x9393ae3dU, 0x26266a4cU, - 0x36365a6cU, 0x3f3f417eU, 0xf7f702f5U, 0xcccc4f83U, - 0x34345c68U, 0xa5a5f451U, 0xe5e534d1U, 0xf1f108f9U, - 0x717193e2U, 0xd8d873abU, 0x31315362U, 0x15153f2aU, - 0x04040c08U, 0xc7c75295U, 0x23236546U, 0xc3c35e9dU, - 0x18182830U, 0x9696a137U, 0x05050f0aU, 0x9a9ab52fU, - 0x0707090eU, 0x12123624U, 0x80809b1bU, 0xe2e23ddfU, - 0xebeb26cdU, 0x2727694eU, 0xb2b2cd7fU, 0x75759feaU, - 0x09091b12U, 0x83839e1dU, 0x2c2c7458U, 0x1a1a2e34U, - 0x1b1b2d36U, 0x6e6eb2dcU, 0x5a5aeeb4U, 0xa0a0fb5bU, - 0x5252f6a4U, 0x3b3b4d76U, 0xd6d661b7U, 0xb3b3ce7dU, - 0x29297b52U, 0xe3e33eddU, 0x2f2f715eU, 0x84849713U, - 0x5353f5a6U, 0xd1d168b9U, 0x00000000U, 0xeded2cc1U, - 0x20206040U, 0xfcfc1fe3U, 0xb1b1c879U, 0x5b5bedb6U, - 0x6a6abed4U, 0xcbcb468dU, 0xbebed967U, 0x39394b72U, - 0x4a4ade94U, 0x4c4cd498U, 0x5858e8b0U, 0xcfcf4a85U, - 0xd0d06bbbU, 0xefef2ac5U, 0xaaaae54fU, 0xfbfb16edU, - 0x4343c586U, 0x4d4dd79aU, 0x33335566U, 0x85859411U, - 0x4545cf8aU, 0xf9f910e9U, 0x02020604U, 0x7f7f81feU, - 0x5050f0a0U, 0x3c3c4478U, 0x9f9fba25U, 0xa8a8e34bU, - 0x5151f3a2U, 0xa3a3fe5dU, 0x4040c080U, 0x8f8f8a05U, - 0x9292ad3fU, 0x9d9dbc21U, 0x38384870U, 0xf5f504f1U, - 0xbcbcdf63U, 0xb6b6c177U, 0xdada75afU, 0x21216342U, - 0x10103020U, 0xffff1ae5U, 0xf3f30efdU, 0xd2d26dbfU, - 0xcdcd4c81U, 0x0c0c1418U, 0x13133526U, 0xecec2fc3U, - 0x5f5fe1beU, 0x9797a235U, 0x4444cc88U, 0x1717392eU, - 0xc4c45793U, 0xa7a7f255U, 0x7e7e82fcU, 0x3d3d477aU, - 0x6464acc8U, 0x5d5de7baU, 0x19192b32U, 0x737395e6U, - 0x6060a0c0U, 0x81819819U, 0x4f4fd19eU, 0xdcdc7fa3U, - 0x22226644U, 0x2a2a7e54U, 0x9090ab3bU, 0x8888830bU, - 0x4646ca8cU, 0xeeee29c7U, 0xb8b8d36bU, 0x14143c28U, - 0xdede79a7U, 0x5e5ee2bcU, 0x0b0b1d16U, 0xdbdb76adU, - 0xe0e03bdbU, 0x32325664U, 0x3a3a4e74U, 0x0a0a1e14U, - 0x4949db92U, 0x06060a0cU, 0x24246c48U, 0x5c5ce4b8U, - 0xc2c25d9fU, 0xd3d36ebdU, 0xacacef43U, 0x6262a6c4U, - 0x9191a839U, 0x9595a431U, 0xe4e437d3U, 0x79798bf2U, - 0xe7e732d5U, 0xc8c8438bU, 0x3737596eU, 0x6d6db7daU, - 0x8d8d8c01U, 0xd5d564b1U, 0x4e4ed29cU, 0xa9a9e049U, - 0x6c6cb4d8U, 0x5656faacU, 0xf4f407f3U, 0xeaea25cfU, - 0x6565afcaU, 0x7a7a8ef4U, 0xaeaee947U, 0x08081810U, - 0xbabad56fU, 0x787888f0U, 0x25256f4aU, 0x2e2e725cU, - 0x1c1c2438U, 0xa6a6f157U, 0xb4b4c773U, 0xc6c65197U, - 0xe8e823cbU, 0xdddd7ca1U, 0x74749ce8U, 0x1f1f213eU, - 0x4b4bdd96U, 0xbdbddc61U, 0x8b8b860dU, 0x8a8a850fU, - 0x707090e0U, 0x3e3e427cU, 0xb5b5c471U, 0x6666aaccU, - 0x4848d890U, 0x03030506U, 0xf6f601f7U, 0x0e0e121cU, - 0x6161a3c2U, 0x35355f6aU, 0x5757f9aeU, 0xb9b9d069U, - 0x86869117U, 0xc1c15899U, 0x1d1d273aU, 0x9e9eb927U, - 0xe1e138d9U, 0xf8f813ebU, 0x9898b32bU, 0x11113322U, - 0x6969bbd2U, 0xd9d970a9U, 0x8e8e8907U, 0x9494a733U, - 0x9b9bb62dU, 0x1e1e223cU, 0x87879215U, 0xe9e920c9U, - 0xcece4987U, 0x5555ffaaU, 0x28287850U, 0xdfdf7aa5U, - 0x8c8c8f03U, 0xa1a1f859U, 0x89898009U, 0x0d0d171aU, - 0xbfbfda65U, 0xe6e631d7U, 0x4242c684U, 0x6868b8d0U, - 0x4141c382U, 0x9999b029U, 0x2d2d775aU, 0x0f0f111eU, - 0xb0b0cb7bU, 0x5454fca8U, 0xbbbbd66dU, 0x16163a2cU, -}; -const u32 Te4[256] = { - 0x63636363U, 0x7c7c7c7cU, 0x77777777U, 0x7b7b7b7bU, - 0xf2f2f2f2U, 0x6b6b6b6bU, 0x6f6f6f6fU, 0xc5c5c5c5U, - 0x30303030U, 0x01010101U, 0x67676767U, 0x2b2b2b2bU, - 0xfefefefeU, 0xd7d7d7d7U, 0xababababU, 0x76767676U, - 0xcacacacaU, 0x82828282U, 0xc9c9c9c9U, 0x7d7d7d7dU, - 0xfafafafaU, 0x59595959U, 0x47474747U, 0xf0f0f0f0U, - 0xadadadadU, 0xd4d4d4d4U, 0xa2a2a2a2U, 0xafafafafU, - 0x9c9c9c9cU, 0xa4a4a4a4U, 0x72727272U, 0xc0c0c0c0U, - 0xb7b7b7b7U, 0xfdfdfdfdU, 0x93939393U, 0x26262626U, - 0x36363636U, 0x3f3f3f3fU, 0xf7f7f7f7U, 0xccccccccU, - 0x34343434U, 0xa5a5a5a5U, 0xe5e5e5e5U, 0xf1f1f1f1U, - 0x71717171U, 0xd8d8d8d8U, 0x31313131U, 0x15151515U, - 0x04040404U, 0xc7c7c7c7U, 0x23232323U, 0xc3c3c3c3U, - 0x18181818U, 0x96969696U, 0x05050505U, 0x9a9a9a9aU, - 0x07070707U, 0x12121212U, 0x80808080U, 0xe2e2e2e2U, - 0xebebebebU, 0x27272727U, 0xb2b2b2b2U, 0x75757575U, - 0x09090909U, 0x83838383U, 0x2c2c2c2cU, 0x1a1a1a1aU, - 0x1b1b1b1bU, 0x6e6e6e6eU, 0x5a5a5a5aU, 0xa0a0a0a0U, - 0x52525252U, 0x3b3b3b3bU, 0xd6d6d6d6U, 0xb3b3b3b3U, - 0x29292929U, 0xe3e3e3e3U, 0x2f2f2f2fU, 0x84848484U, - 0x53535353U, 0xd1d1d1d1U, 0x00000000U, 0xededededU, - 0x20202020U, 0xfcfcfcfcU, 0xb1b1b1b1U, 0x5b5b5b5bU, - 0x6a6a6a6aU, 0xcbcbcbcbU, 0xbebebebeU, 0x39393939U, - 0x4a4a4a4aU, 0x4c4c4c4cU, 0x58585858U, 0xcfcfcfcfU, - 0xd0d0d0d0U, 0xefefefefU, 0xaaaaaaaaU, 0xfbfbfbfbU, - 0x43434343U, 0x4d4d4d4dU, 0x33333333U, 0x85858585U, - 0x45454545U, 0xf9f9f9f9U, 0x02020202U, 0x7f7f7f7fU, - 0x50505050U, 0x3c3c3c3cU, 0x9f9f9f9fU, 0xa8a8a8a8U, - 0x51515151U, 0xa3a3a3a3U, 0x40404040U, 0x8f8f8f8fU, - 0x92929292U, 0x9d9d9d9dU, 0x38383838U, 0xf5f5f5f5U, - 0xbcbcbcbcU, 0xb6b6b6b6U, 0xdadadadaU, 0x21212121U, - 0x10101010U, 0xffffffffU, 0xf3f3f3f3U, 0xd2d2d2d2U, - 0xcdcdcdcdU, 0x0c0c0c0cU, 0x13131313U, 0xececececU, - 0x5f5f5f5fU, 0x97979797U, 0x44444444U, 0x17171717U, - 0xc4c4c4c4U, 0xa7a7a7a7U, 0x7e7e7e7eU, 0x3d3d3d3dU, - 0x64646464U, 0x5d5d5d5dU, 0x19191919U, 0x73737373U, - 0x60606060U, 0x81818181U, 0x4f4f4f4fU, 0xdcdcdcdcU, - 0x22222222U, 0x2a2a2a2aU, 0x90909090U, 0x88888888U, - 0x46464646U, 0xeeeeeeeeU, 0xb8b8b8b8U, 0x14141414U, - 0xdedededeU, 0x5e5e5e5eU, 0x0b0b0b0bU, 0xdbdbdbdbU, - 0xe0e0e0e0U, 0x32323232U, 0x3a3a3a3aU, 0x0a0a0a0aU, - 0x49494949U, 0x06060606U, 0x24242424U, 0x5c5c5c5cU, - 0xc2c2c2c2U, 0xd3d3d3d3U, 0xacacacacU, 0x62626262U, - 0x91919191U, 0x95959595U, 0xe4e4e4e4U, 0x79797979U, - 0xe7e7e7e7U, 0xc8c8c8c8U, 0x37373737U, 0x6d6d6d6dU, - 0x8d8d8d8dU, 0xd5d5d5d5U, 0x4e4e4e4eU, 0xa9a9a9a9U, - 0x6c6c6c6cU, 0x56565656U, 0xf4f4f4f4U, 0xeaeaeaeaU, - 0x65656565U, 0x7a7a7a7aU, 0xaeaeaeaeU, 0x08080808U, - 0xbabababaU, 0x78787878U, 0x25252525U, 0x2e2e2e2eU, - 0x1c1c1c1cU, 0xa6a6a6a6U, 0xb4b4b4b4U, 0xc6c6c6c6U, - 0xe8e8e8e8U, 0xddddddddU, 0x74747474U, 0x1f1f1f1fU, - 0x4b4b4b4bU, 0xbdbdbdbdU, 0x8b8b8b8bU, 0x8a8a8a8aU, - 0x70707070U, 0x3e3e3e3eU, 0xb5b5b5b5U, 0x66666666U, - 0x48484848U, 0x03030303U, 0xf6f6f6f6U, 0x0e0e0e0eU, - 0x61616161U, 0x35353535U, 0x57575757U, 0xb9b9b9b9U, - 0x86868686U, 0xc1c1c1c1U, 0x1d1d1d1dU, 0x9e9e9e9eU, - 0xe1e1e1e1U, 0xf8f8f8f8U, 0x98989898U, 0x11111111U, - 0x69696969U, 0xd9d9d9d9U, 0x8e8e8e8eU, 0x94949494U, - 0x9b9b9b9bU, 0x1e1e1e1eU, 0x87878787U, 0xe9e9e9e9U, - 0xcecececeU, 0x55555555U, 0x28282828U, 0xdfdfdfdfU, - 0x8c8c8c8cU, 0xa1a1a1a1U, 0x89898989U, 0x0d0d0d0dU, - 0xbfbfbfbfU, 0xe6e6e6e6U, 0x42424242U, 0x68686868U, - 0x41414141U, 0x99999999U, 0x2d2d2d2dU, 0x0f0f0f0fU, - 0xb0b0b0b0U, 0x54545454U, 0xbbbbbbbbU, 0x16161616U, -}; -const u32 Td0[256] = { - 0x51f4a750U, 0x7e416553U, 0x1a17a4c3U, 0x3a275e96U, - 0x3bab6bcbU, 0x1f9d45f1U, 0xacfa58abU, 0x4be30393U, - 0x2030fa55U, 0xad766df6U, 0x88cc7691U, 0xf5024c25U, - 0x4fe5d7fcU, 0xc52acbd7U, 0x26354480U, 0xb562a38fU, - 0xdeb15a49U, 0x25ba1b67U, 0x45ea0e98U, 0x5dfec0e1U, - 0xc32f7502U, 0x814cf012U, 0x8d4697a3U, 0x6bd3f9c6U, - 0x038f5fe7U, 0x15929c95U, 0xbf6d7aebU, 0x955259daU, - 0xd4be832dU, 0x587421d3U, 0x49e06929U, 0x8ec9c844U, - 0x75c2896aU, 0xf48e7978U, 0x99583e6bU, 0x27b971ddU, - 0xbee14fb6U, 0xf088ad17U, 0xc920ac66U, 0x7dce3ab4U, - 0x63df4a18U, 0xe51a3182U, 0x97513360U, 0x62537f45U, - 0xb16477e0U, 0xbb6bae84U, 0xfe81a01cU, 0xf9082b94U, - 0x70486858U, 0x8f45fd19U, 0x94de6c87U, 0x527bf8b7U, - 0xab73d323U, 0x724b02e2U, 0xe31f8f57U, 0x6655ab2aU, - 0xb2eb2807U, 0x2fb5c203U, 0x86c57b9aU, 0xd33708a5U, - 0x302887f2U, 0x23bfa5b2U, 0x02036abaU, 0xed16825cU, - 0x8acf1c2bU, 0xa779b492U, 0xf307f2f0U, 0x4e69e2a1U, - 0x65daf4cdU, 0x0605bed5U, 0xd134621fU, 0xc4a6fe8aU, - 0x342e539dU, 0xa2f355a0U, 0x058ae132U, 0xa4f6eb75U, - 0x0b83ec39U, 0x4060efaaU, 0x5e719f06U, 0xbd6e1051U, - 0x3e218af9U, 0x96dd063dU, 0xdd3e05aeU, 0x4de6bd46U, - 0x91548db5U, 0x71c45d05U, 0x0406d46fU, 0x605015ffU, - 0x1998fb24U, 0xd6bde997U, 0x894043ccU, 0x67d99e77U, - 0xb0e842bdU, 0x07898b88U, 0xe7195b38U, 0x79c8eedbU, - 0xa17c0a47U, 0x7c420fe9U, 0xf8841ec9U, 0x00000000U, - 0x09808683U, 0x322bed48U, 0x1e1170acU, 0x6c5a724eU, - 0xfd0efffbU, 0x0f853856U, 0x3daed51eU, 0x362d3927U, - 0x0a0fd964U, 0x685ca621U, 0x9b5b54d1U, 0x24362e3aU, - 0x0c0a67b1U, 0x9357e70fU, 0xb4ee96d2U, 0x1b9b919eU, - 0x80c0c54fU, 0x61dc20a2U, 0x5a774b69U, 0x1c121a16U, - 0xe293ba0aU, 0xc0a02ae5U, 0x3c22e043U, 0x121b171dU, - 0x0e090d0bU, 0xf28bc7adU, 0x2db6a8b9U, 0x141ea9c8U, - 0x57f11985U, 0xaf75074cU, 0xee99ddbbU, 0xa37f60fdU, - 0xf701269fU, 0x5c72f5bcU, 0x44663bc5U, 0x5bfb7e34U, - 0x8b432976U, 0xcb23c6dcU, 0xb6edfc68U, 0xb8e4f163U, - 0xd731dccaU, 0x42638510U, 0x13972240U, 0x84c61120U, - 0x854a247dU, 0xd2bb3df8U, 0xaef93211U, 0xc729a16dU, - 0x1d9e2f4bU, 0xdcb230f3U, 0x0d8652ecU, 0x77c1e3d0U, - 0x2bb3166cU, 0xa970b999U, 0x119448faU, 0x47e96422U, - 0xa8fc8cc4U, 0xa0f03f1aU, 0x567d2cd8U, 0x223390efU, - 0x87494ec7U, 0xd938d1c1U, 0x8ccaa2feU, 0x98d40b36U, - 0xa6f581cfU, 0xa57ade28U, 0xdab78e26U, 0x3fadbfa4U, - 0x2c3a9de4U, 0x5078920dU, 0x6a5fcc9bU, 0x547e4662U, - 0xf68d13c2U, 0x90d8b8e8U, 0x2e39f75eU, 0x82c3aff5U, - 0x9f5d80beU, 0x69d0937cU, 0x6fd52da9U, 0xcf2512b3U, - 0xc8ac993bU, 0x10187da7U, 0xe89c636eU, 0xdb3bbb7bU, - 0xcd267809U, 0x6e5918f4U, 0xec9ab701U, 0x834f9aa8U, - 0xe6956e65U, 0xaaffe67eU, 0x21bccf08U, 0xef15e8e6U, - 0xbae79bd9U, 0x4a6f36ceU, 0xea9f09d4U, 0x29b07cd6U, - 0x31a4b2afU, 0x2a3f2331U, 0xc6a59430U, 0x35a266c0U, - 0x744ebc37U, 0xfc82caa6U, 0xe090d0b0U, 0x33a7d815U, - 0xf104984aU, 0x41ecdaf7U, 0x7fcd500eU, 0x1791f62fU, - 0x764dd68dU, 0x43efb04dU, 0xccaa4d54U, 0xe49604dfU, - 0x9ed1b5e3U, 0x4c6a881bU, 0xc12c1fb8U, 0x4665517fU, - 0x9d5eea04U, 0x018c355dU, 0xfa877473U, 0xfb0b412eU, - 0xb3671d5aU, 0x92dbd252U, 0xe9105633U, 0x6dd64713U, - 0x9ad7618cU, 0x37a10c7aU, 0x59f8148eU, 0xeb133c89U, - 0xcea927eeU, 0xb761c935U, 0xe11ce5edU, 0x7a47b13cU, - 0x9cd2df59U, 0x55f2733fU, 0x1814ce79U, 0x73c737bfU, - 0x53f7cdeaU, 0x5ffdaa5bU, 0xdf3d6f14U, 0x7844db86U, - 0xcaaff381U, 0xb968c43eU, 0x3824342cU, 0xc2a3405fU, - 0x161dc372U, 0xbce2250cU, 0x283c498bU, 0xff0d9541U, - 0x39a80171U, 0x080cb3deU, 0xd8b4e49cU, 0x6456c190U, - 0x7bcb8461U, 0xd532b670U, 0x486c5c74U, 0xd0b85742U, -}; -const u32 Td1[256] = { - 0x5051f4a7U, 0x537e4165U, 0xc31a17a4U, 0x963a275eU, - 0xcb3bab6bU, 0xf11f9d45U, 0xabacfa58U, 0x934be303U, - 0x552030faU, 0xf6ad766dU, 0x9188cc76U, 0x25f5024cU, - 0xfc4fe5d7U, 0xd7c52acbU, 0x80263544U, 0x8fb562a3U, - 0x49deb15aU, 0x6725ba1bU, 0x9845ea0eU, 0xe15dfec0U, - 0x02c32f75U, 0x12814cf0U, 0xa38d4697U, 0xc66bd3f9U, - 0xe7038f5fU, 0x9515929cU, 0xebbf6d7aU, 0xda955259U, - 0x2dd4be83U, 0xd3587421U, 0x2949e069U, 0x448ec9c8U, - 0x6a75c289U, 0x78f48e79U, 0x6b99583eU, 0xdd27b971U, - 0xb6bee14fU, 0x17f088adU, 0x66c920acU, 0xb47dce3aU, - 0x1863df4aU, 0x82e51a31U, 0x60975133U, 0x4562537fU, - 0xe0b16477U, 0x84bb6baeU, 0x1cfe81a0U, 0x94f9082bU, - 0x58704868U, 0x198f45fdU, 0x8794de6cU, 0xb7527bf8U, - 0x23ab73d3U, 0xe2724b02U, 0x57e31f8fU, 0x2a6655abU, - 0x07b2eb28U, 0x032fb5c2U, 0x9a86c57bU, 0xa5d33708U, - 0xf2302887U, 0xb223bfa5U, 0xba02036aU, 0x5ced1682U, - 0x2b8acf1cU, 0x92a779b4U, 0xf0f307f2U, 0xa14e69e2U, - 0xcd65daf4U, 0xd50605beU, 0x1fd13462U, 0x8ac4a6feU, - 0x9d342e53U, 0xa0a2f355U, 0x32058ae1U, 0x75a4f6ebU, - 0x390b83ecU, 0xaa4060efU, 0x065e719fU, 0x51bd6e10U, - 0xf93e218aU, 0x3d96dd06U, 0xaedd3e05U, 0x464de6bdU, - 0xb591548dU, 0x0571c45dU, 0x6f0406d4U, 0xff605015U, - 0x241998fbU, 0x97d6bde9U, 0xcc894043U, 0x7767d99eU, - 0xbdb0e842U, 0x8807898bU, 0x38e7195bU, 0xdb79c8eeU, - 0x47a17c0aU, 0xe97c420fU, 0xc9f8841eU, 0x00000000U, - 0x83098086U, 0x48322bedU, 0xac1e1170U, 0x4e6c5a72U, - 0xfbfd0effU, 0x560f8538U, 0x1e3daed5U, 0x27362d39U, - 0x640a0fd9U, 0x21685ca6U, 0xd19b5b54U, 0x3a24362eU, - 0xb10c0a67U, 0x0f9357e7U, 0xd2b4ee96U, 0x9e1b9b91U, - 0x4f80c0c5U, 0xa261dc20U, 0x695a774bU, 0x161c121aU, - 0x0ae293baU, 0xe5c0a02aU, 0x433c22e0U, 0x1d121b17U, - 0x0b0e090dU, 0xadf28bc7U, 0xb92db6a8U, 0xc8141ea9U, - 0x8557f119U, 0x4caf7507U, 0xbbee99ddU, 0xfda37f60U, - 0x9ff70126U, 0xbc5c72f5U, 0xc544663bU, 0x345bfb7eU, - 0x768b4329U, 0xdccb23c6U, 0x68b6edfcU, 0x63b8e4f1U, - 0xcad731dcU, 0x10426385U, 0x40139722U, 0x2084c611U, - 0x7d854a24U, 0xf8d2bb3dU, 0x11aef932U, 0x6dc729a1U, - 0x4b1d9e2fU, 0xf3dcb230U, 0xec0d8652U, 0xd077c1e3U, - 0x6c2bb316U, 0x99a970b9U, 0xfa119448U, 0x2247e964U, - 0xc4a8fc8cU, 0x1aa0f03fU, 0xd8567d2cU, 0xef223390U, - 0xc787494eU, 0xc1d938d1U, 0xfe8ccaa2U, 0x3698d40bU, - 0xcfa6f581U, 0x28a57adeU, 0x26dab78eU, 0xa43fadbfU, - 0xe42c3a9dU, 0x0d507892U, 0x9b6a5fccU, 0x62547e46U, - 0xc2f68d13U, 0xe890d8b8U, 0x5e2e39f7U, 0xf582c3afU, - 0xbe9f5d80U, 0x7c69d093U, 0xa96fd52dU, 0xb3cf2512U, - 0x3bc8ac99U, 0xa710187dU, 0x6ee89c63U, 0x7bdb3bbbU, - 0x09cd2678U, 0xf46e5918U, 0x01ec9ab7U, 0xa8834f9aU, - 0x65e6956eU, 0x7eaaffe6U, 0x0821bccfU, 0xe6ef15e8U, - 0xd9bae79bU, 0xce4a6f36U, 0xd4ea9f09U, 0xd629b07cU, - 0xaf31a4b2U, 0x312a3f23U, 0x30c6a594U, 0xc035a266U, - 0x37744ebcU, 0xa6fc82caU, 0xb0e090d0U, 0x1533a7d8U, - 0x4af10498U, 0xf741ecdaU, 0x0e7fcd50U, 0x2f1791f6U, - 0x8d764dd6U, 0x4d43efb0U, 0x54ccaa4dU, 0xdfe49604U, - 0xe39ed1b5U, 0x1b4c6a88U, 0xb8c12c1fU, 0x7f466551U, - 0x049d5eeaU, 0x5d018c35U, 0x73fa8774U, 0x2efb0b41U, - 0x5ab3671dU, 0x5292dbd2U, 0x33e91056U, 0x136dd647U, - 0x8c9ad761U, 0x7a37a10cU, 0x8e59f814U, 0x89eb133cU, - 0xeecea927U, 0x35b761c9U, 0xede11ce5U, 0x3c7a47b1U, - 0x599cd2dfU, 0x3f55f273U, 0x791814ceU, 0xbf73c737U, - 0xea53f7cdU, 0x5b5ffdaaU, 0x14df3d6fU, 0x867844dbU, - 0x81caaff3U, 0x3eb968c4U, 0x2c382434U, 0x5fc2a340U, - 0x72161dc3U, 0x0cbce225U, 0x8b283c49U, 0x41ff0d95U, - 0x7139a801U, 0xde080cb3U, 0x9cd8b4e4U, 0x906456c1U, - 0x617bcb84U, 0x70d532b6U, 0x74486c5cU, 0x42d0b857U, -}; -const u32 Td2[256] = { - 0xa75051f4U, 0x65537e41U, 0xa4c31a17U, 0x5e963a27U, - 0x6bcb3babU, 0x45f11f9dU, 0x58abacfaU, 0x03934be3U, - 0xfa552030U, 0x6df6ad76U, 0x769188ccU, 0x4c25f502U, - 0xd7fc4fe5U, 0xcbd7c52aU, 0x44802635U, 0xa38fb562U, - 0x5a49deb1U, 0x1b6725baU, 0x0e9845eaU, 0xc0e15dfeU, - 0x7502c32fU, 0xf012814cU, 0x97a38d46U, 0xf9c66bd3U, - 0x5fe7038fU, 0x9c951592U, 0x7aebbf6dU, 0x59da9552U, - 0x832dd4beU, 0x21d35874U, 0x692949e0U, 0xc8448ec9U, - 0x896a75c2U, 0x7978f48eU, 0x3e6b9958U, 0x71dd27b9U, - 0x4fb6bee1U, 0xad17f088U, 0xac66c920U, 0x3ab47dceU, - 0x4a1863dfU, 0x3182e51aU, 0x33609751U, 0x7f456253U, - 0x77e0b164U, 0xae84bb6bU, 0xa01cfe81U, 0x2b94f908U, - 0x68587048U, 0xfd198f45U, 0x6c8794deU, 0xf8b7527bU, - 0xd323ab73U, 0x02e2724bU, 0x8f57e31fU, 0xab2a6655U, - 0x2807b2ebU, 0xc2032fb5U, 0x7b9a86c5U, 0x08a5d337U, - 0x87f23028U, 0xa5b223bfU, 0x6aba0203U, 0x825ced16U, - 0x1c2b8acfU, 0xb492a779U, 0xf2f0f307U, 0xe2a14e69U, - 0xf4cd65daU, 0xbed50605U, 0x621fd134U, 0xfe8ac4a6U, - 0x539d342eU, 0x55a0a2f3U, 0xe132058aU, 0xeb75a4f6U, - 0xec390b83U, 0xefaa4060U, 0x9f065e71U, 0x1051bd6eU, - - 0x8af93e21U, 0x063d96ddU, 0x05aedd3eU, 0xbd464de6U, - 0x8db59154U, 0x5d0571c4U, 0xd46f0406U, 0x15ff6050U, - 0xfb241998U, 0xe997d6bdU, 0x43cc8940U, 0x9e7767d9U, - 0x42bdb0e8U, 0x8b880789U, 0x5b38e719U, 0xeedb79c8U, - 0x0a47a17cU, 0x0fe97c42U, 0x1ec9f884U, 0x00000000U, - 0x86830980U, 0xed48322bU, 0x70ac1e11U, 0x724e6c5aU, - 0xfffbfd0eU, 0x38560f85U, 0xd51e3daeU, 0x3927362dU, - 0xd9640a0fU, 0xa621685cU, 0x54d19b5bU, 0x2e3a2436U, - 0x67b10c0aU, 0xe70f9357U, 0x96d2b4eeU, 0x919e1b9bU, - 0xc54f80c0U, 0x20a261dcU, 0x4b695a77U, 0x1a161c12U, - 0xba0ae293U, 0x2ae5c0a0U, 0xe0433c22U, 0x171d121bU, - 0x0d0b0e09U, 0xc7adf28bU, 0xa8b92db6U, 0xa9c8141eU, - 0x198557f1U, 0x074caf75U, 0xddbbee99U, 0x60fda37fU, - 0x269ff701U, 0xf5bc5c72U, 0x3bc54466U, 0x7e345bfbU, - 0x29768b43U, 0xc6dccb23U, 0xfc68b6edU, 0xf163b8e4U, - 0xdccad731U, 0x85104263U, 0x22401397U, 0x112084c6U, - 0x247d854aU, 0x3df8d2bbU, 0x3211aef9U, 0xa16dc729U, - 0x2f4b1d9eU, 0x30f3dcb2U, 0x52ec0d86U, 0xe3d077c1U, - 0x166c2bb3U, 0xb999a970U, 0x48fa1194U, 0x642247e9U, - 0x8cc4a8fcU, 0x3f1aa0f0U, 0x2cd8567dU, 0x90ef2233U, - 0x4ec78749U, 0xd1c1d938U, 0xa2fe8ccaU, 0x0b3698d4U, - 0x81cfa6f5U, 0xde28a57aU, 0x8e26dab7U, 0xbfa43fadU, - 0x9de42c3aU, 0x920d5078U, 0xcc9b6a5fU, 0x4662547eU, - 0x13c2f68dU, 0xb8e890d8U, 0xf75e2e39U, 0xaff582c3U, - 0x80be9f5dU, 0x937c69d0U, 0x2da96fd5U, 0x12b3cf25U, - 0x993bc8acU, 0x7da71018U, 0x636ee89cU, 0xbb7bdb3bU, - 0x7809cd26U, 0x18f46e59U, 0xb701ec9aU, 0x9aa8834fU, - 0x6e65e695U, 0xe67eaaffU, 0xcf0821bcU, 0xe8e6ef15U, - 0x9bd9bae7U, 0x36ce4a6fU, 0x09d4ea9fU, 0x7cd629b0U, - 0xb2af31a4U, 0x23312a3fU, 0x9430c6a5U, 0x66c035a2U, - 0xbc37744eU, 0xcaa6fc82U, 0xd0b0e090U, 0xd81533a7U, - 0x984af104U, 0xdaf741ecU, 0x500e7fcdU, 0xf62f1791U, - 0xd68d764dU, 0xb04d43efU, 0x4d54ccaaU, 0x04dfe496U, - 0xb5e39ed1U, 0x881b4c6aU, 0x1fb8c12cU, 0x517f4665U, - 0xea049d5eU, 0x355d018cU, 0x7473fa87U, 0x412efb0bU, - 0x1d5ab367U, 0xd25292dbU, 0x5633e910U, 0x47136dd6U, - 0x618c9ad7U, 0x0c7a37a1U, 0x148e59f8U, 0x3c89eb13U, - 0x27eecea9U, 0xc935b761U, 0xe5ede11cU, 0xb13c7a47U, - 0xdf599cd2U, 0x733f55f2U, 0xce791814U, 0x37bf73c7U, - 0xcdea53f7U, 0xaa5b5ffdU, 0x6f14df3dU, 0xdb867844U, - 0xf381caafU, 0xc43eb968U, 0x342c3824U, 0x405fc2a3U, - 0xc372161dU, 0x250cbce2U, 0x498b283cU, 0x9541ff0dU, - 0x017139a8U, 0xb3de080cU, 0xe49cd8b4U, 0xc1906456U, - 0x84617bcbU, 0xb670d532U, 0x5c74486cU, 0x5742d0b8U, -}; -const u32 Td3[256] = { - 0xf4a75051U, 0x4165537eU, 0x17a4c31aU, 0x275e963aU, - 0xab6bcb3bU, 0x9d45f11fU, 0xfa58abacU, 0xe303934bU, - 0x30fa5520U, 0x766df6adU, 0xcc769188U, 0x024c25f5U, - 0xe5d7fc4fU, 0x2acbd7c5U, 0x35448026U, 0x62a38fb5U, - 0xb15a49deU, 0xba1b6725U, 0xea0e9845U, 0xfec0e15dU, - 0x2f7502c3U, 0x4cf01281U, 0x4697a38dU, 0xd3f9c66bU, - 0x8f5fe703U, 0x929c9515U, 0x6d7aebbfU, 0x5259da95U, - 0xbe832dd4U, 0x7421d358U, 0xe0692949U, 0xc9c8448eU, - 0xc2896a75U, 0x8e7978f4U, 0x583e6b99U, 0xb971dd27U, - 0xe14fb6beU, 0x88ad17f0U, 0x20ac66c9U, 0xce3ab47dU, - 0xdf4a1863U, 0x1a3182e5U, 0x51336097U, 0x537f4562U, - 0x6477e0b1U, 0x6bae84bbU, 0x81a01cfeU, 0x082b94f9U, - 0x48685870U, 0x45fd198fU, 0xde6c8794U, 0x7bf8b752U, - 0x73d323abU, 0x4b02e272U, 0x1f8f57e3U, 0x55ab2a66U, - 0xeb2807b2U, 0xb5c2032fU, 0xc57b9a86U, 0x3708a5d3U, - 0x2887f230U, 0xbfa5b223U, 0x036aba02U, 0x16825cedU, - 0xcf1c2b8aU, 0x79b492a7U, 0x07f2f0f3U, 0x69e2a14eU, - 0xdaf4cd65U, 0x05bed506U, 0x34621fd1U, 0xa6fe8ac4U, - 0x2e539d34U, 0xf355a0a2U, 0x8ae13205U, 0xf6eb75a4U, - 0x83ec390bU, 0x60efaa40U, 0x719f065eU, 0x6e1051bdU, - 0x218af93eU, 0xdd063d96U, 0x3e05aeddU, 0xe6bd464dU, - 0x548db591U, 0xc45d0571U, 0x06d46f04U, 0x5015ff60U, - 0x98fb2419U, 0xbde997d6U, 0x4043cc89U, 0xd99e7767U, - 0xe842bdb0U, 0x898b8807U, 0x195b38e7U, 0xc8eedb79U, - 0x7c0a47a1U, 0x420fe97cU, 0x841ec9f8U, 0x00000000U, - 0x80868309U, 0x2bed4832U, 0x1170ac1eU, 0x5a724e6cU, - 0x0efffbfdU, 0x8538560fU, 0xaed51e3dU, 0x2d392736U, - 0x0fd9640aU, 0x5ca62168U, 0x5b54d19bU, 0x362e3a24U, - 0x0a67b10cU, 0x57e70f93U, 0xee96d2b4U, 0x9b919e1bU, - 0xc0c54f80U, 0xdc20a261U, 0x774b695aU, 0x121a161cU, - 0x93ba0ae2U, 0xa02ae5c0U, 0x22e0433cU, 0x1b171d12U, - 0x090d0b0eU, 0x8bc7adf2U, 0xb6a8b92dU, 0x1ea9c814U, - 0xf1198557U, 0x75074cafU, 0x99ddbbeeU, 0x7f60fda3U, - 0x01269ff7U, 0x72f5bc5cU, 0x663bc544U, 0xfb7e345bU, - 0x4329768bU, 0x23c6dccbU, 0xedfc68b6U, 0xe4f163b8U, - 0x31dccad7U, 0x63851042U, 0x97224013U, 0xc6112084U, - 0x4a247d85U, 0xbb3df8d2U, 0xf93211aeU, 0x29a16dc7U, - 0x9e2f4b1dU, 0xb230f3dcU, 0x8652ec0dU, 0xc1e3d077U, - 0xb3166c2bU, 0x70b999a9U, 0x9448fa11U, 0xe9642247U, - 0xfc8cc4a8U, 0xf03f1aa0U, 0x7d2cd856U, 0x3390ef22U, - 0x494ec787U, 0x38d1c1d9U, 0xcaa2fe8cU, 0xd40b3698U, - 0xf581cfa6U, 0x7ade28a5U, 0xb78e26daU, 0xadbfa43fU, - 0x3a9de42cU, 0x78920d50U, 0x5fcc9b6aU, 0x7e466254U, - 0x8d13c2f6U, 0xd8b8e890U, 0x39f75e2eU, 0xc3aff582U, - 0x5d80be9fU, 0xd0937c69U, 0xd52da96fU, 0x2512b3cfU, - 0xac993bc8U, 0x187da710U, 0x9c636ee8U, 0x3bbb7bdbU, - 0x267809cdU, 0x5918f46eU, 0x9ab701ecU, 0x4f9aa883U, - 0x956e65e6U, 0xffe67eaaU, 0xbccf0821U, 0x15e8e6efU, - 0xe79bd9baU, 0x6f36ce4aU, 0x9f09d4eaU, 0xb07cd629U, - 0xa4b2af31U, 0x3f23312aU, 0xa59430c6U, 0xa266c035U, - 0x4ebc3774U, 0x82caa6fcU, 0x90d0b0e0U, 0xa7d81533U, - 0x04984af1U, 0xecdaf741U, 0xcd500e7fU, 0x91f62f17U, - 0x4dd68d76U, 0xefb04d43U, 0xaa4d54ccU, 0x9604dfe4U, - 0xd1b5e39eU, 0x6a881b4cU, 0x2c1fb8c1U, 0x65517f46U, - 0x5eea049dU, 0x8c355d01U, 0x877473faU, 0x0b412efbU, - 0x671d5ab3U, 0xdbd25292U, 0x105633e9U, 0xd647136dU, - 0xd7618c9aU, 0xa10c7a37U, 0xf8148e59U, 0x133c89ebU, - 0xa927eeceU, 0x61c935b7U, 0x1ce5ede1U, 0x47b13c7aU, - 0xd2df599cU, 0xf2733f55U, 0x14ce7918U, 0xc737bf73U, - 0xf7cdea53U, 0xfdaa5b5fU, 0x3d6f14dfU, 0x44db8678U, - 0xaff381caU, 0x68c43eb9U, 0x24342c38U, 0xa3405fc2U, - 0x1dc37216U, 0xe2250cbcU, 0x3c498b28U, 0x0d9541ffU, - 0xa8017139U, 0x0cb3de08U, 0xb4e49cd8U, 0x56c19064U, - 0xcb84617bU, 0x32b670d5U, 0x6c5c7448U, 0xb85742d0U, -}; -const u32 Td4[256] = { - 0x52525252U, 0x09090909U, 0x6a6a6a6aU, 0xd5d5d5d5U, - 0x30303030U, 0x36363636U, 0xa5a5a5a5U, 0x38383838U, - 0xbfbfbfbfU, 0x40404040U, 0xa3a3a3a3U, 0x9e9e9e9eU, - 0x81818181U, 0xf3f3f3f3U, 0xd7d7d7d7U, 0xfbfbfbfbU, - 0x7c7c7c7cU, 0xe3e3e3e3U, 0x39393939U, 0x82828282U, - 0x9b9b9b9bU, 0x2f2f2f2fU, 0xffffffffU, 0x87878787U, - 0x34343434U, 0x8e8e8e8eU, 0x43434343U, 0x44444444U, - 0xc4c4c4c4U, 0xdedededeU, 0xe9e9e9e9U, 0xcbcbcbcbU, - 0x54545454U, 0x7b7b7b7bU, 0x94949494U, 0x32323232U, - 0xa6a6a6a6U, 0xc2c2c2c2U, 0x23232323U, 0x3d3d3d3dU, - 0xeeeeeeeeU, 0x4c4c4c4cU, 0x95959595U, 0x0b0b0b0bU, - 0x42424242U, 0xfafafafaU, 0xc3c3c3c3U, 0x4e4e4e4eU, - 0x08080808U, 0x2e2e2e2eU, 0xa1a1a1a1U, 0x66666666U, - 0x28282828U, 0xd9d9d9d9U, 0x24242424U, 0xb2b2b2b2U, - 0x76767676U, 0x5b5b5b5bU, 0xa2a2a2a2U, 0x49494949U, - 0x6d6d6d6dU, 0x8b8b8b8bU, 0xd1d1d1d1U, 0x25252525U, - 0x72727272U, 0xf8f8f8f8U, 0xf6f6f6f6U, 0x64646464U, - 0x86868686U, 0x68686868U, 0x98989898U, 0x16161616U, - 0xd4d4d4d4U, 0xa4a4a4a4U, 0x5c5c5c5cU, 0xccccccccU, - 0x5d5d5d5dU, 0x65656565U, 0xb6b6b6b6U, 0x92929292U, - 0x6c6c6c6cU, 0x70707070U, 0x48484848U, 0x50505050U, - 0xfdfdfdfdU, 0xededededU, 0xb9b9b9b9U, 0xdadadadaU, - 0x5e5e5e5eU, 0x15151515U, 0x46464646U, 0x57575757U, - 0xa7a7a7a7U, 0x8d8d8d8dU, 0x9d9d9d9dU, 0x84848484U, - 0x90909090U, 0xd8d8d8d8U, 0xababababU, 0x00000000U, - 0x8c8c8c8cU, 0xbcbcbcbcU, 0xd3d3d3d3U, 0x0a0a0a0aU, - 0xf7f7f7f7U, 0xe4e4e4e4U, 0x58585858U, 0x05050505U, - 0xb8b8b8b8U, 0xb3b3b3b3U, 0x45454545U, 0x06060606U, - 0xd0d0d0d0U, 0x2c2c2c2cU, 0x1e1e1e1eU, 0x8f8f8f8fU, - 0xcacacacaU, 0x3f3f3f3fU, 0x0f0f0f0fU, 0x02020202U, - 0xc1c1c1c1U, 0xafafafafU, 0xbdbdbdbdU, 0x03030303U, - 0x01010101U, 0x13131313U, 0x8a8a8a8aU, 0x6b6b6b6bU, - 0x3a3a3a3aU, 0x91919191U, 0x11111111U, 0x41414141U, - 0x4f4f4f4fU, 0x67676767U, 0xdcdcdcdcU, 0xeaeaeaeaU, - 0x97979797U, 0xf2f2f2f2U, 0xcfcfcfcfU, 0xcecececeU, - 0xf0f0f0f0U, 0xb4b4b4b4U, 0xe6e6e6e6U, 0x73737373U, - 0x96969696U, 0xacacacacU, 0x74747474U, 0x22222222U, - 0xe7e7e7e7U, 0xadadadadU, 0x35353535U, 0x85858585U, - 0xe2e2e2e2U, 0xf9f9f9f9U, 0x37373737U, 0xe8e8e8e8U, - 0x1c1c1c1cU, 0x75757575U, 0xdfdfdfdfU, 0x6e6e6e6eU, - 0x47474747U, 0xf1f1f1f1U, 0x1a1a1a1aU, 0x71717171U, - 0x1d1d1d1dU, 0x29292929U, 0xc5c5c5c5U, 0x89898989U, - 0x6f6f6f6fU, 0xb7b7b7b7U, 0x62626262U, 0x0e0e0e0eU, - 0xaaaaaaaaU, 0x18181818U, 0xbebebebeU, 0x1b1b1b1bU, - 0xfcfcfcfcU, 0x56565656U, 0x3e3e3e3eU, 0x4b4b4b4bU, - 0xc6c6c6c6U, 0xd2d2d2d2U, 0x79797979U, 0x20202020U, - 0x9a9a9a9aU, 0xdbdbdbdbU, 0xc0c0c0c0U, 0xfefefefeU, - 0x78787878U, 0xcdcdcdcdU, 0x5a5a5a5aU, 0xf4f4f4f4U, - 0x1f1f1f1fU, 0xddddddddU, 0xa8a8a8a8U, 0x33333333U, - 0x88888888U, 0x07070707U, 0xc7c7c7c7U, 0x31313131U, - 0xb1b1b1b1U, 0x12121212U, 0x10101010U, 0x59595959U, - 0x27272727U, 0x80808080U, 0xececececU, 0x5f5f5f5fU, - 0x60606060U, 0x51515151U, 0x7f7f7f7fU, 0xa9a9a9a9U, - 0x19191919U, 0xb5b5b5b5U, 0x4a4a4a4aU, 0x0d0d0d0dU, - 0x2d2d2d2dU, 0xe5e5e5e5U, 0x7a7a7a7aU, 0x9f9f9f9fU, - 0x93939393U, 0xc9c9c9c9U, 0x9c9c9c9cU, 0xefefefefU, - 0xa0a0a0a0U, 0xe0e0e0e0U, 0x3b3b3b3bU, 0x4d4d4d4dU, - 0xaeaeaeaeU, 0x2a2a2a2aU, 0xf5f5f5f5U, 0xb0b0b0b0U, - 0xc8c8c8c8U, 0xebebebebU, 0xbbbbbbbbU, 0x3c3c3c3cU, - 0x83838383U, 0x53535353U, 0x99999999U, 0x61616161U, - 0x17171717U, 0x2b2b2b2bU, 0x04040404U, 0x7e7e7e7eU, - 0xbabababaU, 0x77777777U, 0xd6d6d6d6U, 0x26262626U, - 0xe1e1e1e1U, 0x69696969U, 0x14141414U, 0x63636363U, - 0x55555555U, 0x21212121U, 0x0c0c0c0cU, 0x7d7d7d7dU, -}; -const u32 rcon[] = { - 0x01000000, 0x02000000, 0x04000000, 0x08000000, - 0x10000000, 0x20000000, 0x40000000, 0x80000000, - 0x1B000000, 0x36000000, /* for 128-bit blocks, Rijndael never uses more than 10 rcon values */ -}; - -static void do_test(int keybits, u8 * key, - u8 plain[16], u8 cipher[16], - int testno1, int testno2) -{ - u32 ckey[4 * (MAXNR + 1)]; - u8 temp[16]; - int nr; - int ok; - - nr = rijndaelKeySetupEnc(ckey, key, keybits); - rijndaelEncrypt(ckey, nr, plain, temp); - ok = memcmp(temp, cipher, 16) == 0; - printf("Encryption test %d %s\n", testno1, ok ? "passed" : "FAILED"); - nr = rijndaelKeySetupDec(ckey, key, keybits); - rijndaelDecrypt(ckey, nr, cipher, temp); - ok = memcmp(temp, plain, 16) == 0; - printf("Decryption test %d %s\n", testno2, ok ? "passed" : "FAILED"); -} - -static void do_bench(int nblocks) -{ - u32 ckey[4 * (MAXNR + 1)]; - u8 temp[16]; - int nr; - - nr = rijndaelKeySetupEnc(ckey, (u8 *)"\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x0C\x0D\x0E\x0F", 128); - for (; nblocks > 0; nblocks--) - rijndaelEncrypt(ckey, nr, temp, temp); -} - -int main(int argc, char ** argv) -{ - if (argc < 2) { - do_test(128, - (u8 *)"\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x0C\x0D\x0E\x0F", - (u8 *)"\x00\x11\x22\x33\x44\x55\x66\x77\x88\x99\xAA\xBB\xCC\xDD\xEE\xFF", - (u8 *)"\x69\xC4\xE0\xD8\x6A\x7B\x04\x30\xD8\xCD\xB7\x80\x70\xB4\xC5\x5A", - 1, 2); - do_test(192, - (u8 *)"\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x0C\x0D\x0E\x0F\x10\x11\x12\x13\x14\x15\x16\x17", - (u8 *)"\x00\x11\x22\x33\x44\x55\x66\x77\x88\x99\xAA\xBB\xCC\xDD\xEE\xFF", - (u8 *)"\xDD\xA9\x7C\xA4\x86\x4C\xDF\xE0\x6E\xAF\x70\xA0\xEC\x0D\x71\x91", - 3, 4); - do_test(256, - (u8 *)"\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x0C\x0D\x0E\x0F\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1A\x1B\x1C\x1D\x1E\x1F", - (u8 *)"\x00\x11\x22\x33\x44\x55\x66\x77\x88\x99\xAA\xBB\xCC\xDD\xEE\xFF", - (u8 *)"\x8E\xA2\xB7\xCA\x51\x67\x45\xBF\xEA\xFC\x49\x90\x4B\x49\x60\x89", - 5, 6); - } else { - do_bench(atoi(argv[1])); - } - return 0; -} - - - - diff --git a/test/cminor/mainalmabench.c b/test/cminor/mainalmabench.c deleted file mode 100644 index c514ccae..00000000 --- a/test/cminor/mainalmabench.c +++ /dev/null @@ -1,185 +0,0 @@ -#include <stdio.h> -#include <stdlib.h> -#include <math.h> - -static const double J2000 = 2451545.0; -static const int TEST_LENGTH = 36525; - -const double amas [8] = { 6023600.0, 408523.5, 328900.5, 3098710.0, 1047.355, 3498.5, 22869.0, 19314.0 }; - -const double a [8][3] = - { { 0.3870983098, 0, 0 }, - { 0.7233298200, 0, 0 }, - { 1.0000010178, 0, 0 }, - { 1.5236793419, 3e-10, 0 }, - { 5.2026032092, 19132e-10, -39e-10 }, - { 9.5549091915, -0.0000213896, 444e-10 }, - { 19.2184460618, -3716e-10, 979e-10 }, - { 30.1103868694, -16635e-10, 686e-10 } }; - -const double dlm[8][3] = - { { 252.25090552, 5381016286.88982, -1.92789 }, - { 181.97980085, 2106641364.33548, 0.59381 }, - { 100.46645683, 1295977422.83429, -2.04411 }, - { 355.43299958, 689050774.93988, 0.94264 }, - { 34.35151874, 109256603.77991, -30.60378 }, - { 50.07744430, 43996098.55732, 75.61614 }, - { 314.05500511, 15424811.93933, -1.75083 }, - { 304.34866548, 7865503.20744, 0.21103 } }; - -const double e[8][3] = - { { 0.2056317526, 0.0002040653, -28349e-10 }, - { 0.0067719164, -0.0004776521, 98127e-10 }, - { 0.0167086342, -0.0004203654, -0.0000126734 }, - { 0.0934006477, 0.0009048438, -80641e-10 }, - { 0.0484979255, 0.0016322542, -0.0000471366 }, - { 0.0555481426, -0.0034664062, -0.0000643639 }, - { 0.0463812221, -0.0002729293, 0.0000078913 }, - { 0.0094557470, 0.0000603263, 0 } }; - -const double pi[8][3] = - { { 77.45611904, 5719.11590, -4.83016 }, - { 131.56370300, 175.48640, -498.48184 }, - { 102.93734808, 11612.35290, 53.27577 }, - { 336.06023395, 15980.45908, -62.32800 }, - { 14.33120687, 7758.75163, 259.95938 }, - { 93.05723748, 20395.49439, 190.25952 }, - { 173.00529106, 3215.56238, -34.09288 }, - { 48.12027554, 1050.71912, 27.39717 } }; - -const double dinc[8][3] = - { { 7.00498625, -214.25629, 0.28977 }, - { 3.39466189, -30.84437, -11.67836 }, - { 0, 469.97289, -3.35053 }, - { 1.84972648, -293.31722, -8.11830 }, - { 1.30326698, -71.55890, 11.95297 }, - { 2.48887878, 91.85195, -17.66225 }, - { 0.77319689, -60.72723, 1.25759 }, - { 1.76995259, 8.12333, 0.08135 } }; - -const double omega[8][3] = - { { 48.33089304, -4515.21727, -31.79892 }, - { 76.67992019, -10008.48154, -51.32614 }, - { 174.87317577, -8679.27034, 15.34191 }, - { 49.55809321, -10620.90088, -230.57416 }, - { 100.46440702, 6362.03561, 326.52178 }, - { 113.66550252, -9240.19942, -66.23743 }, - { 74.00595701, 2669.15033, 145.93964 }, - { 131.78405702, -221.94322, -0.78728 } }; - -const double kp[8][9] = - { { 69613.0, 75645.0, 88306.0, 59899.0, 15746.0, 71087.0, 142173.0, 3086.0, 0.0 }, - { 21863.0, 32794.0, 26934.0, 10931.0, 26250.0, 43725.0, 53867.0, 28939.0, 0.0 }, - { 16002.0, 21863.0, 32004.0, 10931.0, 14529.0, 16368.0, 15318.0, 32794.0, 0.0 }, - { 6345.0, 7818.0, 15636.0, 7077.0, 8184.0, 14163.0, 1107.0, 4872.0, 0.0 }, - { 1760.0, 1454.0, 1167.0, 880.0, 287.0, 2640.0, 19.0, 2047.0, 1454.0 }, - { 574.0, 0.0, 880.0, 287.0, 19.0, 1760.0, 1167.0, 306.0, 574.0 }, - { 204.0, 0.0, 177.0, 1265.0, 4.0, 385.0, 200.0, 208.0, 204.0 }, - { 0.0, 102.0, 106.0, 4.0, 98.0, 1367.0, 487.0, 204.0, 0.0 } }; - -const double ca[8][9] = - { { 4.0, -13.0, 11.0, -9.0, -9.0, -3.0, -1.0, 4.0, 0.0 }, - { -156.0, 59.0, -42.0, 6.0, 19.0, -20.0, -10.0, -12.0, 0.0 }, - { 64.0, -152.0, 62.0, -8.0, 32.0, -41.0, 19.0, -11.0, 0.0 }, - { 124.0, 621.0, -145.0, 208.0, 54.0, -57.0, 30.0, 15.0, 0.0 }, - { -23437.0, -2634.0, 6601.0, 6259.0, -1507.0, -1821.0, 2620.0, -2115.0,-1489.0 }, - { 62911.0,-119919.0, 79336.0, 17814.0,-24241.0, 12068.0, 8306.0, -4893.0, 8902.0 }, - { 389061.0,-262125.0,-44088.0, 8387.0,-22976.0, -2093.0, -615.0, -9720.0, 6633.0 }, - { -412235.0,-157046.0,-31430.0, 37817.0, -9740.0, -13.0, -7449.0, 9644.0, 0.0 } }; - -const double sa[8][9] = - { { -29.0, -1.0, 9.0, 6.0, -6.0, 5.0, 4.0, 0.0, 0.0 }, - { -48.0, -125.0, -26.0, -37.0, 18.0, -13.0, -20.0, -2.0, 0.0 }, - { -150.0, -46.0, 68.0, 54.0, 14.0, 24.0, -28.0, 22.0, 0.0 }, - { -621.0, 532.0, -694.0, -20.0, 192.0, -94.0, 71.0, -73.0, 0.0 }, - { -14614.0,-19828.0, -5869.0, 1881.0, -4372.0, -2255.0, 782.0, 930.0, 913.0 }, - { 139737.0, 0.0, 24667.0, 51123.0, -5102.0, 7429.0, -4095.0, -1976.0,-9566.0 }, - { -138081.0, 0.0, 37205.0,-49039.0,-41901.0,-33872.0,-27037.0,-12474.0,18797.0 }, - { 0.0, 28492.0,133236.0, 69654.0, 52322.0,-49577.0,-26430.0, -3593.0, 0.0 } }; - -const double kq[8][10] = - { { 3086.0, 15746.0, 69613.0, 59899.0, 75645.0, 88306.0, 12661.0, 2658.0, 0.0, 0.0 }, - { 21863.0, 32794.0, 10931.0, 73.0, 4387.0, 26934.0, 1473.0, 2157.0, 0.0, 0.0 }, - { 10.0, 16002.0, 21863.0, 10931.0, 1473.0, 32004.0, 4387.0, 73.0, 0.0, 0.0 }, - { 10.0, 6345.0, 7818.0, 1107.0, 15636.0, 7077.0, 8184.0, 532.0, 10.0, 0.0 }, - { 19.0, 1760.0, 1454.0, 287.0, 1167.0, 880.0, 574.0, 2640.0, 19.0,1454.0 }, - { 19.0, 574.0, 287.0, 306.0, 1760.0, 12.0, 31.0, 38.0, 19.0, 574.0 }, - { 4.0, 204.0, 177.0, 8.0, 31.0, 200.0, 1265.0, 102.0, 4.0, 204.0 }, - { 4.0, 102.0, 106.0, 8.0, 98.0, 1367.0, 487.0, 204.0, 4.0, 102.0 } }; - -const double cl[8][10] = - { { 21.0, -95.0, -157.0, 41.0, -5.0, 42.0, 23.0, 30.0, 0.0, 0.0 }, - { -160.0, -313.0, -235.0, 60.0, -74.0, -76.0, -27.0, 34.0, 0.0, 0.0 }, - { -325.0, -322.0, -79.0, 232.0, -52.0, 97.0, 55.0, -41.0, 0.0, 0.0 }, - { 2268.0, -979.0, 802.0, 602.0, -668.0, -33.0, 345.0, 201.0, -55.0, 0.0 }, - { 7610.0, -4997.0,-7689.0,-5841.0,-2617.0, 1115.0, -748.0, -607.0, 6074.0, 354.0 }, - { -18549.0, 30125.0,20012.0, -730.0, 824.0, 23.0, 1289.0, -352.0,-14767.0,-2062.0 }, - { -135245.0,-14594.0, 4197.0,-4030.0,-5630.0,-2898.0, 2540.0, -306.0, 2939.0, 1986.0 }, - { 89948.0, 2103.0, 8963.0, 2695.0, 3682.0, 1648.0, 866.0, -154.0, -1963.0, -283.0 } }; - -const double sl[8][10] = - { { -342.0, 136.0, -23.0, 62.0, 66.0, -52.0, -33.0, 17.0, 0.0, 0.0 }, - { 524.0, -149.0, -35.0, 117.0, 151.0, 122.0, -71.0, -62.0, 0.0, 0.0 }, - { -105.0, -137.0, 258.0, 35.0, -116.0, -88.0, -112.0, -80.0, 0.0, 0.0 }, - { 854.0, -205.0, -936.0, -240.0, 140.0, -341.0, -97.0, -232.0, 536.0, 0.0 }, - { -56980.0, 8016.0, 1012.0, 1448.0,-3024.0,-3710.0, 318.0, 503.0, 3767.0, 577.0 }, - { 138606.0,-13478.0,-4964.0, 1441.0,-1319.0,-1482.0, 427.0, 1236.0, -9167.0,-1918.0 }, - { 71234.0,-41116.0, 5334.0,-4935.0,-1848.0, 66.0, 434.0,-1748.0, 3780.0, -701.0 }, - { -47645.0, 11647.0, 2166.0, 3194.0, 679.0, 0.0, -244.0, -419.0, -2531.0, 48.0 } }; - -extern void planetpv (double epoch[2], int np, double pv[2][3]); -extern void radecdist(double state[2][3], double rdd[3]); - -static void test(void) -{ - int p; - double jd[2]; - double pv[2][3]; - double position[3]; - - jd[0] = J2000; - jd[1] = 0.0; - for (p = 0; p < 8; ++p) - { - planetpv(jd,p,pv); - radecdist(pv,position); - printf("p = %d position[0] = %g position[1] = %g\n", - p, position[0], position[1]); - } -} - - -static void bench(int nloops) -{ - int i, n, p; - double jd[2]; - double pv[2][3]; - double position[3]; - - for (i = 0; i < nloops; ++i) - { - jd[0] = J2000; - jd[1] = 0.0; - - for (n = 0; n < TEST_LENGTH; ++n) - { - jd[0] += 1.0; - - for (p = 0; p < 8; ++p) - { - planetpv(jd,p,pv); - radecdist(pv,position); - } - } - } -} - -int main(int argc, char ** argv) -{ - if (argc >= 2) - bench(atoi(argv[1])); - else - test(); - return 0; -} - diff --git a/test/cminor/mainconversions.c b/test/cminor/mainconversions.c deleted file mode 100644 index a274e991..00000000 --- a/test/cminor/mainconversions.c +++ /dev/null @@ -1,115 +0,0 @@ -#include <stdio.h> -#include <math.h> - -extern void intoffloat(int * r, double * x); -extern void intuoffloat(unsigned int * r, double * x); -extern void floatofint(double * r, int * x); -extern void floatofintu(double * r, unsigned int * x); - -/* Linear congruential PRNG */ - -static unsigned int random_seed = 0; - -unsigned int random_uint(void) -{ - random_seed = random_seed * 69069 + 25173; - return random_seed; -} - -double random_double(void) -{ - /* In range 0 .. 2^32+1 */ - unsigned int h = random_uint(); - unsigned int l = random_uint(); - return (double) h + ldexp((double) l, -32); -} - -/* Individual test runs */ - -void test_intoffloat(double x) -{ - int r; - intoffloat(&r, &x); - if (r != (int) x) - printf("intoffloat(%g): expected %d, got %d\n", x, r, (int) x); -} - -void test_intuoffloat(double x) -{ - unsigned int r; - intuoffloat(&r, &x); - if (r != (unsigned int) x) - printf("intuoffloat(%g): expected %d, got %d\n", x, r, (unsigned int) x); -} - -void test_floatofint(int x) -{ - double r; - floatofint(&r, &x); - if (r != (double) x) - printf("floatofint(%d): expected %g, got %g\n", x, r, (double) x); -} - -void test_floatofintu(unsigned int x) -{ - double r; - floatofintu(&r, &x); - if (r != (double) x) - printf("floatofint(%u): expected %g, got %g\n", x, r, (double) x); -} - -/* Limit cases */ - -double cases_intoffloat[] = { - 0.0, 0.1, 0.5, 0.9, 1.0, 1.1, 1.6, - -0.1, -0.5, -0.9, -1.0, -1.1, -1.6, - 2147483647.0, 2147483647.6, 2147483648.0, 2147483647.5, - 2147483648.0, 2147483648.5, 2147483649.0, 10000000000.0, - -2147483647.0, -2147483647.6, -2147483648.0, -2147483647.5, - -2147483648.0, -2147483648.5, -2147483649.0, -10000000000.0 -}; - -double cases_intuoffloat[] = { - 0.0, 0.1, 0.5, 0.9, 1.0, 1.1, 1.6, - -0.1, -0.5, -0.9, -1.0, -1.1, -1.6, - 2147483647.0, 2147483647.6, 2147483648.0, 2147483647.5, - 2147483648.0, 2147483648.5, 2147483649.0, - 4294967295.0, 4294967295.6, 4294967296.0, 4294967296.5, - 10000000000.0 -}; - -int cases_floatofint[] = { - 0, 1, 2, -1, -2, 2147483647, -2147483648 -}; - -unsigned int cases_floatofintu[] = { - 0U, 1U, 2U, 2147483647U, 2147483648U, 4294967295U -}; - -#define TEST(testfun, cases, tyarg, gen) \ - for (i = 0; i < sizeof(cases) / sizeof(tyarg); i++) \ - testfun(cases[i]); \ - for (i = 0; i < numtests; i++) \ - testfun(gen); - -int main(int argc, char ** argv) -{ - int i; - int numtests = 1000000; - - TEST(test_intoffloat, cases_intoffloat, double, - (random_double() - 2147483648.0)); - TEST(test_intuoffloat, cases_intuoffloat, double, - random_double()); - TEST(test_floatofint, cases_floatofint, int, - (int) random_uint()); - TEST(test_floatofintu, cases_floatofintu, unsigned int, - random_uint()); - return 0; -} - - - - - - diff --git a/test/cminor/mainfft.c b/test/cminor/mainfft.c deleted file mode 100644 index ce75062c..00000000 --- a/test/cminor/mainfft.c +++ /dev/null @@ -1,72 +0,0 @@ -#undef DEBUG -#include <math.h> -#include <stdlib.h> -#include <stdio.h> - -#define PI 3.14159265358979323846 - -extern void dfft(double * xr, double * xi, int np); - -double * xr, * xi; - -#ifdef DEBUG -void trace() -{ - int i; - for (i=0; i<=15; i++) printf("%d %g %g\n",i,xr[i],xi[i]); - printf("-----------\n"); -} -void print_int(int n) { printf("%d\n", n); } -void print_float(double x) { printf("%g\n", x); } -#endif - -int main(int argc, char ** argv) -{ - int n, np, npm, n2, i, j; - double enp, t, y, z, zr, zi, zm, a; - double * pxr, * pxi; - - if (argc >= 2) n = atoi(argv[1]); else n = 12; - np = 1 << n; - enp = np; - npm = np / 2 - 1; - t = PI / enp; - xr = calloc(np, sizeof(double)); - xi = calloc(np, sizeof(double)); - pxr = xr; - pxi = xi; - *pxr = (enp - 1.0) * 0.5; - *pxi = 0.0; - n2 = np / 2; - *(pxr+n2) = -0.5; - *(pxi+n2) = 0.0; - for (i = 1; i <= npm; i++) { - j = np - i; - *(pxr+i) = -0.5; - *(pxr+j) = -0.5; - z = t * (double)i; - y = -0.5*(cos(z)/sin(z)); - *(pxi+i) = y; - *(pxi+j) = -y; - } -#ifdef DEBUG - trace(); -#endif - dfft(xr,xi,np); -#ifdef DEBUG - trace(); -#endif - zr = 0.0; - zi = 0.0; - npm = np-1; - for (i = 0; i <= npm; i++ ) { - a = fabs(pxr[i] - i); - if (zr < a) zr = a; - a = fabs(pxi[i]); - if (zi < a) zi = a; - } - zm = zr; - if (zr < zi) zm = zi; - printf("%d points, error %g\n", np, zm); - return 0; -} diff --git a/test/cminor/mainfib.c b/test/cminor/mainfib.c deleted file mode 100644 index a736d70b..00000000 --- a/test/cminor/mainfib.c +++ /dev/null @@ -1,13 +0,0 @@ -#include <stdlib.h> -#include <stdio.h> - -extern int fib(int); - -int main(int argc, char ** argv) -{ - int n, r; - if (argc >= 2) n = atoi(argv[1]); else n = 30; - r = fib(n); - printf("fib(%d) = %d\n", n, r); - return 0; -} diff --git a/test/cminor/maingc.c b/test/cminor/maingc.c deleted file mode 100644 index c7a2e8e1..00000000 --- a/test/cminor/maingc.c +++ /dev/null @@ -1,223 +0,0 @@ -/* Test harness for the simple garbage collectors */ - -#include <stdio.h> -#include <stddef.h> -#include <stdlib.h> -#include <math.h> - -extern int init_heap(int hsize); - -enum block_kind { RAWDATA = 0, PTRDATA = 1, CLOSURE = 2 }; - -struct rootblock { - struct rootblock * next; - int numroots; - void * root[8]; -}; - -extern void * alloc_block(struct rootblock * roots, - enum block_kind kind, - int size); - -#ifdef DEBUG -extern void check_heap(void); -#endif - -void gc_alarm(int live) -{ - if (live == -1) - printf("<GC...>\n"); - else - printf("<GC...%d bytes live>\n", live); -#ifdef DEBUG - check_heap(); -#endif -} - -/* Test with binary trees */ - -typedef struct { - long i; -} boxedInt; - -boxedInt * BoxInt(struct rootblock * r, long n) -{ - boxedInt * new = (boxedInt *) alloc_block(r, RAWDATA, sizeof(long)); - new->i = n; - return new; -} - -typedef struct tn { - struct tn* left; - struct tn* right; - boxedInt * item; -} treeNode; - -treeNode* NewTreeNode(struct rootblock * r, - treeNode* left, treeNode* right, long item) -{ - struct rootblock nr; - treeNode* new; - boxedInt* bitem; - - nr.next = r; nr.numroots = 2; nr.root[0] = left; nr.root[1] = right; - - bitem = BoxInt(&nr, item); - - nr.numroots = 3; nr.root[2] = bitem; - - new = (treeNode*) alloc_block(&nr, PTRDATA, sizeof(treeNode)); - - new->left = (treeNode *) nr.root[0]; - new->right = (treeNode *) nr.root[1]; - new->item = (boxedInt *) nr.root[2]; - - return new; -} - - -long ItemCheck(treeNode* tree) -{ - if (tree->left == NULL) - return tree->item->i; - else - return tree->item->i + ItemCheck(tree->left) - ItemCheck(tree->right); -} - - -treeNode* BottomUpTree(struct rootblock * r, long item, unsigned depth) -{ - struct rootblock nr; - - if (depth > 0) { - nr.next = r; nr.numroots = 0; - nr.root[0] = BottomUpTree(&nr, 2 * item - 1, depth - 1); - nr.numroots = 1; - nr.root[1] = BottomUpTree(&nr, 2 * item, depth - 1); - nr.numroots = 2; - return NewTreeNode(&nr, - (treeNode *) nr.root[0], - (treeNode *) nr.root[1], - item); - } else { - return NewTreeNode(r, NULL, NULL, item); - } -} - -treeNode* SkinnyTree(struct rootblock * r, unsigned depth) -{ - struct rootblock nr; - - if (depth > 0) { - nr.next = r; nr.numroots = 0; - nr.root[0] = SkinnyTree(&nr, depth - 1); - nr.numroots = 1; - return NewTreeNode(&nr, - (treeNode *) nr.root[0], - (treeNode *) nr.root[0], - depth); - } else { - return NULL; - } -} - -void test(unsigned N) -{ - unsigned depth, minDepth, maxDepth, stretchDepth; - struct rootblock r; - - minDepth = 4; - - if ((minDepth + 2) > N) - maxDepth = minDepth + 2; - else - maxDepth = N; - - stretchDepth = maxDepth + 1; - - r.next = NULL; r.numroots = 0; - - r.root[0] = BottomUpTree(&r, 0, stretchDepth); - printf - ( - "stretch tree of depth %u\t check: %li\n", - stretchDepth, - ItemCheck(r.root[0]) - ); - - r.root[0] = SkinnyTree(&r, stretchDepth); - - r.root[0] = BottomUpTree(&r, 0, maxDepth); - r.numroots = 1; - - r.root[1] = SkinnyTree(&r, stretchDepth); - r.numroots = 2; - - for (depth = minDepth; depth <= maxDepth; depth += 2) { - long i, iterations, check; - - iterations = pow(2, maxDepth - depth + minDepth); - - check = 0; - - for (i = 1; i <= iterations; i++) { - r.root[2] = BottomUpTree(&r, i, depth); - check += ItemCheck(r.root[2]); - r.root[2] = BottomUpTree(&r, -i, depth); - check += ItemCheck(r.root[2]); - } - - printf - ( - "%li\t trees of depth %u\t check: %li\n", - iterations * 2, - depth, - check - ); - } - - printf - ( - "long lived tree of depth %u\t check: %li\n", - maxDepth, - ItemCheck(r.root[0]) - ); - - printf - ( - "skinny tree of depth %u\t\t check: %li\n", - stretchDepth, - ItemCheck(r.root[1]) - ); -} - -int main(int argc, char ** argv) -{ - int N, heapsize; - - N = argc > 1 ? atoi(argv[1]) : 16; - heapsize = argc > 2 ? atoi(argv[2]) : 8 * 1024 * 1024; - - if (init_heap(heapsize) == -1) { - fprintf(stderr, "Failed to allocate heap.\n"); - return 2; - } - test(N); -} - -/********************************* - -PROGRAM OUTPUT -============== -stretch tree of depth 17 check: -1 -131072 trees of depth 4 check: -131072 -32768 trees of depth 6 check: -32768 -8192 trees of depth 8 check: -8192 -2048 trees of depth 10 check: -2048 -512 trees of depth 12 check: -512 -128 trees of depth 14 check: -128 -32 trees of depth 16 check: -32 -long lived tree of depth 16 check: -1 - -***********************************/ - diff --git a/test/cminor/mainintegr.c b/test/cminor/mainintegr.c deleted file mode 100644 index 5f5bdfe0..00000000 --- a/test/cminor/mainintegr.c +++ /dev/null @@ -1,13 +0,0 @@ -#include <stdlib.h> -#include <stdio.h> - -extern double test(int); - -int main(int argc, char ** argv) -{ - int n; double r; - if (argc >= 2) n = atoi(argv[1]); else n = 10000; - r = test(n); - printf("integr(square, 0.0, 1.0, %d) = %g\n", n, r); - return 0; -} diff --git a/test/cminor/mainlists.c b/test/cminor/mainlists.c deleted file mode 100644 index 281b919f..00000000 --- a/test/cminor/mainlists.c +++ /dev/null @@ -1,35 +0,0 @@ -#include <stdio.h> -#include <stddef.h> -#include <stdlib.h> - -struct cons { int hd; struct cons * tl; }; -typedef struct cons * list; - -extern list buildlist(int n); -extern list reverselist(list l); - -int checklist(int n, list l) -{ - int i; - for (i = 0; i <= n; i++) { - if (l == NULL) return 0; - if (l->hd != i) return 0; - l = l->tl; - } - return (l == NULL); -} - -int main(int argc, char ** argv) -{ - int n; - - if (argc >= 2) n = atoi(argv[1]); else n = 10; - if (checklist(n, reverselist(buildlist(n)))) { - printf("OK\n"); - return 0; - } else { - printf("Bug!\n"); - return 2; - } -} - diff --git a/test/cminor/mainmanyargs.c b/test/cminor/mainmanyargs.c deleted file mode 100644 index 36bcf762..00000000 --- a/test/cminor/mainmanyargs.c +++ /dev/null @@ -1,13 +0,0 @@ -#include <stdio.h> - -void print_int(int n) { printf("%d\n", n); } -void print_float(double n) { printf("%g\n", n); } - -extern void g(int,int,int,int,int, - double,double,double,double,double); - -int main() -{ - g(1,2,3,4,5, 0.1,0.2,0.3,0.4,0.5); - return 0; -} diff --git a/test/cminor/mainqsort.c b/test/cminor/mainqsort.c deleted file mode 100644 index 63a76143..00000000 --- a/test/cminor/mainqsort.c +++ /dev/null @@ -1,36 +0,0 @@ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> - -extern void quicksort(int lo, int hi, long * data); - -int cmplong(const void * i, const void * j) -{ - long vi = *((long *) i); - long vj = *((long *) j); - if (vi == vj) return 0; - if (vi < vj) return -1; - return 1; -} - -int main(int argc, char ** argv) -{ - int n, i; - long * a, * b; - int bench = 0; - - if (argc >= 2) n = atoi(argv[1]); else n = 1000; - if (argc >= 3) bench = 1; - a = malloc(n * sizeof(long)); - b = malloc(n * sizeof(long)); - for (i = 0; i < n; i++) b[i] = a[i] = rand() & 0xFFFF; - quicksort(0, n - 1, a); - if (!bench) { - qsort(b, n, sizeof(long), cmplong); - for (i = 0; i < n; i++) { - if (a[i] != b[i]) { printf("Bug!\n"); return 2; } - } - printf("OK\n"); - } - return 0; -} diff --git a/test/cminor/mainsha1.c b/test/cminor/mainsha1.c deleted file mode 100644 index 845a46ae..00000000 --- a/test/cminor/mainsha1.c +++ /dev/null @@ -1,75 +0,0 @@ -#include <string.h> -#include <stdio.h> -#include <stdlib.h> - -typedef unsigned int u32; - -struct SHA1Context { - u32 state[5]; - u32 length[2]; - int numbytes; - unsigned char buffer[64]; -}; - -extern void SHA1_init(struct SHA1Context * ctx); -extern void SHA1_add_data(struct SHA1Context * ctx, unsigned char * data, - unsigned long len); -extern void SHA1_finish(struct SHA1Context * ctx, unsigned char output[20]); - -static void do_test(unsigned char * txt, unsigned char * expected_output) -{ - struct SHA1Context ctx; - unsigned char output[20]; - int ok; - - SHA1_init(&ctx); - SHA1_add_data(&ctx, txt, strlen((char *) txt)); - SHA1_finish(&ctx, output); - ok = memcmp(output, expected_output, 20) == 0; - printf("Test `%s': %s\n", - (char *) txt, (ok ? "passed" : "FAILED")); -} - -/* Test vectors: - * - * "abc" - * A999 3E36 4706 816A BA3E 2571 7850 C26C 9CD0 D89D - * - * "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" - * 8498 3E44 1C3B D26E BAAE 4AA1 F951 29E5 E546 70F1 - */ - -unsigned char * test_input_1 = (unsigned char *) "abc"; -unsigned char test_output_1[20] = -{ 0xA9, 0x99, 0x3E, 0x36, 0x47, 0x06, 0x81, 0x6A, 0xBA, 0x3E , - 0x25, 0x71, 0x78, 0x50, 0xC2, 0x6C, 0x9C, 0xD0, 0xD8, 0x9D }; - -unsigned char * test_input_2 = (unsigned char *) - "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"; -unsigned char test_output_2[20] = -{ 0x84, 0x98, 0x3E, 0x44, 0x1C, 0x3B, 0xD2, 0x6E, 0xBA, 0xAE, - 0x4A, 0xA1, 0xF9, 0x51, 0x29, 0xE5, 0xE5, 0x46, 0x70, 0xF1 }; - - -static void do_bench(int nblocks) -{ - struct SHA1Context ctx; - unsigned char output[20]; - unsigned char data[64]; - - SHA1_init(&ctx); - for (; nblocks > 0; nblocks--) - SHA1_add_data(&ctx, data, 64); - SHA1_finish(&ctx, output); -} - -int main(int argc, char ** argv) -{ - if (argc < 2) { - do_test(test_input_1, test_output_1); - do_test(test_input_2, test_output_2); - } else { - do_bench(atoi(argv[1])); - } - return 0; -} diff --git a/test/cminor/mainswitchtbl.c b/test/cminor/mainswitchtbl.c deleted file mode 100644 index 24ba17e7..00000000 --- a/test/cminor/mainswitchtbl.c +++ /dev/null @@ -1,11 +0,0 @@ -#include <stdlib.h> -#include <stdio.h> - -extern int f(int); - -int main(int argc, char ** argv) -{ - int i; - for (i = 0; i < 10; i++) printf("%2d -> %2d\n", i, f(i)); - return 0; -} diff --git a/test/cminor/manyargs.cm b/test/cminor/manyargs.cm deleted file mode 100644 index 97b16626..00000000 --- a/test/cminor/manyargs.cm +++ /dev/null @@ -1,53 +0,0 @@ -"f" (i1, i2, i3, i4, i5, - i6, i7, i8, i9, i10, - f1, f2, f3, f4, f5, - f6, f7, f8, f9, f10, - f11, f12, f13, f14, f15): - int -> int -> int -> int -> int -> - int -> int -> int -> int -> int -> - float -> float -> float -> float -> float -> - float -> float -> float -> float -> float -> - float -> float -> float -> float -> float -> void -{ - "print_int"(i1): int -> void; - "print_int"(i2): int -> void; - "print_int"(i3): int -> void; - "print_int"(i4): int -> void; - "print_int"(i5): int -> void; - "print_int"(i6): int -> void; - "print_int"(i7): int -> void; - "print_int"(i8): int -> void; - "print_int"(i9): int -> void; - "print_int"(i10): int -> void; - "print_float"(f1): float -> void; - "print_float"(f2): float -> void; - "print_float"(f3): float -> void; - "print_float"(f4): float -> void; - "print_float"(f5): float -> void; - "print_float"(f6): float -> void; - "print_float"(f7): float -> void; - "print_float"(f8): float -> void; - "print_float"(f9): float -> void; - "print_float"(f10): float -> void; - "print_float"(f11): float -> void; - "print_float"(f12): float -> void; - "print_float"(f13): float -> void; - "print_float"(f14): float -> void; - "print_float"(f15): float -> void; -} - -"g" (i1, i2, i3, i4, i5, - f1, f2, f3, f4, f5): - int -> int -> int -> int -> int -> - float -> float -> float -> float -> float -> void -{ - "f"(i1,i2,i3,i4,i5, i1,i2,i3,i4,i5, - f1,f2,f3,f4,f5, f1,f2,f3,f4,f5, f1,f2,f3,f4,f5): - int -> int -> int -> int -> int -> - int -> int -> int -> int -> int -> - float -> float -> float -> float -> float -> - float -> float -> float -> float -> float -> - float -> float -> float -> float -> float -> void; - -} - diff --git a/test/cminor/marksweep.cmp b/test/cminor/marksweep.cmp deleted file mode 100644 index 5b356784..00000000 --- a/test/cminor/marksweep.cmp +++ /dev/null @@ -1,298 +0,0 @@ -/* A simple mark-and-sweep garbage collector */ - -var "heap_start"[4] -var "heap_end"[4] -var "freelist_head"[4] - -#define GRAY_CACHE_SIZE 65536 -var "gray_cache"[GRAY_CACHE_SIZE] -var "gray_cache_ptr"[4] -var "gray_cache_overflow"[4] - -/* Format of blocks: - - header word: 28 bits size + 2 bits mark + 2 bits kind - kind = 0 block contains raw data (no pointers) - kind = 1 block contains pointer data - kind = 2 block is closure (all pointers except first word) - mark = 0 block is white (never reached) - mark = 1 block is gray (reached but contents not scanned) - mark = 3 block is black (reached and contents were scanned) - - [size] words of data - - Blocks are stored in one big global array and addressed by pointers - within this block. The pointer goes to the first word of data. -*/ - -#define KIND_RAWDATA 0 -#define KIND_PTRDATA 1 -#define KIND_CLOSURE 2 - -#define COLOR_WHITE 0 -#define COLOR_GRAY 4 -#define COLOR_BLACK 0xC - -#define Kind_header(h) ((h) & 3) -#define Color_header(h) ((h) & 0xC) -#define Size_header(h) (((h) >>u 2) & 0xFFFFFFFC) - -/* Free-list allocation, first-fit */ - -"freelist_alloc"(req_size) : int -> int -{ - var p, b, header, size, newsize; - - p = "freelist_head"; - {{ {{ loop { - b = int32[p]; /* b is current free block */ - if (b == 0) exit 1; /* free list exhausted */ - header = int32[b - 4]; - size = Size_header(header); - if (size >= req_size) exit; - p = b; /* move to next block */ - } }} - /* Found a free block large enough */ - if (size == req_size) { - /* there is nothing left of the free block, remove it - from free list */ - int32[p] = int32[b]; - return b; - } - else if (size == req_size + 4) { - /* one word remains free, which is too small to put - on free list. Do as above, but mark remaining word - so that it can be coalesced later. */ - int32[p] = int32[b]; - int32[b + req_size] = 0; /* header with size == 0 color = white */ - return b; - } else { - /* cut free block in two: - - first part remains free --> just reduce its size - - second part is returned as the free block */ - newsize = size - (req_size + 4); - int32[b - 4] = newsize << 2; - return b + newsize + 4; - } - }} - return 0; /* free list exhausted */ -} - -/* Allocation */ - -extern "abort" : void -extern "gc_alarm" : int -> void - -"alloc_block"(root, kind, size): int -> int -> int -> int -{ - var r; - - r = "freelist_alloc"(size) : int -> int; - if (r == 0) { - "gc_mark"(root) : int -> void; - "gc_sweep"() : void; - "gc_alarm"(-1) : int -> void; - r = "freelist_alloc"(size) : int -> int; - if (r == 0) { "abort"() : void; } - } - int32[r - 4] = (size << 2) | kind; - return r; -} - -#if 0 - -/* Marking phase with recursive traversal. */ - -"gc_mark"(root) : int -> void -{ - var numroots, p; - - {{ loop { - if (root == 0) exit; - numroots = int32[root + 4]; - p = root + 8; - {{ loop { - if (numroots == 0) exit; - "mark_block"(int32[p]) : int -> void; - p = p + 4; - numroots = numroots - 1; - } }} - root = int32[root]; - } }} -} - -"mark_block"(b) : int -> void -{ - var header, kind, size; - - if (b == 0) return; - header = int32[b - 4]; - if (Color_header(header) != COLOR_WHITE) return; - int32[b - 4] = header | COLOR_BLACK; - kind = Kind_header(header); - if (kind == KIND_RAWDATA) return; - size = Size_header(header); - if (kind == KIND_CLOSURE) { b = b + 4; size = size - 4; } - {{ loop { - if (size == 0) exit; - "mark_block"(int32[b]) : int -> void; - b = b + 4; - size = size - 4; - } }} -} - -#else - -/* Marking phase with 3-color marking. */ - -"mark_block"(b): int -> void -{ - var header, cache; - - if (b == 0) return; - header = int32[b - 4]; - if (Color_header(header) != COLOR_WHITE) return; - if (Kind_header(header) == KIND_RAWDATA) { - /* Set it to black now, as there are no pointers within */ - int32[b - 4] = header | COLOR_BLACK; - } else { - int32[b - 4] = header | COLOR_GRAY; - /* Is there room in the gray_cache? */ - cache = int32["gray_cache_ptr"]; - if (cache == "gray_cache" + GRAY_CACHE_SIZE) { - int32["gray_cache_overflow"] = 1; - } else { - int32[cache] = b; - int32["gray_cache_ptr"] = cache + 4; - } - } -} - -"find_first_gray_block"(): int -{ - var p, lastp, header; - - p = int32["heap_start"]; - lastp = int32["heap_end"]; - loop { - if (p >= lastp) return 0; - header = int32[p]; - if (Color_header(header) == COLOR_GRAY) return p + 4; - p = p + 4 + Size_header(header); - } -} - -"gc_mark"(root) : int -> void -{ - var numroots, p, cache, b, header, firstfield, n; - - int32["gray_cache_ptr"] = "gray_cache"; - int32["gray_cache_overflow"] = 0; - - {{ loop { - if (root == 0) exit; - numroots = int32[root + 4]; - p = root + 8; - {{ loop { - if (numroots == 0) exit; - "mark_block"(int32[p]) : int -> void; - p = p + 4; - numroots = numroots - 1; - } }} - root = int32[root]; - } }} - - {{ loop { - /* Find next gray object to work on */ - cache = int32["gray_cache_ptr"]; - if (cache > "gray_cache") { - cache = cache - 4; - b = int32[cache]; - int32["gray_cache_ptr"] = cache; - } else { - if (int32["gray_cache_overflow"] == 0) exit; - b = "find_first_gray_block"() : int; - if (b == 0) exit; - } - /* b is a gray object of kind PTRDATA or CLOSURE */ - header = int32[b - 4]; - int32[b - 4] = header | COLOR_BLACK; - /* Call mark_block on all (pointer) fields of b. - Process fields from last to first since this results - in better gray_cache utilization in case of right-oriented - data structures such as lists */ - firstfield = (Kind_header(header) == KIND_CLOSURE) << 2; - n = Size_header(header); - {{ loop { - if (n == firstfield) exit; - n = n - 4; - "mark_block"(int32[b + n]) : int -> void; - } }} - } }} -} - -#endif - -/* Sweeping phase. */ - -"gc_sweep"() : void -{ - var scan_ptr, scan_end, last_free_block, end_last_free_block, - header, size; - - last_free_block = "freelist_head"; - end_last_free_block = 0; - scan_ptr = int32["heap_start"]; - scan_end = int32["heap_end"]; - {{ loop { - if (scan_ptr >= scan_end) exit; - header = int32[scan_ptr]; - size = Size_header(header); - if (Color_header(header) == COLOR_WHITE) { - /* reclaim this block */ - if (scan_ptr == end_last_free_block) { - /* coalesce it with last free block */ - int32[last_free_block - 4] = - int32[last_free_block - 4] + ((size + 4) << 2); - end_last_free_block = end_last_free_block + size + 4; - } else { - /* insert new free block in free list */ - int32[scan_ptr] = header & ~0xF; /* clear mark and kind bits */ - int32[last_free_block] = scan_ptr + 4; - last_free_block = scan_ptr + 4; - end_last_free_block = last_free_block + size; - } - } else { - /* clear mark on this block */ - int32[scan_ptr] = header & ~COLOR_BLACK; - } - scan_ptr = scan_ptr + 4 + size; - } }} - int32[last_free_block] = 0; /* terminate free list */ -} - -/* Initialize a heap of size [hsize] bytes */ - -extern "malloc" : int -> int - -"init_heap"(hsize) : int -> int -{ - var hbase, i; - - hbase = "malloc"(hsize) : int -> int; - if (hbase == 0) return -1; - int32["heap_start"] = hbase; - int32["heap_end"] = hbase + hsize; - int32[hbase] = (hsize - 4) << 2; - int32[hbase + 4] = 0; - int32["freelist_head"] = hbase + 4; -#ifdef DEBUG - /* Fill heap with garbage (for debugging) */ - i = 8; - {{ loop { - if (i >= hsize) exit; - int32[hbase + i] = 0xDEADBEEF; - i = i + 4; - } }} -#endif - return 0; -} - diff --git a/test/cminor/marksweepcheck.c b/test/cminor/marksweepcheck.c deleted file mode 100644 index 92bbfe57..00000000 --- a/test/cminor/marksweepcheck.c +++ /dev/null @@ -1,119 +0,0 @@ -/* Heap checking for the mark-sweep collector */ - -#include <stdio.h> -#include <stddef.h> -#include <stdlib.h> -#include <assert.h> -#include <string.h> - -#ifdef DEBUG - -enum block_kind { RAWDATA = 0, PTRDATA = 1, CLOSURE = 2 }; -enum block_color { WHITE = 0, GRAY = 4, BLACK = 0xC }; - -#define At(p,ty) (*((ty *)(p))) -#define Kind_header(h) ((h) & 3) -#define Color_header(h) ((h) & 0xC) -#define Size_header(h) (((h) >> 2) & 0xFFFFFFFC) - -extern char * heap_start, * heap_end, * freelist_head; - -char * heap_bitmap = NULL; - -static inline void bitmap_set(char * bm, unsigned i) -{ - bm[i >> 3] |= 1 << (i & 7); -} - -static inline int bitmap_get(char * bm, unsigned i) -{ - return bm[i >> 3] & (1 << (i & 7)); -} - -static void check_block(char * p, unsigned s) -{ - char * d; - for (/**/; s > 0; p += 4, s -= 4) { - d = At(p, char *); - if (d != NULL) { - assert(d >= heap_start + 4); - assert(d <= heap_end - 4); - assert(((unsigned) d & 3) == 0); - assert(bitmap_get(heap_bitmap, (d - heap_start) >> 2)); - } - } -} - -void check_heap(void) -{ - char * p, * f, * nextf; - unsigned h, s, bitmap_size; - - bitmap_size = ((heap_end - heap_start) + 31) / 32; - /* one bit per word -> one byte per 32 bytes in the heap */ - if (heap_bitmap == NULL) { - heap_bitmap = malloc(bitmap_size); - assert (heap_bitmap != NULL); - } - memset(heap_bitmap, 0, bitmap_size); - - /* Superficial check and construction of the bitmap */ - - f = freelist_head; - assert(f >= heap_start + 4); - assert(f <= heap_end - 4); - - for (p = heap_start; p < heap_end; /**/) { - h = At(p, unsigned); - s = Size_header(h); - assert(s >= 4); - assert((s & 3) == 0); - p = p + 4; - assert (p + s <= heap_end); - if (p == f) { - /* this is a free list block */ - assert((h & 0xF) == 0); - nextf = At(p, char *); - if (nextf != NULL) { - assert(nextf > f); - assert(nextf <= heap_end - 4); - } - f = nextf; - } else { - /* this is an allocated block */ - assert(Color_header(h) == WHITE); - bitmap_set(heap_bitmap, (p - heap_start) >> 2); - } - p = p + s; - } - assert (p == heap_end); - assert (f == NULL); - - /* Check block contents */ - f = freelist_head; - for (p = heap_start; p < heap_end; /**/) { - h = At(p, unsigned); - s = Size_header(h); - p = p + 4; - if (p == f) { - /* Fill free block with garbage */ - memset(p + 4, 0xEE, s - 4); - f = At(p, char *); - } else { - /* Check block contents */ - switch (Kind_header(h)) { - case RAWDATA: - break; - case PTRDATA: - check_block(p, s); break; - case CLOSURE: - check_block(p + 4, s - 4); break; - default: - assert(0); - } - } - p = p + s; - } -} - -#endif diff --git a/test/cminor/qsort.cm b/test/cminor/qsort.cm deleted file mode 100644 index 8c735843..00000000 --- a/test/cminor/qsort.cm +++ /dev/null @@ -1,32 +0,0 @@ -"quicksort"(lo, hi, a): int -> int -> int -> void -{ - var i, j, pivot, temp; - - if (! (lo < hi)) return; - i = lo; - j = hi; - pivot = int32[a + hi * 4]; - {{ loop { - if (! (i < j)) exit; - {{ loop { - if (i >= hi) exit; - if (int32[a + i * 4] > pivot) exit; - i = i + 1; - } }} - {{ loop { - if (j <= lo) exit; - if (int32[a + j * 4] < pivot) exit; - j = j - 1; - } }} - if (i < j) { - temp = int32[a + i * 4]; - int32[a + i * 4] = int32[a + j * 4]; - int32[a + j * 4] = temp; - } - } }} - temp = int32[a + i * 4]; - int32[a + i * 4] = int32[a + hi * 4]; - int32[a + hi * 4] = temp; - "quicksort"(lo, i - 1, a) : int -> int -> int -> void; - "quicksort"(i + 1, hi, a) : int -> int -> int -> void; -} diff --git a/test/cminor/sha1.cmp b/test/cminor/sha1.cmp deleted file mode 100644 index 96e3c038..00000000 --- a/test/cminor/sha1.cmp +++ /dev/null @@ -1,200 +0,0 @@ -/* SHA-1 cryptographic hash function */ -/* Ref: Handbook of Applied Cryptography, section 9.4.2, algorithm 9.53 */ - -/* To be preprocessed by cpp -P */ - -extern "memcpy" : int -> int -> int -> void -extern "memset" : int -> int -> int -> void - -#if defined(__ppc__) || defined(__PPC__) || defined(__ARMEB__) -#define ARCH_BIG_ENDIAN -#elif defined(__i386__) || defined(__x86_64__) || defined(__ARMEL__) -#undef ARCH_BIG_ENDIAN -#else -#error "unknown endianness" -#endif - -#define rol1(x) (((x) << 1) | ((x) >>u 31)) -#define rol5(x) (((x) << 5) | ((x) >>u 27)) -#define rol30(x) (((x) << 30) | ((x) >>u 2)) - -"SHA1_copy_and_swap"(src, dst, numwords) : int -> int -> int -> void -{ -#ifdef ARCH_BIG_ENDIAN - "memcpy"(dst, src, numwords * 4) : int -> int -> int -> void; -#else - var s, d, a, b; - s = src; - d = dst; - {{ loop { - if (numwords <= 0) exit; - a = int8u[s]; - b = int8u[s + 1]; - int8u[d] = int8u[s + 3]; - int8u[d + 1] = int8u[s + 2]; - int8u[d + 2] = b; - int8u[d + 3] = a; - s = s + 4; - d = d + 4; - numwords = numwords - 1; - } }} -#endif -} - -#define F(x,y,z) ( z ^ (x & (y ^ z) ) ) -#define G(x,y,z) ( (x & y) | (z & (x | y) ) ) -#define H(x,y,z) ( x ^ y ^ z ) - -#define Y1 0x5A827999 -#define Y2 0x6ED9EBA1 -#define Y3 0x8F1BBCDC -#define Y4 0xCA62C1D6 - -#define context_state(ctx,n) int32[ctx + n * 4] -#define context_length(ctx) ctx + 20 -#define context_length_hi(ctx) int32[ctx + 20] -#define context_length_lo(ctx) int32[ctx + 24] -#define context_numbytes(ctx) int32[ctx + 28] -#define context_buffer(ctx) (ctx + 32) -#define context_size 96 - -"SHA1_transform"(ctx) : int -> void -{ - stack 320; - var i, p, a, b, c, d, e, t; - - /* Convert buffer data to 16 big-endian integers */ - "SHA1_copy_and_swap"(context_buffer(ctx), &0, 16) : int -> int -> int -> void; - /* Expand into 80 integers */ - i = 16; - {{ loop { - if (! (i < 80)) exit; - p = &0 + i * 4; - t = int32[p - 12] ^ int32[p - 32] ^ int32[p - 56] ^ int32[p - 64]; - int32[p] = rol1(t); - i = i + 1; - } }} - - /* Initialize working variables */ - a = context_state(ctx, 0); - b = context_state(ctx, 1); - c = context_state(ctx, 2); - d = context_state(ctx, 3); - e = context_state(ctx, 4); - - /* Perform rounds */ - i = 0; - {{ loop { - if (! (i < 20)) exit; - t = F(b, c, d) + Y1 + rol5(a) + e + int32[&0 + i * 4]; - e = d; d = c; c = rol30(b); b = a; a = t; - i = i + 1; - } }} - {{ loop { - if (! (i < 40)) exit; - t = H(b, c, d) + Y2 + rol5(a) + e + int32[&0 + i * 4]; - e = d; d = c; c = rol30(b); b = a; a = t; - i = i + 1; - } }} - {{ loop { - if (! (i < 60)) exit; - t = G(b, c, d) + Y3 + rol5(a) + e + int32[&0 + i * 4]; - e = d; d = c; c = rol30(b); b = a; a = t; - i = i + 1; - } }} - {{ loop { - if (! (i < 80)) exit; - t = H(b, c, d) + Y4 + rol5(a) + e + int32[&0 + i * 4]; - e = d; d = c; c = rol30(b); b = a; a = t; - i = i + 1; - } }} - - /* Update chaining values */ - context_state(ctx, 0) = context_state(ctx, 0) + a; - context_state(ctx, 1) = context_state(ctx, 1) + b; - context_state(ctx, 2) = context_state(ctx, 2) + c; - context_state(ctx, 3) = context_state(ctx, 3) + d; - context_state(ctx, 4) = context_state(ctx, 4) + e; -} - -"SHA1_init"(ctx) : int -> void -{ - context_state(ctx, 0) = 0x67452301; - context_state(ctx, 1) = 0xEFCDAB89; - context_state(ctx, 2) = 0x98BADCFE; - context_state(ctx, 3) = 0x10325476; - context_state(ctx, 4) = 0xC3D2E1F0; - context_numbytes(ctx) = 0; - context_length_lo(ctx) = 0; - context_length_hi(ctx) = 0; -} - -"SHA1_add_data"(ctx, data, len) : int -> int -> int -> void -{ - var t, t2; - - /* Update length */ - t = context_length_lo(ctx); - t2 = t + (len << 3); - context_length_lo(ctx) = t2; - if (t2 <u t) - context_length_hi(ctx) = context_length_hi(ctx) + 1; - context_length_hi(ctx) = context_length_hi(ctx) + (len >>u 29); - - /* If data was left in buffer, pad it with fresh data and munge block */ - if (context_numbytes(ctx) != 0) { - t = 64 - context_numbytes(ctx); - if (len <u t) { - "memcpy"(context_buffer(ctx) + context_numbytes(ctx), data, len) - : int -> int -> int -> void; - context_numbytes(ctx) = context_numbytes(ctx) + len; - return; - } - "memcpy"(context_buffer(ctx) + context_numbytes(ctx), data, t) - : int -> int -> int -> void; - "SHA1_transform"(ctx) : int -> void; - data = data + t; - len = len - t; - } - /* Munge data in 64-byte chunks */ - {{ loop { - if (! (len >=u 64)) exit; - "memcpy"(context_buffer(ctx), data, 64) - : int -> int -> int -> void; - "SHA1_transform"(ctx) : int -> void; - data = data + 64; - len = len - 64; - } }} - /* Save remaining data */ - "memcpy"(context_buffer(ctx), data, len) - : int -> int -> int -> void; - context_numbytes(ctx) = len; -} - -"SHA1_finish"(ctx, output) : int -> int -> void -{ - var i; - i = context_numbytes(ctx); - /* Set first char of padding to 0x80. There is always room. */ - int8u[context_buffer(ctx) + i] = 0x80; - i = i + 1; - /* If we do not have room for the length (8 bytes), pad to 64 bytes - with zeroes and munge the data block */ - if (i > 56) { - "memset"(context_buffer(ctx) + i, 0, 64 - i) - : int -> int -> int -> void; - "SHA1_transform"(ctx) : int -> void; - i = 0; - } - /* Pad to byte 56 with zeroes */ - "memset"(context_buffer(ctx) + i, 0, 56 - i) - : int -> int -> int -> void; - /* Add length in big-endian */ - "SHA1_copy_and_swap"(context_length(ctx), context_buffer(ctx) + 56, 2) - : int -> int -> int -> void; - /* Munge the final block */ - "SHA1_transform"(ctx) : int -> void; - /* Final hash value is in ctx->state modulo big-endian conversion */ - "SHA1_copy_and_swap"(ctx, output, 5) - : int -> int -> int -> void; -} diff --git a/test/cminor/stopcopy.cmp b/test/cminor/stopcopy.cmp deleted file mode 100644 index eb2b3e10..00000000 --- a/test/cminor/stopcopy.cmp +++ /dev/null @@ -1,187 +0,0 @@ -/* A simple stop-and-copy garbage collector */ - -var "alloc_ptr"[4] -var "fromspace_start_ptr"[4] -var "fromspace_end_ptr"[4] -var "tospace_start_ptr"[4] -var "tospace_end_ptr"[4] - -/* Format of blocks: - - header word: 30 bits size + 2 bits kind - kind = 0 block contains raw data (no pointers) - kind = 1 block contains pointer data - kind = 2 block is closure (all pointers except first word) - kind = 3 block was forwarded - - [size] words of data - - Blocks are stored in one big global array and addressed by pointers - within this block. The pointer goes to the first word of data. -*/ - -#define KIND_RAWDATA 0 -#define KIND_PTRDATA 1 -#define KIND_CLOSURE 2 -#define KIND_FORWARDED 3 -#define Kind_header(h) ((h) & 3) -#define Size_header(h) ((h) & 0xFFFFFFFC) - -/* Copy one block. The reference to that block is passed by reference - at address [location], and will be updated. */ - -"copy_block"(copy_ptr, location): int -> int -> int -{ - var optr, header, kind, size, src, dst; - - optr = int32[location]; - if (optr == 0) return copy_ptr; - header = int32[optr - 4]; - kind = Kind_header(header); - if (kind == KIND_FORWARDED) { - /* Already copied. Reference of copy is stored in the - first field of original. */ - int32[location] = int32[optr]; - } else { - /* Copy contents of original block (including header) */ - size = Size_header(header) + 4; - src = optr - 4; - dst = copy_ptr; - {{ loop { - int32[dst] = int32[src]; - src = src + 4; - dst = dst + 4; - size = size - 4; - if (size == 0) exit; - } }} - copy_ptr = copy_ptr + 4; - /* Mark original as forwarded */ - int32[optr - 4] = header | KIND_FORWARDED; - int32[optr] = copy_ptr; - /* Update location to point to copy */ - int32[location] = copy_ptr; - /* Finish allocating space for copy */ - copy_ptr = copy_ptr + Size_header(header); - } - return copy_ptr; -} - -/* Finish the copying */ - -"copy_all"(scan_ptr, copy_ptr): int -> int -> int -{ - var header, kind, size; - - {{ loop { - if (scan_ptr >= copy_ptr) exit; - header = int32[scan_ptr]; - scan_ptr = scan_ptr + 4; - kind = Kind_header(header); - size = Size_header(header); - if (kind == KIND_RAWDATA) { - /* Nothing to do for a RAWDATA block */ - scan_ptr = scan_ptr + size; - } else { - /* Apply [copy_block] to all fields if PTRDATA, all fields except - first if CLOSURE. */ - if (kind == KIND_CLOSURE) { scan_ptr = scan_ptr + 4; size = size - 4; } - {{ loop { - if (size == 0) exit; - copy_ptr = "copy_block"(copy_ptr, scan_ptr) : int -> int -> int; - scan_ptr = scan_ptr + 4; - size = size - 4; - } }} - } - } }} - return copy_ptr; -} - -/* Copy the roots. The roots are given as a linked list of blocks: - offset 0: pointer to next root block (or NULL) - offset 4: number of roots N - offset 8 and following words: the roots -*/ - -"copy_roots"(copy_ptr, root): int -> int -> int -{ - var n, p; - - {{ loop { - if (root == 0) exit; - n = int32[root + 4]; - p = root + 8; - {{ loop { - if (n == 0) exit; - copy_ptr = "copy_block"(copy_ptr, p) : int -> int -> int; - p = p + 4; - n = n - 1; - } }} - root = int32[root]; - } }} - return copy_ptr; -} - -/* Garbage collection */ - -extern "gc_alarm" : int -> void - -"garbage_collection"(root): int -> void -{ - var heap_base, copy_ptr, tmp; - - copy_ptr = int32["tospace_start_ptr"]; - copy_ptr = "copy_roots"(copy_ptr, root) : int -> int -> int; - copy_ptr = "copy_all"(int32["tospace_start_ptr"], copy_ptr) : int -> int -> int; - /* Swap fromspace and tospace */ - tmp = int32["tospace_start_ptr"]; - int32["tospace_start_ptr"] = int32["fromspace_start_ptr"]; - int32["fromspace_start_ptr"] = tmp; - tmp = int32["tospace_end_ptr"]; - int32["tospace_end_ptr"] = int32["fromspace_end_ptr"]; - int32["fromspace_end_ptr"] = tmp; - /* Reinitialise allocation pointer */ - int32["alloc_ptr"] = copy_ptr; - "gc_alarm"(copy_ptr - int32["fromspace_start_ptr"]) : int -> void; -} - -/* Allocation */ - -extern "abort" : void - -"alloc_block"(root, kind, size): int -> int -> int -> int -{ - var p, np; - - loop { - p = int32["alloc_ptr"]; - np = p + size + 4; - if (np <= int32["fromspace_end_ptr"]) { - int32["alloc_ptr"] = np; - int32[p] = size | kind; - return p + 4; - } - "garbage_collection"(root) : int -> void; - if (int32["alloc_ptr"] + size + 4 > int32["fromspace_end_ptr"]) { - "abort"() : void; - } - } -} - -/* Initialize a heap of size [hsize] bytes */ - -extern "malloc" : int -> int - -"init_heap"(hsize) : int -> int -{ - var from, to; - - from = "malloc"(hsize) : int -> int; - if (from == 0) return -1; - to = "malloc"(hsize) : int -> int; - if (to == 0) return -1; - int32["fromspace_start_ptr"] = from; - int32["fromspace_end_ptr"] = from + hsize; - int32["tospace_start_ptr"] = to; - int32["tospace_end_ptr"] = to + hsize; - int32["alloc_ptr"] = from; - return 0; -} - diff --git a/test/cminor/switchtbl.cm b/test/cminor/switchtbl.cm deleted file mode 100644 index 9605499b..00000000 --- a/test/cminor/switchtbl.cm +++ /dev/null @@ -1,17 +0,0 @@ -"f"(x): int -> int -{ - match (x) { - case -1: return -11; - case 0: return 00; - case 1: return 11; - case 2: return 22; - case 3: return 33; - case 4: return 44; - case 5: return 55; - case 6: return 66; - case 7: return 77; - case 8: return 88; - case 9: return 99; -} -} - @@ -310,8 +310,10 @@ Module Pregmap := EMap(PregEq). Definition regset := Pregmap.t val. Definition genv := Genv.t fundef unit. -Notation "a # b" := (a b) (at level 1, only parsing). -Notation "a # b <- c" := (Pregmap.set b c a) (at level 1, b at next level). +Notation "a # b" := (a b) (at level 1, only parsing) : asm. +Notation "a # b <- c" := (Pregmap.set b c a) (at level 1, b at next level) : asm. + +Open Scope asm. (** Undefining some registers *) diff --git a/x86/Asmgen.v b/x86/Asmgen.v index bb26d507..a627881b 100644 --- a/x86/Asmgen.v +++ b/x86/Asmgen.v @@ -16,8 +16,8 @@ Require Import Coqlib Errors. Require Import AST Integers Floats Memdata. Require Import Op Locations Mach Asm. -Open Local Scope string_scope. -Open Local Scope error_monad_scope. +Local Open Scope string_scope. +Local Open Scope error_monad_scope. (** The code generation functions take advantage of several characteristics of the [Mach] code generated by earlier passes of the compiler: - Argument and result registers are of the correct type. diff --git a/x86/Asmgenproof1.v b/x86/Asmgenproof1.v index 401be7d7..6191ea39 100644 --- a/x86/Asmgenproof1.v +++ b/x86/Asmgenproof1.v @@ -17,7 +17,7 @@ Require Import AST Errors Integers Floats Values Memory Globalenvs. Require Import Op Locations Conventions Mach Asm. Require Import Asmgen Asmgenproof0. -Open Local Scope error_monad_scope. +Local Open Scope error_monad_scope. (** * Correspondence between Mach registers and x86 registers *) diff --git a/x86/SelectLongproof.v b/x86/SelectLongproof.v index f7d5df10..2262a70b 100644 --- a/x86/SelectLongproof.v +++ b/x86/SelectLongproof.v @@ -19,8 +19,8 @@ Require Import Cminor Op CminorSel. Require Import SelectOp SelectOpproof SplitLong SplitLongproof. Require Import SelectLong. -Open Local Scope cminorsel_scope. -Open Local Scope string_scope. +Local Open Scope cminorsel_scope. +Local Open Scope string_scope. (** * Correctness of the instruction selection functions for 64-bit operators *) diff --git a/x86/SelectOp.vp b/x86/SelectOp.vp index db546d99..f8010f0a 100644 --- a/x86/SelectOp.vp +++ b/x86/SelectOp.vp @@ -41,7 +41,7 @@ Require Import Compopts. Require Import AST Integers Floats. Require Import Op CminorSel. -Open Local Scope cminorsel_scope. +Local Open Scope cminorsel_scope. (** ** Constants **) diff --git a/x86/SelectOpproof.v b/x86/SelectOpproof.v index ce15b6e1..cdb79c6f 100644 --- a/x86/SelectOpproof.v +++ b/x86/SelectOpproof.v @@ -24,7 +24,7 @@ Require Import Op. Require Import CminorSel. Require Import SelectOp. -Open Local Scope cminorsel_scope. +Local Open Scope cminorsel_scope. (** * Useful lemmas and tactics *) |