#include <sys/types.h>
#include <sys/stat.h>
#include <sys/wait.h>
#include <pwd.h>
#include <grp.h>
#include <regex.h>
#include <stdio.h>
#include <stdlib.h>
#include <errno.h>
#include <string.h>
#include <time.h>
#include <ctype.h>
#include <fcntl.h>
#include <unistd.h>
#include <limits.h>
#include <signal.h>
#include <libgen.h>
#include <dirent.h>
#include <netdb.h>
#include <sys/socket.h>
#include <netinet/in.h>

/*
 * Runtime-related.
 */

int num_globals;
void FUNCTION_0();
   
#define HASH_SIZE 512
#define POOL_INC 2048
#define GC_FREQUENCY 1000

#define type(n) ( n & 127 )
#define mark(n) ( n |= 128 )
#define unmark(n) ( n &= -129 )
#define ismarked(n) ( n & 128 )

#define length(n) ((int)n >> 8)
#define number(n) ((int)n >> 1 )
#define numberp(n) ((int)n & 1 )
#define toptr(n) ( struct atom *)(((n) << 1) | 1)

#define bzero(n,m) { char *ptr; int i; for( ptr = ( char *)n, i = m; i; --i ) *ptr++ = '\0'; }

#define GLOBAL(n) globals[ n ]
#define LOCAL(n) stack->values[ n ]
#define CLOSURE_REF(n) ( *stack->top )->data.closure[ n ]
#define TOS *stack->top
#define PUSH(n) stack_push( stack, n )
#define MAKE_STRING(s,l) make_atom_from_string( s, l, 1 )
#define MAKE_NUMBER(n) toptr(n)
#define MAKE_CLOSURE(f,n) make_closure( FUNCTION_ ## f , n )
#define HALT next = NULL; stack_pop( stack ); return
#define EXIT next = NULL; exit_status = number( stack_pop( stack ) ); return
#define RESET_STACK stack->free += stack->used; stack->top = stack->values; stack->used = 0
#define JUMP next = ( void (*)() )stack->values[ 0 ]->data.closure[ 0 ]; return
#define BEGIN_IF { struct atom *atom = stack_pop( stack ); \
   if ( ( numberp( atom ) ? number( atom ) : ( atom != empty_string_atom ))) {
#define ELSE } else {
#define END_IF } }

#define ATOM_STRING 1
#define ATOM_CLOSURE 2
#define ATOM_STACK 3
#define ATOM_REGEXP 4
#define ATOM_TABLE 5
#define ATOM_RECORD 6

struct string
{
   int free, used;
   char *top;
   char *str;
};

struct hash_elt
{
   struct atom *element, *binding;
   struct hash_elt *next;
};

struct atom
{
   char *syntax;
   int flags;

   union {
      struct atom **closure;
      struct stack *stack;
      struct hash_elt **table;
      regex_t *regexp;
      struct atom **record;
   } data;
};

struct stack
{
   int free, used;
   struct atom **top, **values;
};

struct atom *empty_string_atom, *atom_pool, *atom_pool_ptr, **globals;
struct string *working_string, *private_string;
struct stack *stack, *reclaimed_atoms, *atom_pool_stack, *working_stack,
   *descriptors[ 3 ];

char **first_arg, **last_arg, **arg_ptr;

struct hash_elt *atoms[ HASH_SIZE ];

void ( *next )();

int atom_pool_free, stack_inc, exit_status;

void *memory( int );

struct hash_elt **make_table();
struct atom *lookup_elt( struct hash_elt **, struct atom * );
void insert_elt( struct hash_elt **, struct atom *, struct atom * );
void remove_elt( struct hash_elt **, struct atom * );
struct stack *get_hash_keys( struct hash_elt ** );
struct stack *get_hash_values( struct hash_elt ** );

struct stack *make_stack();
struct atom *stack_pop( struct stack * );
void stack_push( struct stack *, struct atom * );
void stack_truncate( struct stack *, int );
void stack_clear( struct stack * );

struct string *make_string();
void string_append( struct string *, char );
void string_prepend( struct string *, char );
void string_erase( struct string *, int );
void string_clear( struct string * );
void string_assign( struct string *, char *, int );
void string_chop( struct string * );

struct atom *make_atom();
struct atom *make_atom_from_string( char *, int, int );
struct atom *make_atom_from_stack( struct stack * );
struct atom *make_atom_from_record( struct atom ** );
struct atom *make_atom_from_regexp( regex_t * );
struct atom *make_atom_from_table( struct hash_elt ** );

void mark_stack( struct atom * );
void mark_closure( struct atom * );
void mark_atom( struct atom * );
void mark_table( struct atom * );

void make_closure( void (*)(), int );

char *str_dup( char *, int );
struct atom *checked_global( int );

void resume_descriptor( int );

/*
 * Intrinsics-related.
 */
 
#define REDIRECT redirect()
#define RESUME resume_descriptor( number( *stack->top ) )
#define PIPE { int arg1; struct atom *arg2; arg2 = stack_pop( stack ); arg1 = number( *stack->top ); \
   pipe_open( "pipe", arg2->syntax, arg1 ); }

