Patch title: Release 91 bulk changes
Abstract:
File: /language/compiler/function/function.c
Key:
    Removed line
    Added line
// Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
//
// This program is free software; you can redistribute it and/or
// modify it under the terms of the GNU General Public License version 2
// as published by the Free Software Foundation.
// 
// 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
// version 2 along with this program; if not, write to the Free Software
// Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

/*
abstract
  text "'Function' data type"
*/
 

static Void FunctionPrototype_build(struct FunctionPrototype *p) {
  p->type=null;
  p->access=0;
  p->cpu_register=int_bad;
  p->maps=int_bad;
  Arrow_build(&p->default_value);
  Str_build(&p->name);
  Dictionary_build(&p->properties);
  Arrow_build((Arrow *)&p->inline_argument); }


static Void FunctionPrototype_destroy(struct FunctionPrototype *p) {
  Arrow_destroy(&p->default_value);
  Str_destroy(&p->name);
  Dictionary_destroy(&p->properties);
  Arrow_destroy((Arrow *)&p->inline_argument); }


/*****************************************************************************/


FUNCTION Void Function_build(struct Function *f) {
  check(sizeof(f->modify_registers)>=bit_size(nb_register));
  f->exe=null;
  f->exe_size=0;
  f->flags=0;
  f->definition=0;
  f->arguments=null,f->nb_arg=f->nb_argres=0;
  memory_clear(f->modify_registers,bit_size(nb_register));
  f->stack_grow=0;
  f->generic_index=int_bad;
  Str_build(&f->name);
  ListingPosition_build(&f->position);
  Dictionary_build(&f->properties);
  Arrow_build((Arrow *)&f->extra_module);
  List_build(&f->inline_instructions);
  Arrow_build((Arrow *)&f->generate_assembly);
  Arrow_build((Arrow *)&f->generate_binary);
  Arrow_build(&f->externals);
  f->profiler_counter=0;
  G.function_lock_hook();
  f->previous_function=G.last_function;
  f->next_function=null;
  if(G.last_function!=null) G.last_function->next_function=f; else { check(G.first_function==null); G.first_function=f; }
  G.last_function=f;
  G.function_unlock_hook(); }


FUNCTION Void Function_destroy(struct Function *f) {
  Int i;
  G.function_lock_hook();
  if(f->next_function!=null) f->next_function->previous_function=f->previous_function; else G.last_function=f->previous_function;
  if(f->previous_function!=null) f->previous_function->next_function=f->next_function; else G.first_function=f->next_function;
  G.function_unlock_hook();
  if(f->flags&Function_flag_allocated_exe)
    memory_free(f->exe);
  for(i=0; i<f->nb_argres; i++)
    FunctionPrototype_destroy(f->arguments+i);
  memory_free(f->arguments);
  Str_destroy(&f->name);
  ListingPosition_destroy(&f->position);
  Dictionary_destroy(&f->properties);
  Arrow_destroy((Arrow *)&f->extra_module);
  Arrow_destroy((Arrow *)&f->generate_assembly);
  Arrow_destroy((Arrow *)&f->generate_binary);
  List_destroy(&f->inline_instructions);
  Arrow_destroy(&f->externals); }


FUNCTION Void Function_define_arguments_prototypes(struct Function *f,Int nb_arg,Int nb_res) {
  Int i;
  check(f->arguments==null);
  f->nb_arg=nb_arg;
  f->nb_argres=nb_arg+nb_res;
  f->arguments=(struct FunctionPrototype *)memory_allocate(f->nb_argres*sizeof(struct FunctionPrototype),f);
  for(i=0; i<f->nb_argres; i++)
    FunctionPrototype_build(f->arguments+i); }


FUNCTION Void Function_define_argument_prototype(struct Function *f,struct Type *type,Int access,struct Str *name,Address default_value) {
  struct FunctionPrototype *p;
  f->arguments=(struct FunctionPrototype *)memory_resize(f->arguments,(f->nb_argres+1)*sizeof(struct FunctionPrototype),f);
  p=f->arguments+f->nb_argres;
  FunctionPrototype_build(p);
  p->type=type;
  p->access=access;
  Str_copy(name,&p->name);
  Arrow_set(&p->default_value,default_value);
  f->nb_argres++;
  if(!(access&(Access_result_read|Access_result_write|Access_result_consistent)))
    f->nb_arg++; }


