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

Last change on this file since 1987 was 1987, checked in by orlov, 15 years ago
  • New MPInt class -- selfmade realisation of multiprecision integers.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.5 KB
Line 
1//
2// Copyright (C) 2000 Refal+ Development Group
3//
4// Refal+ is free software; you can redistribute it and/or modify
5// it under the terms of the GNU General Public License as published by
6// the Free Software Foundation; either version 2 of the License, or
7// (at your option) any later version.
8//
9// Refal+ is distributed in the hope that it will be useful,
10// but WITHOUT ANY WARRANTY; without even the implied warranty of
11// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12// GNU General Public License for more details.
13//
14// You should have received a copy of the GNU General Public License
15// along with Refal+; if not, write to the Free Software
16// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
17//
18// $Source$
19// $Revision: 1987 $
20// $Date: 2006-06-14 23:16:35 +0000 (Wed, 14 Jun 2006) $
21// Author: Andrey Slepuhin <pooh@msu.ru>
22
23#include "rf_core.hh"
24#include "rf_types.ih"
25#include "pxx_default_allocator.ih"
26
27#include <time.h>
28#include <stdlib.h>
29#include <locale.h>
30
31namespace pxx {
32  extern void terminate_handler () ;
33}
34
35namespace rfrt
36{
37
38using namespace rftype;
39
40void terminate_handler ()
41{
42  try {
43    throw;
44  } catch (Expr& _expr) {
45    _expr.writeln(stderr);
46  } catch (...) {
47    pxx::terminate_handler();
48  }
49}
50
51class Init
52{
53
54public:
55
56  Init ()
57  {
58    std::set_terminate(terminate_handler);
59  }
60
61  ~Init ()
62  {
63    #if DEBUG
64    printf("Concatenation statistics:\n");
65    printf("- no copy:       %"PRIuPTR"\n", empty_copy);
66    printf("- left copy:     %"PRIuPTR"\n", lt_copy);
67    printf("- right copy:    %"PRIuPTR"\n", rt_copy);
68    printf("- both copy:     %"PRIuPTR"\n", both_copy);
69    printf("- unifications:  %"PRIuPTR"\n", unifications);
70    printf("- identical:     %"PRIuPTR"\n", identical);
71    #if PARANOIA
72    if (allocator) allocator->memory_dump();
73    #endif // PARANOIA
74    #endif // DEBUG
75  }
76
77};
78
79Init init /* __attribute__ ((init_priority (600))) */ ;
80
81pxx::HeapAllocator* allocator = null ;
82pxx::ChunkAllocator<ExprWrapper>* expr_allocator = null ;
83
84const Expr empty ;
85Expr unexpected_fail ;
86Expr trap_stack ;
87
88rftype::Func* entry = null ;
89
90void (*init_StdIn)() = null ;
91
92int argc ;
93char** argv ;
94
95static int parse_RTS (int _argc, char** const _argv)
96{
97  int i = 0;
98  while (i < _argc)
99  {
100    if (strcmp("-RTS", _argv[i]) == 0) {
101      i++;
102      break;
103    }
104    if (strcmp("--RTS", _argv[i]) == 0) {
105      use_rts = false;
106      i++;
107      break;
108    }
109    if (strcmp("+RTS", _argv[i]) == 0) {
110      i++;
111      continue;
112    }
113    if (strcmp("-heap_size", _argv[i]) == 0) {
114      i++;
115      if (i < _argc) {
116        unsigned long l = strtoul(_argv[i], null, 0);
117        if (!errno && l >= pxx::page_size && l <= UINTPTR_MAX) {
118          heap_size = l;
119          i++;
120          continue;
121        }
122      }
123      printf("RTS option -heap_size requires integer parameter between %u and %u\n",
124          pxx::page_size, UINTPTR_MAX);
125      exit(-1);
126    }
127    if (strcmp("-heap_start", _argv[i]) == 0) {
128      i++;
129      if (i < _argc) {
130        unsigned long l = strtoul(_argv[i], null, 0);
131        if (!errno && l >= pxx::page_size && l <= UINTPTR_MAX) {
132          heap_start = pxx::ptr_align(reinterpret_cast<void*>(l), pxx::page_size);
133          i++;
134          continue;
135        }
136      }
137      printf("RTS option -heap_start requires integer parameter between %u and %u\n",
138          pxx::page_size, UINTPTR_MAX);
139      exit(-1);
140    }
141    if (strcmp("-stack_size", _argv[i]) == 0) {
142      i++;
143      if (i < _argc) {
144        unsigned long l = strtoul(_argv[i], null, 0);
145        if (!errno && l >= pxx::page_size && l <= UINTPTR_MAX) {
146          stack_size = l;
147          i++;
148          continue;
149        }
150      }
151      printf("RTS option -stack_size requires integer parameter between %u and %u\n",
152          pxx::page_size, UINTPTR_MAX);
153      exit(-1);
154    }
155    if (strcmp("-stack_start", _argv[i]) == 0) {
156      i++;
157      if (i < _argc) {
158        unsigned long l = strtoul(_argv[i], null, 0);
159        if (!errno && l >= pxx::page_size && l <= UINTPTR_MAX) {
160          stack_start = pxx::ptr_align(reinterpret_cast<void*>(l), pxx::page_size);
161          i++;
162          continue;
163        }
164      }
165      printf("RTS option -stack_start requires integer parameter between %u and %u\n",
166          pxx::page_size, UINTPTR_MAX);
167      exit(-1);
168    }
169    if (strcmp("+trap_stack", _argv[i]) == 0) {
170      trap_stack_on = true;
171      i++;
172      continue;
173    }
174    if (strcmp("-trap_stack", _argv[i]) == 0) {
175      trap_stack_on = false;
176      i++;
177      continue;
178    }
179    printf("Unknown RTS option %.25s\n", _argv[i]);
180    exit(-1);
181  }
182  return i;
183}
184
185}
186
187using namespace rfrt;
188
189RF_REGISTER_SYMBOL(Expr);
190TypeRegister rftype::ObjectRef::reg(&ObjectRef::funcs, type_object) ;
191TypeRegister rftype::Char::reg(&Char::funcs, type_char) ;
192TypeRegister rftype::Int32::reg(&Int32::funcs, type_int32) ;
193TypeRegister rftype::Word::reg(&Word::funcs, type_word) ;
194
195#ifndef RFRT_WITHOUT_MPINT
196#ifndef RFRT_WITHOUT_GMP
197pxx::ChunkAllocator<Integer::MpzContainer>* Integer::mpz_allocator = null ;
198TypeRegister rftype::Integer::reg(&Integer::funcs, type_int) ;
199#else
200TypeRegister RF_SYMBOL(IntMP)::reg(&RF_SYMBOL(IntMP)::funcs, type_int) ;
201#endif
202#endif
203
204
205ObjectRegister rftype::Vector::reg(type_vector) ;
206ObjectRegister rftype::Channel::reg(type_channel) ;
207ObjectRegister rftype::String::reg(type_string) ;
208ObjectRegister rftype::Table::reg(type_table) ;
209
210RF_REGISTER_SYMBOL(Func);
211RF_REGISTER_SYMBOL(Closure);
212RF_REGISTER_SYMBOL(BoxContents);
213RF_REGISTER_SYMBOL_VARIANT(NamedObject<BoxContents>, BoxContents);
214
215int main (int _argc, char* _argv[])
216{
217  if (!use_rts) {
218    argc = _argc;
219    argv = _argv;
220  }
221  else {
222    argc = 0;
223    argv = static_cast<char**>(alloca(_argc * sizeof(char*)));
224    for (int i = 0; i < _argc; )
225    {
226      if (strcmp("+RTS", _argv[i]) == 0) {
227        i++;
228        i += parse_RTS(_argc - i, _argv + i);
229      }
230      else if (strcmp("--RTS", _argv[i]) == 0) {
231        i++;
232        use_rts = false;
233      }
234      else {
235        argv[argc++] = _argv[i++];
236      }
237      if (!use_rts)
238        while (i < _argc)
239          argv[argc++] = _argv[i++];
240    }
241  }
242  stack = static_cast<Stack*>(alloca(sizeof(Stack)));
243  new (stack) Stack(stack_start, stack_size);
244  allocator = new pxx::HeapAllocator(pxx::page_size, heap_size, heap_start);
245#ifndef RFRT_WITHOUT_GMP
246  Integer::mpz_allocator =
247    new pxx::ChunkAllocator<Integer::MpzContainer>(*allocator);
248#endif // !defined RFRT_WITHOUT_GMP
249  expr_allocator = new pxx::ChunkAllocator<ExprWrapper>(*allocator);
250  default_allocator.set(*allocator);
251  double start = clock ();
252  unexpected_fail = Expr::create<Word>("Unexpected fail");
253  for (AtStart* as = AtStart::first; as; as = as->next)
254  {
255    as->invoke();
256  }
257  if (init_StdIn) init_StdIn();
258  init_done = true;
259  D( printf("=== Init is done! ===\n"); )
260  Expr res;
261  try {
262    RF_CALL(rfrt::entry, /*void*/, res);
263  }
264  catch (Expr const& err) {
265    printf("\n$error: ");
266    err.writeln(stdout);
267    if (trap_stack_on) {
268      printf("\nBacktrace:\n\n");
269      res = stack->get_part(0, 0);
270      for (Term* p = res.get_first(); p < res.get_last(); p++)
271      {
272        Expr e(p);
273        Term* q = e.get_first();
274        uintptr_t n = (q++)->cast_to<Integer>()->to_int();
275        wchar_t const* fname;
276        (q++)->get_name(&fname);
277        printf("#%-2u %ls\n", n, fname);
278//        printf(q < e.get_last() ? ":\n" : "\n");
279        for (int i = 1; q < e.get_last(); q++, i++)
280        {
281          printf("      Arg %2d: ", i);
282          Expr(q).writeln(stdout);
283        }
284        printf("\n");
285      }
286    }
287  }
288  printf("Time elapsed: %.2fs\n", (clock () - start) / CLOCKS_PER_SEC);
289  return 0;
290}
291
Note: See TracBrowser for help on using the repository browser.