Lhogho  0.0.028
 All Data Structures Files Functions Variables Typedefs Macros Pages
atoms.c
Go to the documentation of this file.
1 //
2 // Project: Lhogho
3 // File: atoms.c
4 //
5 // Copyright (C) 2007 P.Boytchev
6 //
7 // Revision history:
8 // 2006-09-28 - file created
9 // 2006-09-30 - adjusted to work with pools
10 // 2006-10-01 - new_word()
11 // - new_subword()
12 // 2006-10-07 - introduced *_t types
13 // 2006-10-08 - mbstowcs(), wcstombs(), load_file)
14 // 2006-10-10 - mbstowcs(), wcstombs(), load_file() moved
15 // to new unit util.c
16 // - changed debug and statistic macros
17 // - made statistics more detailed
18 // 2006-10-11 - removed ADVANCED macro
19 // 2006-10-11 - UNICODE macro
20 // - parse_data_list()
21 // 2006-10-13 - append()
22 // - list support in dump_atom()
23 // - fixed parse_data_list()
24 // - parse_data_list() moved to parser.c
25 // 2006-10-14 - fixed bug in dump of empty list
26 // 2006-10-26 - new_error()
27 // - error aroms supported by dump()
28 // 2006-10-27 - clearing flags in new_list()
29 // 2007-02-15 - removing EXPR and LISP types of lists
30 // 2007-02-25 - changed dump_atom() for error atoms
31 // - dump_stdout() accepts len==0
32 // 2007-02-26 - dump_atom() for parsed lists
33 // 2007-02-27 - new_var()
34 // - dump_atom() for vars
35 // - module renamed to ATOMS
36 // 2007-03-01 - fixed dump_atom() for vars
37 // - DEVELOPMENT macro is used
38 // 2007-03-18 - new_atom()
39 // - same_words()
40 // 2007-05-17 - license info
41 // 2007-05-22 - doxygen-friendly documentation
42 // 2007-05-27 - dumps error text of error atoms
43 // - behead()
44 // - added ERROR_VACUUM_TO_END, ERROR_WHERES_NAME
45 // to error_texts[]
46 // - new_error_atom accepts list input
47 // 2007-05-29 - dump function bodies
48 // - init_output(), use_stdout()
49 // - cfg_case_sensitive renamed to option_case_insensitive
50 // 2007-06-01 - added TR_ERROR_BEG_ME_PARDON to error_texts[]
51 // - error texts moved to errors.h
52 // - STATISTICS and DEVELOPMENT merged into ADVANCED
53 // - new_var() accepts anonymous vars
54 // 2007-06-05 - definitions spread to where they belong
55 // 2007-06-08 - Subwords can be used as host words
56 // 2007-06-09 - dump_integer(), dump_float(), dump_list(), dump_word()
57 // - word-related stuff moved to words module
58 // - number-related stuff moved to words module
59 // 2007-06-13 - fixed bug #1736021 "Alloc/dealloc statistics"
60 // 2007-06-19 - added mem atoms
61 // 2007-12-21 - fixed bug #1851865 Locale information not considered
62 // 2009-06-02 - added use_stdin()
63 // 2010-06-25 - added innereof()
64 // 2011-10-07 - Fixed problem with GCC 4+
65 //
66 //
67 // This program is free software; you can redistribute it and/or modify
68 // it under the terms of the GNU General Public License as published by
69 // the Free Software Foundation; either version 2 of the License, or
70 // (at your option) any later version.
71 //
72 // This program is distributed in the hope that it will be useful,
73 // but WITHOUT ANY WARRANTY; without even the implied warranty of
74 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
75 // GNU General Public License for more details.
76 //
77 // You should have received a copy of the GNU General Public License
78 // along with this program; if not, write to the Free Software
79 // Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
80 //
81 
82 
83 
84 #include "globals.h"
85 #ifdef UNICODE_CHARS
86 #include <wchar.h> // UNICODE support: wcslen()
87 #endif //UNICODE_CHARS
88 
89 #include <assert.h> // assert()
90 #include <errno.h> // errno, ENOMEM
91 #include <stdio.h> // fopen(), fread(), fclose()
92 #include <stdlib.h> // malloc()
93 #include <string.h> // memcpy()
94 #include <locale.h> // LC_ALL
95 
96 #include "atoms.h"
97 #include "numbers.h"
98 #include "words.h"
99 #include "lists.h"
100 #include "errors.h"
101 #include "mems.h"
102 #include "pools.h"
103 #include "unicode.h"
104 #include "translate.h"
105 #include "vars.h"
106 #include "parser.h"
107 #include "compiler.h"
108 #include "options.h"
109 
110 
111 
112 
116 int outter_size=0;
120 struct lconv *locale_info;
121 
122 
123 //===================================================
129 //===================================================
130 void init_atoms( )
131 {
132  #ifdef DEBUG_ATOM
133  printf("<ATOM> Atoms initialized\n");
134  #endif //DEBUG_ATOM
135 
136 //#ifdef __LP64__
137 //#warning Definitely 64 bit
138 //#endif
139 //#ifndef __LP64__
140 //#warning Maybe 32 bit
141 //#endif
142 
143  #ifdef ADVANCED
144  int i;
145  stats_free = 0;
146  stats_allocs = 0;
147  for( i=MIN_ID; i<MAX_ID; i++ )
148  {
149  stats[i].max = 0;
150  stats[i].allocs = 0;
151  stats[i].deallocs = 0;
152  }
153  #endif //ADVANCED
154 
155  #ifdef SAFEMODE
156  assert( sizeof(atomrec_t)==16 );
157  #endif
158 
159  //setlocale( LC_ALL, "" );
160  locale_info = localeconv();
161 
164 
166  REF(empty_list) = 1;
167  ID(empty_list) = LIST_ID;
170  FLAGS(empty_list) = 0;
171 }
172 
173 
174 
175 
176 //===================================================
181 //===================================================
182 void finit_atoms( )
183 {
185 
186  #ifdef DEBUG_MEMORY_LEAKS
187  dump_pool();
188  #endif
189 
190  #ifdef DEBUG_ATOM
191  printf("<ATOM> Atoms finalized\n");
192  #endif //DEBUG_ATOM
193 }
194 
195 
196 
197 
198 //===================================================
205 //===================================================
207 {
208  if( IS_UNBOUND(a) || IS_EMPTY(a) || IS_STOPPED(a) )
209  return a;
210 
211  //if( a==0x49f3b8)
212  //{
213  //printf("USE.BUG[%08x] ref %d->%d\n", (int)a, REF(a), REF(a)+1 );
214  //}
215 
216 
217  #ifdef DEBUG_RUNTIME_ATOMS
219  {
220  outter( TEXT("<RUNTIME> use "), -1 );
221  dump_atom_address( a );
222  dump_atom( a, 1 );
223  outter( TEXT("\n"), -1 );
224  }
225  #endif
226  #ifdef DEBUG_COMPILETIME_ATOMS
227  if( compiling_code )
228  {
229  outter( TEXT("<COMPILETIME> use "), -1 );
230  dump_atom_address( a );
231  dump_atom( a, 1 );
232  outter( TEXT("\n"), -1 );
233  }
234  #endif
235 
236  //if( IS_ERROR(a) )
237  // {
238  // printf("TO BE USEIT hex(a)=%x id=%d REF=%d a=",(int)a,ID(a),REF(a)); dumpln(a);
239  // }
240 
241  #ifdef SAFEMODE
242  assert( a );
243  assert( ID(a)<MAX_ID );
244  assert( REF(a)>=0 ); // 2009 was >0
245  #endif //SAFEMODE
246 
247  //if( IS_INTEGER(a) || IS_FLOAT(a))
248  //{
249  //printf("deuse[addr=%x ref=%d]\n",a,REF(a));
250  //printf("use atom="); dumpln(a);
251  //}
252 
253  REF(a)++;
254 
255  #ifdef DEBUG_ATOM
256  printf("<ATOM> [%08x] ref+1\n",(int)a);
257  #endif //DEBUG_ATOM
258  return a;
259 }
260 
261 
262 
263 
264 //===================================================
274 //===================================================
275 #define void void __attribute__ ((used,noinline,regparm(0),stdcall))
276 void deuse ( atom_t a )
277 #undef void
278 {
279  __asm__ volatile ( ASM_STORE_RESULT:::ASM_CLOBBER_REGISTERS );
280 
281  typedef void(*deleter_t)(atom_t);
282 
283  static deleter_t deleters[MAX_ID] = {
284  delete_numeric, // INTEGER_ID
285  delete_numeric, // FLOAT_ID
286  delete_list, // LIST_ID
287  delete_word, // WORD_ID
288  delete_subword, // SUBWORD_ID
289  delete_error, // ERROR_ID
290  delete_var, // VAR_ID
291  delete_mem, // MEM_ID
292  }; // array of deleter functions for each atom type
293 
294  //if( a==0x49f3b8)
295  //{
296  //printf("DEUSE.BUG[%08x] ref %d->%d\n", (int)a, REF(a), REF(a)-1 );
297  //}
298 
299  //if( IS_INTEGER(a) || IS_FLOAT(a))
300  // {
301  // //printf("deuse[addr=%x ref=%d]\n",(int)a,REF(a));
302  // printf("deuse atom="); dumpln(a);
303  // }
304 
305 
306  if( !IS_EMPTY(a) && !IS_UNBOUND(a) && !IS_STOPPED(a))
307  {
308  //printf("deuse "); dumpln(a);
309  #ifdef DEBUG_RUNTIME_ATOMS
311  {
312  outter( TEXT("<RUNTIME> deuse"), -1 );
313  dump_atom_address( a );
314  dump_atom( a, 1 );
315  outter( TEXT("\n"), -1 );
316  }
317  #endif
318  #ifdef DEBUG_COMPILETIME_ATOMS
319  if( compiling_code )
320  {
321  outter( TEXT("<COMPILETIME> deuse"), -1 );
322  dump_atom_address( a );
323  dump_atom( a, 1 );
324  outter( TEXT("\n"), -1 );
325  }
326  #endif
327 
328  //if( IS_ERROR(a) )
329  //{
330  //printf("TO BE DEUSE hex(a)=%x id=%d REF=%d a=",(int)a,ID(a),REF(a)); dumpln(a);
331  //}
332 
333  #ifdef SAFEMODE
334  assert( a );
335  //if(ID(a)>=MAX_ID) {printf("ASSERT[%x]\n",a);}
336  assert( (ID(a)<MAX_ID) );
337  assert( REF(a)>0 );
338  #endif // SAFEMODE
339  //printf("GOODY hex(a)=%x id=%d REF=%d\n\n",(int)a,ID(a),REF(a));
340 
341  if( !--REF(a) )
342  {
343  #ifdef DEBUG_ATOM
344  printf("<ATOM> [%08x] ref-1\n",(int)a);
345  #endif //DEBUG_ATOM
346 
347  #ifdef ADVANCED
348  stats[ID(a)].deallocs++;
349  stats_free++;
350  #endif //ADVANCED
351 
352  deleter_t deleter = deleters[ID(a)];
353  deleter(a);
354  }
355  }
356  __asm__ volatile ( ASM_RESTORE_RESULT:::ASM_CLOBBER_REGISTERS );
357 }
358 
359 
360 
361 
362 //===================================================
374 //===================================================
375 void dump_atom( atom_t a, int level )
376 {
377  typedef void(*dumper_t)(atom_t,int);
378 
379  static dumper_t dumpers[MAX_ID] = {
380  dump_integer, // INTEGER_ID
381  dump_float, // FLOAT_ID
382  dump_list, // LIST_ID
383  dump_word, // WORD_ID
384  dump_word, // SUBWORD_ID
385  dump_error, // ERROR_ID
386  dump_var, // VAR_ID
387  dump_mem, // MEM_ID
388  };
389 
390 
391  #ifdef SAFEMODE
392  assert( a );
393  //assert( outter );
394  if( IS_NOT_EMPTY(a) ) assert( ID(a)<MAX_ID );
395  #endif //SAFEMODE
396 
397  #ifdef DEBUG_REF_COUNT
398  if( IS_EMPTY(a) )
399  {
400  outter( TEXT("##"), 2 );
401  }
402  else
403  {
404  int n;
405  #define DUMP_BUF_SIZE 64
406  char_t buf[DUMP_BUF_SIZE];
407  n = SPRINTF( buf, DUMP_BUF_SIZE, TEXT(" %d#"), REF(a) );
408  outter( buf, n );
409  }
410  #endif
411 
412  dumper_t dumper = dumpers[ID(a)];
413  dumper(a,level);
414 }
415 
416 
417 
418 
419 //===================================================
426 //===================================================
427 void dump( atom_t a )
428 {
429  dump_atom( a, 0 );
430 }
431 
432 
433 
434 
435 //===================================================
443 //===================================================
444 void dumpln( atom_t a )
445 {
446  dump_atom( a, 0 );
447  outter( TEXT("\n"), 1 );
448 }
449 
450 
451 
452 
453 //===================================================
460 //===================================================
461 void init_output( outter_t new_outter )
462 {
463  std_outter = new_outter;
464 }
465 
466 
467 
468 
469 //===================================================
478 //===================================================
479 void init_input( inner_t new_inner, inner_eof_t new_inner_eof )
480 {
481  std_inner = new_inner;
482  std_inner_eof = new_inner_eof;
483 }
484 
485 
486 
487 //===================================================
495 //===================================================
496 void outter( chars_t string, int len )
497 {
498  if( output_stream==NULL )
499  {
500  std_outter( string, len );
501  }
502  else
503  {
504  if( len==-1 ) len = STRLEN( string );
505  for( ; len>0; len--, string++ )
506  {
507  int crlf = (DEBAR(*string)==0x0D) && (DEBAR(*(string+1))==0x0A);
508  if( !crlf )
509  {
510  char_t wc[2];
511  wc[0] = DEBAR(*string);
512  wc[1] = 0;
513 
514  char* buf =(char*) UTF16_to_UTF8(wc);
515  DEALLOC( buf );
516  fprintf( output_stream, "%S", wc );
517  }
518  }
519  }
520 
521  if( dribble_handle )
522  {
523  if( len==-1 ) len = STRLEN( string );
524  for( ; len>0; len--, string++ )
525  {
526  int crlf = (DEBAR(*string)==0x0D) && (DEBAR(*(string+1))==0x0A);
527  if( !crlf )
528  {
529  char_t wc[2];
530  wc[0] = DEBAR(*string);
531  wc[1] = 0;
532 
533  char* buf =(char*) UTF16_to_UTF8(wc);
534  DEALLOC( buf );
535  fprintf( dribble_handle, "%S", wc );
536  }
537  }
538  }
539 
540 }
541 
542 
543 //===================================================
548 //===================================================
549 int inner_eof( )
550 {
551  if( input_stream==NULL )
552  {
553  return std_inner_eof();
554  }
555  else
556  {
557  return feof(input_stream)?1:0;
558  }
559 }
560 
561 
562 //===================================================
568 //===================================================
570 {
571  if( input_stream==NULL )
572  {
573  char_t ch = std_inner();
574 
575  if( dribble_handle )
576  {
577  fprintf( dribble_handle, "%C", (wint_t)ch );
578  }
579 
580  return ch;
581  }
582  else
583  {
584  char_t ch;
585  //ch = GETCHAR( input_stream );
586  //while( ch=='\r' ) ch = GETCHAR( input_stream ); // remove ^M from input, keep ^J
587 
588  ch = (char_t)getc( input_stream );
589  while( ch=='\r' ) ch = (char_t)getc( input_stream ); // remove ^M from input, keep ^J
590  return ch;
591  }
592 }

[ HOME | INDEX | ATOMS | VARS | REFERENCE ]
Lhogho Developer's Documentation
Wed Jul 10 2013