nabaztag_hack_kit 0.0.2

data/ext/mtl/vcomp/memory.cpp

@@ -0,0 +1,241 @@
+//-------------------
+// MV
+// version WIN32 et POCKETPC
+// Sylvain Huet
+// Premiere version : 07/01/2003
+// Derniere mise a jour : 07/01/2003
+//
+
+#include <stdio.h>
+#include <string.h>
+
+#include "param.h"
+#include "terminal.h"
+#include "memory.h"
+#include "util.h"
+#include "interpreter.h"
+
+#define GCincPeriod 20
+
+
+// Gestion de la pile
+Stack::Stack()
+{
+	base=NULL;
+}
+Stack::~Stack()
+{
+	if (base) delete base;
+}
+
+void Stack::dump(FILE *f)
+{
+	const char* buf="stck";
+	fwrite((void*)buf,1,4,f);
+	fwrite((void*)&size,1,4,f);
+	fwrite((void*)&pp,1,4,f);
+	fwrite((void*)&base,1,4,f);
+	fwrite((void*)base,1,4*size,f);
+}
+
+void Stack::initialize(int s)
+{
+	size=s;
+	base=new int[size];
+	pp=base;
+}
+
+int Stack::bigger(Memory* m)
+{
+	int currentpp=pp-base;
+
+	size*=2;
+
+	int* newbase=new int[size];
+	if (!newbase)
+	{
+		PRINTF(m)(LOG_RUNTIME,"Stack : out of Stack Memory\n");
+		AbortMetal(m,1);
+		return MTLERR_OM;	// impossible d'augmenter la taille de la pile
+	}
+	int i; for(i=0;i<=currentpp;i++) newbase[i]=base[i];
+	delete base;
+	base=newbase;
+	pp=&base[currentpp];
+	return 0;
+}
+
+
+
+
+// ajout d'une racine
+int Memory::addroot(int *p)
+{
+	int k;
+
+	if (k=push(PNTTOVAL(p))) return k;
+	int* r=malloc(LIST_LENGTH,TYPE_TAB);
+	TABSET(this,r,LIST_VAL,PNTTOVAL(p));
+	TABSET(this,r,LIST_NEXT,root);
+	root=PNTTOVAL(r);
+	STACKDROP(this);
+	return 0;
+}
+
+// suppression d'une racine
+void Memory::removeroot(int *p)
+{
+	int* last=NULL;	// pointeur vers le précédent maillon de la liste
+	int vq=root;
+	while(vq!=NIL)
+	{
+		int* q=VALTOPNT(vq);
+		if (TABGET(q,LIST_VAL)==PNTTOVAL(p))
+		{
+			if (last) TABSET(this,last,LIST_NEXT,TABGET(q,LIST_NEXT));
+			else root=TABGET(q,LIST_NEXT);
+			return;
+		}
+		last=q;
+		vq=TABGET(q,LIST_NEXT);
+	}
+}
+
+Memory::Memory(int size,Terminal *t,FileSystem *fs)
+{
+	term=t;
+	filesystem=fs;
+	size0=size;	// on retient la taille initiale, elle sert d'ordre de grandeur
+	gcincperiod=GCincPeriod;
+	abort=0;
+
+	util=new Util(this);
+	winutil=NULL;
+//	listing();
+}
+
+Memory::~Memory()
+{
+//	if (winutil) delete winutil;
+	delete util;
+}
+
+void Memory::stop()
+{
+	abort=1;
+	util->stop();
+	root=NIL;
+	stack.pp=0;
+}
+
+int Memory::start()
+{
+	root=NIL;
+
+	stack.initialize(STACK_FIRST_SIZE);
+
+	PRINTF(this)(LOG_RUNTIME,"Metal Virtual Machine\n");
+	PRINTF(this)(LOG_RUNTIME,"V0.2 - Sylvain Huet - 2005\n");
+	PRINTF(this)(LOG_RUNTIME,"--------------------------\n");
+	return util->start();
+}
+
+void Memory::dump()
+{
+}
+
+
+int* Memory::malloc(int size,int type)
+{
+	int *p=NULL;
+
+	int blocsize=size+HEADER_LENGTH;
+	p=new int[blocsize];
+	if (!p) return p;
+
+	HEADERSETSIZETYPE(p,blocsize,type);
+
+	return p;
+}
+
+
+
+int* Memory::mallocClear(int size)
+{
+	int* p=malloc(size,TYPE_TAB);
+	if (!p) return p;
+	int i;
+	for(i=0;i<size;i++) TABSET(this,p,i,NIL);
+	return p;
+}
+
+// allocation de type TYPE_EXT (la fonction fun(pnt) sera appelée lors de l'oubli du bloc)
+int* Memory::mallocExternal(void* pnt,FORGET fun)
+{
+	int* p=malloc(2,TYPE_EXT);
+	if (!p) return p;
+	TABSET(this,p,0,(int)pnt);
+	TABSET(this,p,1,(int)fun);
+	return p;
+}
+
+// allocation de type TYPE_EXT (la fonction fun(pnt) sera appelée lors de l'oubli du bloc)
+int Memory::pushExternal(void* pnt,FORGET fun)
+{
+	int* p=mallocExternal(pnt,fun);
+	if (!p) return MTLERR_OM;
+	return push(PNTTOVAL(p));
+}
+
+int* Memory::storenosrc(int size)
+{
+	// calcul de la taille d'un bloc pouvant contenir une certain nombre de caractères
+	// il faut 1 mot pour la taille et un octet nul final
+	int l=2+(size>>2);
+
+	int* p=malloc(l,TYPE_BINARY);
+	if (!p) return p;
+	STRSETLEN(p,size);
+	STRSTART(p)[size]=0;
+	return p;
+}
+
+int* Memory::storebinary(const char *src,int size)
+{
+	// calcul de la taille d'un bloc pouvant contenir une certain nombre de caractères
+	// il faut 1 mot pour la taille et un octet nul final
+	int l=2+(size>>2);
+
+	int* p=malloc(l,TYPE_BINARY);
+	if (!p) return p;
+	STRSETLEN(p,size);
+	memcpy(STRSTART(p),src,size);
+	STRSTART(p)[size]=0;
+	return p;
+}
+
+int* Memory::storestring(const char *src)
+{
+	return storebinary(src,strlen(src));
+}
+
+int Memory::deftab(int size)
+{
+	int* p=malloc(size,TYPE_TAB);
+	if (!p) return MTLERR_OM;
+	int i; for(i=size-1;i>=0;i--) TABSET(this,p,i,STACKPULL(this));
+	return push(PNTTOVAL(p));
+}
+
+const char* Memory::errorname(int err)
+{
+	if (err==MTLERR_OM) return "Out of memory";
+	else if (err==MTLERR_OP) return "Unknown Operand";
+	else if (err==MTLERR_DIV) return "Division by zero";
+	else if (err==MTLERR_RET) return "Bad implementation on 'return'";
+	else if (err==MTLERR_NOFUN) return "No function defined";
+	else if (err==MTLERR_SN) return "Syntax error";
+	else if (err==MTLERR_TYPE) return "Typechecking error";
+	else if (err==MTLERR_ABORT) return "Application aborted";
+	else return "Unknown error";
+}