#define MIN(a,b) ( a < b ? a : b )

#define CURRENT stack_push( stack, make_atom_from_string( *arg_ptr, -1, 1 ))
#define NEXT stack_push( stack, ( arg_ptr < last_arg ? make_atom_from_string( *++arg_ptr, -1, 1 ) : toptr( 0 )))
#define PREVIOUS stack_push( stack, ( arg_ptr > first_arg ? make_atom_from_string( *--arg_ptr, -1, 1 ) : toptr( 0 )))
#define REWIND stack_push( stack, make_atom_from_string( *( arg_ptr = first_arg ), -1, 1 ))

#define EQ { struct atom *op2 = stack_pop( stack ); *stack->top = toptr(( *stack->top == op2 )); }

#define LT { int op2 = number( stack_pop( stack ) ); \
   *stack->top = toptr( number( *stack->top ) < op2 ); }

#define GT { int op2 = number( stack_pop( stack ) ); \
   *stack->top = toptr( number( *stack->top ) > op2 ); }

#define GTE { int op2 = number( stack_pop( stack ) ); \
   *stack->top = toptr( number( *stack->top ) >= op2 ); }

#define LTE { int op2 = number( stack_pop( stack ) ); \
   *stack->top = toptr( number( *stack->top ) <= op2 ); }

#define ADD { int op2 = number( stack_pop( stack ) ); \
   *stack->top = toptr( number( *stack->top ) + op2 ); }

#define SUB { int op2 = number( stack_pop( stack ) ); \
   *stack->top = toptr( number( *stack->top ) - op2 ); }

#define DIV { int op2 = number( stack_pop( stack ) ); \
   *stack->top = toptr( number( *stack->top ) / op2 ); }

#define MUL { int op2 = number( stack_pop( stack ) ); \
   *stack->top = toptr( number( *stack->top ) * op2 ); }

#define MOD { int op2 = number( stack_pop( stack ) ); \
   *stack->top = toptr( number( *stack->top ) % op2 ); }

#define ABS *stack->top = toptr( abs( number( *stack->top )) )

#define FORK stack_push( stack, toptr( fork() ));

#define DISPLAY { struct atom *atom = *stack->top; \
   if ( numberp( atom ) ) printf( "%d", number( atom )); \
   else fwrite( atom->syntax, length( atom->flags ), 1, stdout ); };

#define DISPLAY_ERROR { struct atom *atom = *stack->top; \
   if ( numberp( atom ) ) fprintf( stderr, "%d", number( atom )); \
   else fwrite( atom->syntax, length( atom->flags ), 1, stderr ); };

#define NEWLINE putc( '\n', stdout ); stack_push( stack, toptr( 1 ) )
#define NEWLINE_ERROR putc( '\n', stderr ); stack_push( stack, toptr( 1 ) )

#define STACK { int i = number( *stack->top ); *stack->top = make_atom_from_stack( make_stack() ); \
   while ( i-- ) stack_push( ( *stack->top )->data.stack, empty_string_atom ); }
#define USED *stack->top = toptr( ( *stack->top )->data.stack->used )

#define INDEX { int i = number( stack_pop( stack )); struct stack *s = ( *stack->top )->data.stack; \
   *stack->top = s->values[ i ]; }

#define TOPIDX { struct stack *s = ( *stack->top )->data.stack; *stack->top = toptr( s->used - 1 ); }

