102 #undef __STRICT_ANSI__
111 #include <sys/stat.h>
117 #if defined(WINDOWS) || defined(LINUX)
142 #define SRC_EXT_COUNT (sizeof source_extensions)/(sizeof source_extensions[0])
143 #define SRC_EXT (source_extensions[i])
279 int size = *(
int*)(code+ptr-8);
347 char* output_filename;
358 char* extension = output_filename+strlen(output_filename);
386 output_filename_chars =
UNFILENAME( output_filename );
388 outfile = fopen( output_filename,
"wb" );
389 if( errno )
return new_os_error( output_filename_chars );
392 #define BUF_SIZE 1024
400 while( (size = fread( buffer, 1,
BUF_SIZE, infile )) )
404 fwrite( buffer, 1, size, outfile );
405 if( errno )
return new_os_error( output_filename_chars );
415 while( (size = fread( buffer, 1,
BUF_SIZE, infile )) )
420 fwrite( buffer, 1, size, outfile );
421 if( errno )
return new_os_error( output_filename_chars );
427 fwrite( &source_size, 1, 4, outfile );
428 if( errno )
return new_os_error( output_filename_chars );
432 fwrite( &size, 1, 4, outfile );
433 if( errno )
return new_os_error( output_filename_chars );
436 if( errno )
return new_os_error( output_filename_chars );
438 chmod( output_filename, S_IRWXU );
439 if( errno )
return new_os_error( output_filename_chars );
486 typedef atom_t(*user_code_t)();
488 user_code_t func = (user_code_t)
ADDRESS(
function);
611 printf(
"<COMPILE> Compile ");
dump(
NAME(func));
630 printf(
"<COMPILE> Syntax tree built\n");
648 offset -=
sizeof(
atom_t );
652 printf(
"<COMPILE> Pass 1\n");
676 printf(
"<COMPILE> Pass 1 done!\n");
677 printf(
"<COMPILE> Code size=%d\n\n",ctx.
size);
678 printf(
"<COMPILE> Pass 2\n");
711 printf(
"<COMPILE> Pass 2 done!\n");
747 printf(
"<COMPILE> Re-compile external ");
dump(
NAME(func));
761 printf(
"<COMPILE> Pass 1\n");
771 printf(
"<COMPILE> Pass 1 done!\n");
772 printf(
"<COMPILE> Code size=%d\n\n",ctx.
size);
773 printf(
"<COMPILE> Pass 2\n");
787 printf(
"<COMPILE> Pass 2 done!\n");
813 printf(
"<COMPILE> Re-compile internal ");
dump(
NAME(func));
827 printf(
"<COMPILE> Pass 1\n");
837 printf(
"<COMPILE> Pass 1 done!\n");
838 printf(
"<COMPILE> Code size=%d\n\n",ctx.
size);
839 printf(
"<COMPILE> Pass 2\n");
852 printf(
"<COMPILE> Pass 2 done!\n");
1101 value_src =
CDR(params);
1167 atom_t value_src = params;
1190 atom_t value_src = params;
1238 atom_t condition_src = params;
1243 int has_else = !
IS_EMPTY(else_lisp);
1362 atom_t repcount_src = params;
1490 *(
STRING(cname)+1) = L
'^';
1511 atom_t x = commands_lisp;
1522 assert( control_var );
1526 *
STRING(step_name) = L
'^';
1587 condition_src =
CDR(
CDR(source));
1588 commands_lisp =
CAR(
CDR(source));
1592 condition_src =
CDR(source);
1831 #define RETURN_NO_CHECK(INSTR) \
1837 #define RETURN_NO_CHECK_EL(INSTR) \
1840 if( !IS_ERROR(result) ) result = empty_list;\
1844 #define RETURN_CHECK(INSTR) \
1854 int needs_check = 1;
1857 #ifdef DEBUG_COMPILE
1858 printf(
"<COMPILE> Compile expression: ");
dumpln(lisp);
1868 #ifdef DEBUG_COMPILE
1869 printf(
"<COMPILE> Normalized expression: ");
dumpln(lisp);
1872 printf(
"<COMPILE>It's source is: |");
1904 INFO(
"code for %a", lisp );
1994 if( addr==(
int)
rt_if )
2066 for( skip =
LARGS(var)+
RARGS(var); skip; skip-- )
2073 #ifdef DEBUG_COMPILE
2074 printf(
"<COMPILE> Compile parameter: ");
dumpln(
CAR(x));
2082 for( skip =
LARGS(var)+
RARGS(var); skip; skip-- )
2086 #ifdef DEBUG_COMPILE
2087 printf(
"<COMPILE> Compile parameter: ");
dumpln(
CAR(x));
2105 #ifdef DEBUG_COMPILE
2106 printf(
"<COMPILE> Compile parameter: ");
dumpln(
CAR(x));
2117 for( i=params-1; i>=0; i-- )
2191 #ifdef DEBUG_COMPILE
2192 printf(
"<COMPILE> Compile command: ");
dumpln(
CAR(x));
2202 #ifdef DEBUG_COMPILE
2203 printf(
"<COMPILE> Command compiled!\n");