data/ext/mtl/vcomp/memory.h

@@ -0,0 +1,326 @@
+//-------------------
+// MV
+// version WIN32 et POCKETPC
+// Sylvain Huet
+// Premiere version : 07/01/2003
+// Derniere mise a jour : 07/01/2003
+//
+
+#ifndef _MEMORY_
+#define _MEMORY_
+
+// commenter pour utiliser les fonctions d'allocatio m�moire du C++
+//#define _MY_MALLOC_
+
+class Terminal;
+class Memory;
+class FileSystem;
+class Prodbuffer;
+
+#define HEADER_LENGTH 3
+#define HEADER_SIZETYPE 0	// la taille contient le header
+
+
+#define HEADER_TYPE(p) ((p)[HEADER_SIZETYPE]&3)
+#define HEADER_SIZE(p) ((p)[HEADER_SIZETYPE]>>2)
+#define HEADERSETSIZETYPE(p,size,type) ((p)[HEADER_SIZETYPE]=(size<<2)+(type&3))
+
+
+
+#define STACK_FIRST_SIZE 128
+class Memory;
+class FileSystem;
+class Util;
+class Winutil;
+
+class Stack
+{
+private:
+public:
+	Stack();
+	~Stack();
+	int size;	// taille du bloc allou�
+	int* base;	// d�but de la pile
+	int* pp;	// pointeur de pile
+
+	void initialize(int s);
+	int bigger(Memory* m);
+	void dump(FILE* f);
+};
+
+typedef void (*FORGET)(Memory*, void*);
+
+
+class Memory
+{
+private:
+
+	// gestion du GC
+	int root;	// bloc racine (initialis� avec le premier bloc allou�)
+
+	int size0;
+
+public:
+	int gcincperiod;
+	int abort;
+	// stack courante
+	Stack stack;
+	Terminal* term;
+	FileSystem* filesystem;
+	Util *util;
+	Winutil *winutil;
+	Memory(int size,Terminal *t,FileSystem *fs);
+	~Memory();
+
+	int start();
+	void stop();
+
+	int addroot(int* p);
+	void removeroot(int *p);
+
+	int* malloc(int size,int type);	// allocation (type vaut TYPE_BINARY ou TYPE_TAB)
+	int* mallocClear(int size);	// allocation de type TYPE_TAB avec initialisation � NIL
+	int* mallocExternal(void* pnt,FORGET fun);	// allocation de type TYPE_EXT (la fonction fun(pnt) sera appel�e lors de l'oubli du bloc)
+	int pushmalloc(int size,int type);	// allocation (type vaut TYPE_BINARY ou TYPE_TAB)
+	int pushmallocClear(int size);	// allocation de type TYPE_TAB avec initialisation � NIL
+	int pushExternal(void* pnt,FORGET fun);
+
+	int push(int val);
+	void tabset(int* p,int i,int val);
+	void stackset(int* p,int val);
+
+
+	int* storestring(const char* src);
+	int* storebinary(const char* src,int size);
+	int* storenosrc(int size);
+	int pushstring(const char* src);
+	int pushbinary(const char* src,int size);
+	int pushnosrc(int size);
+	int pushpnt(void* pnt);
+
+	int deftab(int size);
+
+	void listing();
+	const char* errorname(int err);
+	void dump();
+};
+
+// structures en m�moire
+
+// structure d'une r�f�rence
+#define REF_LENGTH 10
+#define REF_NAME 0	// nom de la r�f�rence
+#define REF_VAL 1	// valeur de la r�f�rence
+#define REF_CODE 2	// >=0 nb d'arguments de la fonction, sinon voir CODE_*
+#define REF_TYPE 3	// graphe de type de la r�f�rence
+#define REF_NEXT 4	// suivant dans la table de hachage
+#define REF_NEXTALL 5	// suivant dans la liste globale du package
+#define REF_PACKAGE 6
+
+//// les champs suivants ne sont - pour l'instant - remplis que pour
+//// les CODE_VAR et les CODE_CONST
+#define REF_USED 7       // 0 au debut, 1 de plus � chaque fois que la
+												 // r�f�rence est utilis�e
+#define REF_SET 8     // pour les var. 0 si la var ne re�oit jamais de
+											// valeur, 1 si elle a seulement une valeur
+											// donn�e � la d�claration, et 2 si elle est
+											// 'set'-�e dans le programme
+#define REF_USED_IN_IFDEF 9  // 0 au d�but, 1 de plus � chaque fois que
+													   // la ref est utlis�e comme condition dans
+													   // un ifdef
+
+#define CODE_TYPE -1	// type
+#define CODE_VAR -2	// variable
+#define CODE_SUM -3	// type somme
+#define CODE_STRUCT -4	// type struct
+#define CODE_EMPTYTYPE -5	// type pr�-d�fini
+#define CODE_FIELD -6	// champ de structure
+#define CODE_CONS -7	// constructeur de type somme
+#define CODE_CONS0 -8	// constructeur de type somme sans valeur
+#define CODE_CONST -9 // valeur constante
+
+
+// structure de lien d'un champ vers le type
+#define FIELD_LENGTH 2
+#define FIELD_NUM 0	// num�ro du champ
+#define FIELD_TYPE 1	// pointeur vers la r�f�rence du type (contient le nombre de champs de la structure)
+
+// structure d'une fonction
+#define FUN_LENGTH 6
+#define FUN_NBARGS 0	// nb arguments de la fonction
+#define FUN_NBLOCALS 1	// nb locals+args de la fonction
+#define FUN_BC 2	// bytecode
+#define FUN_REF 3	// table des r�f�rences globales
+#define FUN_SUPPARGS 4	// liste des arguments attach�s
+#define FUN_REFERENCE 5	// pointeur vers la r�f�rence de la fonction
+
+// structure d'une liste
+#define LIST_LENGTH 2
+#define LIST_VAL 0
+#define LIST_NEXT 1
+
+// structure de type
+#define TYPEHEADER_LENGTH 3
+#define TYPEHEADER_CODE 0 // entier TYPENAME_*
+#define TYPEHEADER_ACTUAL 1
+#define TYPEHEADER_COPY 2
+
+
+#define TYPENAME_UNDEF 0
+#define TYPENAME_FUN 1
+#define TYPENAME_LIST 2
+#define TYPENAME_TUPLE 3
+#define TYPENAME_TAB 4
+#define TYPENAME_WEAK 5
+#define TYPENAME_CORE 6
+#define TYPENAME_REC 7
+
+// structure d'un package
+#define PACK_LENGTH 3
+#define PACK_NAME 0
+#define PACK_HACH 1
+#define PACK_NEXT 2
+
+
+void AbortMetal(Memory* m,int donotstop);
+
+// defines publics
+
+#define PRINTF(m) ((m)->term->printf)
+
+#define TYPE_BINARY 0	// type binaire pour allocation
+#define TYPE_TAB 1	// type table pour allocation
+#define TYPE_EXT 2	// type externe pour allocation
+
+#define PNTTOVAL(p) (1+((int)(p)))	// conversion pointeur vers mot metal
+#define INTTOVAL(i) ((i)<<1)	// conversion entier vers mot metal
+#define FLOATTOVAL(v) ((~1)&(*(int*)(&(v))))	// conversion flottant vers mot metal
+
+#define VALTOPNT(v) ((int*)((v)-1))	// conversion mot metal vers pointeur
+#define VALTOINT(v) ((v)>>1)	// conversion mot metal vers entier
+#define VALTOFLOAT(v) (*((mtl_float*)(&(v))))	// conversion mot metal vers flottant
+
+#define NIL (1)	// nil
+#define ISVALPNT(v) ((v)&1)	// teste si un mot metal est un pointeur
+
+#define MALLOC(m,size,type) (m->malloc(size,type))	// allocation d'un bloc
+#define MALLOCCLEAR(m,size) (m->mallocClear(size))	// allocation d'un bloc de type table, initialis� � nil
+#define MALLOCEXT(m,pnt,fun) (m->mallocExternal(pnt,fun))	// allocation de type TYPE_EXT (la fonction fun(pnt) sera appel�e lors de l'oubli du bloc)
+#define MALLOCBIN(m,size) (m->malloc(((size)+3)>>2,TYPE_BINARY))	// allocation de type TYPE_BINARY en sp�cifiant la taille en octets
+
+#define PUSHMALLOC(m,size,type) (m->pushmalloc(size,type))	// allocation d'un bloc
+#define PUSHMALLOCCLEAR(m,size) (m->pushmallocClear(size))	// allocation d'un bloc de type table, initialis� � nil
+#define PUSHMALLOCBIN(m,size) (m->pushmalloc(((size)+3)>>2,TYPE_BINARY))	// allocation de type TYPE_BINARY en sp�cifiant la taille en octets
+#define PUSHPNT(m,pnt) (m->pushpnt(pnt))	// allocation de type TYPE_BINARY pour stocker un pointeur
+
+#define EXTPUSH(m,pnt,fun) (m->pushExternal(pnt,fun))	// allocation de type TYPE_EXT (la fonction fun(pnt) sera appel�e lors de l'oubli du bloc)
+#define EXTFORGET(p) (p[HEADER_LENGTH]=p[HEADER_LENGTH+1]=0)	// supprime les r�f�rences d'un type externe
+#define EXTVAL(p) ((void*)(p)[HEADER_LENGTH])	// retourne l'objet externe
+#define TABSET(m,p,i,val) (m->tabset(p,i,val)) // r�gle une valeur d'une table
+#define TABGET(p,i)	(p[HEADER_LENGTH+(i)])	// lit une valeur d'une table
+#define TABSTART(p) (&p[HEADER_LENGTH])	// pointeur vers la premi�re case d'une table
+#define TABLEN(p) (HEADER_SIZE(p)-HEADER_LENGTH)	// taille de la table
+#define BINSTART(p) (&p[HEADER_LENGTH])	// pointeur vers le d�but d'un bloc binaire
+
+#define STACKGET(m,i) ((m)->stack.pp[-(i)])	// retourne le n-ieme �l�ment de la pile
+#define STACKSET(m,i,val) ((m)->stackset(&(m)->stack.pp[-(i)],val))	// r�gle le n-ieme �l�ment de la pile
+#define STACKPULL(m) (*(m)->stack.pp--)	// d�pile un �l�ment de la pile
+#define STACKDROP(m) ((m)->stack.pp--)	// supprime 1 �l�ment de la pile
+#define STACKDROPN(m,n) ((m)->stack.pp-=(n))	// supprime n �l�ments de la pile
+#define STACKPUSH(m,val) ((m)->push(val))	// empile un nouvel �l�ment (retourne non nul si out of memory)
+
+#define STACKREF(m) ((m)->stack.pp-(m)->stack.base)	// retourne une r�f�rence correspondant � la taille actuelle de la pile
+#define STACKRESTOREREF(m,size) ((m)->stack.pp=(m)->stack.base+size)	// red�finit la taille de la pile en fonction de la r�f�rence
+#define STACKGETFROMREF(m,size,i) ((m)->stack.base[(size)-(i)])	// lit le n-ieme �l�ment � partir d'une r�f�rence
+#define STACKSETFROMREF(m,size,i,val) ((m)->stackset(&(m)->stack.base[(size)-(i)],val))	// r�gle le l-ieme �l�ment � partir d'une r�f�rence
+
+#define STRSTART(p) ((char*)&p[HEADER_LENGTH+1])	// retourne le d�but d'une cha�ne
+#define STRLEN(p) (p[HEADER_LENGTH])	// retourne la longueur d'une cha�ne
+#define STRSETLEN(p,size) (p[HEADER_LENGTH]=(size))	// d�finit la longueur de la cha�ne
+#define STRSTORE(m,src) (m->storestring(src))	// stocke une cha�ne
+#define STRSTOREBINARY(m,src,size) (m->storebinary(src,size))	// stocke un buffer binaire
+#define STRSTORENOSRC(m,size) (m->storenosrc(size))	// stocke un buffer binaire
+
+#define STRPUSH(m,src) (m->pushstring(src))	// stocke une cha�ne
+#define STRPUSHBINARY(m,src,size) (m->pushbinary(src,size))	// stocke un buffer binaire
+#define STRPUSHNOSRC(m,size) (m->pushnosrc(size))	// stocke un buffer binaire
+
+#define DEFTAB(m,size) (m->deftab(size))	// cr�e un tuple avec les �l�ments dans la pile et empile le tuple
+
+
+#define MTLERR_ENDINTERPRETER 1
+#define MTLERR_OM -1
+#define MTLERR_OP -2
+#define MTLERR_DIV -3
+#define MTLERR_RET -4
+#define MTLERR_NOFUN -5
+#define MTLERR_SN -6
+#define MTLERR_TYPE -7
+#define MTLERR_ABORT -8
+
+#define LOG_RUNTIME 1
+#define LOG_WARNING 2
+#define LOG_DEVCORE 4
+#define LOG_COMPILER 8
+#define LOG_USER 16
+
+inline int Memory::push(int val)
+{
+	*(++stack.pp)=val;
+	if ((stack.pp-stack.base)>=stack.size-1)
+	{
+		int k; if ((k=stack.bigger(this))) return k;
+//	term->printf(LOG_DEVCORE,"## bigger stack %d\n",stack.size);
+//	stackprint(0);
+	}
+	return 0;
+}
+
+inline void Memory::tabset(int* p,int i,int val)
+{
+	p[HEADER_LENGTH+i]=val;	// r�gle une valeur d'une table
+}
+
+inline void Memory::stackset(int* p,int val)
+{
+	*p=val;
+}
+
+inline int Memory::pushmalloc(int size,int type)
+{
+	int* p=malloc(size,type); if (!p) return MTLERR_OM;
+	return push(PNTTOVAL(p));
+}
+
+inline int Memory::pushmallocClear(int size)
+{
+	int* p=mallocClear(size); if (!p) return MTLERR_OM;
+	return push(PNTTOVAL(p));
+}
+
+inline int Memory::pushstring(const char* src)
+{
+	int* p=storestring(src); if (!p) return MTLERR_OM;
+	return push(PNTTOVAL(p));
+}
+
+inline int Memory::pushbinary(const char* src,int size)
+{
+	int* p=storebinary(src,size); if (!p) return MTLERR_OM;
+	return push(PNTTOVAL(p));
+}
+
+inline int Memory::pushnosrc(int size)
+{
+	int* p=storenosrc(size); if (!p) return MTLERR_OM;
+	return push(PNTTOVAL(p));
+}
+
+inline int Memory::pushpnt(void* pnt)
+{
+	int* p=malloc(1,TYPE_BINARY); if (!p) return MTLERR_OM;
+	*(BINSTART(p))=(int)pnt;
+	return push(PNTTOVAL(p));
+}
+
+#endif