FUNCTION struct FunctionPrototype *Function_map_argument_prototype(struct Function *f,Int number) {
  check(number>=0 && number<f->nb_argres);
  return f->arguments+number; }


FUNCTION Void Function_terminate_arguments_prototypes(struct Function *f,Int extra_flags) {
  struct Function *proto;
  struct CompilingRules *rules;
  Int available_call_registers[nb_8_register_sets],available_return_registers[nb_8_register_sets];
  Int push_count;
  Int ii,i,start,mode,flag,reg; struct FunctionPrototype *p;
  Int j,pcg;
  if(f->flags&Function_flag_prototype_terminated) return;
  f->flags|=extra_flags;
  check(f->nb_arg>=0 && f->nb_argres>=f->nb_arg && f->nb_argres<=f->nb_arg+1);
  for(i=0; i<f->nb_argres; i++)
    if(f->arguments[i].type==null) {
      error_notifyn(error_id_compile,Z,"There is a parameter with no type",END); }
  if(f->flags&Function_flag_generic) {
    check(f->nb_arg>0);
    f->generic_index=generic_allocate_method(f->arguments[0].type); }
  proto=Function_watch_generic(f);
  if(proto!=null && proto->nb_argres!=f->nb_argres) {
    error_notifyn(error_id_compile,Z,"The result is inconsistent with the generic prototype",END);
    proto=null; }
  #ifdef _BYTECODE_
    rules=&compiler_rules;
  #else
    rules=(f->flags&Function_flag_varargs ? &varargs_rules : (f->flags&Function_flag_kernel ? &kernel_rules : (f->flags&Function_flag_external ? &external_rules : &compiler_rules)));
  #endif
  f->flags|=rules->flags;
  start=0;
  for(ii=0; ii<f->nb_argres; ii++) {
    i=(ii+f->nb_arg)%f->nb_argres;
    p=f->arguments+i; mode=p->access&(Access_read|Access_write);
    check(i<f->nb_arg || mode==Aw);
    if(p->type->flags&Type_flag_atomic) {
      if(p->access&(Access_mapped|Access_object|Access_force_byaddress)) {
        flag=0;
      orif(i==0 && (f->flags&Function_flag_generic))
        flag=0;
      orif(i>=f->nb_arg)
        flag=Function_flag_result_byvalue;
      orif(mode==Ar)
        flag=Function_flag_ro_byvalue;
      orif(mode==Aw)
        flag=Function_flag_wo_byvalue;
      other
        flag=Function_flag_rw_byvalue; }
      if(f->flags&flag)
        p->access|=Access_byvalue; }
    if(i==0 && (f->flags&Function_flag_generic))
      p->access|=Access_object;
    if(proto!=null && proto!=f) {
      if((p->access&~(Access_byvalue|Access_was_byvalue|Access_object|Access_force_byaddress))!=(proto->arguments[i].access&~(Access_byvalue|Access_was_byvalue|Access_object|Access_force_byaddress)))
        error_notifyn(error_id_compile,Z,"The parameters access are inconsistent with the generic prototype",END);
      p->access=proto->arguments[i].access; }
    if(i>=f->nb_arg)
      if(p->access&Access_byvalue) {
        if(f->flags&Function_flag_byvalue_result_first)
          start=i;
      orif(p->access&Access_mapped)
        if(f->flags&Function_flag_mapped_result_first)
          start=i;
      other
        if(f->flags&Function_flag_byaddress_result_first)
          start=i; } }
  memory_clear(available_call_registers,bit_size(nb_register));
  for(i=0; i<rules->nb_call_registers; i++)
    bit_set(available_call_registers,rules->call_registers[i]);
  memory_clear(available_return_registers,bit_size(nb_register));
  for(i=0; i<rules->nb_return_registers; i++)
    bit_set(available_return_registers,rules->return_registers[i]);
  push_count=0;
  for(ii=0; ii<f->nb_argres; ii++) {
    i=(ii+start)%f->nb_argres;
    p=f->arguments+i; mode=p->access&(Access_read|Access_write);
    reg=int_bad;
    if(mode==Ar || mode==Arw || !(p->access&(Access_byvalue|Access_mapped))) {
      for(j=0; j<rules->nb_call_registers; j++)
        if(bit_test(available_call_registers,rules->call_registers[j])) {
          reg=rules->call_registers[j]; break; }
    other
      check(mode==Aw && (p->access&(Access_byvalue|Access_mapped)));
      for(j=0; j<rules->nb_return_registers; j++)
        if(bit_test(available_return_registers,rules->return_registers[j])) {
          reg=rules->return_registers[j]; break; } }
    if(reg!=int_bad) {
      p->cpu_register=reg;
      if(mode==Ar || !(p->access&(Access_byvalue|Access_mapped))) {
        if(f->flags&Function_flag_modify_call_registers)
          bit_set(f->modify_registers,reg);
        bit_clear(available_call_registers,reg);
      orif(mode==Aw)
        bit_set(f->modify_registers,reg);
        bit_clear(available_return_registers,reg);
      other
        check(mode==Arw);
        bit_set(f->modify_registers,reg);
        bit_clear(available_call_registers,reg);
        bit_clear(available_return_registers,reg); }
    other
      check(!(p->access&Access_mapped));
      if(p->access&Access_write)
        p->access=(p->access&~Access_byvalue)|Access_was_byvalue;
      p->cpu_register=-(++push_count);
      if(f->flags&Function_flag_not_popped) f->stack_grow+=sizeof(Int); } }
  if(!(f->flags&Function_flag_push_reversed))
    for(i=0; i<f->nb_argres; i++) {
      p=f->arguments+i;
      if(p->cpu_register<0)
        p->cpu_register=-(push_count+1)-p->cpu_register; }
  pcg=f->flags&Function_flag_pliant_code_generator;
  for(i=0; i<(pcg ? rules->nb_can_modify_registers : rules->nb_might_modify_registers); i++)
    bit_set(f->modify_registers,pcg ? rules->can_modify_registers[i] : rules->might_modify_registers[i]);
  f->flags|=Function_flag_prototype_terminated; }
  f->flags|=Function_flag_prototype_terminated;
  if(f->flags&Function_flag_has_no_side_effect)
    f->flags&=~Function_flag_has_side_effects; }


FUNCTION struct Function *Function_watch_generic(struct Function *f) {
  Arrow *c,*c2; struct Function *f2; Int i;
  struct Type *generic_type,*type;
  if(f->nb_arg==0) return null;
  if(f->generic_index!=int_bad) {
    i=f->generic_index;
    generic_type=f->arguments[0].type;
    Type_recurse_may_be(generic_type);
    for(c=List_first(&generic_type->maybe); c!=G.null_constant; c=List_next(c)) {
      type=(struct Type *)*c;
      if(Type_get_generic_method(type,i)==null && Type_get_generic_method(generic_type,i)!=null)
        Type_set_generic_method(type,i,Type_get_generic_method(generic_type,i)); } }
  for(c=Dictionary_first(G.general_dictionary,&f->name); c!=G.null_constant; c=Dictionary_next(G.general_dictionary,&f->name,c))
    if(entry_type(*c)==G.type_Function) {
      f2=(struct Function *)*c;
      if(!(f2->flags&Function_flag_generic)) continue;
      check(f2->nb_arg>0);
      if(f2->nb_arg!=f->nb_arg) continue;
      for(i=0; i<f2->nb_arg; i++) {
        if(f2->arguments[i].type==f->arguments[i].type) continue;
        Type_recurse_may_be(f2->arguments[i].type);
        for(c2=List_first(&f2->arguments[i].type->maybe); c2!=G.null_constant; c2=List_next(c2)) {
          check(entry_type(*c2)==G.type_Type);
          if((struct Type *)*c2==f->arguments[i].type) break; }
        if(c2==G.null_constant) break; }
      if(i!=f2->nb_arg) continue;
      Type_set_generic_method(f->arguments[0].type,f2->generic_index,f);
      return f2; }
  return null; }


