Version finale

This commit is contained in:
Yohann D'ANELLO 2020-05-23 11:22:23 +02:00
commit 3fe11684d3
46 changed files with 12561 additions and 0 deletions

11
.gitignore vendored Normal file
View File

@ -0,0 +1,11 @@
*.gz
*.o
*.s
mcc
Exemples/cat
Exemples/fact
Exemples/order
Exemples/sieve
Exemples/test
Exemples/unitest0

27
Exemples/cat.c Normal file
View File

@ -0,0 +1,27 @@
#ifdef MCC
#define FILE char
// pipeau: un FILE est quelque chose de plus complique, normalement...
#define EOF (-1)
// ca, par contre, c'est la vraie valeur de EOF.
#else
#include <stdio.h>
#include <stdlib.h>
#endif
int main (int argc, char **argv)
{
int i, c;
for (i=1; i<argc; i++)
{
FILE *f;
f = fopen (argv[i], "r");
while ((c = fgetc (f))!=EOF)
fputc (c, stdout);
fclose (f);
}
fflush (stdout);
exit (0);
}

42
Exemples/fact.c Normal file
View File

@ -0,0 +1,42 @@
#ifndef MCC
#include <stdio.h>
#include <stdlib.h>
#endif
int fact (int n)
{
int res;
res = 1;
while (n!=0)
{
res = res * n;
n--;
}
return res;
}
int main (int argc, char **argv)
{
if (argc!=2)
{
fprintf (stderr, "Usage: ./fact <n>\ncalcule et affiche la factorielle de <n>.\n");
fflush (stderr);
exit (10); /* non mais! */
}
{
int n, res;
n = atoi (argv[1]); /* conversion chaine -> entier. */
if (n<0)
{
fprintf (stderr, "Ah non, quand meme, un nombre positif ou nul, s'il-vous-plait...\n");
fflush (stderr);
exit (10);
}
res = fact (n);
printf ("La factorielle de %d vaut %d (en tout cas, modulo 2^32...).\n",
n, res);
}
return 0;
}

BIN
Exemples/ordre Executable file

Binary file not shown.

13
Exemples/ordre.c Normal file
View File

@ -0,0 +1,13 @@
#ifndef MCC
#include <stdio.h>
#endif
int main (int argc, char **argv)
{
int i, j;
j = (i=3) + (i=4);
printf ("Valeur de j=%d (normalement 7), valeur de i=%d.\n", j, i);
fflush (stdout);
return 0;
}

102
Exemples/sieve.c Normal file
View File

@ -0,0 +1,102 @@
#ifdef MCC
#define NULL 0
#else
#include <stdio.h>
#include <stdlib.h>
#endif
int main (int argc, char **argv)
{
if (argc!=2)
{
fprintf (stderr, "Usage: ./sieve <n>\ncalcule et affiche les nombres premiers inferieurs a <n>.\n");
fflush (stderr);
exit (10); /* non mais! */
}
{
int n;
int *bits;
n = atoi (argv[1]); // conversion chaine -> entier.
if (n<2)
{
fprintf (stderr, "Ah non, quand meme, un nombre >=2, s'il-vous-plait...\n");
fflush (stderr);
exit (10);
}
bits = malloc (8*n); // allouer de la place pour n entiers (booleens).
// Ca prend 32 fois trop de place. Mais C-- n'a pas les operations &, |,
// qui nous permettraient de manipuler des bits individuellement...
if (bits==NULL)
{
fprintf (stderr, "%d est trop gros, je n'ai pas assez de place memoire...\n");
fflush (stderr);
exit (10);
}
zero_sieve (bits, n);
bits[0] = bits[1] = 1;
fill_sieve (bits, n);
print_sieve (bits, n);
free (bits); // et on libere la place memoire allouee pour bits[].
}
return 0;
}
int zero_sieve (int *bits, int n)
{
int i;
for (i=0; i<n; i++)
bits[i] = 0;
return 0;
}
int fill_sieve (int *bits, int n)
{
int last_prime;
for (last_prime = 2; last_prime<n; )
{
cross_out_prime (bits, n, last_prime);
while (++last_prime<n && bits[last_prime]);
}
return 0;
}
int cross_out_prime (int *bits, int n, int prime)
{
int delta;
for (delta = prime; (prime = prime + delta) < n; )
bits[prime] = 1;
return 0;
}
int print_sieve (int *bits, int n)
{
char *delim;
int i;
int k;
char *buf;
printf ("Les nombres premiers inferieurs a %d sont:\n", n);
delim = " ";
k = 0;
for (i=0; i<n; i++)
{
if (bits[i]==0)
{
printf ("%s%8d", delim, i);
if (++k>=4)
{
printf ("\n"); // retour à la ligne.
k = 0;
delim = " ";
}
else
printf (" "); // espace.
}
}
fflush (stdout); // on vide le tampon de stdout, utilise par printf().
return 0;
}

7
Exemples/test.c Normal file
View File

@ -0,0 +1,7 @@
int global1;
int main() {
global1 = 42;
printf("%d\n", global1);
return 0;
}

1422
Exemples/unitest0.c Normal file

File diff suppressed because it is too large Load Diff

92
Makefile Normal file
View File

