176 #include <sys/stat.h>
177 #include <sys/types.h>
185 #include <mmsystem.h>
188 #define dlopen(a,b) LoadLibrary(a)
189 #define dlclose(a) FreeLibrary(a)
190 #define dlsym(h,a) GetProcAddress(h,a)
217 #define test_elem_and_destroy_if_error(elem, list) \
219 if (IS_ERROR(elem)) \
227 #define ARGUMENT *pdata
228 #define EACH_ARGUMENT pdata=(atom_t*)(&data+data); (int*)pdata>&data; pdata--
232 ((X == 0) ? 0 : (X < 0 ? -1 : 1))
235 #define ZERO_PRECISION 1e-10
236 #define MAX_NUMBER_WORD_LENGTH 64
237 #define MAX_WORD_LENGTH 4096
239 #define CHECK_PARAM(param) if( IS_ERROR(param) ) RETURN(USE(param))
242 #define RUNTIME __attribute__((used,noinline,regparm(0),cdecl))
293 for( i=0; i<FOPEN_MAX; i++ )
313 for( i=0; i<FOPEN_MAX; i++ )
314 if( file_handles[i]==handle )
336 #define rt_makechk __attribute__((used,noinline,regparm(0),stdcall)) rt_makechk
393 #define rt_cmdchk __attribute__((used,noinline,regparm(0),stdcall)) rt_cmdchk
444 #define rt_exprchk __attribute__((used,noinline,regparm(0),stdcall)) rt_exprchk
488 #define rt_boolchk __attribute__((used,noinline,regparm(0),stdcall)) rt_boolchk
531 #define rt_funchk __attribute__((used,noinline,regparm(0),stdcall)) rt_funchk
559 return (
USE(data) );
588 #define rt_repchk __attribute__((used,noinline,regparm(0),stdcall)) rt_repchk
652 #define rt_forchk __attribute__((used,noinline,regparm(0),stdcall)) rt_forchk
732 step_f = (to_f >= from_f) ? 1 : -1;
743 DEUSE( *step_value );
749 if ((to_f >= from_f) && (step_f > 0))
750 cnt = floor( (to_f - from_f) / step_f ) + 1;
752 if ((to_f <= from_f) && (step_f < 0))
753 cnt = floor( (to_f - from_f) / step_f ) + 1;
1064 x += 0.5 *
SIGN( x );
1224 x = (x / 180) * M_PI;
1297 x = (x / 180) * M_PI;
1384 x = (x * 180) / M_PI;
1492 return (
rt_make( static_link, parent, value, name ));
1535 *localsp =
new_list( var, *localsp );
1557 if (x < y)
return -1;
1558 if (y < x)
return 1;
1583 while (w1_len && w2_len)
1595 while (w1_len && w2_len)
1605 return w1_len - w2_len;
1638 data1 =
CDR( data1 );
1639 data2 =
CDR( data2 );
1662 int case_ignore = 0;
1669 (
ID( data1 ) !=
ID( data2 )))
1877 int case_ignore = 0;
1886 word_x =
STRING( data1 );
1900 word_y =
STRING( data2 );
1984 #define rt_dump __attribute__((used,noinline,regparm(0),stdcall)) rt_dump
2013 #define rt_predump __attribute__((used,noinline,regparm(0),stdcall)) rt_predump
2413 if (
LENGTH( data ) < ind)
2564 #define rt_whlchk __attribute__((used,noinline,regparm(0),stdcall)) rt_whlchk
2608 #define void void __attribute__ ((used,noinline,regparm(0),stdcall))
2624 DEUSE( *chain_ptr );
2630 *chain_ptr =
new_list( node, *chain_ptr );
2645 #define void atom_t __attribute__ ((used,noinline,regparm(0),stdcall))
2657 assert(
IS_LIST( *chain_ptr ) );
2660 *chain_ptr =
behead( *chain_ptr );
2695 frame = *((
int*) (frame));
2735 #define void void __attribute__ ((used,noinline,regparm(0),stdcall))
2751 DEUSE( *chain_ptr );
2757 *chain_ptr =
new_list( node, *chain_ptr );
2965 elem_ch =
DEBAR( buff[0] );
2974 comp_buffer =
STRING( data );
2975 buff_len =
LENGTH( data );
2988 if (
DEBAR( comp_buffer[buff_len] ) == elem_ch)
3018 int total_length = 0, real_length = 0;
3031 total_length +=
LENGTH( ARGUMENT );
3049 real_length +=
LENGTH( ARGUMENT );
3061 real_length += buff_len;
3066 if (real_length != total_length)
3341 #ifdef UNICODE_CHARS
3344 if (x < 0 || x > ((1 << 16) - 1))
3354 if (x < 0 || x > 255)
3392 #ifdef UNICODE_CHARS
3410 #ifdef UNICODE_CHARS
3466 for (i = 0; i <
LENGTH( res ); ++i)
3514 for (i = 0; i <
LENGTH( res ); ++i)
3577 elem_ch =
DEBAR( buff[0] );
3586 comp_buffer =
STRING( data );
3587 buff_len =
LENGTH( data );
3599 while (pos < buff_len)
3601 if (
DEBAR( comp_buffer[pos] ) == elem_ch)
3635 atom_t list_start, list_end;
3643 for (; first >= last; --first)
3648 for (; first <= last; ++first)
3681 if (cnt <= 0 || (cnt == 1 && first != last))
3689 for (step = cnt > 1 ? (first - last) / (cnt - 1) : 0; cnt > 0; --cnt, first -= step)
3696 for (step = cnt > 1 ? (last - first) / (cnt - 1) : 0; cnt > 0; --cnt, first += step)
3724 int rand_num = rand( );
3750 else if (count == 2)
3758 if (start > end || start < 0)
3788 else if (count == 0)
3914 GET_INT( precision, num_prec );
3918 format =
TEXT(
"%*.*lf" );
3925 format =
STRING( width );
3926 SPRINTF( buff, buff_len, format, number );
3934 buff_len =
STRLEN( buff );
3959 if (elem[0] ==
TEXT(
'%' ))
3969 while (*elem ==
TEXT(
'l' ) || *elem ==
TEXT(
'u' ) || *elem ==
TEXT(
'h' ))
4010 case TEXT(
'd' ) :
case TEXT(
'i' ) :
case TEXT(
'u' ) :
4012 case TEXT(
'x' ) :
case TEXT(
'X' ) :
case TEXT(
'o' ) :
4023 case TEXT(
'e' ) :
case TEXT(
'E' ) :
4024 case TEXT(
'g' ) :
case TEXT(
'G' ) :
4026 case TEXT(
'a' ) :
case TEXT(
'A' ) :
4038 case TEXT(
'c' ) :
case TEXT(
'C' ) :
4072 case TEXT(
's' ) :
case TEXT(
'S' ) :
4113 buff_len =
STRLEN( buff );
4150 time_t time = time64;
4155 presult = gmtime( &time );
4307 for (i = 0; i <
LEVEL( parent ) -
LEVEL( var ) + 1; i++)
4351 for (i = 0; i <
LEVEL( parent ) -
LEVEL( var ) + 1; i++)
4356 *varptr =
USE( value );
4373 #define rt_use_var __attribute__((used,noinline,regparm(0),stdcall)) rt_use_var
4502 #define rt_check_inputs __attribute__((used,noinline,regparm(0),stdcall)) rt_check_inputs
4505 #undef rt_check_inputs
4510 for( ; inputs>0; inputs-- )
4516 if( res==
unbound ) res = data;
4557 wait_time = (wait_time * 1000) / 60;
4560 wait_time = (wait_time * 1000 * 1000) / 60;
4561 usleep( wait_time );
4813 res_iter =
CDR( res_iter );
4836 total = len =
LENGTH(data1);
4840 for (i = 0; i < total-1; ++i)
4842 for (j = i+1; j < total; ++j)
4853 for (i = 0; i < total; ++i)
4855 for (j = i+1; j < total; ++j)
4864 STRING(result)[len++] = word[i];
4870 for (i = 0; i < total-1; ++i)
4872 for (j = i+1; j < total; ++j)
4883 for (i = 0; i < total; ++i)
4885 for (j = i+1; j < total; ++j)
4894 STRING(result)[len++] = word[i];
4943 res_iter =
CDR( res_iter );
4981 total = len =
LENGTH(data1);
4986 for (i = 0; i < total; ++i)
4995 for (i = 0; i < total; ++i)
4999 STRING(result)[len++] = word[i];
5006 for (i = 0; i < total; ++i)
5008 if (
DEBAR(word[i])==ch)
5015 for (i = 0; i < total; ++i)
5017 if (
DEBAR(word[i])!=ch)
5019 STRING(result)[len++] = word[i];
5072 for (i = 0; i < n; ++i)
5110 #ifdef UNICODE_CHARS
5128 #ifdef UNICODE_CHARS
5157 int num_len, temp, temp_len;
5160 sym[0] =
TEXT(
'G' );
5162 num_len = (int) log10( num ) + 1;
5165 for (temp = num, temp_len = num_len; temp_len > 0; --temp_len, temp /= 10)
5167 sym[temp_len] =
TEXT(
'0' ) + temp % 10;
5189 int case_ignore = 0;
5228 for (pos = 0; pos +
LENGTH( data1 ) <=
LENGTH( data2 ); ++pos)
5261 int case_ignore = 0;
5294 for (pos = 0; pos +
LENGTH( data1 ) <=
LENGTH( data2 ); ++pos)
5485 #define rt_catchchk __attribute__((used,noinline,regparm(0),stdcall)) rt_catchchk
5618 procedure =
CAR( source );
5625 result =
new_list( message, result );
5819 if (n >
RARGS( var ))
5829 result =
new_list( element, result );
5842 append( element, &result, &reslast );
5852 append( element, &result, &reslast );
5892 result =
rt_text( static_link, parent, data );
6059 #define rt_runresult_fix __attribute__((used,noinline,regparm(0),stdcall)) rt_runresult_fix
6062 #undef rt_runresult_fix
6099 printf(
"<TO-END-RUNTIME> DEFINING=" );
6107 LARGS(
function ) = 0;
6108 RARGS(
function ) = 0;
6122 lefts =
CAR( rights );
6123 rights =
CDR( rights );
6128 printf(
"<TO-END-RUNTIME> LEFT PARAMS=" );
6130 printf(
"<TO-END-RUNTIME> RIGHT PARAMS=" );
6153 LARGS(
function )++;
6155 assert(
LARGS(
function ) < 255 );
6157 lefts =
CDR( lefts );
6179 RARGS(
function )++;
6181 assert(
RARGS(
function ) < 255 );
6183 rights =
CDR( rights );
6187 printf(
"<TO-END-RUNTIME> FUNC DEF=" );
6199 offset +=
sizeof (
atom_t);
6223 printf(
"<TO-END-RUNTIME> FUNC BODY=" );
6263 NAME(
function ) =
USE( word );
6271 SOURCE(
function ) = body;
6276 printf(
"<TO-END> DEFINED FUNCTION " );
6278 printf(
"<TO-END> SOURCE " );
6280 printf(
"<TO-END> BODY " );
6282 printf(
"<TO-END> TREE " );
6340 int len =
LENGTH( data );
6342 char filename[len + 1+3+1+2];
6351 for (; i < len; i++) filename[i] = *(ptr++);
6352 filename[len] =
'\0';
6362 handle = dlopen( filename, RTLD_LAZY );
6369 char buf[PATH_MAX+1];
6371 char* path = dirname(buf);
6372 int pathlen = strlen(path);
6373 strncpy(buf,path,pathlen);
6375 int filelen = strlen(filename);
6376 if( pathlen+filelen+6 > PATH_MAX ) filelen=0;
6378 strncpy(buf+pathlen,
"\\lib\\",5);
6380 strncpy(buf+pathlen,
"/lib/",5);
6382 strncpy(buf+5+pathlen,filename,filelen);
6383 buf[pathlen+5+filelen] =
'\0';
6386 handle = dlopen( buf, RTLD_LAZY );
6408 dlclose( (
void*) (
int) x );
6469 ATOMS(memory) = size;
6471 void* ptr =
MEMORY( memory );
6514 ptr = (
void*)(
int)addr;
6564 ptr = (
void*)(
int)addr;
6654 prototype =
CDR( prototype );
6656 int c_type =
get_c_type( static_link, parent, type );
6657 int class =
c_types[c_type].class;
6672 atom_t external_name =
CAR( prototype );
6673 prototype =
CDR( prototype );
6688 type =
CAR( prototype );
6689 c_type =
get_c_type( static_link, parent, type );
6690 class =
c_types[c_type].class;
6701 if(
OFFSET(param)==offset )
6709 offset -=
sizeof(
atom_t );
6720 int len =
LENGTH( external_name );
6722 char func_name[len + 1];
6724 for (i = 0; i < len; i++) func_name[i] = *(ptr++);
6725 func_name[len] =
'\0';
6727 void* address = dlsym( (
void*)hnd, func_name );
6734 ADDRESS( var ) = (int)address;
6779 prototype =
CDR( prototype );
6781 int c_type =
get_c_type( static_link, parent, type );
6782 int class =
c_types[c_type].class;
6805 type =
CAR( prototype );
6806 c_type =
get_c_type( static_link, parent, type );
6807 class =
c_types[c_type].class;
6818 if(
OFFSET(param)==offset )
6826 offset -=
sizeof(
atom_t );
6865 static_link = *(
int*) ((
char*) static_link + base);
6897 static_link = *(
int*) ((
char*) static_link + base);
6989 file_handles[i] = fopen(
file_names[i], mode );
6995 file_handles[i] =
NULL;
7118 FILE *h = file_handles[index];
7125 file_handles[index] =
NULL;
7177 sizeatom =
USE(size);
7200 ATOMS(data) = sizeatom;
7405 buffer =
REALLOC( buffer, (bufsize+bufstep)*
sizeof(
char_t) );
7407 bufsize = bufsize+bufstep;
7408 bufstep = bufstep+1;
7411 *(buffer+buflen) = ch;
7496 varname[
LENGTH(word)] =
'\0';
7498 char* asciivalue = getenv( varname );
7533 char** env = environ;
7535 char** env = __environ;
7542 while( (*v!=
'=') && (*v!=
'\n') ) v++;
7591 char path[PATH_MAX+1];
7593 char* p = getcwd( path, PATH_MAX );
7630 err = mkdir( fname );
7632 err = mkdir( fname, (S_IRWXU|S_IRWXG|S_IRWXO) );
7667 int err = rmdir( fname );
7701 int err = chdir( fname );
7737 int err = stat( fname, &buffer );
7779 int err = stat( fname, &buffer );
7783 ok = S_ISDIR(buffer.st_mode);
7785 ok = S_ISREG(buffer.st_mode);
7788 err = rename( fname, tname );
7874 int err = stat( fname, &buffer );
7875 if( !err && S_ISDIR(buffer.st_mode) )
7881 dp = opendir( fname );
7884 char long_name[PATH_MAX];
7885 int len = strlen( fname );
7886 strcpy( long_name, fname );
7887 long_name[len] =
'/';
7896 strcpy( long_name+len, de->d_name );
7897 int err = stat(long_name,&buffer);
7902 ok = S_ISDIR(buffer.st_mode);
7904 ok = S_ISREG(buffer.st_mode);
7909 append( word, &res, &last );
7984 int err = unlink( fname );
8021 int err = stat( fname, &buffer );
8057 int err = stat( fname, &buffer );
8096 int err = stat( fname, &buffer );
8345 for( i=0; i<FOPEN_MAX; i++ )
8346 if( file_handles[i] )
8352 append( word, &res, &last );
8371 for( i=0; i<FOPEN_MAX; i++ )
8372 if( file_handles[i] )
8375 fclose( file_handles[i] );
8377 file_handles[i] =
NULL;