FUNCTION Void Function_set_generate_assembly(struct Function *f,struct Function *ga) {
  Int i;
  Arrow_set((Arrow *)&f->generate_assembly,ga); 
  memory_clear(f->modify_registers,bit_size(nb_register));
  for(i=0; i<f->nb_argres; i++)
    f->arguments[i].cpu_register=int_bad;
  f->flags&=~Function_flag_inline_instructions;
  f->stack_grow=0; }

FUNCTION Void Function_set_generate_assembly1(struct Function *f,FunctionAssemblyPrototype ga) {
  Function_set_generate_assembly(f,C_function2("",ga)); }


FUNCTION Void Function_set_generate_binary(struct Function *f,struct Function *gb) {
  Int i; struct FunctionPrototype *p;
  Arrow_set((Arrow *)&f->generate_binary,gb);
  memory_clear(f->modify_registers,bit_size(nb_register));
  for(i=0; i<f->nb_argres; i++) {
    p=f->arguments+i;
    p->cpu_register=int_bad;
    if(p->access&Access_was_byvalue)
      p->access|=Access_byvalue; }
  f->flags&=~Function_flag_inline_instructions;
  f->stack_grow=0; }

FUNCTION Void Function_set_generate_binary1(struct Function *f,FunctionBinaryPrototype gb) {
  Function_set_generate_binary(f,C_function2("",gb)); }


/*****************************************************************************/


FUNCTION Void Function_record_external(struct Function *fun,Arrow ref,Bool record_offset) {
  struct FunctionExternal *e;
  if(record_offset) {
    e=(struct FunctionExternal *)entry_new(G.type_FunctionExternal);
    e->code_offset=fun->exe_size;
    Arrow_set(&e->to,ref);
    ref=e; }
  if(fun->externals==null)
    Arrow_set(&fun->externals,entry_new(G.type_List));
  check(entry_type(fun->externals)==G.type_List);
  List_append((struct List *)fun->externals,ref); }


FUNCTION Void Function_code_immediat(struct Function *fun,Int value,Int size) {
  if(!(fun->flags&Function_flag_simulate)) {
    fun->flags|=Function_flag_allocated_exe;
    if(memory_size(fun->exe)<fun->exe_size+sizeof(Int))
      fun->exe=memory_resize(fun->exe,maximum(2*fun->exe_size,1024),null);
    *(Int *)address_translate(fun->exe,fun->exe_size)=value; }
  fun->exe_size+=size; }


FUNCTION Void Function_code_jump_instruction(struct Function *fun,struct Instruction *instruction) {
  if(fun->flags&Function_flag_simulate) {
    fun->exe_size+=sizeof(Int); return; }
  Function_record_external(fun,instruction,true);
  Function_code_immediat(fun,0,sizeof(Int)); }


FUNCTION Void Function_code_jump_function(struct Function *fun,struct Function *function) {
  if(fun->flags&Function_flag_simulate) {
    fun->exe_size+=sizeof(Int); return; }
  Function_record_external(fun,function,true);
  Function_code_immediat(fun,0,sizeof(Int)); }


FUNCTION Void Function_update_uses(struct Function *fun,struct Function *newone) {
  Arrow *r; struct FunctionUse *u; Address exe;
  if(fun->externals==null) return;
  if(entry_type(fun->externals)!=G.type_List) return;
  for(r=List_first((struct List *)fun->externals); r!=G.null_constant; r=List_next(r))
    if(entry_type(*r)==G.type_FunctionUse) {
      u=(struct FunctionUse *)*r;
      exe=((struct Function *)u->in)->exe;
      #ifdef _i386_
        *(Int *)address_translate(exe,u->code_offset)=integer_from_address(newone->exe)-integer_from_address(exe)-(u->code_offset+sizeof(Int));
      #else
        FIXME
      #endif
      } }