@ -0,0 +1,92 @@
# Copyright (c) 2005 by Laboratoire Spécification et Vérification (LSV),
# CNRS UMR 8643 & ENS Cachan.
# Written by Jean Goubault-Larrecq. Derived from the csur project.
#
# Permission is granted to anyone to use this software for any
# purpose on any computer system, and to redistribute it freely,
# subject to the following restrictions:
#
# 1. Neither the author nor its employer is responsible for the consequences
# of use of this software, no matter how awful, even if they arise
# from defects in it.
#
# 2. The origin of this software must not be misrepresented, either
# by explicit claim or by omission.
#
# 3. Altered versions must be plainly marked as such, and must not
# be misrepresented as being the original software.
#
# 4. This software is restricted to non-commercial use only. Commercial
# use is subject to a specific license, obtainable from LSV.
%.cmo: %.ml
ocamlc -g -c $<
%.cmi: %.mli
ocamlc -g -c $<
.PHONY: all projet.tar.gz
# Compilation parameters:
CAMLOBJS=error.cmo cparse.cmo cprint.cmo \
ctab.cmo clex.cmo verbose.cmo genlab.cmo compile.cmo \
main.cmo
CAMLSRC=$(addsuffix .ml,$(basename $(CAMLOBJS)))
PJ=ProjetMiniC
FILES=clex.mll cparse.ml cparse.mli ctab.mly \
compile.ml compile.mli \
cprint.ml cprint.mli \
error.ml verbose.ml genlab.ml main.ml Makefile
all: mcc
projet: projet.tar.gz
mcc: $(CAMLOBJS)
ocamlc -g -o mcc unix.cma $(CAMLOBJS)
clean:
rm -f mcc *.cmi *.cmo
rm -f ctab.ml ctab.mli clex.ml
rm -rf projet.tar.gz $(PJ)
rm -rf Test/
test: projet.tar.gz
-mkdir Test
-rm -rf Test/*
cp projet.tar.gz Test/
(cd Test/; tar -xvzf projet.tar.gz; cd ProjetMiniC/; cp ~/Papers/compile.ml .; make; cp mcc ~/bin)
projet.tar.gz:
rm -rf $(PJ) && mkdir $(PJ)
cp $(FILES) $(PJ)
-mkdir $(PJ)/Exemples
cp Exemples/*.c $(PJ)/Exemples
cp cprint_skel.ml $(PJ)/cprint.ml
cp compile_skel.ml $(PJ)/compile.ml
tar -cvzf $@ $(PJ)
P1=../boostrap
P2=../../2/boostrap
p2_links:
@echo Populating $(P2) with links for missing files...
@mkdir -p $(P2)
@for f in $(FILES) compile_skel.ml cprint_skel.ml ; do \
test -f $(P2)/$$f || (echo Linking $$f... ; ln $(P1)/$$f $(P2)/$$f) ; done
@mkdir -p $(P2)/Exemples
@for f in Exemples/*.c ; do \
test -f $(P2)/$$f || (echo Linking $$f... ; ln $(P1)/$$f $(P2)/$$f) ; done
ctab.ml: ctab.mly
ocamlyacc -v ctab.mly
clex.ml: clex.mll
ocamllex clex.mll
compile.cmi: compile.mli
compile.cmo: compile.ml compile.cmi
depend: Makefile $(wildcard *.ml) $(wildcard *.mli) ctab.ml clex.ml
ocamldep *.mli *.ml > depend
-include depend

294
README.md Normal file
View File

@ -0,0 +1,294 @@
---
title: Compilateur de C-\-
author: Yohann D'ANELLO
geometry:
- top=0.5in
- bottom=0.5in
- left=1in
- right=1in
...
\pagenumbering{gobble}
`MCC` est un compilateur du langage `C--` codé en OCamL. Il prend en entrée un fichier source codé en `C--`, puis le traduit en code assembleur (Intel x86\_64), avant de l'assembler en exécutable machine. La sémantique de `C--` est disponible ici : [http://www.lsv.fr/~goubault/CoursProgrammation/prog1_sem1.pdf](http://www.lsv.fr/~goubault/CoursProgrammation/prog1_sem1.pdf)
Un analyseur syntaxique commence par analyser le code, et le traduire en un *Abstract Syntax Tree* (AST, arbre de syntaxe abstrait). Le compilateur vient ensuite dérouler l'AST et produire le code assembleur nécessaire.
La première chose effectuée par le compilateur est de récupérer la liste des fonctions déclarées par le code. Cela permet de savoir quelles sont les fonctions qui renvoient un entier codé sur 32 ou sur 64 bits, avec les fonctions système `malloc`, `calloc`, `realloc`, `fopen` et `exit`. Ensuite, le code est compilé.
À la lecture du code, le compilateur dispose d'un environnement transmis et mis à jour à chaque appel de fonctions. Un environnement est modélisé par un 9-uplet contenant un compteur de nombre de labels déclarés, la liste des chaîne de caractères déjà rencontré ainsi que leur nombre, la liste des noms des variables globales, un booléen indiquant si le compilateur est actuellement en train de déclarer des paramètres d'une fonction ou non, un dictionnaire des variables locales indiquant à tout nom sa place sur la pile ainsi que la liste des fonctions disposant d'un retour sur 64 bits.
# Déclaration d'une variable globale
Les éléments les plus hauts dans l'AST sont les déclarations de variables globales et de fonctions. Pour déclarer une variable, le compilateur ajoute uniquement dans l'environnement le nom de la variable globale déclarée et ne produit aucun code assembleur. Il attendra d'avoir compilé tout le code avant de déclarer les variables globales dans la section `.data` via l'instruction `.comm <NAME>, 8, 8`.
# Déclaration d'une fonction
Le compilateur commence par déclarer créer un label vers la fonction, via `<NAME>:`{.asm}. Ensuite, la fonction va être parcourue une première fois afin d'estimer la place nécessaire à allouer sur la pile pour déclarer les variables. Pour cela, chaque paramètre et chaque variable déclarée (y compris dans les sous-blocs) compte pour 8 octets), afin de garantir d'avoir toujours de la place pour les besoins nécessaires. Ensuite, l'instruction `ENTERQ $N, 0`{.asm} est ajoutée, où `N` est le plus petit multiple de 16 supérieur ou égal à la place nécessaire pour la fonction. Ensuite, les paramètres sont déclarés, puis c'est au tour du code de la fonction. On convient que la valeur de retour de la fonction doit se trouver dans `%rax`{.asm}. Enfin, l'instruction `LEAVEQ`{.asm} permet d'effectuer l'instruction inverse de `ENTERQ`{.asm}, et donc de remettre `%rbp`{.asm} et `%rsp`{.asm} à leurs bonnes valeurs. L'instruction `RETQ`{.asm} suit ensuite, et va à l'instruction suivante.
# Déclaration d'une variable locale, d'un paramètre
Lors de la déclaration d'une variable locale, celle-ci est ajoutée à l'environnement. En mémoire est conservée la position de son adresse relativement à `%rsp`{.asm}, qui vaut alors la première place libre sur la pile. L'adresse de la `n`-ième variable locale est alors `-n(%rbp)`{.asm}. S'il s'agit d'un paramètre, alors cela implique que le paramètre est déjà initialisé, et donc on ajoute une instruction qui permet de récupérer la valeur du paramètre dans le bon registre, ou bien à la bonne position sur la pile s'il s'agit au moins du septième paramètre.
# Évaluation d'un morceau de code
Il existe 5 types de morceaux de code : les blocs, les expressions, les tests conditionnels `if`{.C}, les boucles `while`{.C} et les valeurs de retour `return`{.C}.
## Les blocs de code
Format : `CBLOCK(declaration list, code)`
Un bloc de code commence par la déclaration des variables locales du bloc. Chaque variable est déclarée une à une, mettant à jour successivement l'environnement courant. Le code du bloc est ensuite exécuté. À la fin du bloc, les variables locales de l'environnement sont remplacées celles présentes avant l'entrée du code. Le reste est conservé.
## Les expressions
Format : `CEXPR(expression)`
Un bloc d'expression évalue alors une expression. Une fois évaluée, la valeur de retour est toujours envoyée dans `%rax`{.asm}. Il existe 11 types d'expression : l'utilisation de variables, l'utilisation de constantes entières, l'utilisation de chaîne de caractères, l'affection dans une variable, l'affectation dans un tableau, l'appel d'une fonction, une opération unaire (opposé, négation binaire, {post,pré}-{in,dé}crémentation), une opération binaire (multiplication, division, modulo, addition, soustraction, accès à l'élément d'un tableau), la comparaison de deux éléments (infériorité stricte, infériorité large, égalité), les conditions ternaires et enfin les séquences d'expression.
### Utilisation de variables
Format : `VAR(name)`
Une ligne d'assembleur est ajoutée, qui va alors chercher dans l'environnement la position sur la pile de la variable appelée si elle est locale, sinon donner son nom directement, pour placer le contenu dans `%rax`{.asm}.
`MOVQ -24(%rbp), %rax`{.asm}\newline
`MOVQ stdout(%rip), %rax`{.asm}
### Utilisation de constantes entières
Format : `CST(value)`
La constante indiquée est directement enregistrée dans `%rax`{.asm}.
`MOVQ $42, %rax`{.asm}
### Utilisation de chaînes de caractères
Format : `STRING(string)`
La chaîne correspondante est ajoutée à l'environnement. Une optimisation du compilateur permet de ne pas enregistrer des chaînes de caractères déjà existantes. Après avoir compilé le code, dans la section `.data`{.asm}, toutes les chaînes de caractères sont ajoutées au code assembleur, sous le label `.strN`{.asm} où `N`{.asm} est le numéro de la chaîne, par ordre d'apparition, via l'instruction :
`.strN:`{.asm}\newline
` .string STR`{.asm}\newline
` .text`{.asm}
Le label en question est alors affecté à `%rax`{.asm} : `MOVQ $.strN, %rax`{.asm}
### Affection dans une variable
Format : `SET_VAR(name, expression)`
L'expression à affecter est évaluée, puis le résultat (dans `%rax`{.asm}) est affecté dans la variable.
`MOVQ %rax, -24(%rbp)`{.asm}
### Affectation dans un tableau
Format : `SET_ARRAY(name, expression, expression)`
La première expression est d'abord évaluée, puis mise sur la pile. La seconde expression est ensuite évaluée, et le résultat est alors dans `%rax`{.asm}. La valeur mise sur la pile est ensuite dépilée dans `%rbx`{.asm}. `%rbx`{.asm} contient alors l'indice du tableau et `%rax`{.asm} la valeur à affecter. On récupère ensuite l'adresse de la case désirée, via des additions, puis on place le contenu `%rax`{.asm} dans la bonne case mémoire.
`MOVQ $1, %rax`{.asm}\newline
`PUSHQ %rax`{.asm}\newline
`MOVQ $4, %rax`{.asm}\newline
`POPQ %rbx`{.asm}\newline
`MOVQ -24(%rbp), %rdx`{.asm}\newline
`LEAQ 0(, %rbx, 8), %rbx`{.asm}\newline
`ADDQ %rbx, %rdx`{.asm}\newline
`MOVQ %rax, (%rdx)`{.asm}
### Appel d'une fonction
Format : `CALL(name, parameter list (expression list))`
On commence par évaluer chacun des arguments, de droite à gauche, et les placer sur la pile un à un. Les (au plus) six premiers sont ensuite dépilés et mis dans l'ordre dans `%rdi`{.asm}, `%rsi`{.asm}, `%rdx`{.asm}, `%rcx`{.asm}, `%r8`{.asm}, `%r9`{.asm}. Par respect de la norme `C`, on fixe `%rax`{.asm} à `0`{.C}, puis on appelle la fonction. Une fois l'appel terminé, on dépile les arguments résiduels éventuels. Si jamais la fonction n'est pas dans la liste des fonctions ayant un retour sur 64 bits, on étend le signe de `%eax` dans `%rax`{.asm}, via l'instruction `CLTQ`{.asm}.
`MOVQ $2, %rax`{.asm}\newline
`PUSHQ %rax`{.asm}\newline
`MOVQ $.str1, %rax`{.asm}\newline
`PUSHQ %rax`{.asm}\newline
`POPQ %rsi`{.asm}\newline
`POPQ %rdi`{.asm}\newline
`MOVQ $0, %rax`{.asm}\newline
`CALLQ printf`{.asm}\newline
`CLTQ`{.asm}\newline
`...`{.asm}\newline
`.str1:`{.asm}\newline
` .string "Valeur de deux = %d\n"`{.asm}\newline
` .text`{.asm}
Cette suite d'instruction assembleur modélise l'appel `printf("Valeur de deux = %d\n", 2);`{.C}.
### Opérateur unaire
Format : `OP1(optype, expression)`
L'expression est évaluée (le résultat est alors dans `%rax`{.asm}), puis traitée.
#### Opposé
Une seule instruction suffit : `NEGQ %rax`{.asm}
#### Négation logique
De même, il suffit d'une instruction assembleur : `NOTQ %rax`{.asm}
#### {Post,Pré}-{in,dé}crémentation
Si on est en post-{in,dé}crémentation, on commence par empiler la valeur de `%rax`{.asm}, qu'on dépilera plus tard, afin de renvoyer la bonne valeur. Sinon, d'abord on {in,dé}crémente, puis on met dans `%rax`{.asm} la valeur souhaitée.
Une telle opération est, selon la sémantique `C--`, soit de la forme `s++`{.C} où `s`{.C} est une variable, soit de la forme `t[e]++`{.C} où `e`{.C} est une expression et `t`{.C} une variable. Dans le premier cas, on se contente d'incrémenter ou de décrémenter la variable via `INCQ`{.asm} ou `DECQ`{.asm}. Dans le second cas, on procède de la même manière que l'affectation dans un tableau en récupérant la bonne adresse, puis on {in,dé}crémente la valeur associée.
### Opérateur binaire
Format : `OP2(optype, expression1, expression2)`
La deuxième expression est d'abord évaluée (en accord avec la sémantique de `C--` qui suggère de toujours évaluer de droite à gauche), puis la valeur est placée sur la pile. La première expression est ensuite évaluée, dont le résultat est dans `%rax`{.asm}. On récupère ensuite l'évaluation de la seconde expression dans `%rbx`{.asm}.
#### Multiplication, addition, soustraction
L'instruction `IMUL %rbx, %rax`{.asm} permet directement de multiplier `%rbx`{.asm} par `%rax`{.asm} et de placer le résultat dans `%rax`{.asm}, ce qui est ce que nous voulions. Les instructions `ADDQ`{.asm} et `SUBQ`{.asm} permettent la même chose pour l'addition et la soustraction.
#### Division, modulo
On commence par étendre le signe de `%rax`{.asm} dans `%rdx`{.asm} via l'instruction `CQO`{.asm}. On ajoute ensuite l'expression `IDIVQ %rbx`{.asm}, qui effectue la division euclidienne de `%rdx:%rax`{.asm} (nombre vu comme la concaténation des deux registres sur 128 bits) par `%rbx`{.asm}, et stocke le quotient dans `%rax`{.asm} et le reste dans `%rdx`{.asm}, selon la sémantique de `C--`. Selon les cas, on met la bonne valeur dans `%rax`{.asm}, puis pour des raisons de sécurité on remet `%rdx`{.asm} à `0`{.C}.
#### Accès dans un tableau
Comme précédemment, on récupère l'adresse de la bonne case mémoire, puis on place le contenu dans `%rax`{.asm} :
`LEAQ (0, %rbx, 8), %rbx`{.asm}\newline
ADDQ %rbx, %rax`{.asm}\newline
MOVQ (%rax), %rax`{.asm}
### Comparaison
Format : `CMP(cmptype, expression1, expression 2)`
On évalue la première expression dans `%rbx`{.asm}, puis la seconde dans `%rax`{.asm}. On compare ensuite `%rax`{.asm} à `rbx`. Puis, selon les cas (`JL` si l'inégalité est stricte, `JLE` si l'inégalité est large, `JE` si on veut l'égalité), on fait un saut vers le prochain label disponible. On se débrouille ensuite pour mettre `1` dans `%rax`{.asm} si la comparaison est concluante, `0` sinon.
`CMPQ %rax, %rbx`{.asm}\newline
`JE .destjump1`{.asm}\newline
`MOVQ $0, %rax`{.asm}\newline
`JMP .destjump2`{.asm}\newline
`.destjump1:`{.asm}\newline
`MOVQ $1, %rax`{.asm}\newline
`.destjump2:`{.asm}
### Condition ternaire
Format : `EIF(expression1, expression2, expression3)`
On évalue d'abord la première expression, qu'on compare à 0. S'il y a égalité, alors on saute vers un futur label où on évaluera la troisième expression (la partie `else`). Sinon, alors on évalue la deuxième expression, où on ajoute un saut vers la fin de la condition.
Cette suite d'instruction simule `1 ? 5 : 7` :
`MOVQ $1, %rax`{.asm}\newline
`CMPQ $0, %rax`{.asm}\newline
`JE .destjump1`{.asm}\newline
`MOVQ $7, %rax`{.asm}\newline
`JMP .destjump2`{.asm}\newline
`.destjump1:`{.asm}\newline
`MOVQ $5, %rax`{.asm}\newline
`.destjump2:`{.asm}
### Séquence d'expression
Format : `ESEQ(expression list)`
Cette expression se contente d'évaluer les sous-expressions et de mettre à jour l'environnement au besoin.
## Instruction conditionnelle
Format : `CIF(expression, code1, code2)`
On procède de la même manière que pour les expressions ternaires, à la différence près qu'on compile des blocs de code au lieu d'évaluer des expressions.
## Boucles
Format : `CWHILE(expression, code)`
On commence par créer un label en haut de la boucle. On en rajoutera un aussi en fin de boucle. On évalue ensuite l'expression, qu'on compare ensuite à `0`. Si la comparaison est concluante, alors on saute directement à la fin de la boucle. Juste avant la fin de boucle, on saute immédiatement en haut de la boucle.
`.whileloop1:`{.asm}\newline
` MOVQ -8(%rbp), %rax`{.asm}\newline
` CMPQ $0, %rax`{.asm}\newline
` JE .endloop1`{.asm}\newline
` # code`{.asm}\newline
` JMP .whileloop1`{.asm}\newline
`endloop1:`{.asm}
## Valeurs de retour
S'il n'y a pas de valeur de retour, alors on ne fait rien. La précédente valeur de `%rax`{.asm} servira de valeur de retour, en accord avec la sémantique qui autorise n'importe quelle valeur de retour si non précisée. Si non, alors on évalue la valeur de retour, qui sera directement dans `%rax`{.asm}. On ajoute ensuite les instructions `LEAVEQ`{.asm} et `RETQ{.asm}`, qui permettent de rétablir les précédentes valeurs de `%rsp`{.asm} et de `%rbp`{.asm} et de sauter à la nouvelle instruction. Il se peut qu'il y ait redondance avec les instructions ajoutées par la déclaration de la fonction, mais cela n'est pas un problème car ces instructions ne seront tout simplement jamais exécutées. Cela évite le problème d'absence d'instruction `return`{.C} dans le code `C`.
# Optimisations possibles
Certaines optimisations pourraient être réalisables, notamment celles qu'effectue `GCC` : on pourrait par exemple ne pas avoir à systématiquement affecter le contenu d'une variable dans `%rax`{.asm}, et utiliser directement l'adresse de la variable. Ce type d'optimisation nécessiterait néanmoins une meilleure maitrise de l'AST, quitte à le parcourir plusieurs fois, pour vérifier si certaines précautions sont nécessaires ou non.
En espérant que ce compilateur vous sera d'une grande aide :)
\newpage
# Exemple de compilation
## Code simple :
`int main(int argc, char** argv) {`{.C}\newline
`int i;`{.C}\newline
`i = 0;`{.C}\newline
`i = (i++ - --i) + 1 + i;`{.C}\newline
`printf("Valeur de i = %d\n", i);`{.C}\newline
`return i;`{.C}\newline
`}`{.C}
## Code assembleur généré :
`.section .text`{.asm}\newline
` .global main`{.asm}\newline
`main:`{.asm}\newline
` ENTERQ $32, $0`{.asm}\newline
` MOVQ %rdi, -8(%rbp) # argc`{.asm}\newline
` MOVQ %rsi, -16(%rbp) # argv`{.asm}\newline
` MOVQ $0, %rax`{.asm}\newline
` MOVQ %rax, -24(%rbp)`{.asm}\newline
` MOVQ -24(%rbp), %rax # i`{.asm}\newline
` PUSHQ %rax`{.asm}\newline
` MOVQ $1, %rax`{.asm}\newline
` PUSHQ %rax`{.asm}\newline
` DECQ -24(%rbp)`{.asm}\newline
` MOVQ -24(%rbp), %rax # i`{.asm}\newline
` PUSHQ %rax`{.asm}\newline
` MOVQ -24(%rbp), %rax # i`{.asm}\newline
` INCQ -24(%rbp)`{.asm}\newline
` POPQ %rbx`{.asm}\newline
` SUBQ %rbx, %rax`{.asm}\newline
` POPQ %rbx`{.asm}\newline
` ADDQ %rbx, %rax`{.asm}\newline
` POPQ %rbx`{.asm}\newline
` ADDQ %rbx, %rax`{.asm}\newline
` MOVQ %rax, -24(%rbp)`{.asm}\newline
` MOVQ -24(%rbp), %rax # i`{.asm}\newline
` PUSHQ %rax`{.asm}\newline
` MOVQ $.str0, %rax`{.asm}\newline
` PUSHQ %rax`{.asm}\newline
` POPQ %rdi`{.asm}\newline
` POPQ %rsi`{.asm}\newline
` MOVQ $0, %rax`{.asm}\newline
` CALLQ printf`{.asm}\newline
` CLTQ`{.asm}\newline
` MOVQ -24(%rbp), %rax # i`{.asm}\newline
` LEAVEQ`{.asm}\newline
` RETQ`{.asm}\newline
`.section .data`{.asm}\newline
`.str0:`{.asm}\newline
` .string "Valeur de i = %d\n"`{.asm}\newline
` .text`{.asm}\newline
### Sortie standard :
`Valeur de i = 1\n`{.C}, code de sortie : `1`{.C}
On peut bien sûr compiler des codes plus longs, mais l'assembleur généré ne tiendrait pas dans une page :)

BIN
README.pdf Normal file

Binary file not shown.

BIN
clex.cmi Normal file

Binary file not shown.

BIN
clex.cmo Normal file

Binary file not shown.

3859
clex.ml Normal file

File diff suppressed because it is too large Load Diff

297
clex.mll Normal file
View File

@ -0,0 +1,297 @@
{
(*
* Copyright (c) 2005 by Laboratoire Spécification et Vérification (LSV),
* UMR 8643 CNRS & ENS Cachan.
* Written by Jean Goubault-Larrecq. Derived from the csur project.
*
* Permission is granted to anyone to use this software for any
* purpose on any computer system, and to redistribute it freely,
* subject to the following restrictions:
*
* 1. Neither the author nor its employer is responsible for the consequences of use of
* this software, no matter how awful, even if they arise
* from defects in it.
*
* 2. The origin of this software must not be misrepresented, either
* by explicit claim or by omission.
*
* 3. Altered versions must be plainly marked as such, and must not
* be misrepresented as being the original software.
*
* 4. This software is restricted to non-commercial use only. Commercial
* use is subject to a specific license, obtainable from LSV.
*
*)
(* Analyse lexicale d'un sous-ensemble (tres) reduit de C.
*)
open Cparse
open Error
open Ctab
let string_buf = Buffer.create 256
let string_iter f s = (* = String.iter; pas present en OCaml 2.04. *)
let n = String.length s
in for i=0 to n-1 do f (s.[i]) done
let count yytext =
(oldcline := !cline; oldccol := !ccol;
string_iter (fun c -> match c with
'\n' -> (cline := !cline+1; ccol := 0)
(* | '\t' -> (ccol := !ccol + 8 - (!ccol mod 8)) *)
| _ -> ccol := !ccol+1) yytext)
let parse_hex yytext tend =
let n = ref 0
in let len = String.length yytext-tend
in ((for i=2 to len-1 do
let c = yytext.[i] in
match c with
'0'..'9' -> n := 16 * !n + (int_of_char c - int_of_char '0')
| 'a'..'f' -> n := 16 * !n + (int_of_char c + 10 - int_of_char 'a')
| 'A'..'F' -> n := 16 * !n + (int_of_char c + 10 - int_of_char 'A')
| _ -> fatal (Some (!cfile, !cline, !ccol-len, !cline, !ccol))
("invalid hexadecimal number " ^ yytext)
done);
!n)
let parse_oct yytext start tend =
let n = ref 0
in let len = String.length yytext-tend
in ((for i=start to len-1 do
let c = yytext.[i] in
match c with
'0'..'7' -> n := 8 * !n + (int_of_char c - int_of_char '0')
| _ -> fatal (Some (!cfile, !cline, !ccol-len, !cline, !ccol))
("invalid octal number " ^ yytext)
done);
!n)
let parse_dec yytext tend =
let n = ref 0
in let len = String.length yytext-tend
in ((for i=0 to len-1 do
let c = yytext.[i] in
match c with
'0'..'9' -> n := 10 * !n + (int_of_char c - int_of_char '0')
| _ -> fatal (Some (!cfile, !cline, !ccol-len, !cline, !ccol))
("invalid number " ^ yytext)
done);
!n)
}
let digit = ['0'-'9']
let letter = ['a'-'z' 'A'-'Z' '_']
let hex = ['a'-'f' 'A'-'F' '0'-'9']
let expo = ['E' 'e'] ['+' '-']? digit+
let fs = ['f' 'F' 'l' 'L']
let is = ['u' 'U' 'l' 'L']*
rule ctoken = parse
"/*" { count (Lexing.lexeme lexbuf); comment lexbuf; ctoken lexbuf }
| "//" { count (Lexing.lexeme lexbuf); inlcomment lexbuf; ctoken lexbuf }
| "auto" { count (Lexing.lexeme lexbuf); AUTO }
| "break" { count (Lexing.lexeme lexbuf); BREAK }
| "case" { count (Lexing.lexeme lexbuf); CASE }
| "char" { count (Lexing.lexeme lexbuf); CHAR }
| "const" { count (Lexing.lexeme lexbuf); CONST }
| "continue" { count (Lexing.lexeme lexbuf); CONTINUE }
| "default" { count (Lexing.lexeme lexbuf); DEFAULT }
| "do" { count (Lexing.lexeme lexbuf); DO }
| "double" { count (Lexing.lexeme lexbuf); DOUBLE }
| "else" { count (Lexing.lexeme lexbuf); ELSE }
| "enum" { count (Lexing.lexeme lexbuf); ENUM }
| "extern" { count (Lexing.lexeme lexbuf); EXTERN }
| "float" { count (Lexing.lexeme lexbuf); FLOATING }
| "for" { count (Lexing.lexeme lexbuf); FOR }
| "goto" { count (Lexing.lexeme lexbuf); GOTO }
| "if" { count (Lexing.lexeme lexbuf); IF }
| "int" { count (Lexing.lexeme lexbuf); INTEGER }
| "long" { count (Lexing.lexeme lexbuf); LONG }
| "register" { count (Lexing.lexeme lexbuf); REGISTER }
| "return" { count (Lexing.lexeme lexbuf); RETURN }
| "short" { count (Lexing.lexeme lexbuf); SHORT }
| "signed" { count (Lexing.lexeme lexbuf); SIGNED }
| "sizeof" { count (Lexing.lexeme lexbuf); SIZEOF }
| "static" { count (Lexing.lexeme lexbuf); STATIC }
| "struct" { count (Lexing.lexeme lexbuf); STRUCT }
| "switch" { count (Lexing.lexeme lexbuf); SWITCH }
| "typedef" { count (Lexing.lexeme lexbuf); TYPEDEF }
| "union" { count (Lexing.lexeme lexbuf); UNION }
| "unsigned" { count (Lexing.lexeme lexbuf); UNSIGNED }
| "void" { count (Lexing.lexeme lexbuf); VOID }
| "volatile" { count (Lexing.lexeme lexbuf); VOLATILE }
| "while" { count (Lexing.lexeme lexbuf); WHILE }
| letter (letter | digit)* { count (Lexing.lexeme lexbuf);
let yytext = Lexing.lexeme lexbuf in
IDENTIFIER yytext
}
| '0' ['x' 'X'] hex+ { count (Lexing.lexeme lexbuf);
CONSTANT (parse_hex (Lexing.lexeme lexbuf) 0) }
| '0' ['x' 'X'] hex+ ['u' 'U'] { count (Lexing.lexeme lexbuf);
CONSTANT (parse_hex (Lexing.lexeme lexbuf) 1) }
| '0' ['x' 'X'] hex+ ['l' 'L'] { count (Lexing.lexeme lexbuf);
CONSTANT (parse_hex (Lexing.lexeme lexbuf) 1) }
| '0' ['x' 'X'] hex+ ['u' 'U'] ['l' 'L'] { count (Lexing.lexeme lexbuf);
CONSTANT (parse_hex (Lexing.lexeme lexbuf) 2) }
| '0' ['x' 'X'] hex+ ['u' 'U'] ['l' 'L'] ['l' 'L'] { count (Lexing.lexeme lexbuf);
CONSTANT (parse_hex (Lexing.lexeme lexbuf) 3) }
| '0' ['0'-'7']+ { count (Lexing.lexeme lexbuf);
CONSTANT (parse_oct (Lexing.lexeme lexbuf) 1 0) }
| '0' ['0'-'7']+ ['u' 'U'] { count (Lexing.lexeme lexbuf);
CONSTANT (parse_oct (Lexing.lexeme lexbuf) 1 1) }
| '0' ['0'-'7']+ ['l' 'L'] { count (Lexing.lexeme lexbuf);
CONSTANT (parse_oct (Lexing.lexeme lexbuf) 1 1) }
| '0' ['0'-'7']+ ['u' 'U'] ['l' 'L'] { count (Lexing.lexeme lexbuf);
CONSTANT (parse_oct (Lexing.lexeme lexbuf) 1 2) }
| '0' ['0'-'7']+ ['u' 'U'] ['l' 'L'] ['l' 'L'] { count (Lexing.lexeme lexbuf);
CONSTANT (parse_oct (Lexing.lexeme lexbuf) 1 3) }
| digit+ { count (Lexing.lexeme lexbuf);
CONSTANT (parse_dec (Lexing.lexeme lexbuf) 0) }
| digit+ ['u' 'U'] { count (Lexing.lexeme lexbuf);
CONSTANT (parse_dec (Lexing.lexeme lexbuf) 1) }
| digit+ ['l' 'L'] { count (Lexing.lexeme lexbuf);
CONSTANT (parse_dec (Lexing.lexeme lexbuf) 1) }
| digit+ ['l' 'L' ] ['l' 'L' ] { count (Lexing.lexeme lexbuf);
CONSTANT (parse_dec (Lexing.lexeme lexbuf) 1) }
| digit+ ['u' 'U'] ['l' 'L'] { count (Lexing.lexeme lexbuf);
CONSTANT (parse_dec (Lexing.lexeme lexbuf) 2) }
| digit+ ['u' 'U'] ['l' 'L'] ['l' 'L'] { count (Lexing.lexeme lexbuf);
CONSTANT (parse_dec (Lexing.lexeme lexbuf) 3) }
| '\'' [^ '\'' '\\'] '\'' { count (Lexing.lexeme lexbuf);
CONSTANT (int_of_char (Lexing.lexeme_char lexbuf 1)) }
| '\'' '\\' ['0'-'7'] ['0'-'7']? ['0'-'7']? '\'' { count (Lexing.lexeme lexbuf);
CONSTANT (parse_oct (Lexing.lexeme lexbuf) 2 1) }
| '\'' '\\' 'a' '\'' { count (Lexing.lexeme lexbuf);
CONSTANT 7 (* bell, ^G *) }
| '\'' '\\' 'b' '\'' { count (Lexing.lexeme lexbuf);
CONSTANT (int_of_char '\b') }
| '\'' '\\' 'f' '\'' { count (Lexing.lexeme lexbuf);
CONSTANT 12 (* form feed, ^L *) }
| '\'' '\\' 'n' '\'' { count (Lexing.lexeme lexbuf);
CONSTANT (int_of_char '\n') }
| '\'' '\\' 'r' '\'' { count (Lexing.lexeme lexbuf);
CONSTANT (int_of_char '\r') }
| '\'' '\\' 't' '\'' { count (Lexing.lexeme lexbuf);
CONSTANT (int_of_char '\t')
(* bell, ^G *) }
| '\'' '\\' 'v' '\'' { count (Lexing.lexeme lexbuf);
CONSTANT 11 (* vertical tab, ^K *) }
| '\'' '\\' _ '\'' { count (Lexing.lexeme lexbuf);
CONSTANT (int_of_char (Lexing.lexeme_char lexbuf 2)) }
| "\""
{
count (Lexing.lexeme lexbuf); Buffer.reset string_buf;
string lexbuf;
STRING_LITERAL (Buffer.contents string_buf)
}
| "..." { count (Lexing.lexeme lexbuf); ELLIPSIS }
| ">>=" { count (Lexing.lexeme lexbuf); RIGHT_ASSIGN }
| "<<=" { count (Lexing.lexeme lexbuf); LEFT_ASSIGN }
| "+=" { count (Lexing.lexeme lexbuf); ADD_ASSIGN }
| "-=" { count (Lexing.lexeme lexbuf); SUB_ASSIGN }
| "*=" { count (Lexing.lexeme lexbuf); MUL_ASSIGN }
| "/=" { count (Lexing.lexeme lexbuf); DIV_ASSIGN }
| "%=" { count (Lexing.lexeme lexbuf); MOD_ASSIGN }
| "&=" { count (Lexing.lexeme lexbuf); AND_ASSIGN }
| "^=" { count (Lexing.lexeme lexbuf); XOR_ASSIGN }
| "|=" { count (Lexing.lexeme lexbuf); OR_ASSIGN }
| ">>" { count (Lexing.lexeme lexbuf); RIGHT_OP }
| "<<" { count (Lexing.lexeme lexbuf); LEFT_OP }
| "++" { count (Lexing.lexeme lexbuf); INC_OP }
| "--" { count (Lexing.lexeme lexbuf); DEC_OP }
| "->" { count (Lexing.lexeme lexbuf); PTR_OP }
| "&&" { count (Lexing.lexeme lexbuf); AND_OP }
| "||" { count (Lexing.lexeme lexbuf); OR_OP }
| "<=" { count (Lexing.lexeme lexbuf); LE_OP }
| ">=" { count (Lexing.lexeme lexbuf); GE_OP }
| "==" { count (Lexing.lexeme lexbuf); EQ_OP }
| "!=" { count (Lexing.lexeme lexbuf); NE_OP }
| ";" { count (Lexing.lexeme lexbuf); SEMI_CHR }
| ("{" | "<%") { count (Lexing.lexeme lexbuf); OPEN_BRACE_CHR }
| ("}" | "%>") { count (Lexing.lexeme lexbuf); CLOSE_BRACE_CHR }
| "," { count (Lexing.lexeme lexbuf); COMMA_CHR }
| ":" { count (Lexing.lexeme lexbuf); COLON_CHR }
| "=" { count (Lexing.lexeme lexbuf); EQ_CHR }
| "(" { count (Lexing.lexeme lexbuf); OPEN_PAREN_CHR }
| ")" { count (Lexing.lexeme lexbuf); CLOSE_PAREN_CHR }
| ("[" | "<:") { count (Lexing.lexeme lexbuf); OPEN_BRACKET_CHR }
| ("]" | ":>") { count (Lexing.lexeme lexbuf); CLOSE_BRACKET_CHR }
| "." { count (Lexing.lexeme lexbuf); DOT_CHR }
| "&" { count (Lexing.lexeme lexbuf); AND_CHR }
| "|" { count (Lexing.lexeme lexbuf); OR_CHR }
| "^" { count (Lexing.lexeme lexbuf); XOR_CHR }
| "!" { count (Lexing.lexeme lexbuf); BANG_CHR }
| "~" { count (Lexing.lexeme lexbuf); TILDE_CHR }
| "+" { count (Lexing.lexeme lexbuf); ADD_CHR }
| "-" { count (Lexing.lexeme lexbuf); SUB_CHR }
| "*" { count (Lexing.lexeme lexbuf); STAR_CHR }
| "/" { count (Lexing.lexeme lexbuf); DIV_CHR }
| "%" { count (Lexing.lexeme lexbuf); MOD_CHR }
| "<" { count (Lexing.lexeme lexbuf); OPEN_ANGLE_CHR }
| ">" { count (Lexing.lexeme lexbuf); CLOSE_ANGLE_CHR }
| "?" { count (Lexing.lexeme lexbuf); QUES_CHR }
| '#' { count (Lexing.lexeme lexbuf); line lexbuf }
| [' ' '\t' '\012' '\013' '\n' '\014']+ { count (Lexing.lexeme lexbuf); ctoken lexbuf }
| _ { fatal (Some (!cfile, !cline, !ccol, !cline, !ccol+1))
("bad character '" ^ (Lexing.lexeme lexbuf) ^ "'") }
| eof { EOF }
and comment = parse
"*/" { count (Lexing.lexeme lexbuf) }
| [^ '*']* { count (Lexing.lexeme lexbuf); comment lexbuf }
| eof { fatal (Some (!cfile, !cline, !ccol, !cline, !ccol)) "end of file reached inside comment" }
and inlcomment = parse
"\n" { count (Lexing.lexeme lexbuf) }
| [^ '\n']* { count (Lexing.lexeme lexbuf); inlcomment lexbuf }
and string = parse
'"' { () }
| '\n'+ { string lexbuf }
| '\\' ['0'-'7'] ['0'-'7']? ['0'-'7']? { Buffer.add_char string_buf (Char.chr (parse_oct (Lexing.lexeme lexbuf) 1 0)); string lexbuf }
| '\\' 'a' { Buffer.add_char string_buf '\007'; string lexbuf }
| '\\' 'b' { Buffer.add_char string_buf '\b'; string lexbuf }
| '\\' 'f' { Buffer.add_char string_buf '\014'; string lexbuf }
| '\\' 'n' { Buffer.add_char string_buf '\n'; string lexbuf }
| '\\' 'r' { Buffer.add_char string_buf '\r'; string lexbuf }
| '\\' 't' { Buffer.add_char string_buf '\t'; string lexbuf }
| '\\' 'v' { Buffer.add_char string_buf '\013'; string lexbuf }
| '\\' _ { Buffer.add_char string_buf (Lexing.lexeme_char lexbuf 1); string lexbuf }
| [^ '\\' '\n' '"']+ { Buffer.add_string string_buf (Lexing.lexeme lexbuf); string lexbuf }
| _ { Buffer.add_char string_buf (Lexing.lexeme_char lexbuf 0); string lexbuf }
| eof { fatal (Some (!cfile, !cline, !ccol, !cline, !ccol)) "end of file reached inside string literal" }
and line = parse
['0'-'9']+ { cline := parse_dec (Lexing.lexeme lexbuf) 0 - 1; line2 lexbuf }
| [' ' '\t']+ { count (Lexing.lexeme lexbuf); line lexbuf }
| '\n' { count (Lexing.lexeme lexbuf); ctoken lexbuf }
| "\"" { count (Lexing.lexeme lexbuf); Buffer.reset string_buf;
string lexbuf;
cfile := Buffer.contents string_buf;
ctoken lexbuf
}
| eof { fatal (Some (!cfile, !cline, !ccol, !cline, !ccol)) "end of file reached inside # directive" }
and line2 = parse
[' ' '\t']+ { count (Lexing.lexeme lexbuf); line2 lexbuf }
| '\n' { count (Lexing.lexeme lexbuf); ctoken lexbuf }
| "\"" { count (Lexing.lexeme lexbuf); Buffer.reset string_buf;
string lexbuf;
cfile := Buffer.contents string_buf;
line3 lexbuf
}
| eof { fatal (Some (!cfile, !cline, !ccol, !cline, !ccol)) "end of file reached inside # directive" }
and line3 = parse
'\n' { count (Lexing.lexeme lexbuf); ctoken lexbuf }
| _ { count (Lexing.lexeme lexbuf); line3 lexbuf }
| eof { fatal (Some (!cfile, !cline, !ccol, !cline, !ccol)) "end of file reached inside # directive" }

BIN
compile.cmi Normal file

Binary file not shown.

BIN
compile.cmo Normal file

Binary file not shown.

399
compile.ml Normal file
View File

@ -0,0 +1,399 @@
open Cparse
open Genlab
let number_str s strings =
let rec aux n l = match l with
| [] -> n, [s]
| s' :: l' when s' = s -> n, l
| s' :: l' -> let n', l = aux (n + 1) l' in n', s' :: l
in aux 0 strings;;
(* Un dictionnaire est soit vide, soit un couple (clé, valeur) suivi de la suite du dictionnaire *)
type ('a, 'b) dict = NIL | D of 'a * 'b * ('a, 'b) dict;;
let new_dict = NIL;;
type env = Env of int * string list * string list * bool * bool * int * (string, int) dict * string list;; (* jumpcount, strings, string count, global variables, declaring parameters, in_function, variables dictionary, functions that return a 64bit output *)
(* On recherche si une clé est présente dans le dictionnaire. Renvoie un booléen. *)
let rec contains d key = match d with
| NIL -> false
| D(k, _, _) when k = key -> true
| D(_, _, d') -> contains d' key;;
(* On récupère, si elle existe, la valeur associée à une clé dans un dictionnaire. Si ce n'est pas possible, on renvoie une erreur. Cas d'erreur : utilisation d'une variable locale non déclarée. *)
let rec search d key = match d with
| NIL -> failwith ("Var " ^ key ^ " not found")
| D(k, v, _) when k = key -> v
| D(_, _, d') -> search d' key;;
(* On ajoute un couple (clé, valeur) dans un dictionnaire, et si la clé existe déjà, on se contente de remplacer la valeur. *)
let rec append d key value = match d with
| NIL -> D(key, value, NIL)
| D(k, v, d') when k = key -> D(key, value, d')
| D(k, v, d') -> D(k, v, (append d' key value));;
(* Tableau des registres d'arguments utiles lors d'un appel de fonction, trié dans l'ordre. *)
let args = [|"%rdi"; "%rsi"; "%rdx"; "%rcx"; "%r8"; "%r9"|];;
(* Tableau des fonctions systèmes disposant d'un retour sur 64 bits. *)
let system_funs_64 = [|"malloc"; "calloc"; "realloc"; "exit"; "fopen"|];;
(* Récupère le nom en assembleur d'une variable. Si la variable est déclarée, alors on renvoie -8n(%rbp) où n est le numéro de la variable, sinon on renvoie s(%rip) où s est le nom de la variable, en supposant que s est une variable globale préalablement déclarée (peut être une variable sytème comme stdout ou stderr *)
let get_name_var vars key =
if contains vars key then (string_of_int (8 * (search vars key)) ^ "(%rbp)") else key ^ "(%rip)";;
(* Écris le code assembleur d'une fonction. Se référer au README pour plus de détails. *)
let compile out decl_list =
Printf.fprintf out ".section\t.text\n\t\t.global main\n\n";
(* Évalue une expression dans un certain environement. Le résultat de l'évaluation est placé dans %rax. On renvoie le nouvel environnement. *)
let rec evaluate e env = match env with Env(loopcount, strings, globals, decl_params, in_function, var_count, vars, funs) -> match e with
| VAR(s) -> begin
Printf.fprintf out "\t\tMOVQ\t\t%s,\t%%rax\t\t# %s\n" (get_name_var vars s) s;
env
end
| CST(i) -> begin
Printf.fprintf out "\t\tMOVQ\t\t$%d,\t\t%%rax\n" i;
env
end
| STRING(s) -> begin
let n, l = number_str s strings in
Printf.fprintf out "\t\tMOVQ\t\t$.str%d,\t\t%%rax\n" n;
Env(loopcount, l, globals, decl_params, in_function, var_count, vars, funs)
end;
| SET_VAR(s, e) -> begin
let new_env = evaluate (e_of_expr e) env in
Printf.fprintf out "\t\tMOVQ\t\t%%rax,\t\t%s\n" (get_name_var vars s);
new_env
end
| SET_ARRAY(s, e1, e2) -> begin
let new_env = evaluate (e_of_expr e1) env in
Printf.fprintf out "\t\tPUSHQ\t\t%%rax\n";
let new_new_env = evaluate (e_of_expr e2) new_env in
Printf.fprintf out "\t\tPOPQ\t\t%%rbx\n";
Printf.fprintf out "\t\tMOVQ\t\t%s,\t%%rdx\n" (get_name_var vars s);
Printf.fprintf out "\t\tLEAQ\t\t0(, %%rbx, 8),\t%%rbx\n";
Printf.fprintf out "\t\tADDQ\t\t%%rbx,\t\t%%rdx\n";
Printf.fprintf out "\t\tMOVQ\t\t%%rax,\t\t(%%rdx)\n";
new_new_env
end
| CALL(s, l) -> begin
let rec empile_args env i = function
| [] -> env
| e :: l' -> begin
let new_env = empile_args env (i + 1) l' in
let new_new_env = evaluate (e_of_expr e) new_env in
Printf.fprintf out "\t\tPUSHQ\t\t%%rax\n";
new_new_env
end
in let rec depile_args env i = function
| [] -> env
| e :: l' -> if i >= 6 then env else begin
Printf.fprintf out "\t\tPOPQ\t\t%s\n" args.(i);
depile_args env (i + 1) l'
end
in let newenv = empile_args env 0 l in
let new_env = depile_args newenv 0 l in
Printf.fprintf out "\t\tMOVQ\t\t$0,\t\t%%rax\n";
Printf.fprintf out "\t\tCALLQ\t\t%s\n" s;
for i = 0 to (List.length l) - 7 do
Printf.fprintf out "\t\tPOPQ\t\t%%rbx\n";
done;
if not (List.mem s funs) then
Printf.fprintf out "\t\tCLTQ\n";
new_env
end
| OP1(mop, e) -> (match mop with
| M_MINUS -> begin
let new_env = evaluate (e_of_expr e) env in
Printf.fprintf out "\t\tNEGQ\t\t%%rax\n";
new_env
end
| M_NOT -> begin
let new_env = evaluate (e_of_expr e) env in
Printf.fprintf out "\t\tNOTQ\t\t%%rax\n";
new_env
end
| M_POST_INC -> begin
let new_env = evaluate (e_of_expr e) env in
(match (e_of_expr e) with
| VAR(s) -> begin
Printf.fprintf out "\t\tINCQ\t\t%s\n" (get_name_var vars s);
new_env
end
| OP2(S_INDEX, e1, e2) -> (match (e_of_expr e1) with
| VAR(s) -> begin
Printf.fprintf out "\t\tPUSHQ\t\t%%rax\n";
let new_new_env = evaluate (e_of_expr e2) env in
Printf.fprintf out "\t\tMOVQ\t\t%s,\t%%rdx\n" (get_name_var vars s);
Printf.fprintf out "\t\tLEAQ\t\t0(, %%rax, 8),\t%%rax\n";
Printf.fprintf out "\t\tADDQ\t\t%%rax,\t\t%%rdx\n";
Printf.fprintf out "\t\tINCQ\t\t(%%rdx)\n";
Printf.fprintf out "\t\tPOPQ\t\t%%rax\n";
new_new_env
end
| _ -> new_env)
| _ -> new_env)
end
| M_POST_DEC -> begin
let new_env = evaluate (e_of_expr e) env in
match (e_of_expr e) with
| VAR(s) -> begin
Printf.fprintf out "\t\tDECQ\t\t%s\n" (get_name_var vars s);
new_env
end
| OP2(S_INDEX, e1, e2) -> (match (e_of_expr e1) with
| VAR(s) -> begin
Printf.fprintf out "\t\tPUSHQ\t\t%%rax\n";
let new_new_env = evaluate (e_of_expr e2) env in
Printf.fprintf out "\t\tMOVQ\t\t%s,\t%%rdx\n" (get_name_var vars s);
Printf.fprintf out "\t\tLEAQ\t\t0(, %%rax, 8),\t%%rax\n";
Printf.fprintf out "\t\tADDQ\t\t%%rax,\t\t%%rdx\n";
Printf.fprintf out "\t\tDECQ\t\t(%%rdx)\n";
Printf.fprintf out "\t\tPOPQ\t\t%%rax\n";
new_new_env
end
| _ -> new_env)
| _ -> new_env
end
| M_PRE_INC -> begin
let new_env = (match (e_of_expr e) with
| VAR(s) -> begin
Printf.fprintf out "\t\tINCQ\t\t%s\n" (get_name_var vars s);
env
end
| OP2(S_INDEX, e1, e2) -> (match (e_of_expr e1) with
| VAR(s) -> begin
let new_new_env = evaluate (e_of_expr e2) env in
Printf.fprintf out "\t\tMOVQ\t\t%s,\t%%rdx\n" (get_name_var vars s);
Printf.fprintf out "\t\tLEAQ\t\t0(, %%rax, 8),\t%%rax\n";
Printf.fprintf out "\t\tADDQ\t\t%%rax,\t\t%%rdx\n";
Printf.fprintf out "\t\tINCQ\t\t(%%rdx)\n";
Printf.fprintf out "\t\tMOVQ\t\t(%%rdx),\t\t%%rax\n";
new_new_env
end
| _ -> env);
| _ -> env) in
evaluate (e_of_expr e) new_env
end
| M_PRE_DEC -> begin
let new_env = (match (e_of_expr e) with
| VAR(s) -> begin
Printf.fprintf out "\t\tDECQ\t\t%s\n" (get_name_var vars s);
env
end
| OP2(S_INDEX, e1, e2) -> (match (e_of_expr e1) with
| VAR(s) -> begin
let new_new_env = evaluate (e_of_expr e2) env in
Printf.fprintf out "\t\tMOVQ\t\t%s,\t%%rdx\n" (get_name_var vars s);
Printf.fprintf out "\t\tLEAQ\t\t0(, %%rax, 8),\t%%rax\n";
Printf.fprintf out "\t\tADDQ\t\t%%rax,\t\t%%rdx\n";
Printf.fprintf out "\t\tDECQ\t\t(%%rdx)\n";
Printf.fprintf out "\t\tMOVQ\t\t(%%rdx),\t\t%%rax\n";
new_new_env
end
| _ -> env);
| _ -> env) in
evaluate (e_of_expr e) new_env
end)
| OP2(bop, e1, e2) -> begin
let new_env = evaluate (e_of_expr e2) env in
Printf.fprintf out "\t\tPUSHQ\t\t%%rax\n";
let new_new_env = evaluate (e_of_expr e1) new_env in match new_new_env with Env(loopcount, strings, _, _, _, _, _, _) ->
Printf.fprintf out "\t\tPOPQ\t\t%%rbx\n";
(match bop with
| S_MUL -> begin
Printf.fprintf out "\t\tIMULQ\t\t%%rbx,\t\t%%rax\n";
new_new_env
end
| S_DIV -> begin
Printf.fprintf out "\t\tCQO\n";
Printf.fprintf out "\t\tIDIVQ\t\t%%rbx\n";
Printf.fprintf out "\t\tMOVQ\t\t$0,\t\t%%rdx\n";
Env(loopcount + 2, strings, globals, decl_params, in_function, var_count, vars, funs)
end
| S_MOD -> begin
Printf.fprintf out "\t\tCQO\n";
Printf.fprintf out "\t\tIDIVQ\t\t%%rbx\n";
Printf.fprintf out "\t\tMOVQ\t\t%%rdx,\t\t%%rax\n";
Printf.fprintf out "\t\tMOVQ\t\t$0,\t\t%%rdx\n";
Env(loopcount + 2, strings, globals, decl_params, in_function, var_count, vars, funs)
end
| S_ADD -> begin
Printf.fprintf out "\t\tADDQ\t\t%%rbx,\t\t%%rax\n";
new_new_env
end
| S_SUB -> begin
Printf.fprintf out "\t\tSUBQ\t\t%%rbx,\t\t%%rax\n";
new_new_env
end
| S_INDEX -> begin
Printf.fprintf out "\t\tLEAQ\t\t0(,%%rbx,8),\t%%rbx\n";
Printf.fprintf out "\t\tADDQ\t\t%%rbx,\t\t%%rax\n";
Printf.fprintf out "\t\tMOVQ\t\t(%%rax),\t\t%%rax\n";
new_new_env
end)
end
| CMP(cop, e1, e2) -> begin
let new_env = evaluate (e_of_expr e1) env in
Printf.fprintf out "\t\tPUSHQ\t\t%%rax\n";
let new_new_env = evaluate (e_of_expr e2) new_env in match new_new_env with Env(loopcount, strings, _, _, _, _, _, _) ->
Printf.fprintf out "\t\tPOPQ\t\t%%rbx\n";
Printf.fprintf out "\t\tCMPQ\t\t%%rax,\t\t%%rbx\n";
(match cop with
| C_LT -> Printf.fprintf out "\t\tJL\t\t";
| C_LE -> Printf.fprintf out "\t\tJLE\t\t";
| C_EQ -> Printf.fprintf out "\t\tJE\t\t";);
Printf.fprintf out ".destjump%d\n" (loopcount + 1);
Printf.fprintf out "\t\tMOVQ\t\t$0,\t\t%%rax\n";
Printf.fprintf out "\t\tJMP\t\t.destjump%d\n" (loopcount + 2);
Printf.fprintf out "\t.destjump%d:\n" (loopcount + 1);
Printf.fprintf out "\t\tMOVQ\t\t$1,\t\t%%rax\n";
Printf.fprintf out "\t.destjump%d:\n" (loopcount + 2);
Env(loopcount + 2, strings, globals, decl_params, in_function, var_count, vars, funs)
end
| EIF(e1, e2, e3) -> begin
let new_env = evaluate (e_of_expr e1) env in match new_env with Env(loopcount, strings, _, _, _, _, _, _) ->
Printf.fprintf out "\t\tCMPQ\t\t$0,\t\t%%rax\n";
let x = (loopcount + 1) in
Printf.fprintf out "\t\tJE\t\t.destjump%d\n" x;
let new_new_env = evaluate (e_of_expr e2) (Env(loopcount + 1, strings, globals, decl_params, in_function, var_count, vars, funs)) in match new_new_env with Env(loopcount2, strings2, _, _, _, _, _, _) ->
let y = (loopcount2 + 1) in
Printf.fprintf out "\t\tJMP\t\t.destjump%d\n" y;
Printf.fprintf out "\t.destjump%d:\n" x;
let new_new_env = evaluate (e_of_expr e3) (Env(loopcount2 + 1, strings2, globals, decl_params, in_function, var_count, vars, funs)) in
Printf.fprintf out "\t.destjump%d:\n" y;
new_new_env
end
| ESEQ(l) -> begin
let rec aux env l = match l with
| [] -> env
| e :: l' -> aux (evaluate (e_of_expr e) env) l'
in aux env l
end
(* Déclare une liste de variables ou de fonctions, en mettant bien à jour l'environnement. *)
in let rec compile_decl_list env = function
| [] -> env
| h :: t -> let new_env = compile_decl env h in compile_decl_list new_env t
(* Compte la place nécessaire pour les variables au sein d'un bloc de code. *)
and count_vars (_, c) = match c with
| CBLOCK(vdl, lcl) -> let vars = (List.length vdl) in
let rec aux lcl = match lcl with
| [] -> 0, 0
| c :: l -> let v, p = count_vars c in let v2, p2 = aux l in (v + v2), (max p p2)
in let v, p = aux lcl in (v + vars), p
| CIF(_, c1, c2) -> let i1, j1 = (count_vars c1) in let i2, j2 = (count_vars c2) in (max i1 i2), (max j1 j2)
| CEXPR(_) -> 0, 0
| CWHILE(_, c) -> count_vars c
| CRETURN(_) -> 0, 0
(* Déclare une variable locale en distingant si c'est un paramètre ou non, ou une fonction. *)
and compile_decl env decl = match env with Env(loopcount, strings, globals, decl_params, in_function, var_count, vars, funs) -> match decl with
| CDECL(l, s) -> begin
if decl_params then begin
if var_count < 6 then begin
Printf.fprintf out "\t\tMOVQ\t\t%s,\t\t%d(%%rbp)\t# %s\n" args.(var_count) (-8 * (var_count + 1)) s;
Env(loopcount, strings, globals, decl_params, in_function, var_count + 1, (append vars s (-(var_count + 1))), funs)
end
else begin
Printf.fprintf out "\t\tMOVQ\t\t%d(%%rbp),\t%%rax\n" (8 * (var_count - 4));
Printf.fprintf out "\t\tMOVQ\t\t%%rax,\t\t%d(%%rbp)\t# %s\n" (-8 * (var_count + 1)) s;
Env(loopcount, strings, globals, decl_params, in_function, var_count + 1, (append vars s (-(var_count + 1))), funs)
end
end
else begin
if in_function then begin
Env(loopcount, strings, globals, decl_params, in_function, var_count + 1, (append vars s (-(var_count + 1))), funs)
end
else begin
Env(loopcount, strings, (s :: globals), decl_params, in_function, var_count, vars, funs)
end
end
end
| CFUN (l, s, vdl, lc) -> begin
Printf.fprintf out "\n%s:\n" s;
let nb_decl = List.length vdl in
let total_vars, max_params = count_vars lc in
let size = total_vars + nb_decl + max_params in
let real_size = size + (size mod 2) in
Printf.fprintf out "\t\tENTERQ\t\t$%d,\t\t$0\n" (8 * real_size);
let new_env = compile_decl_list (Env(loopcount, strings, globals, true, true, 0, new_dict, funs)) vdl in match new_env with Env(_, _, _, _, _, var_count, vars, _) ->
let new_new_env = compile_code lc (Env(loopcount, strings, globals, false, true, var_count, vars, funs)) in match new_new_env with Env(loopcount2, strings2, globals2, _, _, var_count2, vars2, _) ->
Printf.fprintf out "\t\tLEAVEQ\n";
Printf.fprintf out "\t\tRETQ\n";
Env(loopcount2, strings2, globals2, false, false, var_count2, vars2, funs)
end
(* Écris le code assembleur d'un bout de code. *)
and compile_code (_, c) env = match env with Env(loopcount, strings, globals, decl_params, in_function, var_count, vars, funs) -> match c with
| CBLOCK(vdl, lcl) -> begin
let new_env = compile_decl_list env vdl in
let rec aux lcl env = match lcl with
| [] -> env
| c :: l -> let new_env = (compile_code c env) in aux l new_env
in let new_env = aux lcl new_env in match new_env with Env(loopcount2, strings2, globals2, _, _, _, _, _) ->
Env(loopcount2, strings2, globals2, decl_params, in_function, var_count, vars, funs)
end
| CEXPR(expr) -> begin
evaluate (e_of_expr expr) env
end
| CIF(expr, c1, c2) -> begin
let new_env = evaluate (e_of_expr expr) env in
match new_env with Env(loopcount2, strings2, _, _, _, _, _, _) ->
let x = (loopcount2 + 1) in
Printf.fprintf out "\t\tCMPQ\t\t$0,\t\t%%rax\n";
Printf.fprintf out "\t\tJE\t\t.destjump%d\n" x;
let new_new_env = compile_code c1 (Env(loopcount2 + 1, strings2, globals, decl_params, in_function, var_count, vars, funs)) in
match new_new_env with Env(loopcount3, strings3, _, _, _, _, _, _) ->
let y = (loopcount3 + 1) in
Printf.fprintf out "\t\tJMP\t\t.destjump%d\n" y;
Printf.fprintf out "\t.destjump%d:\n" x;
let new_new_new_env = compile_code c2 (Env(loopcount3 + 1, strings3, globals, decl_params, in_function, var_count, vars, funs)) in
Printf.fprintf out "\t.destjump%d:\n" y;
new_new_new_env
end
| CWHILE(expr, c) -> begin
let x = (loopcount + 1) in
Printf.fprintf out "\t.whileloop%d:\n" x;
let new_env = evaluate (e_of_expr expr) (Env(loopcount + 1, strings, globals, decl_params, in_function, var_count, vars, funs)) in
Printf.fprintf out "\t\tCMPQ\t\t$0,\t\t%%rax\n";
Printf.fprintf out "\t\tJE\t\t.endloop%d\n" x;
let new_new_env = compile_code c new_env in
Printf.fprintf out "\t\tJMP\t\t.whileloop%d\n" x;
Printf.fprintf out "\t.endloop%d:\n" x;
new_new_env
end
| CRETURN(o) -> begin
let new_env = match o with
| Some(e) -> evaluate (e_of_expr e) env
| None -> env
in Printf.fprintf out "\t\tLEAVEQ\n";
Printf.fprintf out "\t\tRETQ\n";
new_env
end
(* Récupère la liste des fonctions déclarées, afin de gérer quelles fonctions renvoient un entier sur 64 bits ou 32 bits. *)
in let rec get_functions = function
| [] -> []
| CFUN(_, s, _, _) :: l -> s :: get_functions l
| _ :: l -> get_functions l
(* Compile le code. *)
in let final_env = compile_decl_list (Env(0, [], [], false, false, 0, new_dict, (Array.to_list system_funs_64) @ (get_functions decl_list))) decl_list in match final_env with Env(_, strings, globals, _, _, _, _, _) ->
(* Déclare les chaînes de caractères présentes. *)
Printf.fprintf out "\n.section\t.data\n";
let rec add_string_globals n = function
| [] -> ();
| s :: l' -> begin
Printf.fprintf out ".str%d:\n" n;
Printf.fprintf out "\t\t.string\t\t\"%s\"\n" (String.escaped s);
Printf.fprintf out "\t\t.text\n";
add_string_globals (n + 1) l';
end
in add_string_globals 0 strings;
(* Déclare les variables globales présentes. *)
let rec add_int_globals = function
| [] -> ()
| s :: l -> begin
add_int_globals l;
Printf.fprintf out ".comm\t\t%s,\t\t8,\t\t8\n" s;
end
in add_int_globals globals;;

25
compile.mli Normal file
View File

@ -0,0 +1,25 @@
(*
* Copyright (c) 2005 by Laboratoire Spécification et Vérification (LSV),
* CNRS UMR 8643 & ENS Cachan.
* Written by Jean Goubault-Larrecq. Not derived from licensed software.
*
* Permission is granted to anyone to use this software for any
* purpose on any computer system, and to redistribute it freely,
* subject to the following restrictions:
*
* 1. Neither the author nor its employer is responsible for the consequences of use of
* this software, no matter how awful, even if they arise
* from defects in it.
*
* 2. The origin of this software must not be misrepresented, either
* by explicit claim or by omission.
*
* 3. Altered versions must be plainly marked as such, and must not
* be misrepresented as being the original software.
*
* 4. This software is restricted to non-commercial use only. Commercial
* use is subject to a specific license, obtainable from LSV.
*)
val compile : out_channel -> Cparse.var_declaration list -> unit;;

BIN
cparse.cmi Normal file

Binary file not shown.

BIN
cparse.cmo Normal file

Binary file not shown.

271
cparse.ml Normal file
View File

@ -0,0 +1,271 @@
(*
* Copyright (c) 2005 by Laboratoire Spécification et Vérification (LSV),
* UMR 8643 CNRS & ENS Cachan.
* Written by Jean Goubault-Larrecq. Not derived from licensed software.
*
* Permission is granted to anyone to use this software for any
* purpose on any computer system, and to redistribute it freely,
* subject to the following restrictions:
*
* 1. Neither the author nor its employer is responsible for the consequences
* of use of this software, no matter how awful, even if they arise
* from defects in it.
*
* 2. The origin of this software must not be misrepresented, either
* by explicit claim or by omission.
*
* 3. Altered versions must be plainly marked as such, and must not
* be misrepresented as being the original software.
*
* 4. This software is restricted to non-commercial use only. Commercial
* use is subject to a specific license, obtainable from LSV.
*
*)
open Error
type mon_op = M_MINUS | M_NOT | M_POST_INC | M_POST_DEC | M_PRE_INC | M_PRE_DEC
(* Les opérations unaires:
M_MINUS: calcule l'opposé -e de e;
M_NOT: calcule la négation logique ~e de e;
M_POST_INC: post-incrémentation e++;
M_POST_DEC: post-décrémentation e--;
M_PRE_INC: pré-incrémentation ++e;
M_PRE_DEC: pré-décrémentation --e.
*)
type bin_op = S_MUL | S_DIV | S_MOD | S_ADD | S_SUB | S_INDEX
(* Les opérations binaires:
S_MUL: multiplication entière;
S_DIV: division entière (quotient);
S_MOD: division entière (reste);
S_ADD: addition entière;
S_SUB: soustraction entière;
S_INDEX: accès à un élément de tableau a[i].
*)
type cmp_op = C_LT | C_LE | C_EQ
(* Les opérations de comparaison:
C_LT (less than): <;
C_LE (less than or equal to): <=;
C_EQ (equal): ==.
*)
type loc_expr = locator * expr
and expr = VAR of string (* une variable --- toujours de type int. *)
| CST of int (* une constante entiere. *)
| STRING of string (* une constante chaine. *)
| SET_VAR of string * loc_expr (* affectation x=e. *)
| SET_ARRAY of string * loc_expr * loc_expr (* affectation x[e]=e'. *)
| CALL of string * loc_expr list (* appel de fonction f(e1,...,en) *)
(* operations arithmetiques: *)
| OP1 of mon_op * loc_expr (* OP1(mop, e) dénote -e, ~e, e++, e--, ++e, ou --e. *)
| OP2 of bin_op * loc_expr * loc_expr (* OP2(bop,e,e') dénote e*e', e/e', e%e',
e+e', e-e', ou e[e']. *)
| CMP of cmp_op * loc_expr * loc_expr (* CMP(cop,e,e') vaut e<e', e<=e', ou e==e' *)
| EIF of loc_expr * loc_expr * loc_expr (* EIF(e1,e2,e3) est e1?e2:e3 *)
| ESEQ of loc_expr list (* e1, ..., en [sequence, analogue a e1;e2 au niveau code];
si n=0, represente skip. *)
type var_declaration =
CDECL of locator * string (* declaration de variable de type int. *)
| CFUN of locator * string * var_declaration list * loc_code
(* fonction avec ses arguments, et son code. *)
and loc_code = locator * code
and code =
CBLOCK of var_declaration list * loc_code list (* { declarations; code; } *)
| CEXPR of loc_expr (* une expression e; vue comme instruction. *)
| CIF of loc_expr * loc_code * loc_code (* if (e) c1; else c2; *)
| CWHILE of loc_expr * loc_code (* while (e) c1; *)
| CRETURN of loc_expr option (* return; ou return (e); *)
let cline = ref 1
let ccol = ref 0
let oldcline = ref 1
let oldccol = ref 0
let cfile = ref ""
let getloc () = (!cfile, !oldcline, !oldccol, !cline, !ccol)
let loc_of_expr (loc, _) = loc
let e_of_expr (_, e) = e
let index_prec = 15 (* a[i] *)
let ptr_prec = 15 (* a->f *)
let dot_prec = 15 (* a.f *)
let bang_prec = 14 (* !a *)
let tilde_prec = 14 (* ~a *)
let incdec_prec = 14 (* ++a, a++, --a, a-- *)
let cast_prec = 14 (* (T)a *)
let sizeof_prec = 14 (* sizeof T *)
let uplus_prec = 14 (* +a *)
let uminus_prec = 14 (* -a *)
let star_prec = 14 (* *a *)
let amper_prec = 14 (* &a *)
let mul_prec = 13 (* a*b *)
let div_prec = 13 (* a/b *)
let mod_prec = 13 (* a%b *)
let add_prec = 12 (* a+b *)
let sub_prec = 12 (* a-b *)
let shift_prec = 11 (* a<<b, a>>b *)
let cmp_prec = 10 (* a<b, a<=b, a>b, a>=b *)
let eq_prec = 9 (* a==b, a!=b *)
let binand_prec = 8 (* a & b *)
let binxor_prec = 7 (* a ^ b *)
let binor_prec = 6 (* a | b *)
let and_prec = 5 (* a && b *)
let or_prec = 4 (* a || b *)
let if_prec = 3 (* a?b:c *)
let setop_prec = 2 (* a += b, a *= b, ... *)
let comma_prec = 1 (* a, b *)
let bufout_delim buf pri newpri s =
if newpri<pri
then Buffer.add_string buf s
else ()
let bufout_open buf pri newpri = bufout_delim buf pri newpri "("
let bufout_close buf pri newpri = bufout_delim buf pri newpri ")"
let setop_text setop =
match setop with
S_MUL -> "*="
| S_DIV -> "/="
| S_MOD -> "%="
| S_ADD -> "+="
| S_SUB -> "-="
| S_INDEX -> ""
let mop_text mop =
match mop with
M_MINUS -> "-"
| M_NOT -> "~"
| M_POST_INC | M_PRE_INC -> "++"
| M_POST_DEC | M_PRE_DEC -> "--"
let mop_prec mop =
match mop with
M_MINUS -> uminus_prec
| M_NOT -> tilde_prec
| M_POST_INC | M_POST_DEC | M_PRE_INC | M_PRE_DEC -> incdec_prec
let op_text setop =
match setop with
S_MUL -> "*"
| S_DIV -> "/"
| S_MOD -> "%"
| S_ADD -> "+"
| S_SUB -> "-"
| S_INDEX -> "["
let fin_op_text setop =
match setop with
S_MUL -> ""
| S_DIV -> ""
| S_MOD -> ""
| S_ADD -> ""
| S_SUB -> ""
| S_INDEX -> "]"
let op_prec setop =
match setop with
S_MUL -> mul_prec
| S_DIV -> div_prec
| S_MOD -> mod_prec
| S_ADD -> add_prec
| S_SUB -> sub_prec
| S_INDEX -> index_prec
let rec bufout_expr buf pri e =
match e with
VAR s -> Buffer.add_string buf s
| CST n -> Buffer.add_string buf (string_of_int n)
| STRING s ->
begin
Buffer.add_string buf "\"";
Buffer.add_string buf (String.escaped s);
Buffer.add_string buf "\""
end
| SET_VAR (x, e) -> (bufout_open buf pri setop_prec;
Buffer.add_string buf x;
Buffer.add_string buf "=";
bufout_loc_expr buf setop_prec e;
bufout_close buf pri setop_prec)
| SET_ARRAY (x, e, e') -> (bufout_open buf pri setop_prec;
Buffer.add_string buf x;
Buffer.add_string buf "[";
bufout_loc_expr buf index_prec e;
Buffer.add_string buf "]=";
bufout_loc_expr buf setop_prec e';
bufout_close buf pri setop_prec)
| CALL (f, l) -> (bufout_open buf pri index_prec;
Buffer.add_string buf f;
Buffer.add_string buf "(";
bufout_loc_expr_list buf l;
Buffer.add_string buf ")";
bufout_close buf pri index_prec)
| OP1 (mop, e') ->
let newpri = mop_prec mop in
(bufout_open buf pri newpri;
(match mop with
M_MINUS | M_NOT | M_PRE_INC | M_PRE_DEC ->
(Buffer.add_string buf (mop_text mop);
bufout_loc_expr buf newpri e')
| _ ->
(bufout_loc_expr buf newpri e';
Buffer.add_string buf (mop_text mop)));
bufout_close buf pri newpri)
| OP2 (setop, e, e') -> let newpri = op_prec setop in
(bufout_open buf pri newpri;
bufout_loc_expr buf newpri e;
Buffer.add_string buf (op_text setop);
bufout_loc_expr buf newpri e';
Buffer.add_string buf (fin_op_text setop);
bufout_close buf pri newpri)
| CMP (C_LT, e, e') -> (bufout_open buf pri cmp_prec;
bufout_loc_expr buf cmp_prec e;
Buffer.add_string buf "<";
bufout_loc_expr buf cmp_prec e';
bufout_close buf pri cmp_prec)
| CMP (C_LE, e, e') -> (bufout_open buf pri cmp_prec;
bufout_loc_expr buf cmp_prec e;
Buffer.add_string buf "<=";
bufout_loc_expr buf cmp_prec e';
bufout_close buf pri cmp_prec)
| CMP (C_EQ, e, e') -> (bufout_open buf pri eq_prec;
bufout_loc_expr buf eq_prec e;
Buffer.add_string buf "==";
bufout_loc_expr buf eq_prec e';
bufout_close buf pri eq_prec)
| EIF (eb, et, ee) -> (bufout_open buf pri if_prec;
bufout_loc_expr buf if_prec eb;
Buffer.add_string buf "?";
bufout_loc_expr buf if_prec et;
Buffer.add_string buf ":";
bufout_loc_expr buf if_prec ee;
bufout_close buf pri if_prec)
| ESEQ (e::l) -> (bufout_open buf pri comma_prec;
bufout_loc_expr buf comma_prec e;
List.iter (fun e' -> (Buffer.add_string buf ",";
bufout_loc_expr buf comma_prec e')) l;
bufout_close buf pri comma_prec)
| ESEQ [] -> ()
and bufout_loc_expr buf pri (_, e) =
bufout_expr buf pri e
and bufout_loc_expr_list buf l =
match l with
[] -> ()
| [a] -> bufout_loc_expr buf comma_prec a
| a::l' -> (bufout_loc_expr buf comma_prec a;
Buffer.add_string buf ",";
bufout_loc_expr_list buf l')
let rec string_of_expr e =
let buf = Buffer.create 128 in
bufout_loc_expr buf comma_prec e;
Buffer.contents buf
let rec string_of_loc_expr e =
let buf = Buffer.create 128 in
bufout_expr buf comma_prec e;
Buffer.contents buf

73
cparse.mli Normal file
View File

@ -0,0 +1,73 @@
type mon_op = M_MINUS | M_NOT | M_POST_INC | M_POST_DEC | M_PRE_INC | M_PRE_DEC
(** Les opérations unaires:
M_MINUS: calcule l'opposé -e de e;
M_NOT: calcule la négation logique ~e de e;
M_POST_INC: post-incrémentation e++;
M_POST_DEC: post-décrémentation e--;
M_PRE_INC: pré-incrémentation ++e;
M_PRE_DEC: pré-décrémentation --e.
*)
type bin_op = S_MUL | S_DIV | S_MOD | S_ADD | S_SUB | S_INDEX
(** Les opérations binaires:
S_MUL: multiplication entière;
S_DIV: division entière (quotient);
S_MOD: division entière (reste);
S_ADD: addition entière;
S_SUB: soustraction entière;
S_INDEX: accès à un élément de tableau a[i].
*)
type cmp_op = C_LT | C_LE | C_EQ
(** Les opérations de comparaison:
C_LT (less than): <;
C_LE (less than or equal to): <=;
C_EQ (equal): ==.
*)
type loc_expr = Error.locator * expr
and expr =
| VAR of string (** une variable --- toujours de type int. *)
| CST of int (** une constante entiere. *)
| STRING of string (** une constante chaine. *)
| SET_VAR of string * loc_expr (** affectation x=e. *)
| SET_ARRAY of string * loc_expr * loc_expr (** affectation x[e]=e'. *)
| CALL of string * loc_expr list (** appel de fonction f(e1,...,en) *)
| OP1 of mon_op * loc_expr
(** OP1(mop, e) dénote -e, ~e, e++, e--, ++e, ou --e. *)
| OP2 of bin_op * loc_expr * loc_expr
(** OP2(bop,e,e') dénote e*e', e/e', e%e',
e+e', e-e', ou e[e']. *)
| CMP of cmp_op * loc_expr * loc_expr
(** CMP(cop,e,e') vaut e<e', e<=e', ou e==e' *)
| EIF of loc_expr * loc_expr * loc_expr
(** EIF(e1,e2,e3) est e1?e2:e3 *)
| ESEQ of loc_expr list
(** e1, ..., en [sequence, analogue a e1;e2 au niveau code];
si n=0, represente skip. *)
type var_declaration =
| CDECL of Error.locator * string
(** declaration de variable de type int. *)
| CFUN of Error.locator * string * var_declaration list * loc_code
(** fonction avec ses arguments, et son code. *)
and loc_code = Error.locator * code
and code =
CBLOCK of var_declaration list * loc_code list (** { declarations; code; } *)
| CEXPR of loc_expr (** une expression e; vue comme instruction. *)
| CIF of loc_expr * loc_code * loc_code (** if (e) c1; else c2; *)
| CWHILE of loc_expr * loc_code (** while (e) c1; *)
| CRETURN of loc_expr option (** return; ou return (e); *)
val cline : int ref
val ccol : int ref
val oldcline : int ref
val oldccol : int ref
val cfile : string ref
val getloc : unit -> string * int * int * int * int
val loc_of_expr : Error.locator*'a -> Error.locator
val e_of_expr : loc_expr -> expr

BIN
cprint.cmi Normal file

Binary file not shown.

BIN
cprint.cmo Normal file

Binary file not shown.

20
cprint.ml Normal file
View File

@ -0,0 +1,20 @@
open Cparse
let print_declarations out dec_list =
let rec print_dec_list = function
| [] -> ();
| h :: t -> print_dec h; print_dec_list t;
and print_dec = function
| CDECL(l, s) -> Printf.printf "Declare varaible %s\n" s;
| CFUN(l, s, vdl, lc) -> begin
Printf.printf "Starting function %s\n" s;
print_dec_list vdl;
end
in print_dec_list dec_list;;
let print_locator out nom fl fc ll lc =
Printf.printf "%s %d %d %d %d\n" nom fl fc ll lc
let print_ast out dec_list =
print_declarations out dec_list;
Printf.printf "Ended\n";;

5
cprint.mli Normal file
View File

@ -0,0 +1,5 @@
val print_declarations : Format.formatter -> Cparse.var_declaration list -> unit
val print_locator : Format.formatter -> string -> int -> int -> int -> int -> unit
val print_ast : Format.formatter -> Cparse.var_declaration list -> unit

BIN
ctab.cmi Normal file

Binary file not shown.

BIN
ctab.cmo Normal file

Binary file not shown.

1570
ctab.ml Normal file

File diff suppressed because it is too large Load Diff

88
ctab.mli Normal file
View File

@ -0,0 +1,88 @@
type token =
| IDENTIFIER of (string)
| TYPE_NAME of (string)
| CONSTANT of (int)
| STRING_LITERAL of (string)
| SIZEOF
| PTR_OP
| INC_OP
| DEC_OP
| LEFT_OP
| RIGHT_OP
| LE_OP
| GE_OP
| EQ_OP
| NE_OP
| AND_OP
| OR_OP
| MUL_ASSIGN
| DIV_ASSIGN
| MOD_ASSIGN
| ADD_ASSIGN
| SUB_ASSIGN
| LEFT_ASSIGN
| RIGHT_ASSIGN
| AND_ASSIGN
| XOR_ASSIGN
| OR_ASSIGN
| SEMI_CHR
| OPEN_BRACE_CHR
| CLOSE_BRACE_CHR
| COMMA_CHR
| COLON_CHR
| EQ_CHR
| OPEN_PAREN_CHR
| CLOSE_PAREN_CHR
| OPEN_BRACKET_CHR
| CLOSE_BRACKET_CHR
| DOT_CHR
| AND_CHR
| OR_CHR
| XOR_CHR
| BANG_CHR
| TILDE_CHR
| ADD_CHR
| SUB_CHR
| STAR_CHR
| DIV_CHR
| MOD_CHR
| OPEN_ANGLE_CHR
| CLOSE_ANGLE_CHR
| QUES_CHR
| TYPEDEF
| EXTERN
| STATIC
| AUTO
| REGISTER
| CHAR
| SHORT
| INTEGER
| LONG
| SIGNED
| UNSIGNED
| FLOATING
| DOUBLE
| CONST
| VOLATILE
| VOID
| STRUCT
| UNION
| ENUM
| ELLIPSIS
| EOF
| CASE
| DEFAULT
| IF
| ELSE
| SWITCH
| WHILE
| DO
| FOR
| GOTO
| CONTINUE
| BREAK
| RETURN
| ASM
val translation_unit :
(Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Cparse.var_declaration list)

464
ctab.mly Normal file
View File

@ -0,0 +1,464 @@
%{
(*
* Copyright (c) 2005 by Laboratoire Spécification et Vérification
* (LSV), UMR 8643 CNRS & ENS Cachan.
* Written by Jean Goubault-Larrecq. Derived from the csur project.
*
* Permission is granted to anyone to use this software for any
* purpose on any computer system, and to redistribute it freely,
* subject to the following restrictions:
*
* 1. Neither the author nor its employer is responsible for the
* consequences of use of this software, no matter how awful, even if
* they arise from defects in it.
*
* 2. The origin of this software must not be misrepresented, either
* by explicit claim or by omission.
*
* 3. Altered versions must be plainly marked as such, and must not
* be misrepresented as being the original software.
*
* 4. This software is restricted to non-commercial use only. Commercial
* use is subject to a specific license, obtainable from LSV.
*
*)
(* Analyse syntaxique d'un sous-ensemble (tres) reduit de C.
*)
open Cparse
open Error
let parse_error msg =
fatal (Some (getloc ())) msg
%}
%token <string> IDENTIFIER TYPE_NAME
%token <int> CONSTANT
%token <string> STRING_LITERAL
%token SIZEOF
%token PTR_OP INC_OP DEC_OP LEFT_OP RIGHT_OP LE_OP GE_OP EQ_OP NE_OP
%token AND_OP OR_OP MUL_ASSIGN DIV_ASSIGN MOD_ASSIGN ADD_ASSIGN
%token SUB_ASSIGN LEFT_ASSIGN RIGHT_ASSIGN AND_ASSIGN
%token XOR_ASSIGN OR_ASSIGN
%token SEMI_CHR OPEN_BRACE_CHR CLOSE_BRACE_CHR COMMA_CHR COLON_CHR
%token EQ_CHR OPEN_PAREN_CHR CLOSE_PAREN_CHR OPEN_BRACKET_CHR
%token CLOSE_BRACKET_CHR DOT_CHR AND_CHR OR_CHR XOR_CHR BANG_CHR
%token TILDE_CHR ADD_CHR SUB_CHR STAR_CHR DIV_CHR MOD_CHR
%token OPEN_ANGLE_CHR CLOSE_ANGLE_CHR QUES_CHR
%token TYPEDEF EXTERN STATIC AUTO REGISTER
%token CHAR SHORT INTEGER LONG SIGNED UNSIGNED FLOATING DOUBLE CONST VOLATILE VOID
%token STRUCT UNION ENUM ELLIPSIS EOF
%token CASE DEFAULT IF ELSE SWITCH WHILE DO FOR GOTO CONTINUE BREAK RETURN
%token ASM
%type <(Cparse.var_declaration list)> translation_unit
%start translation_unit
%%
primary_expression:
identifier { let loc, var = $1 in loc, VAR var }
| constant { let loc, cst = $1 in loc, CST cst }
| string_literal { let loc, s = $1 in loc, STRING s }
| OPEN_PAREN_CHR expression CLOSE_PAREN_CHR { $2 }
;
constant : CONSTANT { getloc (), $1 };
identifier : IDENTIFIER { getloc (), $1 };
open_brace : OPEN_BRACE_CHR { getloc () };
close_brace : CLOSE_BRACE_CHR { getloc () };
string_literal:
STRING_LITERAL { getloc (), $1 }
| STRING_LITERAL string_literal
{
let l, s = $2 in
let s2 = $1 in
(getloc (), s2^s)
}
inc_op : INC_OP { getloc () }
dec_op : DEC_OP { getloc () }
postfix_expression:
primary_expression { $1 }
| postfix_expression OPEN_BRACKET_CHR expression close_bracket
{ sup_locator (loc_of_expr $1) $4, OP2 (S_INDEX, $1, $3) }
| identifier OPEN_PAREN_CHR close_paren
{ let loc, var = $1 in
let loc1 = sup_locator loc $3 in
loc1, CALL (var, [])
}
| identifier OPEN_PAREN_CHR argument_expression_list close_paren
{ let loc, var = $1 in
let loc1 = sup_locator loc $4 in
loc1, CALL (var, List.rev $3)
}
| postfix_expression inc_op
{ sup_locator (loc_of_expr $1) $2, OP1 (M_POST_INC, $1) }
| postfix_expression dec_op
{ sup_locator (loc_of_expr $1) $2, OP1 (M_POST_DEC, $1) }
;
/* Les argument_expression_list sont des listes a l'envers */
argument_expression_list:
assignment_expression { [$1] }
| argument_expression_list COMMA_CHR assignment_expression {
$3 :: $1 }
;
unary_expression:
postfix_expression { $1 }
| inc_op unary_expression
{ sup_locator $1 (loc_of_expr $2), OP1 (M_PRE_INC, $2) }
| dec_op unary_expression
{ sup_locator $1 (loc_of_expr $2), OP1 (M_PRE_DEC, $2) }
| unary_operator cast_expression
{
let loc, c = $1 in
let loc' = sup_locator loc (loc_of_expr $2) in
match c with
ADD_CHR -> $2
| SUB_CHR -> loc', OP1 (M_MINUS, $2)
| BANG_CHR -> loc', EIF ($2, (loc', CST 0), (loc', CST 1))
| TILDE_CHR -> loc', OP1 (M_NOT, $2)
| _ -> (Error.error (Some loc) "unknown unary operator";
loc, CST 0) }
;
unary_operator:
add_chr { $1 }
| sub_chr { $1 }
| bang_chr { $1 }
| tilde_chr { $1 }
;
add_chr : ADD_CHR { getloc (), ADD_CHR }
sub_chr : SUB_CHR { getloc (), SUB_CHR }
bang_chr : BANG_CHR { getloc (), BANG_CHR }
tilde_chr : TILDE_CHR { getloc (), TILDE_CHR }
close_paren : CLOSE_PAREN_CHR { getloc () }
cast_expression:
unary_expression { $1 }
;
multiplicative_expression:
cast_expression { $1 }
| multiplicative_expression STAR_CHR cast_expression
{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
OP2 (S_MUL, $1, $3)
}
| multiplicative_expression DIV_CHR cast_expression
{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
OP2 (S_DIV, $1, $3)
}
| multiplicative_expression MOD_CHR cast_expression
{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
OP2 (S_MOD, $1, $3)
}
;
additive_expression:
multiplicative_expression
{ $1 }
| additive_expression ADD_CHR multiplicative_expression
{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
OP2 (S_ADD, $1, $3)
}
| additive_expression SUB_CHR multiplicative_expression
{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
OP2 (S_SUB, $1, $3)
}
;
shift_expression:
additive_expression { $1 }
;
relational_expression:
shift_expression { $1 }
| relational_expression OPEN_ANGLE_CHR shift_expression
{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
CMP (C_LT, $1, $3)
}
| relational_expression CLOSE_ANGLE_CHR shift_expression
{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
CMP (C_LT, $3, $1)
}
| relational_expression LE_OP shift_expression
{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
CMP (C_LE, $1, $3)
}
| relational_expression GE_OP shift_expression
{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
CMP (C_LE, $3, $1)
}
;
equality_expression:
relational_expression { $1 }
| equality_expression EQ_OP relational_expression
{ sup_locator (loc_of_expr $1) (loc_of_expr $3),
CMP (C_EQ, $1, $3)
}
| equality_expression NE_OP relational_expression
{
let loc = sup_locator (loc_of_expr $1) (loc_of_expr $3) in
loc, EIF ((loc, CMP (C_EQ, $1, $3)),
(loc, CST 0),
(loc, CST 1))
}
;
and_expression:
equality_expression { $1 }
;
exclusive_or_expression:
and_expression { $1 }
;
inclusive_or_expression:
exclusive_or_expression { $1 }
;
logical_and_expression:
inclusive_or_expression { $1 }
| logical_and_expression AND_OP inclusive_or_expression
{ let loc = sup_locator (loc_of_expr $1) (loc_of_expr $3) in
loc, EIF ($1, $3, (loc, CST 0))
}
;
logical_or_expression:
logical_and_expression { $1 }
| logical_or_expression OR_OP logical_and_expression
{ let loc = sup_locator (loc_of_expr $1) (loc_of_expr $3) in
loc, EIF ($1, (loc, CST 1), $3)
}
;
conditional_expression:
logical_or_expression { $1 }
| logical_or_expression QUES_CHR expression COLON_CHR conditional_expression
{
sup_locator (loc_of_expr $1) (loc_of_expr $5),
EIF ($1, $3, $5)
}
;
assignment_expression:
conditional_expression { $1 }
| unary_expression EQ_CHR assignment_expression
{
let locvar, left = $1 in
let loc = sup_locator locvar (loc_of_expr $3) in
match left with
VAR x -> loc, SET_VAR (x, $3)
| OP2 (S_INDEX, (_, VAR x), i) -> loc, SET_ARRAY (x, i, $3)
| _ ->
begin
Error.error (Some loc)
"Can only write assignments of the form x=e or x[e]=e'.\n";
$3
end
}
;
expression:
assignment_expression { $1 }
| expression COMMA_CHR assignment_expression
{
sup_locator (loc_of_expr $1) (loc_of_expr $3),
ESEQ [$1; $3]
}
;
declaration:
type_specifier optional_init_declarator_list SEMI_CHR
{ List.rev $2 }
;
optional_init_declarator_list :
{ [] }
| init_declarator_list { $1 }
;
/* Une init_declarator_list est une liste a l'envers de declarator. */
init_declarator_list
: init_declarator
{ [$1] }
| init_declarator_list COMMA_CHR init_declarator
{ $3 :: $1 }
;
init_declarator: declarator { $1 };
declarator:
identifier { let loc, x = $1 in CDECL (loc, x) }
;
type_specifier: INTEGER { () }
| CHAR STAR_CHR { () }
| type_specifier STAR_CHR { () };
close_bracket : CLOSE_BRACKET_CHR { getloc () };
statement: compound_statement
{ $1 }
| expression_statement
{ loc_of_expr $1, CEXPR $1 }
| selection_statement
{ $1 }
| iteration_statement
{ $1 }
| jump_statement
{ $1 }
;
open_block : open_brace { $1 };
close_block : close_brace { $1 };
compound_statement:
open_block close_block
{ sup_locator $1 $2, CBLOCK ([], []) }
| open_block statement_list close_block
{ sup_locator $1 $3, CBLOCK ([], List.rev $2) }
| open_block declaration_list close_block
{ sup_locator $1 $3, CBLOCK ($2, []) }
| open_block declaration_list statement_list close_block
{ sup_locator $1 $4, CBLOCK ($2, List.rev $3) }
;
/* Une declaration_list est une liste non inversee de declaration */
declaration_list
: declaration
{ $1 }
| declaration_list declaration
{ $1 @ $2 }
;
/* Une statement_list est une liste inversee de statement */
statement_list
: statement
{ [$1] }
| statement_list statement
{ $2 :: $1 }
;
expression_statement:
semi_chr
{ $1, ESEQ [] }
| expression SEMI_CHR
{ $1 }
;
semi_chr : SEMI_CHR { getloc () }
ifkw : IF { getloc () };
selection_statement
: ifkw OPEN_PAREN_CHR expression CLOSE_PAREN_CHR statement
{
sup_locator $1 (fst $5), CIF ($3, $5,
(getloc (), CBLOCK ([], [])))
}
| ifkw OPEN_PAREN_CHR expression CLOSE_PAREN_CHR statement ELSE statement
{
sup_locator $1 (fst $7), CIF ($3, $5, $7)
}
;
whilekw : WHILE { getloc () };
forkw : FOR { getloc () };
iteration_statement: whilekw OPEN_PAREN_CHR expression close_paren statement
{
let loc = sup_locator $1 (fst $5) in
loc, CWHILE ($3, $5)
}
| forkw OPEN_PAREN_CHR expression_statement expression_statement close_paren statement
/* for (e0; e; ) c == e0; while (e) c; */
{
let loc = sup_locator $1 (fst $6) in
loc, CBLOCK ([], [(loc_of_expr $3, CEXPR $3);
loc, CWHILE ($4, $6)])
}
| forkw OPEN_PAREN_CHR expression_statement expression_statement expression close_paren statement
/* for (e0; e; e1) c == e0; while (e) { c; e1 } */
{
let loc = sup_locator $1 (fst $7) in
loc, CBLOCK ([], [(loc_of_expr $3, CEXPR $3);
loc, CWHILE ($4,
(sup_locator (loc_of_expr $5) (loc_of_expr $7),
CBLOCK ([], [$7; (loc_of_expr $5,
CEXPR $5)])))])
}
;
return : RETURN { getloc () };
jump_statement:
return SEMI_CHR
{ $1, CRETURN None }
| return expression SEMI_CHR
{ sup_locator $1 (loc_of_expr $2), CRETURN (Some $2) }
;
translation_unit:
external_declaration
{ $1 }
| translation_unit external_declaration
{ $1 @ $2 }
| EOF
{ [] }
;
external_declaration
: function_definition
{ [$1] }
| declaration
{ $1 }
;
parameter_declaration: type_specifier declarator { $2 };
/*!!!should check no repeated param name! */
/* Une parameter_list est une liste inversee de parameter_list. */
parameter_list: parameter_declaration
{ [$1] }
| parameter_list COMMA_CHR parameter_declaration
{ $3 :: $1 }
;
parameter_type_list
: parameter_list { List.rev $1}
| parameter_list COMMA_CHR ELLIPSIS { List.rev $1 }
;
parameter_declarator :
OPEN_PAREN_CHR CLOSE_PAREN_CHR { [] }
| OPEN_PAREN_CHR parameter_type_list CLOSE_PAREN_CHR { $2 }
;
function_declarator : type_specifier identifier parameter_declarator
{ $2, $3 }
;
function_definition
: function_declarator compound_statement
{
let (loc, var), decls = $1 in
CFUN (loc, var, decls, $2)
}
;
%%

3223
ctab.output Normal file

File diff suppressed because it is too large Load Diff

24
depend Normal file
View File

@ -0,0 +1,24 @@
compile.cmi : cparse.cmi
cparse.cmi : error.cmo
cprint.cmi : cparse.cmi
ctab.cmi : cparse.cmi
clex.cmo : error.cmo ctab.cmi cparse.cmi
clex.cmx : error.cmx ctab.cmx cparse.cmx
compile.cmo : genlab.cmo cparse.cmi compile.cmi
compile.cmx : genlab.cmx cparse.cmx compile.cmi
cparse.cmo : error.cmo cparse.cmi
cparse.cmx : error.cmx cparse.cmi
cprint.cmo : cparse.cmi cprint.cmi
cprint.cmx : cparse.cmx cprint.cmi
ctab.cmo : error.cmo cparse.cmi ctab.cmi
ctab.cmx : error.cmx cparse.cmx ctab.cmi
error.cmo :
error.cmx :
genlab.cmo :
genlab.cmx :
main.cmo : verbose.cmo error.cmo ctab.cmi cprint.cmi cparse.cmi compile.cmi \
clex.cmo
main.cmx : verbose.cmx error.cmx ctab.cmx cprint.cmx cparse.cmx compile.cmx \
clex.cmx
verbose.cmo :
verbose.cmx :

BIN
error.cmi Normal file

Binary file not shown.

BIN
error.cmo Normal file

Binary file not shown.

95
error.ml Normal file
View File

@ -0,0 +1,95 @@
(*
* Copyright (c) 2005 by Laboratoire Spécification et Vérification (LSV),
* UMR 8643 CNRS & ENS Cachan.
* Written by Jean Goubault-Larrecq. Not derived from licensed software.
*
* Permission is granted to anyone to use this software for any
* purpose on any computer system, and to redistribute it freely,
* subject to the following restrictions:
*
* 1. Neither the author nor its employer is responsible for the consequences
* of use of this software, no matter how awful, even if they arise
* from defects in it.
*
* 2. The origin of this software must not be misrepresented, either
* by explicit claim or by omission.
*
* 3. Altered versions must be plainly marked as such, and must not
* be misrepresented as being the original software.
*
* 4. This software is restricted to non-commercial use only. Commercial
* use is subject to a specific license, obtainable from LSV.
*
*)
type locator = string * int * int * int * int
(* nom du fichier, ou "";
premiere ligne,
premiere colonne,
derniere ligne,
derniere colonne.
*)
let sup_locator (file, line1, col1, _, _) (file', _, _, line2, col2) =
(if file="" then file' else file),
line1, col1, line2, col2
type hlocator = string * int * int
let loc_start (file, line1, col1, _, _) = (file, line1, col1)
let loc_end (file, _, _, line2, col2) = (file, line2, col2)
let prerr_locator (file, line1, col1, line2, col2) =
if file<>"" then begin
prerr_string file;
prerr_string ", line";
if line1<>line2 then prerr_string "s";
prerr_string " ";
prerr_int line1;
if col1<>0 then begin
prerr_string "("; prerr_int col1; prerr_string ")"
end;
if line1<>line2 || col1<>col2 then begin
prerr_string "-";
prerr_int line2;
if col2<>0 then begin
prerr_string "(";
prerr_int col2;
prerr_string ")"
end
end
end
let prerr_loc loc =
match loc with
| Some l ->
prerr_locator l;
prerr_string ": "
| _ -> ()
let warning loc msg =
prerr_string "parser: ";
prerr_loc loc;
prerr_endline msg
let error_count = ref 0
let error_count_max = 10000
let fatal loc msg =
warning loc msg; exit 10
let flush_error () =
if !error_count>=error_count_max then
fatal None "Too many errors: quit"
let error loc msg =
error_count := !error_count + 1;
warning loc msg;
if !error_count>=error_count_max then
fatal loc "Too many errors: quit"
let gensym_count = ref 0
let gensym prefix =
incr gensym_count;
let s = string_of_int (!gensym_count) in
prefix ^ s

BIN
genlab.cmi Normal file

Binary file not shown.

BIN
genlab.cmo Normal file

Binary file not shown.

31
genlab.ml Normal file
View File

@ -0,0 +1,31 @@
(*
* Copyright (c) 2005 by Laboratoire Spécification et Vérification (LSV),
* CNRS UMR 8643 & ENS Cachan.
* Written by Jean Goubault-Larrecq. Not derived from licensed software.
*
* Permission is granted to anyone to use this software for any
* purpose on any computer system, and to redistribute it freely,
* subject to the following restrictions:
*
* 1. Neither the author nor its employer is responsible for the consequences of use of
* this software, no matter how awful, even if they arise
* from defects in it.
*
* 2. The origin of this software must not be misrepresented, either
* by explicit claim or by omission.
*
* 3. Altered versions must be plainly marked as such, and must not
* be misrepresented as being the original software.
*
* 4. This software is restricted to non-commercial use only. Commercial
* use is subject to a specific license, obtainable from LSV.
*)
open Printf
let counter = ref 0
let rec genlab func =
incr counter;
sprintf ".%s_%d" func (!counter)

BIN
main.cmi Normal file

Binary file not shown.

BIN
main.cmo Normal file

Binary file not shown.

82
main.ml Normal file
View File

@ -0,0 +1,82 @@
(*
* Copyright (c) 2005 by Laboratoire Spécification et Vérification (LSV),
* CNRS UMR 8643 & ENS Cachan.
* Written by Jean Goubault-Larrecq. Derived from the csur project.
*
* Permission is granted to anyone to use this software for any
* purpose on any computer system, and to redistribute it freely,
* subject to the following restrictions:
*
* 1. Neither the author nor its employer is responsible for the consequences of use of
* this software, no matter how awful, even if they arise
* from defects in it.
*
* 2. The origin of this software must not be misrepresented, either
* by explicit claim or by omission.
*
* 3. Altered versions must be plainly marked as such, and must not
* be misrepresented as being the original software.
*
* 4. This software is restricted to non-commercial use only. Commercial
* use is subject to a specific license, obtainable from LSV.
*)
open Cparse
open Verbose
open Compile
open Arg
let input = ref stdin
let c_prefix = ref "a.out"
let c_E = ref false
let c_A = ref false
let c_D = ref false
let basename s =
try String.sub s 0 (String.rindex s '.')
with Not_found -> s
let () =
parse
[("-v", Unit (fun () -> verbose:=1), "reports stuff");
("-v1", Unit (fun () -> verbose:=1), "reports stuff");
("-v2", Unit (fun () -> verbose:=2), "reports stuff, and stuff");
("-D", Unit (fun () -> c_D:=true), "print declarations");
("-A", Unit (fun () -> c_A:=true), "print abstract syntax tree");
("-E", Unit (fun () -> c_E:=true), "output assembler dump")]
(fun s ->
c_prefix := basename s;
input :=
Unix.open_process_in ("cpp -DMCC \"" ^ (String.escaped s) ^ "\""))
"compiles a C-- program"
let () =
let lexbuf = Lexing.from_channel (!input) in
let c = Ctab.translation_unit Clex.ctoken lexbuf in
let out = if !c_E then stdout else open_out (!c_prefix ^ ".s") in
Error.flush_error ();
if !c_D then begin
Cprint.print_declarations Format.std_formatter c
end;
if !c_A then begin
Cprint.print_ast Format.std_formatter c
end;
if not (!c_D || !c_A) then begin
compile out c;
Error.flush_error ()
end;
if not (!c_D || !c_A || !c_E) then begin
flush out;
close_out_noerr out;
let command =
let prefix = String.escaped !c_prefix in
Printf.sprintf
"gcc -ggdb -o \"%s\" \"%s.s\" -lc -lm"
prefix prefix
in
ignore (Unix.system command)
end

BIN
verbose.cmi Normal file

Binary file not shown.

BIN
verbose.cmo Normal file

Binary file not shown.

25
verbose.ml Normal file
View File

@ -0,0 +1,25 @@
(*
* Copyright (c) 2005 by Laboratoire Spécification et Vérification (LSV),
* UMR 8643 CNRS & ENS Cachan.
* Written by Jean Goubault-Larrecq. Not derived from licensed software.
*
* Permission is granted to anyone to use this software for any
* purpose on any computer system, and to redistribute it freely,
* subject to the following restrictions:
*
* 1. Neither the author nor its employer is responsible for the consequences
* of use of this software, no matter how awful, even if they arise
* from defects in it.
*
* 2. The origin of this software must not be misrepresented, either
* by explicit claim or by omission.
*
* 3. Altered versions must be plainly marked as such, and must not
* be misrepresented as being the original software.
*
* 4. This software is restricted to non-commercial use only. Commercial
* use is subject to a specific license, obtainable from LSV.
*
*)
let verbose = ref 0