ocaml/testasmcomp/parsecmm.mly

314 lines
8.9 KiB
OCaml

/***********************************************************************/
/* */
/* Objective Caml */
/* */
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
/* */
/* Copyright 1996 Institut National de Recherche en Informatique et */
/* Automatique. Distributed only by permission. */
/* */
/***********************************************************************/
/* $Id$ */
/* A simple parser for C-- */
%{
open Cmm
open Parsecmmaux
let rec make_letdef def body =
match def with
[] -> body
| (id, def) :: rem ->
unbind_ident id;
Clet(id, def, make_letdef rem body)
let make_switch n selector caselist =
let index = Array.create n 0 in
let casev = Array.of_list caselist in
let actv = Array.create (Array.length casev) Cexit in
for i = 0 to Array.length casev - 1 do
let (posl, e) = casev.(i) in
List.iter (fun pos -> index.(pos) <- i) posl;
actv.(i) <- e
done;
Cswitch(selector, index, actv)
let access_array base numelt size =
match numelt with
Cconst_int 0 -> base
| Cconst_int n -> Cop(Cadda, [base; Cconst_int(n * size)])
| _ -> Cop(Cadda, [base;
Cop(Clsl, [numelt; Cconst_int(Misc.log2 size)])])
%}
%token ABSF
%token ADDA
%token ADDF
%token ADDI
%token ADDR
%token ALIGN
%token ALLOC
%token AND
%token APPLY
%token ASR
%token ASSIGN
%token BYTE
%token CASE
%token CATCH
%token CHECKBOUND
%token COLON
%token DIVF
%token DIVI
%token EOF
%token EQA
%token EQF
%token EQI
%token EXIT
%token EXTCALL
%token FLOAT
%token <string> FLOATCONST
%token FLOATOFINT
%token FUNCTION
%token GEA
%token GEF
%token GEI
%token GTA
%token GTF
%token GTI
%token HALF
%token <string> IDENT
%token IF
%token INT
%token <int> INTCONST
%token INTOFFLOAT
%token KSTRING
%token LBRACKET
%token LEA
%token LEF
%token LEI
%token LET
%token LOAD
%token LPAREN
%token LSL
%token LSR
%token LTA
%token LTF
%token LTI
%token MODI
%token MULF
%token MULI
%token NEA
%token NEF
%token NEI
%token OR
%token <int> POINTER
%token PROJ
%token RAISE
%token RBRACKET
%token RPAREN
%token SEQ
%token SIGNED
%token SKIP
%token STAR
%token STORE
%token <string> STRING
%token SUBA
%token SUBF
%token SUBI
%token SWITCH
%token TRY
%token UNIT
%token UNSIGNED
%token WHILE
%token WITH
%token XOR
%token ADDRAREF
%token INTAREF
%token FLOATAREF
%token ADDRASET
%token INTASET
%token FLOATASET
%start phrase
%type <Cmm.phrase> phrase
%%
phrase:
fundecl { Cfunction $1 }
| datadecl { Cdata $1 }
| EOF { raise End_of_file }
;
fundecl:
LPAREN FUNCTION STRING LPAREN params RPAREN sequence RPAREN
{ List.iter (fun (id, ty) -> unbind_ident id) $5;
{fun_name = $3; fun_args = $5; fun_body = $7; fun_fast = true} }
;
params:
oneparam params { $1 :: $2 }
| /**/ { [] }
;
oneparam:
IDENT COLON machtype { (bind_ident $1, $3) }
;
machtype:
UNIT { [||] }
| componentlist { Array.of_list(List.rev $1) }
;
component:
ADDR { Addr }
| INT { Int }
| FLOAT { Float }
;
componentlist:
component { [$1] }
| componentlist STAR component { $3 :: $1 }
;
expr:
INTCONST { Cconst_int $1 }
| FLOATCONST { Cconst_float $1 }
| STRING { Cconst_symbol $1 }
| POINTER { Cconst_pointer $1 }
| IDENT { Cvar(find_ident $1) }
| LPAREN LET letdef sequence RPAREN { make_letdef $3 $4 }
| LPAREN ASSIGN IDENT expr RPAREN { Cassign(find_ident $3, $4) }
| LBRACKET exprlist RBRACKET { Ctuple(List.rev $2) }
| LPAREN APPLY expr expr machtype RPAREN { Cop(Capply $5, [$3; $4]) }
| LPAREN EXTCALL STRING expr machtype RPAREN { Cop(Cextcall($3, $5, true), [$4]) }
| LPAREN LOAD expr machtype RPAREN { Cop(Cload $4, [$3]) }
| LPAREN SUBF expr RPAREN { Cop(Cnegf, [$3]) }
| LPAREN SUBF expr expr RPAREN { Cop(Csubf, [$3; $4]) }
| LPAREN unaryop expr RPAREN { Cop($2, [$3]) }
| LPAREN binaryop expr expr RPAREN { Cop($2, [$3; $4]) }
| LPAREN SEQ sequence RPAREN { $3 }
| LPAREN IF expr expr expr RPAREN { Cifthenelse($3, $4, $5) }
| LPAREN SWITCH INTCONST expr caselist RPAREN { make_switch $3 $4 $5 }
| LPAREN WHILE expr sequence RPAREN
{ Ccatch(Cloop(Cifthenelse($3, $4, Cexit)), Ctuple []) }
| LPAREN CATCH sequence WITH sequence RPAREN { Ccatch($3, $5) }
| EXIT { Cexit }
| LPAREN TRY sequence WITH bind_ident sequence RPAREN
{ unbind_ident $5; Ctrywith($3, $5, $6) }
| LPAREN ADDRAREF expr expr RPAREN
{ Cop(Cload typ_addr, [access_array $3 $4 Arch.size_addr]) }
| LPAREN INTAREF expr expr RPAREN
{ Cop(Cload typ_int, [access_array $3 $4 Arch.size_int]) }
| LPAREN FLOATAREF expr expr RPAREN
{ Cop(Cload typ_float, [access_array $3 $4 Arch.size_float]) }
| LPAREN ADDRASET expr expr expr RPAREN
{ Cop(Cstore, [access_array $3 $4 Arch.size_addr; $5]) }
| LPAREN INTASET expr expr expr RPAREN
{ Cop(Cstore, [access_array $3 $4 Arch.size_int; $5]) }
| LPAREN FLOATASET expr expr expr RPAREN
{ Cop(Cstore, [access_array $3 $4 Arch.size_float; $5]) }
;
exprlist:
exprlist expr { $2 :: $1 }
| /**/ { [] }
;
letdef:
oneletdef { [$1] }
| LPAREN letdefmult RPAREN { $2 }
;
letdefmult:
/**/ { [] }
| oneletdef letdefmult { $1 :: $2 }
;
oneletdef:
IDENT expr { (bind_ident $1, $2) }
;
chunk:
UNSIGNED BYTE { Byte_unsigned }
| SIGNED BYTE { Byte_signed }
| UNSIGNED HALF { Sixteen_unsigned }
| SIGNED HALF { Sixteen_signed }
;
unaryop:
PROJ INTCONST { Cproj($2, 1) }
| PROJ INTCONST SUBI INTCONST { Cproj($2, $4 - $2 - 1) }
| LOAD chunk { Cloadchunk $2 }
| ALLOC { Calloc }
| FLOATOFINT { Cfloatofint }
| INTOFFLOAT { Cintoffloat }
| RAISE { Craise }
| ABSF { Cabsf }
;
binaryop:
STORE { Cstore }
| STORE chunk { Cstorechunk $2 }
| ADDI { Caddi }
| SUBI { Csubi }
| MULI { Cmuli }
| DIVI { Cdivi }
| MODI { Cmodi }
| AND { Cand }
| OR { Cor }
| XOR { Cxor }
| LSL { Clsl }
| LSR { Clsr }
| ASR { Casr }
| EQI { Ccmpi Ceq }
| NEI { Ccmpi Cne }
| LTI { Ccmpi Clt }
| LEI { Ccmpi Cle }
| GTI { Ccmpi Cgt }
| GEI { Ccmpi Cge }
| ADDA { Cadda }
| SUBA { Csuba }
| EQA { Ccmpa Ceq }
| NEA { Ccmpa Cne }
| LTA { Ccmpa Clt }
| LEA { Ccmpa Cle }
| GTA { Ccmpa Cgt }
| GEA { Ccmpa Cge }
| ADDF { Caddf }
| MULF { Cmulf }
| DIVF { Cdivf }
| EQF { Ccmpf Ceq }
| NEF { Ccmpf Cne }
| LTF { Ccmpf Clt }
| LEF { Ccmpf Cle }
| GTF { Ccmpf Cgt }
| GEF { Ccmpf Cge }
| CHECKBOUND { Ccheckbound }
;
sequence:
expr sequence { Csequence($1, $2) }
| expr { $1 }
;
caselist:
onecase sequence caselist { ($1, $2) :: $3 }
| /**/ { [] }
;
onecase:
CASE INTCONST COLON onecase { $2 :: $4 }
| CASE INTCONST COLON { [$2] }
;
bind_ident:
IDENT { bind_ident $1 }
;
datadecl:
LPAREN datalist RPAREN { List.rev $2 }
;
datalist:
datalist dataitem { $2 :: $1 }
| /**/ { [] }
;
dataitem:
STRING COLON { Cdefine_symbol $1 }
| INTCONST COLON { Cdefine_label $1 }
| BYTE INTCONST { Cint8 $2 }
| HALF INTCONST { Cint16 $2 }
| INT INTCONST { Cint $2 }
| FLOAT FLOATCONST { Cfloat $2 }
| ADDR STRING { Csymbol_address $2 }
| ADDR INTCONST { Clabel_address $2 }
| KSTRING STRING { Cstring $2 }
| SKIP INTCONST { Cskip $2 }
| ALIGN INTCONST { Calign $2 }
;