[prev in list] [next in list] [prev in thread] [next in thread]
List: gambas-devel
Subject: Re: [Gambas-devel] Gambas component creation / Error
From: Benoit Minisini <gambas () users ! sourceforge ! net>
Date: 2005-03-29 12:05:14
Message-ID: 200503291405.14904.gambas () users ! sourceforge ! net
[Download RAW message or body]
On Tuesday 29 March 2005 12:09, Daniel Campos wrote:
> >Please send me the component project.
>
> Sorry! I forgot to attach the project in the previous message...
>
> Here is...
>
> Regards,
>
> D, Campos
This was a bug in the compiler that generated bad .info files in some cases.
Here is a patch for the compiler.
Mmm... It seems I should enforce a naming convention for public constants :-)
--
Benoit Minisini
mailto:gambas@users.sourceforge.net
["gbc_dump.c" (text/x-csrc)]
/***************************************************************************
dump.c
Class dumping
(c) 2000-2004 Benoît Minisini <gambas@users.sourceforge.net>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
***************************************************************************/
#define __GBC_DUMP_C
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#include <ctype.h>
#include "gb_common.h"
#include "gb_error.h"
#include "gb_table.h"
#include "gbc_compile.h"
#include "gb_code.h"
#include "gb_file.h"
static FILE *_flist = NULL;
static FILE *_finfo = NULL;
static const char *get_name(long index)
{
return TABLE_get_symbol_name(JOB->class->table, index);
}
static const char *get_string(long index)
{
return TABLE_get_symbol_name(JOB->class->string, index);
}
static void dump_name(long index)
{
printf("%s", get_name(index));
}
static void dump_type(TYPE type, boolean as)
{
long value;
TYPE_ID id;
CLASS_ARRAY *array;
int i;
id = TYPE_get_id(type);
value = TYPE_get_value(type);
if (id == T_ARRAY)
{
array = &JOB->class->array[value];
printf("[");
for (i = 0; i < array->ndim; i++)
{
if (i > 0)
printf(",");
printf("%ld", array->dim[i]);
}
printf("] AS ");
dump_type(array->type, FALSE);
}
else if (id == T_OBJECT && value >= 0)
{
if (as)
printf(" AS ");
dump_name(JOB->class->class[value]);
}
else
{
if (as)
printf(" AS ");
printf("%s", TYPE_get_desc(type));
}
}
PRIVATE void dump_function(FUNCTION *func)
{
int i;
printf("(");
for (i = 0; i < func->nparam; i++)
{
if (i > 0) printf(", ");
if (i == func->npmin)
printf("OPTIONAL ");
dump_name(func->param[i].index);
dump_type(func->param[i].type, TRUE);
}
printf(")");
}
PUBLIC void CLASS_dump(void)
{
int i;
TYPE type;
CLASS_SYMBOL *sym;
CLASS *class = JOB->class;
printf("\n");
if (JOB->is_module)
printf("MODULE ");
else if (JOB->is_form)
printf("FORM ");
else
printf("CLASS ");
printf("%s\n", class->name);
if (class->parent != NO_SYMBOL)
{
printf("CLASS INHERITS ");
dump_name(class->parent);
printf("\n");
}
if (class->exported)
printf("EXPORT\n");
if (class->autocreate)
printf("CREATE\n");
printf("\n");
printf("Static size : %ld octets\n", class->size_stat);
printf("Dynamic size : %ld octets\n\n", class->size_dyn);
for (i = 0; i < TABLE_count(class->table); i++)
{
sym = CLASS_get_symbol(class, i);
type = sym->global.type;
if (TYPE_is_null(type))
continue;
if (TYPE_is_static(type)) printf("STATIC ");
if (TYPE_is_public(type)) printf("PUBLIC "); else printf("PRIVATE ");
switch(TYPE_get_kind(type))
{
case TK_VARIABLE:
dump_name(i);
dump_type(type, TRUE);
break;
case TK_FUNCTION:
if (TYPE_get_id(type) == T_VOID)
printf("PROCEDURE ");
else
printf("FUNCTION ");
dump_name(i);
dump_function(&class->function[sym->global.value]);
break;
case TK_CONST:
printf("CONST ");
dump_name(i);
dump_type(type, TRUE);
printf(" = ");
dump_name(class->constant[sym->global.value].index);
break;
case TK_PROPERTY:
printf("PROPERTY ");
if (class->prop[sym->global.value].write == NO_SYMBOL)
printf("READ ");
dump_name(i);
dump_type(type, TRUE);
break;
case TK_EVENT:
printf("EVENT ");
dump_name(i);
break;
case TK_UNKNOWN: printf("UNKNOWN "); break;
case TK_EXTERN: printf("EXTERN "); break;
case TK_LABEL: printf("LABEL "); break;
}
printf("\n");
/*
if (TYPE_get_kind(type) == TK_FUNCTION)
{
func = &class->function[value];
printf(" L:%ld", func->line);
}
else if (TYPE_get_kind(type) == TK_EVENT)
func = (FUNCTION *)&class->event[value];
else if (TYPE_get_kind(type) == TK_EXTERN)
{
func = (FUNCTION *)&class->ext_func[value];
printf(" in %s", TABLE_get_symbol_name(class->table, class->ext_func[value].library));
}
*/
}
printf("\n");
}
static void export_newline(void)
{
fputc('\n', _finfo);
}
static void export_type(TYPE type, bool scomma)
{
long value;
TYPE_ID id;
id = TYPE_get_id(type);
value = TYPE_get_value(type);
if (id == T_OBJECT && value >= 0)
{
fprintf(_finfo, get_name(JOB->class->class[value]));
if (scomma)
fputc(';', _finfo);
}
else
fprintf(_finfo, TYPE_get_short_desc(type));
}
static void export_signature(int nparam, int npmin, PARAM *param)
{
int i;
for (i = 0; i < nparam; i++)
{
if (i == npmin)
fprintf(_finfo, "[");
fprintf(_finfo, "(%s)", get_name(param[i].index));
export_type(param[i].type, TRUE);
}
if (npmin < nparam)
fprintf(_finfo, "]");
export_newline();
}
PUBLIC void CLASS_export(void)
{
const char *path;
CLASS *class = JOB->class;
int i;
TYPE type;
CLASS_SYMBOL *sym;
char kind;
bool func;
long val;
if (!_flist)
{
path = FILE_cat(FILE_get_dir(JOB->name), ".list#", NULL);
_flist = fopen(path, "w");
if (!_flist)
THROW("Cannot create file: &1", path);
path = FILE_cat(FILE_get_dir(JOB->name), ".info#", NULL);
_finfo = fopen(path, "w");
if (!_finfo)
THROW("Cannot create file: &1", path);
}
fprintf(_flist, "%s\n", class->name);
fprintf(_finfo, "#%s\n", class->name);
if (class->parent != NO_SYMBOL)
fprintf(_finfo, "%s", get_name(class->parent));
export_newline();
if (class->autocreate)
fprintf(_finfo, "A");
export_newline();
for (i = 0; i < TABLE_count(class->table); i++)
{
sym = CLASS_get_symbol(class, i);
type = sym->global.type;
if (TYPE_is_null(type))
continue;
if (!TYPE_is_public(type))
continue;
func = FALSE;
switch(TYPE_get_kind(type))
{
case TK_CONST:
kind = 'C';
break;
case TK_FUNCTION:
kind = 'm';
func = TRUE;
break;
case TK_PROPERTY:
if (class->prop[sym->global.value].write == NO_SYMBOL)
kind = 'r';
else
kind = 'p';
break;
case TK_EVENT:
kind = ':';
func = TRUE;
break;
default:
continue;
}
fprintf(_finfo, "%s\n", get_name(i));
fprintf(_finfo, "%c\n", TYPE_is_static(type) ? toupper(kind) : kind);
export_type(type, FALSE);
export_newline();
if (kind == 'C')
{
val = class->constant[sym->global.value].index;
switch(TYPE_get_id(type))
{
case T_BOOLEAN:
case T_BYTE:
case T_SHORT:
case T_INTEGER:
fprintf(_finfo, "%ld\n", val);
break;
case T_FLOAT:
case T_STRING:
fprintf(_finfo, "%s\n", get_string(val));
break;
default:
export_newline();
break;
}
}
else if (kind == 'm')
{
FUNCTION *func = &class->function[sym->global.value];
export_signature(func->nparam, func->npmin, func->param);
}
else if (kind == ':')
{
EVENT *event = &class->event[sym->global.value];
export_signature(event->nparam, event->nparam, event->param);
}
else
export_newline();
}
}
PUBLIC void CLASS_exit_export(void)
{
if (_flist)
{
fclose(_flist);
fclose(_finfo);
chdir(FILE_get_dir(JOB->name));
unlink(".list"); rename(".list#", ".list");
unlink(".info"); rename(".info#", ".info");
}
}
-------------------------------------------------------
SF email is sponsored by - The IT Product Guide
Read honest & candid reviews on hundreds of IT Products from real users.
Discover which products truly live up to the hype. Start reading now.
http://ads.osdn.com/?ad_id=6595&alloc_id=14396&op=click
_______________________________________________
Gambas-devel mailing list
Gambas-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/gambas-devel
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic