int replace(int *i, int *j,int size, char* s1, int size_s1)
{
int k, res = 0;
char c;
is_saved = 0;
*j -= size;
for (k = 0; k < size; k++)
{
delete_symbol(*i, *j);
}
for (k = 0; k < size_s1; k++)
{
c = s1[k];
if (c == '\n')
{
insert_symbol(*i, *j, '\n');
*j = 1;
*i = *i + 1;
res++;
}
else
{
insert_symbol(*i, *j, c);
*j = *j + 1;
}
}
return res;
}
void load_pixmap_symbol_file(char *filename, int reloading) {
QFile *f;
// char filen[500];
char line[100];
char table_char;
char symbol_char;
int done;
char pixels[400];
char orient;
//symbols_loaded = 0;
table_char = '\0';
symbol_char = '\0';
done = 0;
f = new QFile(filename);
if (f->open(QIODevice::ReadOnly)) {
while (!f->atEnd() && !done) {
f->readLine(line,100);
if (strncasecmp("TABLE ",line,6)==0) {
table_char=line[6];
/*fprintf(stderr,"TABLE %c\n",table_char);*/
} else {
if (strncasecmp("DONE",line,4)==0) {
done=1;
/*fprintf(stderr,"DONE\n");*/
} else {
if (strncasecmp("APRS ",line,5)==0) {
symbol_char=line[5];
if (strlen(line)>=20 && line[19] == 'l') // symbol with orientation ?
orient = 'l'; // should be 'l' for left
else
orient = ' ';
read_symbol_from_file(f, pixels, table_char); // read pixels for one symbol
insert_symbol(table_char,symbol_char,pixels,270,orient,reloading); // always have normal orientation
if (orient == 'l') {
insert_symbol(table_char,symbol_char,pixels, 0,'u',reloading); // create other orientations
insert_symbol(table_char,symbol_char,pixels, 90,'r',reloading);
insert_symbol(table_char,symbol_char,pixels,180,'d',reloading);
}
}
}
}
}
f->close();
} else {
qDebug() << "Error opening symbol file " << filename <<": " << f->errorString();
QMessageBox::warning(NULL, "Error Opening Symbol File", "Unable to open APRS Symbols");
}
delete f;
}
static value_object assign_value(expr* left, expr* right)
{
value_object rhs = eval_aux(right);
symbol_def* symbol = make_variable(left->text, rhs);
insert_symbol(symbol);
return rhs;
}
void insert_symbol(symbol *r,symbol *s){
/*
insert_symbol() - inserts symbol s in the approporiate
place in the symbol table-tree represented by r
*/
if (r->frequency < s->frequency){
if (r->next != NULL && r->next->frequency < s->frequency)
insert_symbol(r->next,s);
else {
s->next = r->next;
if (r->next != NULL)
r->next->prev=s;
r->next = s;
s->prev=r;
}
}
else if (r->frequency > s->frequency) {
fprintf(stderr,"ERROR: insertion error\n");
}
else if (r->frequency == s->frequency ||
(r->frequency > s->frequency &&
r->prev->frequency < s->frequency)){
s->prev=r->prev;
if (r->prev != NULL)
r->prev->next=s;
r->prev=s;
s->next=r;
}
}
void define_symbol(char *name, Address value)
{
symbol *s = search_symbol(name);
if (s == NULL)
s = insert_symbol(name);
else if (s->fr == NULL)
{
number_of_errors += 1;
fprintf(stderr, "symbol %s redefined; old value = 0x%03X, new value = 0x%03X\n", name, s->value, value);
}
else
{
if (debug) fprintf(stderr, "symbol %s defined; value = 0x%03X\n", s->name, s->value);
}
/* define the new value */
s->value = value;
/* if there were forward references, walk the list and define them */
if (s->fr != NULL)
{
handle_forward_references(s);
}
}
SYM *new_symbol(char *name)
{
SYM *p;
SYM ts;
if (p = find_symbol(name)) {
printf("Symbol already in table.\r\n");
return p;
}
if (numsym > 65525) {
printf("Too many symbols.\r\n");
return (SYM *)NULL;
}
if (pass > 5) {
printf("%s: added\r\n", name);
}
ts.name = nmTable.AddName(name);
// strncpy(syms[numsym].name, name, sizeof(syms[numsym].name)/sizeof(char)-1);
// syms[numsym].name[199] = '\0';
ts.value = 0x8000000000000000LL | numsym;
ts.defined = 0;
ts.segment = segment;
ts.scope = ' ';
ts.isExtern = 0;
p = insert_symbol(&ts);
numsym++;
return p;
}
int prepare_mod_for_load(struct LKM_Module *lkm_mod, int sym_index, int str_index)
{
int i,ret=0, flag=0;
struct Secthdr *secthdr = lkm_mod->sect_hdr;
struct Symhdr *tsymhdr,*symhdr = (void *)(lkm_mod->tmp_buf + secthdr[sym_index].sh_offset);
tsymhdr = symhdr;
char *sttab = (void *)(lkm_mod->tmp_buf + secthdr[str_index].sh_offset);
size_t sym_size = secthdr[sym_index].sh_size / (sizeof(struct Symhdr));
i=0;
while(i < sym_size){
if(ELF64_ST_TYPE(tsymhdr->st_info) == STT_FUNC){
if((ret = strcmp("lkm_init", sttab + tsymhdr->st_name)) == 0){
modules_lkm[mod_num].init_mod = (void (*) (void))lkm_mod->text_addr + tsymhdr->st_value;
flag++;
}else if((ret = strcmp("lkm_exit", sttab + tsymhdr->st_name)) == 0){
modules_lkm[mod_num].unload_mod = (void (*) (void))lkm_mod->text_addr + tsymhdr->st_value;
flag++;
}else if((ret = strlen(sttab + tsymhdr->st_name)) != 0){
insert_symbol(sttab + tsymhdr->st_name, (uintptr_t)(lkm_mod->text_addr + tsymhdr->st_value), modules_lkm[mod_num].name);
// cprintf("Inserting Symbol Name : %s Symbol addr: %x \n", sttab + tsymhdr->st_name, (uintptr_t)(lkm_mod->text_addr + tsymhdr->st_value));
}
}
i++;
tsymhdr++;
}
if(flag != 2)
return -1;
return 0;
}
uint64_t find_symbol(struct LKM_Module *lkm_mod, struct Secthdr *secthdr, struct Symhdr *symhdr, struct Elf64_Rela *rela)
{
struct Symhdr *rela_sym = &symhdr[ELF64_R_SYM(rela->r_info)];
char *str_tab = lkm_mod->st_table;
uint64_t sym_val;
int ret=0,ret2=0;
switch(rela_sym->st_shndx){
case ELF_SHN_UNDEF:
// cprintf("Undefined Symbol:%s \n", (void *)((char *)lkm_mod->st_table + rela_sym->st_name));
sym_val = fetch_symbol_addr(rela_sym->st_name +str_tab);
if(sym_val == 0){
cprintf("Unable to find %s(). Probably its Dependent on some Module which is not loaded.....\n",(void *)((char *)lkm_mod->st_table + rela_sym->st_name));
return 0;
}
dependencies_tmp[dependent_count]=fetch_symbol_tag(rela_sym->st_name +str_tab);
if(((ret = strncmp("kernel", dependencies_tmp[dependent_count], strlen("kernel"))) != 0) && ((ret2=strlen(dependencies_tmp[dependent_count]))!=0)){
// cprintf("Symbol: %s Dependent on %s Dependent count = %d \n", rela_sym->st_name +str_tab, dependencies_tmp[dependent_count],dependent_count);
lkm_mod->depd_count++;
dependent_count++;
}else{
memset(dependencies_tmp[dependent_count],'\0', sizeof(dependencies_tmp[dependent_count]));
}
sym_val = sym_val + rela->r_addend;
break;
case ELF_SHN_ABS:
sym_val = rela_sym->st_value;
break;
case ELF_SHN_COMMON:
sym_val = 0;
break;
default:
if(rela_sym->st_shndx > lkm_mod->elf_hdr->e_shnum){
cprintf("Error while relocating..\n");
return 0;
}
struct Secthdr *tmp_sect = &lkm_mod->sect_hdr[rela_sym->st_shndx];
uint64_t addr;
if(strcmp((lkm_mod->shname_st_table + tmp_sect->sh_name),".data") == 0){
addr = (uint64_t)lkm_mod->data_addr;
}else if(strcmp((lkm_mod->shname_st_table + tmp_sect->sh_name),".text") == 0){
addr = (uint64_t)lkm_mod->text_addr;
}else if(strcmp((lkm_mod->shname_st_table + tmp_sect->sh_name),".rodata") == 0){
addr = (uint64_t)lkm_mod->rodata_addr;
}else if(strcmp((lkm_mod->shname_st_table + tmp_sect->sh_name),".bss") == 0){
addr = (uint64_t)lkm_mod->bss_addr;
}
sym_val = addr + rela_sym->st_value + rela->r_addend;
if(ELF64_ST_TYPE(rela_sym->st_info) == STT_FUNC){
// cprintf("symbol name is %s symbol value is %x \n",(str_tab + rela_sym->st_name), sym_val);
if((ret = strncmp(str_tab + rela_sym->st_name, "lkm_init", strlen("lkm_init")) != 0) && (ret = strncmp(str_tab + rela_sym->st_name, "lkm_exit", strlen("lkm_exit")))!= 0){
if((ret = strlen(str_tab + rela_sym->st_name)) != 0){ //new code
insert_symbol(str_tab + rela_sym->st_name, sym_val, modules_lkm[mod_num].name);
}
}
}
break;
}
return sym_val;
}
a_Id_List new_id_list( c_constr xid, int pos )
{
a_Id_List a = (a_Id_List)checked_malloc( sizeof( struct a_Id_List_ ) );
a->xid = insert_symbol( xid );
a->next = NULL;
a->linepos = pos;
return a;
}
void make_vardecl(astree* root){
astree* vardecl = root->children[0]->children[0];
symbol* sym = newsymbol(vardecl);
const string* key;
key = vardecl->lexinfo;
insert_symbol (*symbol_stack[block_count.back()],
key, sym, vardecl);
}
a_Var_Decl new_var_decl( c_constr xid, a_Array_Sub array, int pos )
{
a_Var_Decl a = (a_Var_Decl)checked_malloc( sizeof( struct a_Var_Decl_ ) );
a->xid = insert_symbol(xid);
a->array = array;
a->linepos = pos;
return a;
}
a_Stmt new_stmt_from_label( c_str xid, int pos )
{
a_Stmt a = (a_Stmt)checked_malloc( sizeof( struct a_Stmt_ ) );
a->s_type = ae_stmt_gotolabel;
a->stmt_gotolabel.name = insert_symbol( xid );
a->linepos = pos;
a->stmt_gotolabel.linepos = pos;
a->stmt_gotolabel.self = a;
return a;
}
void make_struct_symbol (astree* root) {
symbol* sym = newsymbol(root->children[0]);
const string* key;
symbol_table fields;
sym->fields = &fields;
key = root->children[0]->lexinfo;
// insert struct symbol into global (block 0) symbol table
insert_symbol(*symbol_stack[0], key, sym, root->children[0]);
for (size_t index = 1; index < root->children.size(); ++index) {
// turn fields into symbols
astree* field = root->children[index]->children[0];
sym = newsymbol(field);
// turn fields into key
key = field->lexinfo;
// insert (key,symbol) into fields symbol table
fprintf (fsym, " ");
insert_symbol(fields, key, sym, field);
}
}
a_Exp new_exp_from_member_dot( a_Exp base, c_str xid, int pos )
{
a_Exp a = (a_Exp)checked_malloc( sizeof( struct a_Exp_ ) );
a->s_type = ae_exp_dot_member;
a->s_meta = ae_meta_var;
a->dot_member.base = base;
a->dot_member.xid = insert_symbol( xid );
a->linepos = pos;
a->dot_member.linepos = pos;
a->dot_member.self = a;
return a;
}
a_Exp new_exp_from_id( c_str xid, int pos )
{
a_Exp a = (a_Exp)checked_malloc( sizeof( struct a_Exp_ ) );
a->s_type = ae_exp_primary;
a->s_meta = ae_meta_var;
a->primary.s_type = ae_primary_var;
a->primary.var = insert_symbol( xid );
a->linepos = pos;
a->primary.linepos = pos;
a->primary.self = a;
return a;
}
void add_symbol(const char *name, void *addr, const char *decl) {
if(!addr) return;
struct symbol *s;
if((s = remove_symbol(symbol_table, name))) {
fprintf(stderr, "Warning: '%s' redeclared as '%s'\n", s->decl, decl);
free((void *) s->decl);
free(s);
}
s = malloc(sizeof(struct symbol));
s->name = strdup(name);
s->addr = addr;
s->decl = strdup(decl);
insert_symbol(symbol_table, s->name, s);
}
void update_frequency(symbol *r, int c){
/*
update_frequency() - given the root of a symbol table-tree and a character,
increases the frequency of that character in the symbol table-tree,
creating nodes as necessary.
*/
symbol *s;
if (!exists_symbol(r,c))
s=init_symbol(c);
else
s=remove_symbol(r,c);
s->frequency++;
insert_symbol(r,s);
}
void make_func_symbol(astree* root){
astree* function = root->children[0]->children[0];
symbol* sym = newsymbol(function);
const string* key;
vector<symbol*> params;
sym->parameters = ¶ms;
key = function->lexinfo;
insert_symbol (*symbol_stack[0], key, sym, function);
astree* paramlist = root->children[1];
for (size_t index = 0;
index < paramlist->children.size(); ++index){
astree* param = paramlist->children[index]->children[0];
sym = newsymbol(param);
key = param->lexinfo;
++sym->blocknr;
params.push_back(sym);
fprintf(fsym, " ");
insert_symbol (*symbol_stack[0], key, sym, param);
}
make_block(root->children[2]);
}
a_Func_Def new_func_def( ae_Keyword func_decl, ae_Keyword static_decl,
a_Type_Decl type_decl, c_str name,
a_Arg_List arg_list, a_Stmt code, int pos )
{
a_Func_Def a = (a_Func_Def)checked_malloc(
sizeof( struct a_Func_Def_ ) );
a->func_decl = func_decl;
a->static_decl = static_decl;
a->type_decl = type_decl;
a->name = insert_symbol( name );
a->arg_list = arg_list;
a->s_type = ae_func_user;
a->code = code;
a->linepos = pos;
return a;
}
void forward_reference(char *name, int line_number, Address reference_address, Boolean full)
{
if (debug) fprintf(stderr, "%s forward reference to %s at line %d, address 0x%03X\n",
(full ? "full" : "page"),
name, line_number, reference_address);
/* get a symbol table entry; define one if necessary */
symbol *s = search_symbol(name);
if (s == NULL)
s = insert_symbol(name);
struct forward_reference_node *fr = TYPED_MALLOC(struct forward_reference_node);
fr->addr = reference_address;
fr->full = full;
fr->line_number = line_number;
/* link this into the list */
fr->next = s->fr;
s->fr = fr;
}
void make_proto_symbol(astree* root){
astree* proto = root->children[0]->children[0];
symbol* sym = newsymbol(proto);
const string* key;
vector<symbol*> params;
sym->parameters = ¶ms;
key = proto->lexinfo;
insert_symbol (*symbol_stack[0], key, sym, proto);
astree* paramlist = root->children[1];
for (size_t index = 0;
index < paramlist->children.size(); ++index){
astree* param = paramlist->
children[index]->children[0];
sym = newsymbol(param);
++sym->blocknr;
params.push_back(sym);
}
}
//-----------------------------------------------------------------------------
// name: Temp_named_label()
// desc: the label will be created only if it is not found.
//-----------------------------------------------------------------------------
Temp_Label Temp_named_label( c_str s )
{
return insert_symbol( s );
}
int main(int argc, char *argv[]){
// 1. Initialization
int c;
symbol *root;
root=init_symbol(ROOT_NODE);
root->frequency=NON_EXISTENT;
root->parent=root;
// 1.a. init: file pointers
FILE *inputfile;
FILE *outputfile;
inputfile=NULL;
outputfile=NULL;
if (argc >=2)
inputfile = fopen(argv[1],"r");
if (argc >=3)
outputfile = fopen(argv[2],"w");
if (inputfile == NULL) {
fprintf(stderr, "Can't open input file. \n");
exit(1);
}
if (outputfile == NULL) {
outputfile=stdout;
}
// 2. count the frequency of each character in inputfile
while((c=fgetc(inputfile))!=EOF){
update_frequency(root,c);
}
update_frequency(root,-1);
// 3. Make the huffman tree
while(count_parentless_nodes(root) > 1){
symbol *node1,*node2, *newnode;
node1 = get_rarest_parentless_node(root);
node1->parent=node1; //temporarily
node2 = get_rarest_parentless_node(root);
node2->parent=node2; //temporarily
newnode = new_node(node1, node2);
insert_symbol(root,newnode);
}
// 4. Output symbol mappings
for(c=-1;c<256;c++){
char *encodingstring;
encodingstring=get_encoding(root,c);
int freq=get_frequency(root,c);
if (freq > 0){
/*if (c <=127 && c>=32 )
fprintf(outputfile,"%c\t%d\t%s\n", c, freq, encodingstring);
else */
fprintf(outputfile,"%d\t%d\t%s\n", c, freq, encodingstring);
}
free(encodingstring);
}
fprintf(outputfile,"\n");
// 5. Output encoding of inputfile
rewind(inputfile);
while((c=fgetc(inputfile))!=EOF){
char *encodingstring;
encodingstring=get_encoding(root,c);
fprintf(outputfile, "%s", encodingstring);
free(encodingstring);
}
char *encodingstring;
encodingstring=get_encoding(root,EOF);
fprintf(outputfile, "%s", encodingstring);
free(encodingstring);
fprintf(outputfile,"\n");
free_symbol(root);
// 6. Close file pointers
fclose(inputfile);
fclose(outputfile);
}
int parse_string (char *line, int offset, int line_length, int type)
{
int state, i, ret;
char var_name[32];
int var_index;
char assignment[256];
int assign_index;
char buffer[256];
int size;
memset(var_name, 0, 32);
var_index = 0;
memset(assignment, 0, 256);
assign_index = 0;
state = ret = 0;
for (i = offset; i < line_length && state != 3; i++) {
switch(state) {
case 0:
if (isspace(line[i]))
continue;
if (is_variable(line[i])) {
var_name[var_index++] = line[i];
ret = check_overflow(var_index, 32);
} else {
if (line[i] == ';')
state = 3;
else if (line[i] == '=')
state = 1;
}
break;
case 1:
if (!isspace(line[i])) {
if (line[i] == '\"')
state = 2;
} else
continue;
break;
case 2:
if (!isspace(line[i])) {
if (line[i] == '\"')
state = 3;
else {
assignment[assign_index++] = line[i];
ret = check_overflow(assign_index, 256);
}
} else
continue;
break;
default:
break;
}
}
if (type == 1) {
if (root != NULL)
insert_symbol(root, var_name);
size = snprintf(buffer, 256, "\tchar %s = calloc(%d, sizeof(char));\n\0",
var_name, assign_index+1);
fwrite(buffer, size, sizeof(char), tmp);
if (assign_index) {
size = snprintf(buffer, 256, "\tstrcpy(%s, \"%s\");\n\0",
var_name, assignment);
fwrite(buffer, size, sizeof(char), tmp);
}
} else {
size = snprintf(buffer, 256, "\t%s = realloc(%s, %d);\n\0",
var_name, var_name, assign_index+1);
fwrite(buffer, size, sizeof(char), tmp);
size = snprintf(buffer, 256, "\tstrcpy(%s, \"%s\");\n\0",
var_name, (assign_index)? assignment : "0");
fwrite(buffer, size, sizeof(char), tmp);
}
printf("Var_name: %s - Assign: %s Assign_size: %d\n", var_name, assignment, assign_index);
return ret;
}
int insert_after(int p, char* s, int size_s)
{
int i, j, k;
char c;
struct MyString *tmpstring, *newstring, *tmp2string;
is_saved = 0;
if ((N == 0) && ((p == 0)||(p == -1)))
{
/* В пустой файл ввожу первую строку*/
tmp2string = malloc(sizeof(struct MyString));
if (tmp2string == NULL)
return exit_force();
newstring = tmp2string;
newstring->cur_size = 0;
newstring->prev_string = newstring->next_string = NULL;
newstring->first_symbol = newstring->last_symbol = NULL;
my_strings_start = my_strings_end = newstring;
N = 1;
j = 1;
i = 1;
for (k = 0; k < size_s; k++)
{
c = s[k];
if (c == '\n')
{
insert_symbol(j,i,c);
j++;
i = 1;
}
else
{
insert_symbol(j,i, c);
i++;
}
}
free(s);
return 0;
}
if (p >= N)
{
free(s);
return -3;
}
if (p == 0)
{
insert_symbol(1, 1, '\n');
j = 1;
i = 1;
for (k = 0; k < size_s; k++)
{
c = s[k];
if (c == '\n') {
insert_symbol(j,i,c);
j++;
i = 1;
}
else
{
insert_symbol(j,i, c);
i++;
}
}
free(s);
return 0;
}
if (p == -1)
{
insert_symbol(N, my_strings_end->cur_size+1, '\n');
j = N;
i = 1;
for (k = 0; k < size_s; k++)
{
c = s[k];
if (c == '\n') {
insert_symbol(j,i,c);
j++;
i = 1;
}
else
{
insert_symbol(j,i, c);
i++;
}
}
free(s);
return 0;
}
tmpstring = my_strings_start;
for (i = 0; i < p-1; i++)
{
tmpstring = tmpstring->next_string;
}
insert_symbol(p, tmpstring->cur_size+1, '\n');
j = p+1;
i = 1;
for (k = 0; k < size_s; k++)
{
c = s[k];
if (c == '\n')
{
insert_symbol(j,i,c);
j++;
i = 1;
}
else
{
insert_symbol(j,i, c);
i++;
}
}
free(s);
return 0;
}
memptr func_setq(memptr func_expr) {
if (num_nodes(func_expr) != 3) {
// invalid call
#ifdef DEBUG
printf("22\n");
#endif
ERROR(ERROR_SETQ, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
return NOT_FOUND;
}
memptr local_security = safe_allocate_cons();
cons_pool[local_security].carKind = NIL;
cons_pool[local_security].cdrKind = NIL;
memptr current_node = cons_pool[func_expr].cdr;
memptr current_param = cons_pool[current_node].car;
Type first_type = type(current_param);
if (first_type != TYPE_SYMBOL) {
// first argument not a name
#ifdef DEBUG
printf("23\n");
#endif
ERROR(ERROR_SETQ, ERROR_FAILURE, ERROR_INVALID, ERROR_MALFORMED);
return NOT_FOUND;
}
memptr symbol_name = current_param;
current_node = cons_pool[current_node].cdr;
current_param = cons_pool[current_node].car;
memptr value = resolve_expr(current_param);
if (value == NOT_FOUND) {
// invalid value
#ifdef DEBUG
printf("24\n");
#endif
ERROR(ERROR_SETQ, ERROR_FAILURE, ERROR_INVALID, ERROR_EMPTY);
return NOT_FOUND;
}
cons_pool[local_security].car = value;
cons_pool[local_security].carKind = CONS;
// defining the new symbol
memptr symbol = allocate_cons();
cons_pool[local_security].cdr = symbol;
cons_pool[local_security].cdrKind = CONS;
cons_pool[symbol].car = cons_pool[symbol_name].car;
cons_pool[symbol].carKind = STRING;
cons_pool[symbol].cdr = value;
cons_pool[symbol].cdrKind = CONS;
memptr env = lookup(symbol, ENVIRONMENT);
if (env == NOT_FOUND) {
// inserting to current environment
insert_symbol(environment, symbol); // includes 1 allocation
} else {
// replacing previous interpretation
remove_symbol(env, symbol);
insert_symbol(env, symbol); // includes 1 allocation
}
return value;
}
memptr func_defun(memptr func_expr) {
if (num_nodes(func_expr) != 4) {
#ifdef DEBUG
printf("25\n");
#endif
ERROR(ERROR_DEFUN, ERROR_FAILURE, ERROR_INVALID, ERROR_COUNT);
return NOT_FOUND;
}
memptr name = cons_pool[cons_pool[func_expr].cdr].car;
if (cons_pool[name].carKind != STRING || cons_pool[name].cdrKind != CONS) {
// first argument not a name
#ifdef DEBUG
printf("26\n");
#endif
ERROR(ERROR_DEFUN, ERROR_FAILURE, ERROR_INVALID, ERROR_MALFORMED);
return NOT_FOUND;
}
memptr parameters = cons_pool[cons_pool[cons_pool[func_expr].cdr].cdr].car;
if (parameters != nil) {
if (cons_pool[parameters].carKind != CONS
|| cons_pool[parameters].cdrKind != NIL) {
// second argument not a parameters list
#ifdef DEBUG
printf("27\n");
#endif
ERROR(ERROR_DEFUN, ERROR_FAILURE, ERROR_INVALID, ERROR_MALFORMED);
return NOT_FOUND;
}
memptr current_param_node, next_param_node = cons_pool[parameters].car,
current_param;
// function has parameter(s)
do {
current_param_node = next_param_node;
current_param = cons_pool[current_param_node].car;
if (cons_pool[current_param].carKind != STRING
|| cons_pool[current_param].cdrKind != CONS) {
// a parameter is not a name
#ifdef DEBUG
printf("28\n");
#endif
ERROR(ERROR_DEFUN, ERROR_FAILURE, ERROR_INVALID, ERROR_MALFORMED);
return NOT_FOUND;
}
next_param_node = cons_pool[next_param_node].cdr;
} while (cons_pool[current_param_node].cdrKind == CONS);
}
// now we can build the function representation in the memory pool,
// and connect the functions name to it
memptr function = safe_allocate_cons(), current;
cons_pool[function].car = cons_pool[name].car;
cons_pool[function].carKind = STRING;
cons_pool[function].cdr = allocate_cons();
cons_pool[function].cdrKind = CONS;
// the name value - a user function
current = cons_pool[function].cdr;
cons_pool[current].car = allocate_cons();
cons_pool[current].carKind = CONS;
cons_pool[current].cdrKind = NIL;
// first argument - parameters list
current = cons_pool[current].car;
cons_pool[current].car = (
parameters == nil ? nil : cons_pool[parameters].car);
cons_pool[current].carKind = CONS;
cons_pool[current].cdr = allocate_cons();
cons_pool[current].cdrKind = CONS;
// second argument - function body
current = cons_pool[current].cdr;
cons_pool[current].carKind = CONS;
cons_pool[current].cdrKind = NIL;
cons_pool[current].car =
cons_pool[cons_pool[cons_pool[cons_pool[func_expr].cdr].cdr].cdr].car;
#ifdef DEFUN_SECURE_BODY
memptr local_security = safe_allocate_cons();
cons_pool[local_security].car = cons_pool[current].car;
cons_pool[local_security].carKind = CONS;
cons_pool[local_security].cdrKind = NIL;
#endif
// hashing the function into the system
memptr env = lookup(function, ENVIRONMENT);
if (env == NOT_FOUND) {
// inserting to current environment
insert_symbol(environment, function);
} else {
// replacing previous interpretation
remove_symbol(env, function);
insert_symbol(env, function);
}
return cons_pool[function].cdr;
}
