source: to-imperative/trunk/runtime/rf_core.cc @ 1987

//
// Copyright (C) 2000 Refal+ Development Group
//
// Refal+ 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 2 of the License, or
// (at your option) any later version.
//
// Refal+ 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 Refal+; if not, write to the Free Software
// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
//
// $Source$
// $Revision: 1987 $
// $Date: 2006-06-14 23:16:35 +0000 (Wed, 14 Jun 2006) $
// Author: Andrey Slepuhin <pooh@msu.ru>

#include "rf_core.hh"
#include "rf_types.ih"
#include "pxx_default_allocator.ih"

#include <time.h>
#include <stdlib.h>
#include <locale.h>

namespace pxx {
  extern void terminate_handler () ;
}

namespace rfrt
{

using namespace rftype;

void terminate_handler ()
{
  try {
    throw;
  } catch (Expr& _expr) {
    _expr.writeln(stderr);
  } catch (...) {
    pxx::terminate_handler();
  }
}

class Init
{

public:

  Init ()
  {
    std::set_terminate(terminate_handler);
  }

  ~Init ()
  {
    #if DEBUG
    printf("Concatenation statistics:\n");
    printf("- no copy:       %"PRIuPTR"\n", empty_copy);
    printf("- left copy:     %"PRIuPTR"\n", lt_copy);
    printf("- right copy:    %"PRIuPTR"\n", rt_copy);
    printf("- both copy:     %"PRIuPTR"\n", both_copy);
    printf("- unifications:  %"PRIuPTR"\n", unifications);
    printf("- identical:     %"PRIuPTR"\n", identical);
    #if PARANOIA
    if (allocator) allocator->memory_dump();
    #endif // PARANOIA
    #endif // DEBUG
  }

};

Init init /* __attribute__ ((init_priority (600))) */ ;

pxx::HeapAllocator* allocator = null ;
pxx::ChunkAllocator<ExprWrapper>* expr_allocator = null ;

const Expr empty ;
Expr unexpected_fail ;
Expr trap_stack ;

rftype::Func* entry = null ;

void (*init_StdIn)() = null ;

int argc ;
char** argv ;

static int parse_RTS (int _argc, char** const _argv)
{
  int i = 0;
  while (i < _argc)
  {
    if (strcmp("-RTS", _argv[i]) == 0) {
      i++;
      break;
    }
    if (strcmp("--RTS", _argv[i]) == 0) {
      use_rts = false;
      i++;
      break;
    }
    if (strcmp("+RTS", _argv[i]) == 0) {
      i++;
      continue;
    }
    if (strcmp("-heap_size", _argv[i]) == 0) {
      i++;
      if (i < _argc) {
        unsigned long l = strtoul(_argv[i], null, 0);
        if (!errno && l >= pxx::page_size && l <= UINTPTR_MAX) {
          heap_size = l;
          i++;
          continue;
        }
      }
      printf("RTS option -heap_size requires integer parameter between %u and %u\n",
          pxx::page_size, UINTPTR_MAX);
      exit(-1);
    }
    if (strcmp("-heap_start", _argv[i]) == 0) {
      i++;
      if (i < _argc) {
        unsigned long l = strtoul(_argv[i], null, 0);
        if (!errno && l >= pxx::page_size && l <= UINTPTR_MAX) {
          heap_start = pxx::ptr_align(reinterpret_cast<void*>(l), pxx::page_size);
          i++;
          continue;
        }
      }
      printf("RTS option -heap_start requires integer parameter between %u and %u\n",
          pxx::page_size, UINTPTR_MAX);
      exit(-1);
    }
    if (strcmp("-stack_size", _argv[i]) == 0) {
      i++;
      if (i < _argc) {
        unsigned long l = strtoul(_argv[i], null, 0);
        if (!errno && l >= pxx::page_size && l <= UINTPTR_MAX) {
          stack_size = l;
          i++;
          continue;
        }
      }
      printf("RTS option -stack_size requires integer parameter between %u and %u\n",
          pxx::page_size, UINTPTR_MAX);
      exit(-1);
    }
    if (strcmp("-stack_start", _argv[i]) == 0) {
      i++;
      if (i < _argc) {
        unsigned long l = strtoul(_argv[i], null, 0);
        if (!errno && l >= pxx::page_size && l <= UINTPTR_MAX) {
          stack_start = pxx::ptr_align(reinterpret_cast<void*>(l), pxx::page_size);
          i++;
          continue;
        }
      }
      printf("RTS option -stack_start requires integer parameter between %u and %u\n",
          pxx::page_size, UINTPTR_MAX);
      exit(-1);
    }
    if (strcmp("+trap_stack", _argv[i]) == 0) {
      trap_stack_on = true;
      i++;
      continue;
    }
    if (strcmp("-trap_stack", _argv[i]) == 0) {
      trap_stack_on = false;
      i++;
      continue;
    }
    printf("Unknown RTS option %.25s\n", _argv[i]);
    exit(-1);
  }
  return i;
}

}

