nabaztag_hack_kit 0.1.0.beta3 → 0.1.0.beta8

data/ext/mtl_linux/src/vcomp/compiler_file.cpp

@@ -0,0 +1,1253 @@
+//-------------------
+// MV
+// version WIN32 et POCKETPC
+// Sylvain Huet
+// Derniere mise a jour : 07/01/2003
+//
+
+#include <stdio.h>
+#include <string.h>
+#include <stdint.h>
+
+#include "param.h"
+#include "terminal.h"
+#include "memory.h"
+#include "parser.h"
+#include "prodbuffer.h"
+#include "compiler.h"
+#include "interpreter.h"
+
+
+int Compiler::recglobal(int val,Prodbuffer *b)
+{
+    if (val==NIL)
+    {
+        b->addint(-1);
+//		printf("nil\n");
+    }
+    else if (ISVALPNT(val))
+    {
+        intptr_t* p=VALTOPNT(val);
+        if (HEADER_TYPE(p)==TYPE_TAB)
+        {
+            b->addint((TABLEN(p)<<2)+3);
+//			printf("tuple %d @ %x : %x\n",TABLEN(p),val,*p);
+            for(int i=0; i<TABLEN(p); i++)
+            {
+                recglobal(TABGET(p,i),b);
+            }
+        }
+        else
+        {
+            b->addint((STRLEN(p)<<2)+1);
+            b->addstr(STRSTART(p),STRLEN(p));
+//			printf("'%s'\n",STRSTART(p));
+        }
+    }
+    else
+    {
+        b->addint(val);
+//		printf("%d\n",VALTOINT(val));
+    }
+    return 0;
+}
+
+
+/**
+	 G�n�re le bytecode correspondant � la d�claration de toutes les
+	 variables globales
+*/
+int Compiler::recglobals(int vlab,Prodbuffer *b)
+{
+    if (vlab==NIL)
+    {
+        return -1;
+    }
+
+    int n=1+recglobals(TABGET(VALTOPNT(vlab),LABELLIST_NEXT),b);
+    int val=TABGET(VALTOPNT(vlab),LABELLIST_REF);
+
+//	printf("%d:%s ",n,STRSTART(VALTOPNT(TABGET(VALTOPNT(vlab),LABELLIST_NAME))));
+    // avant de l'enregistrer, on verifie si tout est correct
+    intptr_t* p;
+    p = searchref_nosetused(PNTTOVAL(newpackage),STRSTART(VALTOPNT(TABGET(VALTOPNT(vlab),LABELLIST_NAME))));
+    if (NULL != p)
+    {
+        if (VALTOINT(TABGET(p,REF_USED)) == 0)
+        {
+            PRINTF(m)(LOG_WARNING,"%s is declared but never used\n",
+                      STRSTART(VALTOPNT(TABGET(VALTOPNT(vlab),LABELLIST_NAME))));
+        }
+        else if (VALTOINT(TABGET(p,REF_CODE)) == CODE_VAR)
+        {
+            if (VALTOINT(TABGET(p,REF_SET)) == 0)
+            {
+                if (VALTOINT(TABGET(p,REF_USED)) > VALTOINT(TABGET(p,REF_USED_IN_IFDEF)))
+                    PRINTF(m)(LOG_WARNING,"%s never gets a value\n",
+                              STRSTART(VALTOPNT(TABGET(VALTOPNT(vlab),LABELLIST_NAME))));
+            }
+            else if (VALTOINT(TABGET(p,REF_SET)) == 1)
+                PRINTF(m)(LOG_WARNING,"%s is only set once, at declaration. It should be a const.\n",
+                          STRSTART(VALTOPNT(TABGET(VALTOPNT(vlab),LABELLIST_NAME))));
+        }
+    }
+
+    recglobal(val,b);
+    return n;
+}
+
+int Compiler::recbc(int vref,Prodbuffer *b,Prodbuffer *btab,int offset)
+{
+    if (vref==NIL)
+    {
+        return -1;
+    }
+    int f=recbc(TABGET(VALTOPNT(vref),REF_NEXTALL),b,btab,offset);
+    if (f<-1)
+    {
+        return f;
+    }
+    if (VALTOINT(TABGET(VALTOPNT(vref),REF_CODE))<0)
+    {
+        return f;
+    }
+    int nf=VALTOINT(TABGET(VALTOPNT(vref),REF_PACKAGE));
+    if (nf<=f)
+    {
+        return f;
+    }
+    if (TABGET(VALTOPNT(vref),REF_VAL)==NIL)
+    {
+        printf("%s is EMPTY !!!\n",STRSTART(VALTOPNT(TABGET(VALTOPNT(vref),REF_NAME))));
+        return -2;
+    }
+    intptr_t *fun=VALTOPNT(TABGET(VALTOPNT(vref),REF_VAL));
+    int nloc=VALTOINT(TABGET(fun,FUN_NBLOCALS))-VALTOINT(TABGET(fun,FUN_NBARGS));
+    int nargs=VALTOINT(TABGET(fun,FUN_NBARGS));
+    int ipc=b->getsize()-offset;
+    btab->addint(ipc);
+    b->addchar(nargs);
+    b->addshort(nloc);
+    b->addstr(STRSTART(VALTOPNT(TABGET(fun,FUN_BC))),STRLEN(VALTOPNT(TABGET(fun,FUN_BC))));
+    printf("%d@%d:%s nargs=%d nlocals=%d / %d bytes\n",nf,ipc,STRSTART(VALTOPNT(TABGET(VALTOPNT(vref),REF_NAME))),nargs,nloc,STRLEN(VALTOPNT(TABGET(fun,FUN_BC))));
+    return nf;
+}
+
+
+// compilation
+// [filename/src packages] -> [packages]
+int Compiler::gocompile(int type)
+{
+    int k;
+
+    if (STACKGET(m,0)==NIL)
+    {
+        STACKDROP(m);
+        return 0;
+    }
+    char* name=STRSTART(VALTOPNT(STACKGET(m,0)));
+    if (type==COMPILE_FROMFILE)
+    {
+        parser=new Parser(m->term,m->filesystem,name);
+        PRINTF(m)(LOG_COMPILER,"Compiler : compiling file '%s'\n",name);
+    }
+    else
+    {
+        parser=new Parser(m->term,name);
+        name="...";
+        PRINTF(m)(LOG_COMPILER,"Compiler : compiling string buffer\n");
+    }
+
+    if (k=createpackage(name,4))
+    {
+        return k;    // [package nom_fichier env]
+    }
+    TABSET(m,VALTOPNT(STACKGET(m,0)),PACK_NEXT,STACKGET(m,2));
+    STACKSET(m,2,STACKGET(m,0));	// [newenv nom_fichier newenv]
+    STACKDROPN(m,2);	// [newenv]
+    newpackage=VALTOPNT(STACKGET(m,0));
+    // parsing
+
+//### ici on doit pouvoir ajouter la liste des globales et la liste des fonctions
+//### c'est ici �galement qu'on va r�initialiser la structure bc
+    if (k=STACKPUSH(m,NIL))
+    {
+        return k;    // GLOBALS
+    }
+    globals=STACKREF(m);
+    ifuns=0;
+
+    k=parsefile(0);
+
+//### c'est fait, on a le bytecode, la liste des fonctions, et la liste des globales
+    if (!k)
+    {
+        Prodbuffer* btab=new Prodbuffer();
+
+        int n=nblabels(globals);
+        brelease->addint(0);
+        recglobals(STACKGETFROMREF(m,globals,0),brelease);
+        brelease->setint(0,brelease->getsize());
+
+        int sizebc=brelease->getsize();
+        brelease->addint(0);	// on pr�pare le champ pour la taille du bytecode
+        intptr_t* p=VALTOPNT(TABGET(newpackage,PACK_HACH));
+        int vref=TABGET(p,TABLEN(p)-1);
+        int nfun=recbc(vref,brelease,btab,sizebc+4);
+        if (nfun<0)
+        {
+            return nfun;
+        }
+
+        brelease->setint(sizebc,brelease->getsize()-sizebc-4);
+        brelease->addshort(nfun+1);
+        brelease->addstr(btab->getstart(),btab->getsize());
+        delete btab;
+    }
+    if (k)
+    {
+        parser->echoposition();
+    }
+    PRINTF(m)(LOG_COMPILER,"\n");
+//	dumppackage(STACKGET(m,0));
+    delete parser;
+    return k;
+}
+
+
+int Compiler::parsefile(int ifdef)
+{
+    int k;
+
+    while(parser->next(0))
+    {
+        if (!strcmp(parser->token,"fun"))
+        {
+            if ((!parser->next(0))||(!islabel(parser->token)))
+            {
+                if (parser->token)
+                {
+                    PRINTF(m)(LOG_COMPILER,"Compiler : name of function expected (found '%s')\n",parser->token);
+                }
+                else
+                {
+                    PRINTF(m)(LOG_COMPILER,"Compiler : name of function expected (found EOF)\n");
+                }
+                return MTLERR_SN;
+            }
+            if (k=STRPUSH(m,parser->token))
+            {
+                return k;
+            }
+            intptr_t* s=VALTOPNT(STACKGET(m,0));
+            if (k=parsefun())
+            {
+                PRINTF(m)(LOG_COMPILER,"Compiler : error compiling function '%s'\n",STRSTART(s));
+                return k;
+            }
+        }
+        else if (!strcmp(parser->token,"type"))
+        {
+            if ((!parser->next(0))||(!islabel(parser->token)))
+            {
+                if (parser->token)
+                {
+                    PRINTF(m)(LOG_COMPILER,"Compiler : name of type expected (found '%s')\n",parser->token);
+                }
+                else
+                {
+                    PRINTF(m)(LOG_COMPILER,"Compiler : name of type expected (found EOF)\n");
+                }
+                return MTLERR_SN;
+            }
+            if (k=STRPUSH(m,parser->token))
+            {
+                return k;
+            }
+            intptr_t* s=VALTOPNT(STACKGET(m,0));
+
+            if (k=parsetype())
+            {
+                PRINTF(m)(LOG_COMPILER,"Compiler : error compiling type '%s'\n",STRSTART(s));
+                return k;
+            }
+        }
+        else if (!strcmp(parser->token,"var"))
+        {
+            if ((!parser->next(0))||(!islabel(parser->token)))
+            {
+                if (parser->token)
+                {
+                    PRINTF(m)(LOG_COMPILER,"Compiler : name of reference expected (found '%s')\n",parser->token);
+                }
+                else
+                {
+                    PRINTF(m)(LOG_COMPILER,"Compiler : name of reference expected (found EOF)\n");
+                }
+                return MTLERR_SN;
+            }
+            if (k=STRPUSH(m,parser->token))
+            {
+                return k;
+            }
+            intptr_t* s=VALTOPNT(STACKGET(m,0));
+
+            if (k=parsevar())
+            {
+                PRINTF(m)(LOG_COMPILER,"Compiler : error compiling var '%s'\n",STRSTART(s));
+                return k;
+            }
+        }
+        else if (!strcmp(parser->token,"const"))
+        {
+            if ((!parser->next(0))||(!islabel(parser->token)))
+            {
+                if (parser->token)
+                {
+                    PRINTF(m)(LOG_COMPILER,"Compiler : name of reference expected (found '%s')\n",parser->token);
+                }
+                else
+                {
+                    PRINTF(m)(LOG_COMPILER,"Compiler : name of reference expected (found EOF)");
+                }
+                return MTLERR_SN;
+            }
+            if (k=STRPUSH(m,parser->token))
+            {
+                return k;
+            }
+            intptr_t *s=VALTOPNT(STACKGET(m,0));
+            if (k=parseconst())
+            {
+                PRINTF(m)(LOG_COMPILER,"Compiler : error compiling const '%s'\n",STRSTART(s));
+                return k;
+            }
+        }
+        else if (!strcmp(parser->token,"proto"))
+        {
+            if ((!parser->next(0))||(!islabel(parser->token)))
+            {
+                if (parser->token)
+                {
+                    PRINTF(m)(LOG_COMPILER,"Compiler : name of function expected (found '%s')\n",parser->token);
+                }
+                else
+                {
+                    PRINTF(m)(LOG_COMPILER,"Compiler : name of function expected (found EOF)\n");
+                }
+                return MTLERR_SN;
+            }
+            if (k=STRPUSH(m,parser->token))
+            {
+                return k;
+            }
+            intptr_t* s=VALTOPNT(STACKGET(m,0));
+
+            if (k=parseproto())
+            {
+                PRINTF(m)(LOG_COMPILER,"Compiler : error compiling proto '%s'\n",STRSTART(s));
+                return k;
+            }
+        }
+        else if (!strcmp(parser->token,"ifdef"))
+        {
+            if (k=parseifdef(0))
+            {
+                return k;
+            }
+        }
+        else if (!strcmp(parser->token,"ifndef"))
+        {
+            if (k=parseifdef(1))
+            {
+                return k;
+            }
+        }
+        else if ((ifdef)&&(!strcmp(parser->token,"}")))
+        {
+            parser->giveback();
+            return 0;
+        }
+        else
+        {
+            PRINTF(m)(LOG_COMPILER,"Compiler : unknown token %s\n",parser->token);
+            return MTLERR_SN;
+        }
+    }
+    return 0;
+}
+
+int Compiler::skipifdef()
+{
+    int n=0;
+    while(parser->next(0))
+    {
+        if (!strcmp(parser->token,"{"))
+        {
+            n++;
+        }
+        else if (!strcmp(parser->token,"}"))
+        {
+            n--;
+            if (n<0)
+            {
+                return 0;
+            }
+        }
+    }
+    PRINTF(m)(LOG_COMPILER,"Compiler : '}' expected (found EOF)\n");
+    return MTLERR_SN;
+}
+
+int Compiler::parseifdef(int ifndef)
+{
+    int k;
+    if (!parser->next(0))
+    {
+        PRINTF(m)(LOG_COMPILER,"Compiler : label expected (found EOF)\n");
+        return MTLERR_SN;
+    }
+    if (!islabel(parser->token))
+    {
+        PRINTF(m)(LOG_COMPILER,"Compiler : label expected (found '%s')\n",parser->token);
+        return MTLERR_SN;
+    }
+    int first=1;
+
+    intptr_t
+    *ref, *type;
+    if ((!(ref = searchref(PNTTOVAL(newpackage),parser->token)))&&(!(type = searchtype(PNTTOVAL(newpackage),parser->token))))
+    {
+        first=0;
+    }
+
+    // si c'est une variable on note qu'elle est utlilis� dans un ifdef
+    // �a nous permet de savoir, plus tard, si elle est seulement
+    // utilis�e dans un/des ifdef - dans ce cas elle n'a pas besoin de
+    // valeur - ou aussi autre part - dans ce cas elle a besoin d'�tre
+    // sett�e au moins une fois.
+    if (ref)
+    {
+        int curval = VALTOINT(TABGET(ref,REF_USED_IN_IFDEF));
+        TABSET(m,ref,REF_USED_IN_IFDEF,INTTOVAL(curval+1));
+    }
+
+    if (ifndef)
+    {
+        first=!first;
+    }
+    if (k=parser->parsekeyword("{"))
+    {
+        return k;
+    }
+    if (first)
+    {
+        parsefile(1);
+        if (k=parser->parsekeyword("}"))
+        {
+            return k;
+        }
+    }
+    else if (k=skipifdef())
+    {
+        return k;
+    }
+    if (!parser->next(0))
+    {
+        return 0;
+    }
+    if (strcmp(parser->token,"else"))
+    {
+        parser->giveback();
+        return 0;
+    }
+    else
+    {
+        if (k=parser->parsekeyword("{"))
+        {
+            return k;
+        }
+        if (!first)
+        {
+            parsefile(1);
+            if (k=parser->parsekeyword("}"))
+            {
+                return k;
+            }
+        }
+        else if (k=skipifdef())
+        {
+            return k;
+        }
+    }
+    return 0;
+}
+
+void displaybc(Memory* m,char* src);
+
+
+// compilation d'une fonction
+// [name] -> 0
+int Compiler::parsefun()
+{
+    int k;
+    intptr_t* type_result;
+//	PRINTF(m)(LOG_DEVCORE,"fonction %s\n",STRSTART(VALTOPNT(STACKGET(m,0))));
+
+    char* name=STRSTART(VALTOPNT(STACKGET(m,0)));
+    // cr�ation des variables de travail
+    if (k=STACKPUSH(m,NIL))
+    {
+        return k;    // LOCALS
+    }
+    locals=STACKREF(m);
+
+    if (k=createnodetype(TYPENAME_FUN))
+    {
+        return k;
+    }
+
+    // recherche des arguments
+    int narg=0;
+    do
+    {
+        if (!parser->next(0))
+        {
+            PRINTF(m)(LOG_COMPILER,"Compiler : argument or '=' expected (found EOF)\n");
+            return MTLERR_SN;
+        }
+        if (islabel(parser->token))
+        {
+            if (k=createnodetype(TYPENAME_UNDEF))
+            {
+                return k;
+            }
+            if (k=addlabel(locals,parser->token,INTTOVAL(narg++),STACKGET(m,0)))
+            {
+                return k;
+            }
+        }
+        else if (strcmp(parser->token,"="))
+        {
+            PRINTF(m)(LOG_COMPILER,"Compiler : argument or '=' expected (found '%s')\n",parser->token);
+            return MTLERR_SN;
+        }
+    }
+    while(strcmp(parser->token,"="));
+    // construction du type initial de la fonction
+    if (k=createnodetuple(narg))
+    {
+        return k;
+    }
+    TABSET(m,VALTOPNT(STACKGET(m,1)),TYPEHEADER_LENGTH,STACKGET(m,0));	// attachement du noeud tuple au noeud fun
+    STACKDROP(m);
+
+    if (k=createnodetype(TYPENAME_UNDEF))
+    {
+        return k;    // noeud r�sultat
+    }
+    TABSET(m,VALTOPNT(STACKGET(m,1)),TYPEHEADER_LENGTH+1,STACKGET(m,0));	// attachement du noeud resultat au noeud fun
+    type_result=VALTOPNT(STACKPULL(m));	// on garde en m�moire le type du r�sultat
+    // ici : [type local global name]
+
+    // on cr�e le bloc fonction
+    newref=MALLOCCLEAR(m,REF_LENGTH);
+    if (!newref)
+    {
+        return MTLERR_OM;
+    }
+    TABSET(m,newref,REF_TYPE,STACKPULL(m));
+    TABSET(m,newref,REF_NAME,STACKGET(m,1));
+    TABSET(m,newref,REF_CODE,INTTOVAL(narg));
+
+    // vient d'�tre d�clar�e, pas encore utilis�e
+    TABSET(m,newref,REF_USED,INTTOVAL(0));
+
+    k=findproto(PNTTOVAL(newpackage),newref);
+
+    TABSET(m,newref,REF_PACKAGE,(k!=NIL)?k:INTTOVAL(ifuns++));
+
+    if (k=STACKPUSH(m,PNTTOVAL(newref)))
+    {
+        return MTLERR_OM;    // [newref local global name]
+    }
+    addreftopackage(newref,newpackage);
+    STACKDROP(m);
+    // [local global name]
+
+    // on poursuit la compilation vers le corps de la fonction
+    nblocals=narg;
+
+    bc->reinit();	// initialisation de la production de bytecode
+
+    // [locals globals]
+
+    // parsing
+    if (k=parseprogram())
+    {
+        return k;
+    }
+
+    // [type locals globals]
+//	la pile contient le type du r�sultat de la fonction
+    if (k=parser->parsekeyword(";;"))
+    {
+        return k;
+    }
+
+    // unifier le type r�sultat
+    if (k=unif(type_result,VALTOPNT(STACKGET(m,0))))
+    {
+        return k;
+    }
+    STACKDROP(m);
+    // [locals globals name]
+    // cr�er le bloc programme
+    intptr_t* fun=MALLOCCLEAR(m,FUN_LENGTH);
+    if (!fun)
+    {
+        return MTLERR_OM;
+    }
+    TABSET(m,newref,REF_VAL,PNTTOVAL(fun));
+
+    TABSET(m,fun,FUN_NBARGS,INTTOVAL(narg));
+    TABSET(m,fun,FUN_NBLOCALS,INTTOVAL(nblocals));
+
+    // stocker le bytecode
+    bc->addchar(OPret);
+
+    if (k=STRPUSHBINARY(m,bc->getstart(),bc->getsize()))
+    {
+        return k;
+    }
+    TABSET(m,fun,FUN_BC,STACKPULL(m));
+
+    if (!strcmp(name,"awcConnect"))
+    {
+        displaybc(m,STRSTART(VALTOPNT(TABGET(fun,FUN_BC))));
+    }
+
+    // construire le tuple des r�f�rences globales
+//	int* globalstuple=tuplefromlabels(globals);
+//	if (!globalstuple) return MTLERR_OM;
+//	TABSET(m,fun,FUN_REF,PNTTOVAL(globalstuple));
+    TABSET(m,fun,FUN_REFERENCE,PNTTOVAL(newref));
+
+    STACKDROPN(m,2);
+
+    // []
+
+    // chercher d'�ventuels prototypes
+    if (k=fillproto(PNTTOVAL(newpackage),newref))
+    {
+        return k;
+    }
+
+    outputbuf->reinit();
+    outputbuf->printf("Compiler : %s : ",STRSTART(VALTOPNT(TABGET(newref,REF_NAME))));
+    echograph(outputbuf,VALTOPNT(TABGET(newref,REF_TYPE)));
+    PRINTF(m)(LOG_COMPILER,"%s\n",outputbuf->getstart());
+
+    return 0;
+}
+
+// compilation d'une variable
+// [name] -> 0
+int Compiler::parsevar()
+{
+    int k;
+    int hasvalue = 0;
+
+    if (!parser->next(0))
+    {
+        PRINTF(m)(LOG_COMPILER,"Compiler : ';;' expected (found EOF)\n");
+        return MTLERR_SN;
+    }
+    if (!strcmp(parser->token,"="))
+    {
+        if (k=parseval())
+        {
+            return k;
+        }
+        hasvalue = 1;
+    }
+    else
+    {
+        parser->giveback();
+        if (k=STACKPUSH(m,NIL))
+        {
+            return k;
+        }
+        if (k=createnodetype(TYPENAME_WEAK))
+        {
+            return k;
+        }
+    }
+    // [val type name]
+    if (k=parser->parsekeyword(";;"))
+    {
+        return k;
+    }
+
+    int val=INTTOVAL(nblabels(globals));
+    if (k=addlabel(globals,STRSTART(VALTOPNT(STACKGET(m,2))),val,STACKGET(m,1)))
+    {
+        return k;    // enregistrement d'une nouvelle globale
+    }
+
+    // on cr�e le bloc fonction
+    newref=MALLOCCLEAR(m,REF_LENGTH);
+    if (!newref)
+    {
+        return MTLERR_OM;
+    }
+    TABSET(m,newref,REF_TYPE,STACKPULL(m));
+    TABSET(m,newref,REF_VAL,STACKPULL(m));
+    TABSET(m,newref,REF_NAME,STACKPULL(m));
+    TABSET(m,newref,REF_CODE,INTTOVAL(CODE_VAR));
+
+    // la variable vient d'�tre cr��, elle n'est donc ni utilis�e ni modifi�e encore
+    TABSET(m,newref,REF_USED,INTTOVAL(0));
+    TABSET(m,newref,REF_SET,INTTOVAL(hasvalue));
+    TABSET(m,newref,REF_USED_IN_IFDEF,INTTOVAL(0));
+
+    TABSET(m,newref,REF_PACKAGE,val);
+
+    if (k=STACKPUSH(m,PNTTOVAL(newref)))
+    {
+        return MTLERR_OM;    // [newref]
+    }
+    addreftopackage(newref,newpackage);
+    STACKDROP(m);
+
+    outputbuf->reinit();
+    outputbuf->printf("Compiler : var %s : ",STRSTART(VALTOPNT(TABGET(newref,REF_NAME))));
+    echograph(outputbuf,VALTOPNT(TABGET(newref,REF_TYPE)));
+    PRINTF(m)(LOG_COMPILER,"%s\n",outputbuf->getstart());
+    return 0;
+}
+
+
+// compilation d'une constante (const var = val;;)
+// [name] -> 0
+int Compiler::parseconst()
+{
+    int k;
+
+    if (k=parser->parsekeyword("="))
+    {
+        return k;
+    }
+    if (k=parseval())
+    {
+        return k;
+    }
+    if (k=parser->parsekeyword(";;"))
+    {
+        return k;
+    }
+
+    int val=INTTOVAL(nblabels(globals));
+    if (k=addlabel(globals,STRSTART(VALTOPNT(STACKGET(m,2))),val,STACKGET(m,1)))
+    {
+        return k;    // enregistrement d'une nouvelle globale
+    }
+
+    // on cr�e le bloc fonction
+    newref=MALLOCCLEAR(m,REF_LENGTH);
+    if (!newref)
+    {
+        return MTLERR_OM;
+    }
+    TABSET(m,newref,REF_TYPE,STACKPULL(m));
+    TABSET(m,newref,REF_VAL,STACKPULL(m));
+    TABSET(m,newref,REF_NAME,STACKPULL(m));
+    TABSET(m,newref,REF_CODE,INTTOVAL(CODE_CONST));
+
+    // la constante vient d'�tre cr��e, elle n'est donc pas utilis�e, mais elle a une valeur
+    TABSET(m,newref,REF_USED,INTTOVAL(0));
+    TABSET(m,newref,REF_SET,INTTOVAL(1));
+    TABSET(m,newref,REF_USED_IN_IFDEF,INTTOVAL(0));
+
+    TABSET(m,newref,REF_PACKAGE,val);
+
+    if (k=STACKPUSH(m,PNTTOVAL(newref)))
+    {
+        return MTLERR_OM;    // [newref]
+    }
+    addreftopackage(newref,newpackage);
+    STACKDROP(m);
+
+    outputbuf->reinit();
+    outputbuf->printf("Compiler : const %s : ",STRSTART(VALTOPNT(TABGET(newref,REF_NAME))));
+    echograph(outputbuf,VALTOPNT(TABGET(newref,REF_TYPE)));
+    PRINTF(m)(LOG_COMPILER,"%s\n",outputbuf->getstart());
+    return 0;
+}
+
+
+// compilation d'un prototype
+// [name] -> 0
+int Compiler::parseproto()
+{
+    int k;
+
+    if (!parser->next(0))
+    {
+        PRINTF(m)(LOG_COMPILER,"Compiler : integer or '=' expected (found EOF)\n");
+        return MTLERR_SN;
+    }
+    int nbarg=-1;
+    if (!strcmp(parser->token,"="))
+    {
+        if (k=creategraph(parser,PNTTOVAL(newpackage),0))
+        {
+            return k;
+        }
+        int vp=STACKGET(m,0);
+        if (vp!=NIL)
+        {
+            intptr_t* p=VALTOPNT(vp);
+            if (TABGET(p,TYPEHEADER_CODE)==INTTOVAL(TYPENAME_FUN))
+            {
+                vp=TABGET(p,TYPEHEADER_LENGTH);
+                if (vp!=NIL)
+                {
+                    intptr_t* p=VALTOPNT(vp);
+                    if (TABGET(p,TYPEHEADER_CODE)==INTTOVAL(TYPENAME_TUPLE))
+                    {
+                        nbarg=TABLEN(p)-TYPEHEADER_LENGTH;
+                    }
+                }
+            }
+        }
+        if (nbarg<0)
+        {
+            PRINTF(m)(LOG_COMPILER,"Compiler : function type expected\n");
+            return MTLERR_SN;
+        }
+    }
+    else if (isdecimal(parser->token))
+    {
+        nbarg=mtl_atoi(parser->token);
+
+        if (k=createnodetype(TYPENAME_FUN))
+        {
+            return k;
+        }
+
+        int i;
+        for(i=0; i<nbarg; i++) if (k=createnodetype(TYPENAME_WEAK))
+            {
+                return k;
+            }
+        if (k=createnodetuple(nbarg))
+        {
+            return k;
+        }
+
+        TABSET(m,VALTOPNT(STACKGET(m,1)),TYPEHEADER_LENGTH,STACKGET(m,0));	// attachement du noeud tuple au noeud fun
+        STACKDROP(m);
+
+        if (k=createnodetype(TYPENAME_WEAK))
+        {
+            return k;    // noeud r�sultat
+        }
+        TABSET(m,VALTOPNT(STACKGET(m,1)),TYPEHEADER_LENGTH+1,STACKGET(m,0));	// attachement du noeud resultat au noeud fun
+        STACKDROP(m);
+    }
+    if (nbarg<0)
+    {
+        PRINTF(m)(LOG_COMPILER,"Compiler : integer or '=' expected (found '%s')\n",parser->token);
+        return MTLERR_SN;
+    }
+    if (k=parser->parsekeyword(";;"))
+    {
+        return k;
+    }
+    // on cr�e le bloc fonction
+    newref=MALLOCCLEAR(m,REF_LENGTH);
+    if (!newref)
+    {
+        return MTLERR_OM;
+    }
+    TABSET(m,newref,REF_TYPE,STACKPULL(m));
+    TABSET(m,newref,REF_NAME,STACKPULL(m));
+    TABSET(m,newref,REF_CODE,INTTOVAL(nbarg));
+    TABSET(m,newref,REF_PACKAGE,INTTOVAL(ifuns++));
+    if (k=STACKPUSH(m,PNTTOVAL(newref)))
+    {
+        return MTLERR_OM;    // [newref]
+    }
+    addreftopackage(newref,newpackage);
+    STACKDROP(m);
+
+    outputbuf->reinit();
+    outputbuf->printf("Compiler : proto %s : ",STRSTART(VALTOPNT(TABGET(newref,REF_NAME))));
+    echograph(outputbuf,VALTOPNT(TABGET(newref,REF_TYPE)));
+    PRINTF(m)(LOG_COMPILER,"%s\n",outputbuf->getstart());
+    return 0;
+}
+// compilation d'un type
+// [name] -> 0
+int Compiler::parsetype()
+{
+    int k;
+//	PRINTF(m)(LOG_DEVCORE,"type %s\n",STRSTART(VALTOPNT(STACKGET(m,0))));
+
+    char* name=STRSTART(VALTOPNT(STACKGET(m,0)));
+    // cr�ation des variables de travail
+    if (k=STACKPUSH(m,NIL))
+    {
+        return k;    // LOCALS
+    }
+    locals=STACKREF(m);
+
+    newref=searchemptytype(PNTTOVAL(newpackage),name);
+    int mergetype=1;
+    if (newref)
+    {
+        if (k=createnodetypecore(TABGET(VALTOPNT(TABGET(newref,REF_TYPE)),TYPEHEADER_LENGTH+1)))
+        {
+            return k;
+        }
+    }
+    else
+    {
+        mergetype=0;
+        if (k=createnodetypecore(STACKGET(m,1)))
+        {
+            return k;
+        }
+        newref=MALLOCCLEAR(m,REF_LENGTH);
+        if (!newref)
+        {
+            return MTLERR_OM;
+        }
+        TABSET(m,newref,REF_CODE,INTTOVAL(CODE_EMPTYTYPE));
+        TABSET(m,newref,REF_TYPE,STACKGET(m,0));
+        if (k=STACKPUSH(m,PNTTOVAL(newref)))
+        {
+            return MTLERR_OM;    // [newtyp local name]
+        }
+        addreftopackage(newref,newpackage);
+        STACKDROP(m);
+    }
+
+    int narg=0;
+    if (parser->next(0))
+    {
+        if (strcmp(parser->token,"("))
+        {
+            parser->giveback();
+        }
+        else
+        {
+            do
+            {
+                if (!parser->next(0))
+                {
+                    PRINTF(m)(LOG_COMPILER,"Compiler : parameter or ')' expected (found EOF)\n");
+                    return MTLERR_SN;
+                }
+                if (islabel(parser->token))
+                {
+                    if (k=createnodetype(TYPENAME_UNDEF))
+                    {
+                        return k;
+                    }
+                    if (k=addlabel(locals,parser->token,STACKGET(m,0),INTTOVAL(narg++)))
+                    {
+                        return k;
+                    }
+                }
+                else if (strcmp(parser->token,")"))
+                {
+                    PRINTF(m)(LOG_COMPILER,"Compiler : parameter or ')' expected (found '%s')\n",parser->token);
+                    return MTLERR_SN;
+                }
+            }
+            while(strcmp(parser->token,")"));
+            if (k=DEFTAB(m,narg))
+            {
+                return k;
+            }
+            TABSET(m,VALTOPNT(STACKGET(m,1)),TYPEHEADER_LENGTH,STACKGET(m,0));
+            STACKDROP(m);
+        }
+    }
+    if (!mergetype)
+    {
+        STACKDROP(m);
+    }
+    else if (k=unif(VALTOPNT(STACKPULL(m)),VALTOPNT(TABGET(newref,REF_TYPE))))
+    {
+        return k;
+    }
+
+    if (!parser->next(0))
+    {
+        PRINTF(m)(LOG_COMPILER,"Compiler : '=' or ';;' expected (found EOF)\n");
+        return MTLERR_SN;
+    }
+    if (!strcmp(parser->token,"="))
+    {
+        if (!parser->next(0))
+        {
+            PRINTF(m)(LOG_COMPILER,"Compiler : uncomplete type definition (found EOF)\n");
+            return MTLERR_SN;
+        }
+        if (!strcmp(parser->token,"["))
+        {
+            return parsestruct();
+        }
+        parser->giveback();
+        return parsesum();
+    }
+    else if (!strcmp(parser->token,";;"))
+    {
+        STACKDROPN(m,2);
+        outputbuf->reinit();
+        outputbuf->printf("Compiler : uncompleted type : ");
+        echograph(outputbuf,VALTOPNT(TABGET(newref,REF_TYPE)));
+        PRINTF(m)(LOG_COMPILER,"%s\n",outputbuf->getstart());
+        return 0;
+    }
+    PRINTF(m)(LOG_COMPILER,"Compiler : '=' or ';;' expected (found '%s')\n",parser->token);
+    return MTLERR_SN;
+}
+
+
+// compilation d'une structure (le premier '[' a �t� lu)
+// [locals nom]
+int Compiler::parsestruct()
+{
+    int k;
+
+    // on cr�e le bloc type
+    TABSET(m,newref,REF_VAL,INTTOVAL(0));
+    TABSET(m,newref,REF_CODE,INTTOVAL(CODE_STRUCT));
+    // [local name]
+
+    int loop=1;
+    do
+    {
+        if (!parser->next(0))
+        {
+            PRINTF(m)(LOG_COMPILER,"Compiler : field name or ']' expected (found EOF)\n");
+            return MTLERR_SN;
+        }
+        if (islabel(parser->token))
+        {
+            if (k=STRPUSH(m,parser->token))
+            {
+                return k;
+            }
+
+            // on cr�e le bloc champ
+            intptr_t* newfield=MALLOCCLEAR(m,REF_LENGTH);
+            if (!newfield)
+            {
+                return MTLERR_OM;
+            }
+            TABSET(m,newfield,REF_NAME,STACKPULL(m));
+            TABSET(m,newfield,REF_CODE,INTTOVAL(CODE_FIELD));
+            if (k=STACKPUSH(m,PNTTOVAL(newfield)))
+            {
+                return MTLERR_OM;    // [newfield local name]
+            }
+            addreftopackage(newfield,newpackage);
+            STACKDROP(m);
+            // [local name]
+            if (k=STACKPUSH(m,TABGET(newref,REF_VAL)))
+            {
+                return k;
+            }
+            if (k=STACKPUSH(m,PNTTOVAL(newref)))
+            {
+                return k;
+            }
+            if (k=DEFTAB(m,FIELD_LENGTH))
+            {
+                return k;
+            }
+            TABSET(m,newfield,REF_VAL,STACKPULL(m));
+
+            TABSET(m,newref,REF_VAL,INTTOVAL(1+VALTOINT(TABGET(newref,REF_VAL))));	// incr�mentation
+
+            if (k=createnodetype(TYPENAME_FUN))
+            {
+                return k;
+            }
+            if (k=STACKPUSH(m,TABGET(newref,REF_TYPE)))
+            {
+                return k;
+            }
+            if (k=createnodetuple(1))
+            {
+                return k;
+            }
+            TABSET(m,VALTOPNT(STACKGET(m,1)),TYPEHEADER_LENGTH,STACKGET(m,0));	// attachement du noeud tuple au noeud fun
+            STACKDROP(m);
+
+            if ((!parser->next(0))||(strcmp(parser->token,":")))
+            {
+                parser->giveback();
+                k=createnodetype(TYPENAME_WEAK);
+            }
+            else
+            {
+                k=creategraph(parser,PNTTOVAL(newpackage),1,locals);
+            }
+            if (k)
+            {
+                return k;
+            }
+            TABSET(m,VALTOPNT(STACKGET(m,1)),TYPEHEADER_LENGTH+1,STACKGET(m,0));	// attachement du noeud resultat au noeud fun
+            STACKDROP(m);
+            TABSET(m,newfield,REF_TYPE,STACKPULL(m));
+
+            outputbuf->reinit();
+            outputbuf->printf("Compiler : %s : ",STRSTART(VALTOPNT(TABGET(newfield,REF_NAME))));
+            echograph(outputbuf,VALTOPNT(TABGET(newfield,REF_TYPE)));
+            PRINTF(m)(LOG_COMPILER,"%s\n",outputbuf->getstart());
+        }
+        else if (!strcmp(parser->token,"]"))
+        {
+            loop=0;
+        }
+        else
+        {
+            PRINTF(m)(LOG_COMPILER,"Compiler : field name or ']' expected (found '%s')\n",parser->token);
+            return MTLERR_SN;
+        }
+    }
+    while(loop);
+    if (k=parser->parsekeyword(";;"))
+    {
+        return k;
+    }
+
+    STACKDROPN(m,2);
+
+    outputbuf->reinit();
+    outputbuf->printf("Compiler : ");
+    echograph(outputbuf,VALTOPNT(TABGET(newref,REF_TYPE)));
+    outputbuf->printf(" : struct (%d)\n",VALTOINT(TABGET(newref,REF_VAL)));
+    PRINTF(m)(LOG_COMPILER,"%s\n",outputbuf->getstart());
+
+    return 0;
+}
+
+// compilation d'une somme
+// [locals nom]
+int Compiler::parsesum()
+{
+    int k;
+
+    // on cr�e le bloc type
+    TABSET(m,newref,REF_VAL,INTTOVAL(0));
+    TABSET(m,newref,REF_CODE,INTTOVAL(CODE_SUM));
+    // [local name]
+
+    int loop=1;
+    do
+    {
+        if (!parser->next(0))
+        {
+            PRINTF(m)(LOG_COMPILER,"Compiler : constructor expected (found EOF)\n");
+            return MTLERR_SN;
+        }
+        if (islabel(parser->token))
+        {
+            if (k=STRPUSH(m,parser->token))
+            {
+                return k;
+            }
+
+            // on cr�e le bloc champ
+            intptr_t* newcons=MALLOCCLEAR(m,REF_LENGTH);
+            if (!newcons)
+            {
+                return MTLERR_OM;
+            }
+            TABSET(m,newcons,REF_NAME,STACKPULL(m));
+            if (k=STACKPUSH(m,PNTTOVAL(newcons)))
+            {
+                return MTLERR_OM;    // [newcons local name]
+            }
+            addreftopackage(newcons,newpackage);
+            STACKDROP(m);
+            // [local name]
+            TABSET(m,newcons,REF_VAL,TABGET(newref,REF_VAL));
+            TABSET(m,newref,REF_VAL,INTTOVAL(1+VALTOINT(TABGET(newref,REF_VAL))));	// incr�mentation
+
+            if (k=createnodetype(TYPENAME_FUN))
+            {
+                return k;
+            }
+
+            if ((parser->next(0))&&((!strcmp(parser->token,"|"))||(!strcmp(parser->token,";;"))))
+            {
+                parser->giveback();
+                if (k=createnodetuple(0))
+                {
+                    return k;
+                }
+                TABSET(m,newcons,REF_CODE,INTTOVAL(CODE_CONS0));
+            }
+            else
+            {
+                parser->giveback();
+                if (k=creategraph(parser,PNTTOVAL(newpackage),1,locals))
+                {
+                    return k;
+                }
+                if (k=createnodetuple(1))
+                {
+                    return k;
+                }
+                TABSET(m,newcons,REF_CODE,INTTOVAL(CODE_CONS));
+            }
+            TABSET(m,VALTOPNT(STACKGET(m,1)),TYPEHEADER_LENGTH,STACKGET(m,0));	// attachement du noeud tuple au noeud fun
+            STACKDROP(m);
+            TABSET(m,VALTOPNT(STACKGET(m,0)),TYPEHEADER_LENGTH+1,TABGET(newref,REF_TYPE));	// attachement du type resultat au noeud fun
+            TABSET(m,newcons,REF_TYPE,STACKPULL(m));
+
+            outputbuf->reinit();
+            outputbuf->printf("Compiler : %s : ",STRSTART(VALTOPNT(TABGET(newcons,REF_NAME))));
+            echograph(outputbuf,VALTOPNT(TABGET(newcons,REF_TYPE)));
+            PRINTF(m)(LOG_COMPILER,"%s\n",outputbuf->getstart());
+        }
+        else
+        {
+            PRINTF(m)(LOG_COMPILER,"Compiler : constructor expected (found '%s')\n",parser->token);
+            return MTLERR_SN;
+        }
+
+        if (!parser->next(0))
+        {
+            PRINTF(m)(LOG_COMPILER,"Compiler : '|' or ';;' expected (found EOF)\n");
+            return MTLERR_SN;
+        }
+        if (!strcmp(parser->token,";;"))
+        {
+            loop=0;
+        }
+        else if (strcmp(parser->token,"|"))
+        {
+            PRINTF(m)(LOG_COMPILER,"Compiler : '|' or ';;' expected (found '%s')\n",parser->token);
+            return MTLERR_SN;
+        }
+    }
+    while(loop);
+    STACKDROPN(m,2);
+
+    outputbuf->reinit();
+    outputbuf->printf("Compiler : ");
+    echograph(outputbuf,VALTOPNT(TABGET(newref,REF_TYPE)));
+    outputbuf->printf(" : constructor\n");
+    PRINTF(m)(LOG_COMPILER,"%s\n",outputbuf->getstart());
+
+    return 0;
+}