FUNCTION Void Function_terminate_code(struct Function *fun) {
  Address exe;
  struct List *externals; struct Relation hashed; struct Array *compacted;
  Arrow *c,*c2;
  struct FunctionExternal *e; struct Function *f; struct Instruction *i;
  Int u,count; struct RelationNode *n;
  exe=memory_allocate(fun->exe_size,fun);
  memory_copy(fun->exe,exe,fun->exe_size);
  memory_free(fun->exe); fun->exe=exe;
  Function_update_uses(fun,fun);
  if(fun->externals==null) return;
  check(entry_type(fun->externals)==G.type_List);
  Relation_build(&hashed);
  externals=(struct List *)fun->externals;
  for(c=List_first(externals); c!=G.null_constant; c=c2) {
    c2=List_next(c);
    if(entry_type(*c)==G.type_FunctionExternal) {
      e=(struct FunctionExternal *)*c;
      if(entry_type(e->to)==G.type_Function) {
        f=(struct Function *)e->to;
        #ifdef _i386_
         *(Int *)address_translate(exe,e->code_offset)=integer_from_address(f->exe)-integer_from_address(exe)-(e->code_offset+sizeof(Int));
        #else
          FIXME
        #endif
        if(f->flags&Function_flag_external) continue;
        if(f!=fun)
          Relation_define(&hashed,f,null,f);
      orif(entry_type(e->to)==G.type_Instruction)
        i=(struct Instruction *)e->to;
        #ifdef _i386_
          *(Int *)address_translate(exe,e->code_offset)=i->order-(e->code_offset+sizeof(Int));
        #else
          FIXME
        #endif
        }
    orif(entry_type(*c)==G.type_FunctionUse)
    other
      if(*c!=G.general_dictionary && *c!=G.module_dictionary)
        Relation_define(&hashed,*c,null,*c); }
    List_remove(externals,c); }
  if(List_first(externals)==G.null_constant)
    Arrow_set(&fun->externals,null);
  if(hashed.count!=0) {
    compacted=(struct Array *)entry_new(G.type_Array);
    Array_resize(compacted,hashed.count);
    count=0;
    for(u=0; u<hashed.hashsize; u++)
      for(n=hashed.table[u]; n!=null; n=n->next)
        Array_set_index(compacted,count++,n->reference);
    check(count==compacted->nb);
    if(fun->externals==null)
      Arrow_set(&fun->externals,compacted);
    else
      List_append((struct List *)fun->externals,compacted); }
  Relation_destroy(&hashed); }


/*****************************************************************************/

#include <stdarg.h>


FUNCTION struct Function *C_function2(Char *name,Address cfun) {
  struct EntryHeader *h; struct Function *f;
  h=(struct EntryHeader *)memory_allocate(sizeof(struct EntryHeader)+sizeof(struct Function),null);
  entry_record(h,G.type_Function);
  f=(struct Function *)(h+1);
  Function_build(f);
  f->exe=cfun;
  string_Str(name,&f->name);
  return f; }


FUNCTION struct Function *C_function(Char *name,struct Module *module,Address cfun,Int flags, ...) {
  struct Function *f;
  va_list arguments; struct Type *t; Int a;
  Int result; struct Str temp;
  f=entry_new(G.type_Function);
  f->exe=cfun;
  va_start(arguments,flags);
  for(;;) {
    t=va_arg(arguments,struct Type *); if(t==END) break;
    a=va_arg(arguments,Int);
    Function_define_argument_prototype(f,t,a,Str_map_string(&temp,""),null); }
  va_end(arguments);
  string_Str(name,&f->name);
  Function_terminate_arguments_prototypes(f,flags);
  Dictionary_insert2(G.general_dictionary,&f->name,true,f,module);
  return f; }


FUNCTION struct Function *C_meta(Char *name,struct Module *module,FunctionMacroPrototype cfun,Int flags) {
  struct Function *f;
  f=entry_new(G.type_Meta);
  string_Str(name,&f->name);
  f->flags=flags;
  f->exe=cfun;
  Dictionary_insert2(G.general_dictionary,&f->name,true,f,module);
  return f; }