Lhogho
0.0.028
Main Page
Related Pages
Data Structures
Files
File List
Globals
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
113
inner_t
std_inner
;
114
inner_eof_t
std_inner_eof
;
115
outter_t
std_outter
;
116
int
outter_size
=0;
117
FILE*
input_stream
=
NULL
;
118
FILE*
output_stream
=
NULL
;
119
FILE*
dribble_handle
=
NULL
;
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
162
init_pool
( &
data_pool
,
ATOM_SIZE
);
163
init_pool
( &
data_pool_ex
,
ATOM_SIZE_EX
);
164
165
empty_list
= (
atom_t
)
take_from_pool
( &
data_pool
);
166
REF
(
empty_list
) = 1;
167
ID
(
empty_list
) =
LIST_ID
;
168
CAR
(
empty_list
) =
empty_list
;
169
CDR
(
empty_list
) =
empty_list
;
170
FLAGS
(
empty_list
) = 0;
171
}
172
173
174
175
176
//===================================================
181
//===================================================
182
void
finit_atoms
( )
183
{
184
return_to_pool
( &
data_pool
,
empty_list
);
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
//===================================================
206
atom_t
use
(
atom_t
a )
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
218
if
(
running_compiled_code
)
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
310
if
(
running_compiled_code
)
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
//===================================================
569
char_t
inner
( )
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