#define STORE { struct atom *atom = stack_pop( stack ); int i = number( stack_pop( stack ) ); \
   struct stack *s = ( *stack->top )->data.stack; s->values[ i ] = atom; }

#define STACK_PUSH { struct atom *atom = stack_pop( stack ); struct stack *s = ( *stack->top )->data.stack; \
   stack_push( s, atom ); }

#define STACK_POP *stack->top = stack_pop( ( *stack->top )->data.stack );

#define CLEAR ( *stack->top )->data.stack->free += ( *stack->top )->data.stack->used; \
   ( *stack->top )->data.stack->top = ( *stack->top )->data.stack->values; \
   ( *stack->top )->data.stack->used = 0;

#define SORT_NUMBERS qsort( ( *stack->top )->data.stack->values, ( *stack->top )->data.stack->used, sizeof( struct atom * ), compare_numbers )
#define SORT_STRINGS qsort( ( *stack->top )->data.stack->values, ( *stack->top )->data.stack->used, sizeof( int ), compare_strings )

#define LENGTH *stack->top = toptr( length( ( *stack->top )->flags ));

#define CHAR { char c = ( char )number( *stack->top ); *stack->top = make_atom_from_string( &c, 1, 1 ); }

#define CODE { char c = *( *stack->top )->syntax; *stack->top = toptr( c ); }

#define STRINGIFY { char n[ 32 ]; snprintf( n, sizeof( n ), "%d", number( *stack->top )); \
   *stack->top = make_atom_from_string( n, -1, 1 ); }

#define DIGITIZE { int n = atoi( ( *stack->top )->syntax ); *stack->top = toptr( n ); }

#define CHOP string_assign( working_string, ( *stack->top )->syntax, length( ( *stack->top )->flags )); \
   string_chop( working_string ); *stack->top = make_atom_from_string( working_string->str, working_string->used, 1 );

#define CHOMP { char *ptr; string_assign( working_string, ( *stack->top )->syntax, length( ( *stack->top )->flags )); \
   for( ptr = ( working_string->top - 1 ); ptr >= working_string->str; --ptr ) \
      if ( *ptr == '\n' || *ptr == '\r' ) string_chop( working_string ); \
   *stack->top = make_atom_from_string( working_string->str, working_string->used, 1 ); }

#define EXPLODE { struct stack *output = make_stack(); char *ptr; \
   string_assign( working_string, ( *stack->top )->syntax, length( ( *stack->top )->flags )); \
   for( ptr = working_string->str; ptr < working_string->top; ++ptr ) \
      stack_push( output, make_atom_from_string( ptr, 1, 1 )); \
   *stack->top = make_atom_from_stack( output ); }

#define SUBSTRING { int len1, len2, start; len2 = number( stack_pop( stack )); start = number( stack_pop( stack )); \
   len1 = length( ( *stack->top )->flags ) - start; \
   *stack->top = make_atom_from_string( &( *stack->top )->syntax[ start ], \
      ( len2 ? MIN( len1, len2 ) : len1 ), 1 ); }

#define CONCAT { int len, len2, len3; char *c; struct atom **ptr; \
   len = number( stack_pop( stack ) ); ptr = ( stack->top - ( len3 = --len )); \
   string_assign( working_string, ( *ptr )->syntax, length( ( *ptr )->flags ) ); \
   while( len-- ) { c = ( *++ptr )->syntax; len2 = length( ( *ptr )->flags ); \
   while( len2-- ) string_append( working_string, *c++ ); } \
   while( len3-- ) stack_pop( stack ); *stack->top = make_atom_from_string( working_string->str, working_string->used, 1 ); }
   
#define GETLINE { char buffer[ 4096 ]; *buffer = '\0'; \
   if ( fgets( buffer, sizeof( buffer ), stdin ) == NULL ) { \
      if ( feof( stdin ) ) stack_push( stack, toptr( 0 )); \
      else { fprintf( stderr, "getline: %s\n", strerror( errno )); \
         stack_push( stack, empty_string_atom ); } } \
   else stack_push( stack, make_atom_from_string( buffer, strlen( buffer ), 1 ) ); }