data/ext/mtl/vcomp/param.h

@@ -0,0 +1,95 @@
+//-------------------
+// MV
+// version WIN32 et POCKETPC
+// Sylvain Huet
+// Premiere version : 07/01/2003
+// Derniere mise a jour : 07/01/2003
+//
+#ifndef _PARAM_
+#define _PARAM_
+
+
+#define VLSB
+
+//-------------------
+// Parametres du benchmark
+
+//++++++++
+//Plateforme : commenter pour la version win32, decommenter pour la version pocketpc
+//#define POCKETPC
+
+//++++++++
+//Precision des flottant : decommenter une des deux lignes
+
+//#define myfloat double
+#define mtl_float float
+
+//++++++++
+//Resolution de l'image : commenter pour utiliser des bmp 24 bits,
+// decommenter pour avoir des bmp 32 bits (impossible sur pocketpc ipaq 3630
+
+#define MODEBMP32
+
+
+// Fin des parametres du benchmark
+//-------------------
+
+#ifdef POCKETPC
+
+#define FlagMainWindow (WS_VISIBLE)
+#define UNICODEDISPLAY
+#define UNICODEFILENAME
+
+#else
+
+#define FlagMainWindow (WS_OVERLAPPED|WS_CAPTION|WS_SYSMENU|WS_THICKFRAME|WS_MINIMIZEBOX)
+
+#endif
+
+#ifdef MODEBMP32
+#define BMPINC 4
+#else
+#define BMPINC 3
+#endif
+
+typedef unsigned char uchar;
+
+#ifdef UNICODEDISPLAY
+#define display_type unsigned short
+#define display_strlen wcslen
+#define display_copyfromchar(dst,src) wsprintf(dst,TEXT("%S"),src)
+#define display_copy(dst,src) wcscpy(dst,src)
+#else
+#define display_type char
+#define display_strlen strlen
+#define display_copyfromchar(dst,src) strcpy(dst,src)
+#define display_copy(dst,src) strcpy(dst,src)
+#endif
+
+#ifdef UNICODEFILENAME
+#define filename_type unsigned short
+#define filename_strlen wcslen
+#define filename_copyfromchar(dst,src) wsprintf(dst,TEXT("%S"),src)
+#define filename_copy(dst,src) wcscpy(dst,src)
+#define filename_copyn(dst,src,n) {wcsncpy(dst,src,n);(dst)[n]=0;}
+#define filename_strcmp(s1,s2) wcscmp(s1,s2)
+#define filename_strncmp(s1,s2,n) wcsncmp(s1,s2,n)
+#define filename_mkdir(d) _wmkdir(d)
+#else
+#define filename_type char
+#define filename_strlen strlen
+#define filename_copyfromchar(dst,src) strcpy(dst,src)
+#define filename_copy(dst,src) strcpy(dst,src)
+#define filename_copyn(dst,src,n) {strncpy(dst,src,n);(dst)[n]=0;}
+#define filename_strcmp(s1,s2) strcmp(s1,s2)
+#define filename_strncmp(s1,s2,n) strncmp(s1,s2,n)
+#define filename_mkdir(d) _mkdir(d)
+
+#endif
+
+//#define API_PUB __declspec(dllexport)
+#define API_PUB
+
+
+#endif
+