using namespace rfrt;

RF_REGISTER_SYMBOL(Expr);
TypeRegister rftype::ObjectRef::reg(&ObjectRef::funcs, type_object) ;
TypeRegister rftype::Char::reg(&Char::funcs, type_char) ;
TypeRegister rftype::Int32::reg(&Int32::funcs, type_int32) ;
TypeRegister rftype::Word::reg(&Word::funcs, type_word) ;

#ifndef RFRT_WITHOUT_MPINT
#ifndef RFRT_WITHOUT_GMP
pxx::ChunkAllocator<Integer::MpzContainer>* Integer::mpz_allocator = null ;
TypeRegister rftype::Integer::reg(&Integer::funcs, type_int) ;
#else
TypeRegister RF_SYMBOL(IntMP)::reg(&RF_SYMBOL(IntMP)::funcs, type_int) ;
#endif
#endif


ObjectRegister rftype::Vector::reg(type_vector) ;
ObjectRegister rftype::Channel::reg(type_channel) ;
ObjectRegister rftype::String::reg(type_string) ;
ObjectRegister rftype::Table::reg(type_table) ;

RF_REGISTER_SYMBOL(Func);
RF_REGISTER_SYMBOL(Closure);
RF_REGISTER_SYMBOL(BoxContents);
RF_REGISTER_SYMBOL_VARIANT(NamedObject<BoxContents>, BoxContents);

int main (int _argc, char* _argv[])
{
  if (!use_rts) {
    argc = _argc;
    argv = _argv;
  }
  else {
    argc = 0;
    argv = static_cast<char**>(alloca(_argc * sizeof(char*)));
    for (int i = 0; i < _argc; )
    {
      if (strcmp("+RTS", _argv[i]) == 0) {
        i++;
        i += parse_RTS(_argc - i, _argv + i);
      }
      else if (strcmp("--RTS", _argv[i]) == 0) {
        i++;
        use_rts = false;
      }
      else {
        argv[argc++] = _argv[i++];
      }
      if (!use_rts)
        while (i < _argc)
          argv[argc++] = _argv[i++];
    }
  }
  stack = static_cast<Stack*>(alloca(sizeof(Stack)));
  new (stack) Stack(stack_start, stack_size);
  allocator = new pxx::HeapAllocator(pxx::page_size, heap_size, heap_start);
#ifndef RFRT_WITHOUT_GMP
  Integer::mpz_allocator =
    new pxx::ChunkAllocator<Integer::MpzContainer>(*allocator);
#endif // !defined RFRT_WITHOUT_GMP
  expr_allocator = new pxx::ChunkAllocator<ExprWrapper>(*allocator);
  default_allocator.set(*allocator);
  double start = clock ();
  unexpected_fail = Expr::create<Word>("Unexpected fail");
  for (AtStart* as = AtStart::first; as; as = as->next)
  {
    as->invoke();
  }
  if (init_StdIn) init_StdIn();
  init_done = true;
  D( printf("=== Init is done! ===\n"); )
  Expr res;
  try {
    RF_CALL(rfrt::entry, /*void*/, res);
  }
  catch (Expr const& err) {
    printf("\n$error: ");
    err.writeln(stdout);
    if (trap_stack_on) {
      printf("\nBacktrace:\n\n");
      res = stack->get_part(0, 0);
      for (Term* p = res.get_first(); p < res.get_last(); p++)
      {
        Expr e(p);
        Term* q = e.get_first();
        uintptr_t n = (q++)->cast_to<Integer>()->to_int();
        wchar_t const* fname;
        (q++)->get_name(&fname);
        printf("#%-2u %ls\n", n, fname);
//        printf(q < e.get_last() ? ":\n" : "\n");
        for (int i = 1; q < e.get_last(); q++, i++)
        {
          printf("      Arg %2d: ", i);
          Expr(q).writeln(stdout);
        }
        printf("\n");
      }
    }
  }
  printf("Time elapsed: %.2fs\n", (clock () - start) / CLOCKS_PER_SEC);
  return 0;
}