#define NUMBERP *stack->top = toptr( numberp( *stack->top ))
#define STRINGP *stack->top = toptr( ( numberp( *stack->top ) == 0 && type( ( *stack->top )->flags ) == ATOM_STRING ))
#define STACKP *stack->top = toptr( ( numberp( *stack->top ) == 0 && type( ( *stack->top )->flags ) == ATOM_STACK ))
#define TABLEP *stack->top = toptr( ( numberp( *stack->top ) == 0 && type( ( *stack->top )->flags ) == ATOM_TABLE ))
#define REGEXP *stack->top = toptr( ( numberp( *stack->top ) == 0 && type( ( *stack->top )->flags ) == ATOM_REGEXP )) 

#define SETENV { char *val = ( stack_pop( stack ) )->syntax; char *name = ( *stack->top )->syntax; \
   *stack->top = toptr( setenv( name, val, 1 ) ); }

#define GETENV { char *env = getenv( ( *stack->top )->syntax ); \
   *stack->top = ( env == NULL ? toptr( 0 ) : make_atom_from_string( env, -1, 1 ) ); }

#define SYSTEM *stack->top = toptr( system( ( *stack->top )->syntax ) )

#define TABLE stack_push( stack, make_atom_from_table( make_table() ))
#define ASSOCIATE { struct atom *obj = stack_pop( stack ), *key = stack_pop( stack ); \
   insert_elt( ( *stack->top )->data.table, key, obj ); }
#define DISSOCIATE { struct atom *key = stack_pop( stack ); remove_elt( ( *stack->top )->data.table, key ); }
#define LOOKUP { struct atom *key = stack_pop( stack ); *stack->top = lookup_elt( ( *stack->top )->data.table, key ); }
#define KEYS *stack->top = make_atom_from_stack( get_hash_keys( ( *stack->top )->data.table ))
#define VALUES *stack->top = make_atom_from_stack( get_hash_values( ( *stack->top )->data.table ))

#define SHIFT shift()
#define UNSHIFT unshift()
#define JOIN join( 0 )
#define JOIN_STACK join( 1 )
#define SPLIT split()
#define EXEC exec( 0 )
#define EXEC_STACK exec( 1 )
#define SUBSTACK substack()
#define APPEND append_stacks()

#define STRCMP { struct atom *a = stack_pop( stack ); \
   *stack->top = toptr( strcmp( ( *stack->top )->syntax, a->syntax ) ); }

#define REG_COMP regexp_comp()
#define REG_MATCH regexp_match( 0 )
#define REG_MATCHES regexp_match( 1 )
#define REG_SUBST regexp_substitute()

#define BASENAME *stack->top = make_atom_from_string( basename( ( *stack->top )->syntax ), -1, 1 )
#define DIRNAME *stack->top = make_atom_from_string( dirname( ( *stack->top )->syntax ), -1, 1 )

#define RANDOM *stack->top = toptr( ( int )( random() * ( double )number( *stack->top ) / RAND_MAX ))
#define DATE the_date()
#define TIME { char buffer[ 17 ]; snprintf( buffer, sizeof( buffer ), "%016d", time( NULL ) ); \
   stack_push( stack, make_atom_from_string( buffer, -1, 1 )); }

#define DIRECTORY directory()
#define RENAME file_rename()
#define REMOVE file_remove()
#define STAT file_stat()
#define SYMLINK file_symlink()

#define READCHARS readchars()
#define EXPAND_TABS expand_tabs()

#define MAKE_RECORD { int n = number( *stack->top ); \
   struct atom **ptr = ( struct atom **)memory( sizeof( struct atom * ) * n ); \
   *stack->top = make_atom_from_record( ptr ); }
#define GETFIELD { int n = number( stack_pop( stack ) ); *stack->top = ( *stack->top )->data.record[ n ]; }
#define SETFIELD { struct atom *obj = stack_pop( stack ); int n = number( stack_pop( stack ) ); \
   *stack->top = ( *stack->top )->data.record[ n ] = obj; }

int compare_numbers( const void *, const void * );
int compare_strings( const void *, const void * );

void join( int );
void split();

void exec( int );
void regexp_comp();
void regexp_match( int );
void regexp_substitute();

void redirect();
void pipe_open( char *, char *, int );

void the_date();

void readchars();
void directory();
void file_symlink();
void file_stat();
void file_remove();
void file_rename();
void expand_tabs();


syntax highlighted by Code2HTML, v. 0.9.1