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

Last change on this file since 2040 was 2040, checked in by orlov, 15 years ago
  • New RTS option -break -- for breaking in functions compiled with -dbg.
  • Table support for Values and Entries new library functions.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.8 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: 2040 $
20// $Date: 2006-07-27 13:00:40 +0000 (Thu, 27 Jul 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
95int breakc ;
96char** breakv ;
97
98static int parse_RTS (int _argc, char** const _argv)
99{
100  int i = 0;
101  while (i < _argc)
102  {
103    if (strcmp("-RTS", _argv[i]) == 0) {
104      i++;
105      break;
106    }
107    if (strcmp("--RTS", _argv[i]) == 0) {
108      use_rts = false;
109      i++;
110      break;
111    }
112    if (strcmp("+RTS", _argv[i]) == 0) {
113      i++;
114      continue;
115    }
116    if (strcmp("-heap_size", _argv[i]) == 0) {
117      i++;
118      if (i < _argc) {
119        unsigned long l = strtoul(_argv[i], null, 0);
120        if (!errno && l >= pxx::page_size && l <= UINTPTR_MAX) {
121          heap_size = l;
122          i++;
123          continue;
124        }
125      }
126      printf("RTS option -heap_size requires integer parameter between %u and %u\n",
127          pxx::page_size, UINTPTR_MAX);
128      exit(-1);
129    }
130    if (strcmp("-heap_start", _argv[i]) == 0) {
131      i++;
132      if (i < _argc) {
133        unsigned long l = strtoul(_argv[i], null, 0);
134        if (!errno && l >= pxx::page_size && l <= UINTPTR_MAX) {
135          heap_start = pxx::ptr_align(reinterpret_cast<void*>(l), pxx::page_size);
136          i++;
137          continue;
138        }
139      }
140      printf("RTS option -heap_start requires integer parameter between %u and %u\n",
141          pxx::page_size, UINTPTR_MAX);
142      exit(-1);
143    }
144    if (strcmp("-stack_size", _argv[i]) == 0) {
145      i++;
146      if (i < _argc) {
147        unsigned long l = strtoul(_argv[i], null, 0);
148        if (!errno && l >= pxx::page_size && l <= UINTPTR_MAX) {
149          stack_size = l;
150          i++;
151          continue;
152        }
153      }
154      printf("RTS option -stack_size requires integer parameter between %u and %u\n",
155          pxx::page_size, UINTPTR_MAX);
156      exit(-1);
157    }
158    if (strcmp("-stack_start", _argv[i]) == 0) {
159      i++;
160      if (i < _argc) {
161        unsigned long l = strtoul(_argv[i], null, 0);
162        if (!errno && l >= pxx::page_size && l <= UINTPTR_MAX) {
163          stack_start = pxx::ptr_align(reinterpret_cast<void*>(l), pxx::page_size);
164          i++;
165          continue;
166        }
167      }
168      printf("RTS option -stack_start requires integer parameter between %u and %u\n",
169          pxx::page_size, UINTPTR_MAX);
170      exit(-1);
171    }
172    if (strcmp("+trap_stack", _argv[i]) == 0) {
173      trap_stack_on = true;
174      i++;
175      continue;
176    }
177    if (strcmp("-trap_stack", _argv[i]) == 0) {
178      trap_stack_on = false;
179      i++;
180      continue;
181    }
182    if (strcmp("-break", _argv[i]) == 0) {
183      i++;
184      if (i < _argc) {
185        breakv[breakc++] = _argv[i++];
186        continue;
187      }
188      printf("RTS option -break requires parameter -- a name of function to break at\n");
189      exit(-1);
190    }
191    printf("Unknown RTS option `%.25s'\n", _argv[i]);
192    exit(-1);
193  }
194  return i;
195}
196
197}
198
199using namespace rfrt;
200
201RF_REGISTER_SYMBOL(Expr);
202TypeRegister rftype::ObjectRef::reg(&ObjectRef::funcs, type_object) ;
203TypeRegister rftype::Char::reg(&Char::funcs, type_char) ;
204TypeRegister rftype::Int32::reg(&Int32::funcs, type_int32) ;
205TypeRegister rftype::Word::reg(&Word::funcs, type_word) ;
206
207#ifndef RFRT_WITHOUT_MPINT
208#ifndef RFRT_WITHOUT_GMP
209pxx::ChunkAllocator<Integer::MpzContainer>* Integer::mpz_allocator = null ;
210TypeRegister rftype::Integer::reg(&Integer::funcs, type_int) ;
211#else
212TypeRegister RF_SYMBOL(IntMP)::reg(&RF_SYMBOL(IntMP)::funcs, type_int) ;
213#endif
214#endif
215
216
217ObjectRegister rftype::Vector::reg(type_vector) ;
218ObjectRegister rftype::Channel::reg(type_channel) ;
219ObjectRegister rftype::String::reg(type_string) ;
220ObjectRegister rftype::Table::reg(type_table) ;
221
222RF_REGISTER_SYMBOL(Func);
223RF_REGISTER_SYMBOL(Closure);
224RF_REGISTER_SYMBOL(BoxContents);
225RF_REGISTER_SYMBOL_VARIANT(NamedObject<BoxContents>, BoxContents);
226
227int main (int _argc, char* _argv[])
228{
229  if (!use_rts) {
230    argc = _argc;
231    argv = _argv;
232  }
233  else {
234    argc = 0;
235    argv = static_cast<char**>(alloca(_argc * sizeof(char*)));
236    breakv = static_cast<char**>(alloca(_argc / 2 * sizeof(char*)));
237    for (int i = 0; i < _argc; )
238    {
239      if (strcmp("+RTS", _argv[i]) == 0) {
240        i++;
241        i += parse_RTS(_argc - i, _argv + i);
242      }
243      else if (strcmp("--RTS", _argv[i]) == 0) {
244        i++;
245        use_rts = false;
246      }
247      else {
248        argv[argc++] = _argv[i++];
249      }
250      if (!use_rts)
251        while (i < _argc)
252          argv[argc++] = _argv[i++];
253    }
254  }
255  stack = static_cast<Stack*>(alloca(sizeof(Stack)));
256  new (stack) Stack(stack_start, stack_size);
257  allocator = new pxx::HeapAllocator(pxx::page_size, heap_size, heap_start);
258#ifndef RFRT_WITHOUT_GMP
259  Integer::mpz_allocator =
260    new pxx::ChunkAllocator<Integer::MpzContainer>(*allocator);
261#endif // !defined RFRT_WITHOUT_GMP
262  expr_allocator = new pxx::ChunkAllocator<ExprWrapper>(*allocator);
263  default_allocator.set(*allocator);
264  double start = clock ();
265  unexpected_fail = Expr::create<Word>("Unexpected fail");
266  for (AtStart* as = AtStart::first; as; as = as->next)
267  {
268    as->invoke();
269  }
270  if (init_StdIn) init_StdIn();
271  init_done = true;
272  D( printf("=== Init is done! ===\n"); )
273  Expr res;
274  try {
275    RF_CALL(rfrt::entry, /*void*/, res);
276  }
277  catch (Expr const& err) {
278    printf("\n$error: ");
279    err.writeln(stdout);
280    if (trap_stack_on) {
281      printf("\nBacktrace:\n\n");
282      res = stack->get_part(0, 0);
283      for (Term* p = res.get_first(); p < res.get_last(); p++)
284      {
285        Expr e(p);
286        Term* q = e.get_first();
287        uintptr_t n = (q++)->cast_to<Integer>()->to_int();
288        wchar_t const* fname;
289        (q++)->get_name(&fname);
290        printf("#%-2u %ls\n", n, fname);
291//        printf(q < e.get_last() ? ":\n" : "\n");
292        for (int i = 1; q < e.get_last(); q++, i++)
293        {
294          printf("      Arg %2d: ", i);
295          Expr(q).writeln(stdout);
296        }
297        printf("\n");
298      }
299    }
300  }
301  printf("Time elapsed: %.2fs\n", (clock () - start) / CLOCKS_PER_SEC);
302  return 0;
303}
304
Note: See TracBrowser for help on using the repository browser.