Lhogho  0.0.028
 All Data Structures Files Functions Variables Typedefs Macros Pages
runtime.c File Reference

Go to the source code of this file.

Macros

#define test_elem_and_destroy_if_error(elem, list)
 Check if element is error and if destroy the list. More...
 
#define ARGUMENT   *pdata
 
#define EACH_ARGUMENT   pdata=(atom_t*)(&data+data); (int*)pdata>&data; pdata--
 
#define SIGN(X)   ((X == 0) ? 0 : (X < 0 ? -1 : 1))
 
#define ZERO_PRECISION   1e-10
 
#define MAX_NUMBER_WORD_LENGTH   64
 
#define MAX_WORD_LENGTH   4096
 
#define CHECK_PARAM(param)   if( IS_ERROR(param) ) RETURN(USE(param))
 
#define RUNTIME   __attribute__((used,noinline,regparm(0),cdecl))
 default attributes of runtime functions More...
 
#define rt_makechk   __attribute__((used,noinline,regparm(0),stdcall)) rt_makechk
 
#define rt_cmdchk   __attribute__((used,noinline,regparm(0),stdcall)) rt_cmdchk
 
#define rt_exprchk   __attribute__((used,noinline,regparm(0),stdcall)) rt_exprchk
 
#define rt_boolchk   __attribute__((used,noinline,regparm(0),stdcall)) rt_boolchk
 
#define rt_funchk   __attribute__((used,noinline,regparm(0),stdcall)) rt_funchk
 
#define rt_repchk   __attribute__((used,noinline,regparm(0),stdcall)) rt_repchk
 
#define rt_forchk   __attribute__((used,noinline,regparm(0),stdcall)) rt_forchk
 
#define rt_dump   __attribute__((used,noinline,regparm(0),stdcall)) rt_dump
 
#define rt_predump   __attribute__((used,noinline,regparm(0),stdcall)) rt_predump
 
#define rt_whlchk   __attribute__((used,noinline,regparm(0),stdcall)) rt_whlchk
 
#define void   void __attribute__ ((used,noinline,regparm(0),stdcall))
 
#define void   atom_t __attribute__ ((used,noinline,regparm(0),stdcall))
 
#define void   void __attribute__ ((used,noinline,regparm(0),stdcall))
 
#define rt_use_var   __attribute__((used,noinline,regparm(0),stdcall)) rt_use_var
 
#define rt_check_inputs   __attribute__((used,noinline,regparm(0),stdcall)) rt_check_inputs
 
#define rt_catchchk   __attribute__((used,noinline,regparm(0),stdcall)) rt_catchchk
 
#define rt_runresult_fix   __attribute__((used,noinline,regparm(0),stdcall)) rt_runresult_fix
 

Functions

void rt_set_var_value (int static_link, atom_t parent, atom_t var, atom_t value)
 sets var's value in the local stacks More...
 
void init_runtime ()
 initializes the Runtime module More...
 
void finit_runtime ()
 finalizes the Runtime module More...
 
int find_file_by_filename (char *filename)
 search log by filename More...
 
int find_file_by_handle (FILE *handle)
 search log by handlee More...
 
atom_t rt_makechk (atom_t source, atom_t data)
 checks for valid result of a MAKE command More...
 
atom_t rt_cmdchk (atom_t source, atom_t data)
 checks for valid result of a command More...
 
atom_t rt_exprchk (atom_t source, atom_t data)
 checks for valid result of an expression More...
 
atom_t rt_boolchk (atom_t source, atom_t data)
 checks for valid boolean value More...
 
atom_t rt_funchk (atom_t source, atom_t data)
 checks for valid result of a function More...
 
atom_t rt_repchk (atom_t source, atom_t data)
 checks for valid repetition count More...
 
atom_t rt_forchk (atom_t source, atom_t *step_value, atom_t step, atom_t to, atom_t from)
 checks for valid repetition count More...
 
atom_t RUNTIME rt_print (atom_t pdl, atom_t pwl, atom_t fpp, int data)
 implementation of primitive PRINT More...
 
atom_t RUNTIME rt_plus (int count, atom_t data2, atom_t data1)
 implementation of primitive operator + More...
 
atom_t RUNTIME rt_minus (int count, atom_t data2, atom_t data1)
 implementation of primitive operator - More...
 
atom_t RUNTIME rt_mul (atom_t data2, atom_t data1)
 implementation of primitive operator * More...
 
atom_t RUNTIME rt_div (atom_t data2, atom_t data1)
 implementation of primitive operator / More...
 
atom_t RUNTIME rt_sum (int data)
 implementation of aritmetic primitive SUM More...
 
atom_t RUNTIME rt_difference (atom_t data2, atom_t data1)
 implementation of aritmetic primitive DIFFERENCE More...
 
atom_t RUNTIME rt_unminus (atom_t data)
 implementation of aritmetic unary primitive MINUS More...
 
atom_t RUNTIME rt_product (int data)
 implementation of aritmetic primitive PRODUCT More...
 
atom_t RUNTIME rt_remainder (atom_t data2, atom_t data1)
 implementation of aritmetic primitive REMAINDER More...
 
atom_t RUNTIME rt_int (atom_t data)
 implementation of aritmetic unary primitive INT More...
 
atom_t RUNTIME rt_round (atom_t data)
 implementation of aritmetic unary primitive ROUND More...
 
atom_t RUNTIME rt_sqrt (atom_t data)
 implementation of aritmetic unary primitive SQRT More...
 
atom_t RUNTIME rt_power (atom_t power, atom_t base)
 implementation of aritmetic primitive POWER More...
 
atom_t RUNTIME rt_exp (atom_t power)
 implementation of aritmetic primitive EXP More...
 
atom_t RUNTIME rt_log10 (atom_t data)
 implementation of aritmetic primitive LOG10 More...
 
atom_t RUNTIME rt_ln (atom_t data)
 implementation of aritmetic primitive LN More...
 
atom_t RUNTIME rt_abs (atom_t data)
 implementation of aritmetic primitive ABS More...
 
atom_t RUNTIME rt_pi (void)
 implementation of aritmetic primitive PI More...
 
atom_t RUNTIME rt_sin (atom_t data)
 implementation of aritmetic primitive SIN More...
 
atom_t RUNTIME rt_radsin (atom_t data)
 implementation of aritmetic primitive RADSIN More...
 
atom_t RUNTIME rt_cos (atom_t data)
 implementation of aritmetic primitive COS More...
 
atom_t RUNTIME rt_radcos (atom_t data)
 implementation of aritmetic primitive RADCOS More...
 
atom_t RUNTIME rt_arctan (int count, atom_t data2, atom_t data1)
 implementation of aritmetic primitive ARCTAN More...
 
atom_t RUNTIME rt_radarctan (int count, atom_t data2, atom_t data1)
 implementation of aritmetic primitive RADARCTAN More...
 
atom_t RUNTIME rt_make (int static_link, atom_t parent, atom_t value, atom_t name)
 implementation of primitive command MAKE More...
 
atom_t RUNTIME rt_name (int static_link, atom_t parent, atom_t name, atom_t value)
 implementation of primitive command NAME More...
 
atom_t RUNTIME rt_local (int static_link, atom_t parent, int data)
 dummy implementation of primitive command LOCAL More...
 
int num_compare (float64_t x, float64_t y)
 compares two numbers. More...
 
int word_compare (int cip, chars_t w1, int w1_len, chars_t w2, int w2_len)
 compares two words. More...
 
int atom_equal (atom_t cip, atom_t data2, atom_t data1)
 compares two atoms. More...
 
int list_equal (atom_t cip, atom_t data1, atom_t data2)
 compares two lists. More...
 
atom_t RUNTIME rt_equal (atom_t cip, atom_t data2, atom_t data1)
 implementation compare operation EQUALP More...
 
atom_t RUNTIME rt_nequal (atom_t cip, atom_t data2, atom_t data1)
 implementation compare operation NOTEQUALP More...
 
atom_t RUNTIME rt_less (atom_t data2, atom_t data1)
 implementation compare operation LESSP More...
 
atom_t RUNTIME rt_more (atom_t data2, atom_t data1)
 implementation compare operation GREATERP More...
 
atom_t RUNTIME rt_lesseq (atom_t data2, atom_t data1)
 implementation compare operation LESSEQUALP More...
 
atom_t RUNTIME rt_moreeq (atom_t data2, atom_t data1)
 implementation compare operation GREATEREQUALP More...
 
atom_t RUNTIME rt_before (atom_t cip, atom_t data2, atom_t data1)
 implementation compare operation BEFOREP More...
 
atom_t RUNTIME rt_output (atom_t data)
 dummy implementation of primitive command OUTPUT More...
 
atom_t RUNTIME rt_maybeoutput (atom_t data)
 dummy implementation of primitive command MAYBEOUTPUT More...
 
atom_t RUNTIME rt_stop ()
 dummy implementation of primitive command STOP More...
 
atom_t rt_dump (atom_t source)
 dump source command More...
 
atom_t rt_predump (atom_t source)
 dump source command More...
 
atom_t RUNTIME rt_and (int data)
 implementation of boolean primitive AND More...
 
atom_t RUNTIME rt_or (int data)
 implementation of boolean primitive OR More...
 
atom_t RUNTIME rt_not (atom_t data)
 implementation of boolean primitive NOT More...
 
atom_t RUNTIME rt_ignore (atom_t data)
 implementation of primitive IGNORE More...
 
atom_t RUNTIME rt_first (atom_t data)
 implementation of primitive FIRST More...
 
atom_t RUNTIME rt_butfirst (atom_t data)
 implementation of primitive BUTFIRST More...
 
atom_t RUNTIME rt_firsts (atom_t data)
 implementation of primitive FIRSTS More...
 
atom_t RUNTIME rt_butfirsts (atom_t data)
 implementation of primitive BUTFIRSTS and BFS More...
 
atom_t RUNTIME rt_last (atom_t data)
 implementation of primitive LAST More...
 
atom_t RUNTIME rt_butlast (atom_t data)
 implementation of primitive BUTALST More...
 
atom_t RUNTIME rt_item (atom_t data, atom_t index)
 implementation of primitive ITEM More...
 
atom_t RUNTIME rt_if (int count)
 dummy implementation of primitive command IF More...
 
atom_t RUNTIME rt_repeat (atom_t repcount, atom_t commands)
 dummy implementation of primitive command REPEAT More...
 
atom_t RUNTIME rt_while (atom_t condition, atom_t commands)
 dummy implementation of primitive command WHILE More...
 
atom_t RUNTIME rt_dowhile (atom_t commands, atom_t condition)
 
atom_t RUNTIME rt_until (atom_t condition, atom_t commands)
 dummy implementation of primitive command UNTIL More...
 
atom_t RUNTIME rt_dountil (atom_t commands, atom_t condition)
 dummy implementation of primitive command UNTIL More...
 
atom_t rt_whlchk (atom_t source, atom_t data)
 checks for valid while condition More...
 
void rt_repeat_enter (int frame, int count)
 initializes a repeat loop More...
 
void rt_repeat_exit (int frame)
 finalizes a repeat loop More...
 
atom_t RUNTIME rt_repcount (int frame)
 implementation of primitive function REPCOUNT More...
 
atom_t RUNTIME rt_forever (atom_t commands)
 dummy implementation of primitive command FOREVER More...
 
void rt_forever_enter (int frame)
 initializes a forever loop More...
 
atom_t RUNTIME rt_parse (atom_t data)
 implementation of PARSE More...
 
atom_t RUNTIME rt_runparse (atom_t data)
 implementation of RUNPARSE More...
 
atom_t RUNTIME rt_wordp (atom_t data)
 implementation of WORDP More...
 
atom_t RUNTIME rt_listp (atom_t data)
 implementation of LISTP More...
 
atom_t RUNTIME rt_numberp (atom_t data)
 implementation of NUMBERP More...
 
atom_t RUNTIME rt_empty (atom_t data)
 implementation of EMPTYP More...
 
atom_t RUNTIME rt_memberp (atom_t cip, atom_t data, atom_t elem)
 implementation of MEMBERP More...
 
atom_t RUNTIME rt_word (int data)
 implementation of constructor primitive WORD More...
 
atom_t RUNTIME rt_list (int data)
 implementation of constructor primitive LIST More...
 
atom_t RUNTIME rt_sent (int data)
 implementation of constructor primitive SE More...
 
atom_t RUNTIME rt_fput (atom_t data2, atom_t data1)
 implementation of constructor primitive FPUT More...
 
atom_t RUNTIME rt_lput (atom_t data2, atom_t data1)
 implementation of constructor primitive LPUT More...
 
atom_t RUNTIME rt_count (atom_t data)
 implementation of querie primitive COUNT More...
 
atom_t RUNTIME rt_char (atom_t data)
 implementation of querie primitive CHAR More...
 
atom_t RUNTIME rt_ascii (atom_t data)
 implementation of querie primitive ASCII More...
 
atom_t RUNTIME rt_lower (atom_t data)
 implementation of querie primitive LOWERCASE More...
 
atom_t RUNTIME rt_upper (atom_t data)
 implementation of querie primitive UPPERCASE More...
 
atom_t RUNTIME rt_member (atom_t cip, atom_t data, atom_t elem)
 implementation of MEMBER More...
 
atom_t RUNTIME rt_iseq (atom_t to, atom_t from)
 implementation of ISEQ More...
 
atom_t RUNTIME rt_rseq (atom_t count, atom_t to, atom_t from)
 implementation of RSEQ More...
 
atom_t RUNTIME rt_random (int count, atom_t data2, atom_t data1)
 implementation of aritmetic primitive RANDOM More...
 
atom_t RUNTIME rt_rerandom (int count, atom_t seed)
 implementation of primitive RERANDOM More...
 
atom_t RUNTIME rt_show (atom_t pdl, atom_t pwl, atom_t fpp, int data)
 implementation of primitive SHOW More...
 
atom_t RUNTIME rt_type (atom_t pdl, atom_t pwl, atom_t fpp, int data)
 implementation of primitive TYPE More...
 
atom_t RUNTIME rt_form (atom_t precision, atom_t width, atom_t num)
 implementation of primitive FORM More...
 
char_t RUNTIME get_format (chars_t string)
 extracts format specifier More...
 
atom_t RUNTIME rt_format (atom_t format, atom_t data)
 implementation of primitive FORMAT More...
 
atom_t RUNTIME rt_formattime (atom_t format, atom_t data)
 implementation of primitive FORMATTIME More...
 
atom_t RUNTIME rt_definedp (int static_link, atom_t parent, atom_t data)
 implementation of DEFINED? More...
 
atom_t RUNTIME rt_primitivep (int static_link, atom_t parent, atom_t data)
 implementation of PRIMITIVE? More...
 
atom_t RUNTIME rt_namep (int static_link, atom_t parent, atom_t data)
 implementation of NAME? More...
 
atom_t RUNTIME rt_procedurep (int static_link, atom_t parent, atom_t data)
 implementation of PROCEDURE? More...
 
atom_t rt_var_value (int static_link, atom_t parent, atom_t var)
 searches var's value in the local stacks More...
 
atom_t rt_use_var (atom_t source, atom_t value)
 checks the value of a variable More...
 
atom_t RUNTIME rt_thing (int static_link, atom_t parent, atom_t data)
 implementation of THING More...
 
atom_t RUNTIME rt_reference (int static_link, atom_t parent, atom_t data)
 implementation of : More...
 
atom_t rt_check_inputs (int stack_frame)
 check inputs params More...
 
atom_t RUNTIME rt_bye (void)
 implementation of command BYE More...
 
atom_t RUNTIME rt_wait (atom_t time)
 implementation of command WAIT More...
 
atom_t RUNTIME rt_ashift (atom_t bits, atom_t num)
 implementation of primitive command ASHIFT More...
 
atom_t RUNTIME rt_lshift (atom_t bits, atom_t num)
 implementation of primitive command LSHIFT More...
 
atom_t RUNTIME rt_bitand (int data)
 implementation of primitive command BITAND More...
 
atom_t RUNTIME rt_bitor (int data)
 implementation of primitive command BITOR More...
 
atom_t RUNTIME rt_bitxor (int data)
 implementation of primitive command BITXOR More...
 
atom_t RUNTIME rt_bitnot (atom_t data)
 implementation of primitive command BITNOT More...
 
atom_t RUNTIME rt_pick (atom_t list)
 implementation of primitive command PICK More...
 
atom_t RUNTIME rt_remdup (atom_t cip, atom_t data)
 implementation of primitive command REMDUP More...
 
atom_t RUNTIME rt_remove (atom_t cip, atom_t data, atom_t elem)
 implementation of primitive command REMOVE More...
 
atom_t RUNTIME rt_reverse (atom_t data)
 implementation of primitive command REVERSE More...
 
atom_t RUNTIME rt_rawascii (atom_t data)
 implementation of querie primitive RAWASCII More...
 
atom_t RUNTIME rt_gensym ()
 implements primitive function GENSYM More...
 
atom_t RUNTIME rt_substringp (atom_t cip, atom_t data2, atom_t data1)
 implements primitive predicate SUBSTRINGP More...
 
atom_t RUNTIME rt_substring (atom_t cip, atom_t data2, atom_t data1)
 implements primitive SUBSTRING More...
 
atom_t RUNTIME rt_combine (atom_t data2, atom_t data1)
 implementation of constructor primitive COMBINE More...
 
atom_t RUNTIME rt_quoted (atom_t data)
 implementation of primitive function QUOTED More...
 
atom_t RUNTIME rt_throw (int count, atom_t data1, atom_t data2)
 implementation of primitive THROW More...
 
atom_t RUNTIME rt_catch (atom_t commands, atom_t tag)
 dummy implementation of primitive command CATCH More...
 
atom_t rt_catchchk (int status, atom_t tag, atom_t data)
 checks for valid result of a catch More...
 
atom_t RUNTIME rt_error ()
 implementation of primitive function ERROR More...
 
atom_t RUNTIME rt_tag ()
 dummy implementation of primitive command TAG More...
 
atom_t RUNTIME rt_goto (int static_link, atom_t parent, atom_t data, atom_t source)
 implementation of primitive command GOTO More...
 
atom_t RUNTIME rt_iftrue (atom_t commands)
 dummy implementation of primitive command IFTRUE More...
 
atom_t RUNTIME rt_iffalse (atom_t commands)
 dummy implementation of primitive command IFFALSE More...
 
atom_t RUNTIME rt_test (atom_t condition, int frame)
 implementation of primitive command TEST More...
 
atom_t RUNTIME rt_backslashedp (atom_t data)
 implementation of primitive BACKSLASHED? More...
 
atom_t RUNTIME rt_text (int static_link, atom_t parent, atom_t data)
 implementation of TEXT More...
 
atom_t RUNTIME rt_fulltext (int static_link, atom_t parent, atom_t data)
 implementation of FULLTEXT More...
 
atom_t RUNTIME rt_run (int static_link, atom_t parent, atom_t data, int mode)
 implementation of RUN More...
 
atom_t RUNTIME rt_runmacro (int static_link, atom_t parent, atom_t data, int mode)
 implementation of RUNMACRO More...
 
atom_t RUNTIME rt_runresult (int static_link, atom_t parent, atom_t data)
 implementation of RUNRESULT More...
 
atom_t rt_runresult_fix (atom_t data)
 fixes the result of RUNRESULT More...
 
atom_t RUNTIME rt_define (int static_link, atom_t parent, atom_t value, atom_t name)
 implementation of primitive command DEFINE More...
 
atom_t RUNTIME rt_for (atom_t body, atom_t limits, atom_t var)
 dummy implementation of primitive command FOR More...
 
atom_t RUNTIME rt_libload (atom_t data)
 implementation of primitive LIBLOAD More...
 
atom_t RUNTIME rt_libfree (atom_t data)
 implementation of primitive LIBFREE More...
 
atom_t RUNTIME rt_blocksize (int static_link, atom_t parent, atom_t prototype)
 implementation of PACKSIZE More...
 
atom_t RUNTIME rt_listtoblock (int static_link, atom_t parent, atom_t prototype, atom_t data)
 implementation of LISTTOBLOCK More...
 
atom_t RUNTIME rt_blocktolist (int static_link, atom_t parent, atom_t prototype, atom_t data)
 implementation of PACK More...
 
atom_t RUNTIME rt_dataaddr (atom_t data)
 implementation of DATAADDR More...
 
atom_t RUNTIME rt_listintoblock (int static_link, atom_t parent, atom_t prototype, atom_t dest, atom_t data)
 implementation of PACKTO More...
 
atom_t RUNTIME rt_funcaddr (int static_link, atom_t parent, atom_t data)
 implementation of FUNVADDR More...
 
atom_t RUNTIME rt_external (int static_link, atom_t parent, atom_t handle, atom_t prototype, atom_t name)
 implementation of EXTERNAL More...
 
atom_t RUNTIME rt_internal (int static_link, atom_t parent, atom_t prototype, atom_t name)
 implementation of INTERNAL More...
 
atom_t RUNTIME rt_stackframe (int static_link, atom_t parent, atom_t offset, atom_t frame)
 implementation of _STACKFRAME More...
 
atom_t RUNTIME rt_stackframeatom (int static_link, atom_t parent, atom_t offset, atom_t frame)
 implementation of _STACKFRAMEATOM More...
 
atom_t RUNTIME rt_int3 ()
 dummy implementation of debug command _INT3 More...
 
atom_t RUNTIME rt_load (atom_t data)
 implementation of LOAD More...
 
atom_t RUNTIME rt_commandline ()
 implementation of COMMANDLINE More...
 
atom_t RUNTIME rt_openfile_mode (atom_t filename, char *mode, int call_mode)
 used by OPEN* functions More...
 
atom_t RUNTIME rt_openfile (atom_t mode, atom_t filename, int call_mode)
 implementation of OPENFILE More...
 
atom_t RUNTIME get_file_index (atom_t file, int *index)
 get file index More...
 
atom_t RUNTIME rt_closefile (atom_t file)
 implementation of CLOSEFILE More...
 
atom_t RUNTIME rt_readblock (int static_link, atom_t parent, atom_t size)
 implementation of READBLOCK More...
 
atom_t RUNTIME rt_readinblock (atom_t block, int call_mode)
 implementation of READINBLOCK More...
 
atom_t RUNTIME rt_writeblock (atom_t data)
 implementation of WRITEBLOCK More...
 
atom_t RUNTIME rt_readchar (void)
 implementation of primitive function readchar More...
 
atom_t RUNTIME rt_readchars (atom_t data)
 implementation of primitive function readchars More...
 
atom_t RUNTIME rt_readrawline (void)
 implementation of primitive function readrawline More...
 
atom_t RUNTIME rt_readword (void)
 implementation of primitive function readword More...
 
atom_t RUNTIME rt_readlist (void)
 implementation of primitive function readlist More...
 
atom_t RUNTIME rt_getenv (atom_t data)
 implementation of GETENV More...
 
atom_t RUNTIME rt_getenvs ()
 implementation of GETENVS More...
 
atom_t RUNTIME rt_eofp (void)
 implementation of primitive function eof? More...
 
atom_t RUNTIME rt_currentfolder (void)
 implementation of primitive function currentfolder More...
 
atom_t RUNTIME rt_makefolder (atom_t name)
 implementation of primitive function makefolder More...
 
atom_t RUNTIME rt_erasefolder (atom_t name)
 implementation of primitive function erasefolder More...
 
atom_t RUNTIME rt_changefolder (atom_t name)
 implementation of primitive function changefolder More...
 
atom_t RUNTIME rt_folderp (atom_t name)
 implementation of primitive function folder? More...
 
atom_t RUNTIME rt_renamefolder_or_file (atom_t toname, atom_t fromname, int folders)
 implementation of primitive function renamefolder More...
 
atom_t RUNTIME rt_renamefolder (atom_t toname, atom_t fromname)
 implementation of primitive function renamefolder More...
 
atom_t RUNTIME rt_renamefile (atom_t toname, atom_t fromname)
 implementation of primitive function renamefile More...
 
atom_t RUNTIME rt_folders_or_files (atom_t name, int folders)
 scans a folder More...
 
atom_t RUNTIME rt_folders (atom_t name)
 implementation of primitive function folders More...
 
atom_t RUNTIME rt_files (atom_t name)
 implementation of primitive function files More...
 
atom_t RUNTIME rt_erasefile (atom_t name)
 implementation of primitive function erasefile More...
 
atom_t RUNTIME rt_filep (atom_t name)
 implementation of primitive function file? More...
 
atom_t RUNTIME rt_filesize (atom_t name)
 implementation of primitive function filesize More...
 
atom_t RUNTIME rt_filetimes (atom_t name)
 implementation of primitive function filetimes More...
 
atom_t RUNTIME rt_openread (atom_t name, int call_mode)
 implementation of primitive function openread More...
 
atom_t RUNTIME rt_openwrite (atom_t name, int call_mode)
 implementation of primitive function openwrite More...
 
atom_t RUNTIME rt_openappend (atom_t name, int call_mode)
 implementation of primitive function openappend More...
 
atom_t RUNTIME rt_openupdate (atom_t name, int call_mode)
 implementation of primitive function openupdate More...
 
atom_t RUNTIME rt_setread (atom_t file)
 implementation of SETREAD More...
 
atom_t RUNTIME rt_setwrite (atom_t file)
 implementation of SETWRITE More...
 
atom_t RUNTIME rt_reader ()
 implementation of READER More...
 
atom_t RUNTIME rt_writer ()
 implementation of WRITER More...
 
atom_t RUNTIME rt_allopen ()
 implementation of ALLOPEN More...
 
atom_t RUNTIME rt_closeall ()
 implementation of CLOSEALL More...
 
atom_t RUNTIME rt_setreadpos (atom_t pos)
 implementation of SETREADPOS More...
 
atom_t RUNTIME rt_readpos ()
 implementation of READPOS More...
 
atom_t RUNTIME rt_setwritepos (atom_t pos)
 implementation of SETWRITEPOS More...
 
atom_t RUNTIME rt_writepos ()
 implementation of WRITEPOS More...
 
atom_t RUNTIME rt_timezone ()
 implementation of TIMEZONE More...
 
atom_t RUNTIME rt_nodribble ()
 implementation of NODRIBBLE More...
 
atom_t RUNTIME rt_dribble (atom_t file)
 implements prmitive DRIBBLE More...
 

Variables

char * file_names [FOPEN_MAX] = { [0 ... (FOPEN_MAX-1)]=NULL }
 Array of names of opened files. More...
 
FILE * file_handles [FOPEN_MAX] = { [0 ... (FOPEN_MAX-1)]=NULL }
 Array of handles of opened files. More...
 

Macro Definition Documentation

#define test_elem_and_destroy_if_error (   elem,
  list 
)
Value:
{ \
if (IS_ERROR(elem)) \
{ \
DEUSE (list); \
RETURN (elem); \
} \
}

Definition at line 217 of file runtime.c.

#define ARGUMENT   *pdata

Definition at line 234 of file runtime.c.

#define EACH_ARGUMENT   pdata=(atom_t*)(&data+data); (int*)pdata>&data; pdata--

Definition at line 235 of file runtime.c.

#define SIGN (   X)    ((X == 0) ? 0 : (X < 0 ? -1 : 1))

Definition at line 238 of file runtime.c.

#define ZERO_PRECISION   1e-10

Definition at line 242 of file runtime.c.

#define MAX_NUMBER_WORD_LENGTH   64

Definition at line 243 of file runtime.c.

#define MAX_WORD_LENGTH   4096

Definition at line 244 of file runtime.c.

#define CHECK_PARAM (   param)    if( IS_ERROR(param) ) RETURN(USE(param))

Definition at line 246 of file runtime.c.

#define RUNTIME   __attribute__((used,noinline,regparm(0),cdecl))

Definition at line 249 of file runtime.c.

#define rt_makechk   __attribute__((used,noinline,regparm(0),stdcall)) rt_makechk

Definition at line 343 of file runtime.c.

#define rt_cmdchk   __attribute__((used,noinline,regparm(0),stdcall)) rt_cmdchk

Definition at line 400 of file runtime.c.

#define rt_exprchk   __attribute__((used,noinline,regparm(0),stdcall)) rt_exprchk

Definition at line 451 of file runtime.c.

#define rt_boolchk   __attribute__((used,noinline,regparm(0),stdcall)) rt_boolchk

Definition at line 495 of file runtime.c.

#define rt_funchk   __attribute__((used,noinline,regparm(0),stdcall)) rt_funchk

Definition at line 538 of file runtime.c.

#define rt_repchk   __attribute__((used,noinline,regparm(0),stdcall)) rt_repchk

Definition at line 595 of file runtime.c.

#define rt_forchk   __attribute__((used,noinline,regparm(0),stdcall)) rt_forchk

Definition at line 659 of file runtime.c.

#define rt_dump   __attribute__((used,noinline,regparm(0),stdcall)) rt_dump

Definition at line 1991 of file runtime.c.

#define rt_predump   __attribute__((used,noinline,regparm(0),stdcall)) rt_predump

Definition at line 2020 of file runtime.c.

#define rt_whlchk   __attribute__((used,noinline,regparm(0),stdcall)) rt_whlchk

Definition at line 2571 of file runtime.c.

#define void   void __attribute__ ((used,noinline,regparm(0),stdcall))

Definition at line 2742 of file runtime.c.

#define void   atom_t __attribute__ ((used,noinline,regparm(0),stdcall))

Definition at line 2742 of file runtime.c.

#define void   void __attribute__ ((used,noinline,regparm(0),stdcall))

Definition at line 2742 of file runtime.c.

#define rt_use_var   __attribute__((used,noinline,regparm(0),stdcall)) rt_use_var

Definition at line 4380 of file runtime.c.

#define rt_check_inputs   __attribute__((used,noinline,regparm(0),stdcall)) rt_check_inputs

Definition at line 4509 of file runtime.c.

#define rt_catchchk   __attribute__((used,noinline,regparm(0),stdcall)) rt_catchchk

Definition at line 5492 of file runtime.c.

#define rt_runresult_fix   __attribute__((used,noinline,regparm(0),stdcall)) rt_runresult_fix

Definition at line 6066 of file runtime.c.

Function Documentation

void rt_set_var_value ( int  static_link,
atom_t  parent,
atom_t  var,
atom_t  value 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
varthe variable
valuethe value

This function looks for a variable somewhere in stack frames and sets it value. If the variable is global do not scan the stack.

Definition at line 4335 of file runtime.c.

4338  {
4339  //printf("VALUE IS VAR ATOM\n");
4340  //printf("var = "); dumpln(var);
4341  //printf("old value="); dumpln(VALUE(var));
4342  //printf("new value="); dumpln(value);
4343  DEUSE( VALUE( var ) );
4344  VALUE( var ) = USE( value );
4345  //printf("new value="); dumpln(VALUE(var));
4346  return;
4347  }
4348 
4349  //printf("VALUE IN STACK\n");
4350  int i;
4351  for (i = 0; i < LEVEL( parent ) - LEVEL( var ) + 1; i++)
4352  static_link = *(int*) ((char*) static_link + BASE_OFFSET_STATIC);
4353 
4354  atom_t* varptr = (atom_t*) ((char*) static_link + OFFSET( var ));
4355  DEUSE( *varptr );
4356  *varptr = USE( value );
4357 }
4358 
4359 
4360 
4361 //===================================================
void init_runtime ( )

So far nothing to be initialized

Definition at line 263 of file runtime.c.

272 {
void finit_runtime ( )

Deallocates all names of unclosed files and closes them.

Definition at line 278 of file runtime.c.

290 {
int find_file_by_filename ( char *  filename)
Parameters
filenamename of a file
Returns
index of found filename; -1 if not found

Searches file_names for the string in filename and return its index in the array. If not found returns -1.

Definition at line 296 of file runtime.c.

311 {
int find_file_by_handle ( FILE *  handle)
Parameters
handlehandle of a file
Returns
index of found file; -1 if not found

Searches file_handles for a given handle and return its index in the array. If not found returns -1.

Definition at line 317 of file runtime.c.

340 {
atom_t rt_makechk ( atom_t  source,
atom_t  data 
)
Parameters
sourcesource of the command
datavalue to check
Returns
error or unbound atom

Checks whether the result of a MAKE is valid. Returns error atom if the result is error or unbound. Otherwise returns unbound atom. The source parameter points to the source where the make is called. It is used to locate the error position in case of errors.

Definition at line 345 of file runtime.c.

353  {
354  outter( TEXT( "DONE " ), -1 );
355  dumpln( source );
356  }
357 #endif
358 
359  if (IS_UNBOUND( data ))
360  {
361  return new_error( ERROR_MISSING_VALUE, source );
362  }
363 
364  if (IS_ERROR( data ))
365  {
366  add_error_source( data, source );
367  return USE( data );
368  }
369 
370  // this unbound should not be USE()'d, because
371  // it is used only for checking -- it is not
372  // stored anywhere
373  return unbound;
374 }
375 
376 
377 
378 
379 //===================================================
atom_t rt_cmdchk ( atom_t  source,
atom_t  data 
)
Parameters
sourcesource of the command
datavalue to check
Returns
error or unbound atom

Checks whether the result of a command is valid. Returns error atom if the result is error or not unbound. Otherwise returns unbound atom. The source parameter points to the source where the command is called. It is used to locate the error position in case of errors.

Definition at line 402 of file runtime.c.

411  {
412  outter( TEXT( "DONE " ), -1 );
413  dumpln( source );
414  }
415 #endif
416  if (IS_UNBOUND( data ) || IS_STOPPED( data ))
417  return data;
418 
419  if (IS_ERROR( data ))
420  {
421  add_error_source( data, source );
422  return USE( data );
423  }
424 
425  DEUSE( data );
426  return new_error( ERROR_UNUSED_VALUE, source );
427 }
428 
429 
430 
431 
432 //===================================================
atom_t rt_exprchk ( atom_t  source,
atom_t  data 
)
Parameters
sourcesource of the expression
datavalue to check
Returns
error or unbound atom

Checks whether the result of an expression is valid. Actually any result is valid. Thus this function is used only to add new error position or dump the source if -Zrt option is on.

Definition at line 453 of file runtime.c.

461  {
462  outter( TEXT( "DONE " ), -1 );
463  dumpln( source );
464  }
465 #endif
466 
467  if (IS_ERROR( data ))
468  {
469  add_error_source( USE( data ), source );
470  }
471 
472  return data;
473 }
474 
475 
476 
477 
478 //===================================================
atom_t rt_boolchk ( atom_t  source,
atom_t  data 
)
Parameters
sourcesource of the command
datavalue to check
Returns
error, true or false atom

Checks whether the value is true or false. If not then returns an error atom.

Definition at line 497 of file runtime.c.

498  {
499  add_error_source( data, source );
500  return USE( data );
501  }
502 
503  int b;
504  if (atom_to_boolean( data, &b ))
505  {
506  DEUSE( data );
507  return ( false_true[b]);
508  }
509 
510  DEUSE( data );
511  return new_error( ERROR_BOOLEAN_EXPECTED, source );
512 }
513 
514 
515 
516 
517 //===================================================
atom_t rt_funchk ( atom_t  source,
atom_t  data 
)
Parameters
datavalue to check
sourcesource of the function
Returns
error or unbound atom

Checks whether the result of a function is valid. Returns error atom if the result is error or unbound. Otherwise returns the same atom. The source parameter points to the source where the function is called. It is used to locate the error position in case of errors.

Definition at line 540 of file runtime.c.

548  {
549  outter( TEXT( "EVAL " ), -1 );
550  dump( source );
551  outter( TEXT( " = " ), 3 );
552  dumpln( data );
553  }
554 #endif
555 
556  if (IS_ERROR( data ))
557  {
558  add_error_source( data, source );
559  return ( USE(data) );
560  }
561 
562  if (!IS_UNBOUND( data ))
563  return data;
564 
565 
566  DEUSE( data );
567  return new_error( ERROR_MISSING_VALUE, source );
568 }
569 
570 
571 
572 
573 //===================================================
atom_t rt_repchk ( atom_t  source,
atom_t  data 
)
Parameters
datavalue to check
sourcesource of the expression
Returns
error or unbound atom

Checks whether the number of repetition in a repeat command is valid. Returns error atom if the result is error, unbound or invalid. Otherwise returns an integer atom containing the number of repetitions. The source parameter points to the source where the expression is called. It is used to locate the error position in case of errors.

Definition at line 597 of file runtime.c.

602  {
603  add_error_source( data, source );
604  return USE( data );
605  }
606 
607  if (IS_UNBOUND( data ))
608  {
609  DEUSE( data );
610  return new_error( ERROR_MISSING_VALUE, source );
611  }
612 
613  int64_t cnt;
614  if (!atom_to_int( data, &cnt ))
615  {
616  DEUSE( data );
617  return new_error( ERROR_NOT_AN_INTEGER, source );
618  }
619 
620  DEUSE( data );
621 
622  if (cnt > INT_MAX)
623  return new_error( ERROR_TOO_BIG_NUMBER, source );
624 
625  if (cnt < 0)
626  return new_error( ERROR_TOO_SMALL_NUMBER, source );
627 
628  return new_integer( cnt );
629 }
630 
631 
632 
633 
634 //===================================================
atom_t rt_forchk ( atom_t  source,
atom_t step_value,
atom_t  step,
atom_t  to,
atom_t  from 
)
Parameters
frominitial value
tofinal value
stepstep value (could be UNBOUND)
step_valuepointer to step value
sourcesource of the expression
Returns
error or unbound atom

Calculates the number of repetition in a for command. Returns error atom if the result is error, unbound or invalid. Otherwise returns an integer atom containing the number of repetitions. The source parameter points to the source where the expression is called. It is used to locate the error position in case of errors.

Definition at line 661 of file runtime.c.

670  {
671  DEUSE( to );
672  DEUSE( step );
673  add_error_source( from, source );
674  return USE( from );
675  }
676 
677  if (IS_UNBOUND( from ))
678  {
679  //DEUSE( from ); /// ???
680  DEUSE( to );
681  DEUSE( step );
682  return new_error( ERROR_MISSING_VALUE, source );
683  }
684 
685  if (!atom_to_float( from, &from_f ))
686  {
687  //DEUSE( from );
688  DEUSE( to );
689  DEUSE( step );
690  return new_error( ERROR_NOT_A_NUMBER, source );
691  }
692 
693 
694  // process the final value
695  if (IS_ERROR( to ))
696  {
697  DEUSE( from );
698  DEUSE( step );
699  add_error_source( to, CDR( source ) );
700  return USE( to );
701  }
702 
703  if (IS_UNBOUND( to ))
704  {
705  DEUSE( from );
706  //DEUSE( to );
707  DEUSE( step );
708  return new_error( ERROR_MISSING_VALUE, CDR( source ) );
709  }
710 
711  if (!atom_to_float( to, &to_f ))
712  {
713  //DEUSE( from );
714  DEUSE( to );
715  DEUSE( step );
716  return new_error( ERROR_NOT_A_NUMBER, CDR( source ) );
717  }
718 
719 
720 
721  // process the step
722  if (IS_ERROR( step ))
723  {
724  DEUSE( from );
725  DEUSE( to );
726  add_error_source( step, CDR( CDR( source ) ) );
727  return USE( step );
728  }
729 
730  if (IS_UNBOUND( step ))
731  {
732  step_f = (to_f >= from_f) ? 1 : -1;
733  }
734  else
735  if (!atom_to_float( step, &step_f ))
736  {
737  //DEUSE( from );
738  DEUSE( to );
739  DEUSE( step );
740  return new_error( ERROR_NOT_A_NUMBER, CDR( CDR( source ) ) );
741  }
742 
743  DEUSE( *step_value );
744  *step_value = new_float( step_f );
745  //printf("FOR from=%f to=%f step=%f\n",from_f,to_f,step_f);
746 
747  int64_t cnt;
748 
749  if ((to_f >= from_f) && (step_f > 0))
750  cnt = floor( (to_f - from_f) / step_f ) + 1;
751  else
752  if ((to_f <= from_f) && (step_f < 0))
753  cnt = floor( (to_f - from_f) / step_f ) + 1;
754  else
755  cnt = 0;
756 
757  //DEUSE( from );
758  DEUSE( to );
759  DEUSE( step );
760 
761  //printf(" repeat count=%Ld\n",cnt);
762  //printf("---<<< end of RT_FOR_CHK >>>---\n");
763 
764  return new_integer( cnt );
765 }
766 
767 
768 
769 
770 //===================================================
atom_t rt_print ( atom_t  pdl,
atom_t  pwl,
atom_t  fpp,
int  data 
)
Parameters
pdlvalue of PRINTDEPTHLIMIT
pwlvalue of PRINTWIDTHLIMIT
fppvalue of FULLPRINTP
datanumber of inputs of PRINT

Implements the primitive PRINT. The only input contains the number of inputs which are pulled out from the stack.

Definition at line 790 of file runtime.c.

797  {
799  dump( ARGUMENT );
800  outter( TEXT( " " ), 1 );
801  };
802  outter( TEXT( "\n" ), 1 );
803  RETURN( unbound );
804 }
805 
806 
807 
808 //===================================================
atom_t rt_plus ( int  count,
atom_t  data2,
atom_t  data1 
)
Parameters
countnumber of inputs of +
data1first input
data2second input
Returns
Number atom - sum of its arguments

Implements the primitive operator +. If + is used as infix operator, then count=2, otherwise count=1 and only data2 input is used.

Definition at line 828 of file runtime.c.

853 {
atom_t rt_minus ( int  count,
atom_t  data2,
atom_t  data1 
)
Parameters
countnumber of inputs of -
data1first input
data2second input
Returns
Number atom - diference of its arguments

Implements the primitive operator -. If - is used as infix operator, then count=2, otherwise count=1 and only data2 input is used.

Definition at line 859 of file runtime.c.

881 {
atom_t rt_mul ( atom_t  data2,
atom_t  data1 
)
Parameters
data1first input
data2second input
Returns
Number atom - product of it's arguments

Implements the primitive operator *.

Definition at line 887 of file runtime.c.

903 {
atom_t rt_div ( atom_t  data2,
atom_t  data1 
)
Parameters
data1first input
data2second input
Returns
Number atom - quotient of it's arguments

Implements the primitive operator /.

Definition at line 909 of file runtime.c.

926 {
atom_t rt_sum ( int  data)
Parameters
datanumber of inputs of SUM
Returns
Number atom - sum of all arguments

Implements the primitive SUM. The only input contains the number of inputs which are pulled out from the stack. Returns their sum

Definition at line 932 of file runtime.c.

932  {
933  GET_FLOAT( ARGUMENT, x );
934  acc += x;
935  }
936  RETURN( new_float( acc ) );
937 }
938 
939 
940 //===================================================
atom_t rt_difference ( atom_t  data2,
atom_t  data1 
)
Parameters
data1first input
data2second input
Returns
Number atom - difference of arguments

Implements the aritmetic primitive DIFFERENCE

Definition at line 957 of file runtime.c.

972 {
atom_t rt_unminus ( atom_t  data)
Parameters
dataargument
Returns
Number atom - negate of the argument

Implements the aritmetic primitive MINUS

Definition at line 978 of file runtime.c.

993 {
atom_t rt_product ( int  data)
Parameters
datanumber of inputs of PRODUCT
Returns
Number atom - product of all arguments

Implements the primitive PRODUCT. The only input contains the number of inputs which are pulled out from the stack. Returns their product

Definition at line 999 of file runtime.c.

999  {
1000  GET_FLOAT( ARGUMENT, x );
1001  acc *= x;
1002  }
1003  RETURN( new_float( acc ) );
1004 }
1005 
1006 
1007 //===================================================
atom_t rt_remainder ( atom_t  data2,
atom_t  data1 
)
Parameters
data1first input
data2second input
Returns
Integer number atom - remainder of devision data1 / data2

Implements the aritmetic primitive REMAINDER

Definition at line 1024 of file runtime.c.

1025  { RETURN( new_integer( x % y ) ); }
1026  else
1027  { RETURN( new_integer( 0 ) ); }
1028 }
1029 
1030 
1031 //===================================================
atom_t rt_int ( atom_t  data)
Parameters
dataargument
Returns
Integer number atom - integer part of argument

Implements the aritmetic primitive INT

Definition at line 1047 of file runtime.c.

1060 {
atom_t rt_round ( atom_t  data)
Parameters
dataargument
Returns
Integer number atom - rounded integer nearest to argument

Implements the aritmetic primitive ROUND

Definition at line 1066 of file runtime.c.

1080 {
atom_t rt_sqrt ( atom_t  data)
Parameters
dataargument
Returns
Number atom - square root of argument

Implements the aritmetic primitive SQRT Calculates square root from the number

Definition at line 1086 of file runtime.c.

1101 {
atom_t rt_power ( atom_t  power,
atom_t  base 
)
Parameters
basebase number
powerpower to calculate
Returns
Number atom - base on power

Implements the aritmetic primitive POWER

Definition at line 1107 of file runtime.c.

1124 {
atom_t rt_exp ( atom_t  power)
Parameters
powerpower to calculate
Returns
Number atom - e on power

Outputs e (2.718281828+) to the input power.

Definition at line 1130 of file runtime.c.

1144 {
atom_t rt_log10 ( atom_t  data)
Parameters
dataargument
Returns
Number atom - logarithm of argument

Outputs the common logarithm of the input

Definition at line 1150 of file runtime.c.

1164 {
atom_t rt_ln ( atom_t  data)
Parameters
dataargument
Returns
Number atom - natural logarithm of argument

Outputs natural logarithm of the input

Definition at line 1170 of file runtime.c.

1184 {
atom_t rt_abs ( atom_t  data)
Parameters
dataargument
Returns
Number atom - absolute value of argument

Outputs the absolute value of the input

Definition at line 1190 of file runtime.c.

1203 {
atom_t rt_pi ( void  )
Returns
Number atom - PI number (3.141592...)

Outputs Value of PI

Definition at line 1209 of file runtime.c.

1218 {
atom_t rt_sin ( atom_t  data)
Parameters
dataargument in degrees
Returns
Number atom - Sine of argument

Outputs the sine of its input, which is taken in degrees

Definition at line 1224 of file runtime.c.

1229  {
1230  x = 0;
1231  }
1232  else
1233  if (fabs( 0.5 + x ) < ZERO_PRECISION)
1234  {
1235  x = -0.5;
1236  }
1237  else
1238  if (fabs( 0.5 - x ) < ZERO_PRECISION)
1239  {
1240  x = 0.5;
1241  }
1242  else
1243  if (fabs( 1 + x ) < ZERO_PRECISION)
1244  {
1245  x = -1;
1246  }
1247  else
1248  if (fabs( 1 - x ) < ZERO_PRECISION)
1249  {
1250  x = 1;
1251  }
1252 
1253  RETURN( new_float( x ) );
1254 }
1255 
1256 
1257 //===================================================
atom_t rt_radsin ( atom_t  data)
Parameters
dataargument in radians
Returns
Number atom - Sine of argument

Outputs the sine of its input, which is taken in radians

Definition at line 1273 of file runtime.c.

1274  {
1275  x = 0;
1276  }
1277  RETURN( new_float( x ) );
1278 }
1279 
1280 
1281 //===================================================
atom_t rt_cos ( atom_t  data)
Parameters
dataargument in degrees
Returns
Number atom - Cosine of argument

Outputs the cosine of its input, which is taken in degrees

Definition at line 1297 of file runtime.c.

1302  {
1303  x = 0;
1304  }
1305  else
1306  if (fabs( 0.5 + x ) < ZERO_PRECISION)
1307  {
1308  x = -0.5;
1309  }
1310  else
1311  if (fabs( 0.5 - x ) < ZERO_PRECISION)
1312  {
1313  x = 0.5;
1314  }
1315  else
1316  if (fabs( 1 + x ) < ZERO_PRECISION)
1317  {
1318  x = -1;
1319  }
1320  else
1321  if (fabs( 1 - x ) < ZERO_PRECISION)
1322  {
1323  x = 1;
1324  }
1325 
1326  RETURN( new_float( x ) );
1327 }
1328 
1329 
1330 //===================================================
atom_t rt_radcos ( atom_t  data)
Parameters
dataargument in radians
Returns
Number atom - Cosine of argument

Outputs the cosine of its input, which is taken in radians

Definition at line 1346 of file runtime.c.

1347  {
1348  x = 0;
1349  }
1350 
1351  RETURN( new_float( x ) );
1352 }
1353 
1354 
1355 //===================================================
atom_t rt_arctan ( int  count,
atom_t  data2,
atom_t  data1 
)
Parameters
countnumber of arguments (1 or 2)
data1first argument
data2second argument
Returns
Number atom - Arctangent of argument(s)

Outputs the arctangent, in degrees, of its input.

Definition at line 1373 of file runtime.c.

1374  {
1375  x = atan( y );
1376  }
1377  else
1378  {
1379  GET_FLOAT( data1, x );
1380  x = atan2( x, y );
1381  }
1382 
1383  //Convert radians to degrees.
1384  x = (x * 180) / M_PI;
1385  RETURN( new_float( x ) );
1386 }
1387 
1388 
1389 //===================================================
atom_t rt_radarctan ( int  count,
atom_t  data2,
atom_t  data1 
)
Parameters
countnumber of arguments (1 or 2)
data1first argument
data2second argument
Returns
Number atom - Arctangent of argument(s)

Outputs the arctangent, in radians, of its input.

Definition at line 1407 of file runtime.c.

1408  {
1409  x = atan( y );
1410  }
1411  else
1412  {
1413  GET_FLOAT( data1, x );
1414  x = atan2( x, y );
1415  }
1416 
1417  RETURN( new_float( x ) );
1418 }
1419 
1420 
1421 //===================================================
atom_t rt_make ( int  static_link,
atom_t  parent,
atom_t  value,
atom_t  name 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
namename of variable
valuenew value of variable

Implements the primitive command MAKE. This function is called when it is not possible to compile MAKE. This happens when the name of the variable is an expression or is unknown. In such cases the search for the variable must be done in run-time.

Definition at line 1444 of file runtime.c.

1452  {
1453  var = new_var( word, globals, 1 );
1454  SET_FLAGS( var, FLAG_VARIABLE );
1455  VARTYPE( var ) = VAR_TYPE_RUNTIME;
1456  VALUE( var ) = USE( unbound );
1457  }
1458 
1459  // var name as a word is not needed any more
1460  DEUSE( word );
1461 
1462  // not a variable (i.e. it is a function or a procedure)
1463  if (!IS_VARIABLE( var ))
1464  RETURN( new_error( ERROR_NOT_A_VAR, name ) );
1465 
1466  //printf("rt_make, var="); dumpln(var);
1467  //printf("rt_make, val="); dumpln(value);
1468  rt_set_var_value( static_link, parent, var, value );
1469  //printf("value is set, see var(%x)=",(int)var); dumpln(var);
1470  //printf(" its parent is="); dumpln(PARENT(var));
1471  RETURN( unbound );
1472 }
1473 
1474 
1475 
1476 
1477 //===================================================
atom_t rt_name ( int  static_link,
atom_t  parent,
atom_t  name,
atom_t  value 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
namename of variable
valuenew value of variable

Implements the primitive command NAME. It uses the same code as MAKE.

Definition at line 1496 of file runtime.c.

1510 {
atom_t rt_local ( int  static_link,
atom_t  parent,
int  data 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
datacount of LOCAL's arguments

Implements the primitive command LOCAL. LOCAL is processed by the parser, so this function is not called.

Definition at line 1516 of file runtime.c.

1516  {
1517  //printf("creating local var: "); dumpln(ARGUMENT);
1518  if (IS_ERROR( ARGUMENT )) RETURN( USE( ARGUMENT ) );
1519  if (IS_UNBOUND( ARGUMENT ))
1520  {
1522  }
1523 
1524  // check whether this variable exists locally
1525  if (find_local_var( ARGUMENT, parent ) ||
1526  find_local_var( ARGUMENT, *localsp ))
1527  {
1529  }
1530 
1531  atom_t var = new_var( ARGUMENT, parent, 0 );
1532  SET_FLAGS( var, FLAG_VARIABLE );
1533  VALUE( var ) = USE( unbound );
1534  VARTYPE( var ) = VAR_TYPE_RUNTIME;
1535  *localsp = new_list( var, *localsp ); // attach to other runtimers
1536  };
1537  //printf("new locals="); dumpln(*localsp);
1538  RETURN( unbound );
1539 }
1540 
1541 
1542 //===================================================
int num_compare ( float64_t  x,
float64_t  y 
)
Parameters
xfirst number
ysecond number
Returns
Compatison result

Compares two numbers. If first is larger returns positive number, if first is smaller returns negative number, if both are equal returns 0

Definition at line 1562 of file runtime.c.

1580 {
int word_compare ( int  cip,
chars_t  w1,
int  w1_len,
chars_t  w2,
int  w2_len 
)
Parameters
cipto ignote or not case in comparison
w1first word
w1_lenfirst word length
w2second word
w2_lensecond word length
Returns
Compatison result

Compares two numbers. If first is larger returns positive number, if first is smaller returns negative number, if both are equal returns 0

Definition at line 1586 of file runtime.c.

1594  {
1595  while (w1_len && w2_len)
1596  {
1597  if (TOLOWER( DEBAR( w1[0] ) ) != TOLOWER( DEBAR( w2[0] ) ))
1598  return TOLOWER( DEBAR( w1[0] ) ) - TOLOWER( DEBAR( w2[0] ) );
1599  ++w1;
1600  ++w2;
1601  --w1_len;
1602  --w2_len;
1603  }
1604  }
1605  return w1_len - w2_len;
1606 }
1607 
1608 
1609 // Function prototype
1610 int atom_equal( atom_t cip, atom_t data2, atom_t data1 );
1611 
1612 //===================================================
int atom_equal ( atom_t  cip,
atom_t  data1,
atom_t  data2 
)
Parameters
cipvalue of CASEIGNOREDP
data1first atom
data2second atom
Returns
!= 0 number if lists are equal or 0 if they are not

Compares two atoms. if both are same types and have equal values returns positive number Returns 0 if atoms are diferent. Returns -1 if some error occurs

Definition at line 1666 of file runtime.c.

1670  {
1671  return 0;
1672  }
1673 
1674  // Now we know that both are lists or both are not lists
1675  if (IS_LIST( data1 ))
1676  {
1677  return list_equal( cip, data1, data2 );
1678  }
1679 
1680  if (!atom_to_boolean( cip, &case_ignore ))
1681  {
1682  case_ignore = 1;
1683  }
1684 
1685  // If both atoms are words - best way to compare them is directly
1686  if (IS_ANY_WORD( data1 ) && IS_ANY_WORD( data2 ))
1687  {
1688  int xx = word_compare( case_ignore, STRING( data1 ), LENGTH( data1 ), STRING( data2 ), LENGTH( data2 ) ) == 0;
1689  return xx;
1690  }
1691 
1692  // Here we are in case that both are numbers or unsupported types
1693  if (atom_to_float( data1, &x ))
1694  {
1695  // First is a number
1696  float64_t y;
1697  if (!atom_to_float( data2, &y ))
1698  {
1699  return 0;
1700  }
1701  return num_compare( x, y ) == 0; // Both are numbers
1702  }
1703 
1704  return -1; //Different or unsupproted atom types -> error
1705 }
1706 
1707 
1708 
1709 //===================================================
list_equal ( atom_t  cip,
atom_t  data1,
atom_t  data2 
)
Parameters
cipvalue of CASEIGNOREDP
data1first list
data2second list
Returns
!= 0 number if lists are equal or 0 if they are not

Compares two lists. if both are equal returns not 0 number Returns 0 if lists are diferent.

Definition at line 1632 of file runtime.c.

1634  {
1635  return comp;
1636  }
1637 
1638  data1 = CDR( data1 );
1639  data2 = CDR( data2 );
1640  }
1641  return (IS_EMPTY( data1 ) && IS_EMPTY( data2 ));
1642 }
1643 
1644 
1645 //===================================================
atom_t rt_equal ( atom_t  cip,
atom_t  data2,
atom_t  data1 
)
Parameters
cipvalue of CASEIGNOREDP
data1first input
data2second input
Returns
Boolean atom

Implements compare operation EQUALP

Definition at line 1727 of file runtime.c.

1729  {
1730  RETURN( new_error( ERROR_MISSING_VALUE, data2 ) );
1731  }
1732 
1733  RETURN( USE( false_true[comp > 0] ) );
1734 }
1735 
1736 
1737 //===================================================
atom_t rt_nequal ( atom_t  cip,
atom_t  data2,
atom_t  data1 
)
Parameters
cipvalue of CASEIGNOREDP
data1first input
data2second input
Returns
Boolean atom

Implements compare operation NOTEQUALP

Definition at line 1755 of file runtime.c.

1757  {
1758  RETURN( new_error( ERROR_MISSING_VALUE, data2 ) );
1759  }
1760 
1761  RETURN( USE( false_true[comp == 0] ) );
1762 }
1763 
1764 
1765 //===================================================
atom_t rt_less ( atom_t  data2,
atom_t  data1 
)
Parameters
data1first number
data2second number
Returns
Boolean atom

Implements compare operation LESSP Arguments must be numbers

Definition at line 1783 of file runtime.c.

1800 {
atom_t rt_more ( atom_t  data2,
atom_t  data1 
)
Parameters
data1first number
data2second number
Returns
Boolean atom

Implements compare operation GREATERP Arguments must be numbers

Definition at line 1806 of file runtime.c.

1823 {
atom_t rt_lesseq ( atom_t  data2,
atom_t  data1 
)
Parameters
data1first number
data2second number
Returns
Boolean atom

Implements compare operation LESSEQUALP Arguments must be numbers

Definition at line 1829 of file runtime.c.

1846 {
atom_t rt_moreeq ( atom_t  data2,
atom_t  data1 
)
Parameters
data1first number
data2second number
Returns
Boolean atom

Implements compare operation GREATEREQUALP Arguments must be numbers

Definition at line 1852 of file runtime.c.

1871 {
atom_t rt_before ( atom_t  cip,
atom_t  data2,
atom_t  data1 
)
Parameters
cipvalue of CASEIGNOREDP
data1first word
data2second word
Returns
Boolean atom

Implements compare operation BEFOREP Arguments must be words. Note that if the inputs are numbers, the result may not be the same as with LESSP; for example, BEFOREP 3 12 is false because 3 collates after 1.

Definition at line 1877 of file runtime.c.

1885  {
1886  word_x = STRING( data1 );
1887  len_x = LENGTH( data1 );
1888  }
1889  else if (atom_to_string( data1, x, &len_x ))
1890  {
1891  word_x = x;
1892  }
1893  else
1894  {
1895  RETURN( USE( false_true[0] ) );
1896  }
1897 
1898  if (IS_ANY_WORD( data2 ))
1899  {
1900  word_y = STRING( data2 );
1901  len_y = LENGTH( data2 );
1902  }
1903  else if (atom_to_string( data2, y, &len_y ))
1904  {
1905  word_y = y;
1906  }
1907  else
1908  {
1909  RETURN( USE( false_true[0] ) );
1910  }
1911 
1912  if (!atom_to_boolean( cip, &case_ignore ))
1913  {
1914  case_ignore = 1;
1915  }
1916 
1917  RETURN( USE( false_true[word_compare( case_ignore, word_x, len_x, word_y, len_y ) < 0] ) );
1918 }
1919 
1920 
1921 
1922 //===================================================
atom_t rt_output ( atom_t  data)
Parameters
datareturn value of the Logo program
Returns
unbound atom

This is a dummy implementation, which is not used except for reserving a unique address for OUTPUT primitive.

Definition at line 1940 of file runtime.c.

1952 {
atom_t rt_maybeoutput ( atom_t  data)
Parameters
datareturn value of the Logo program
Returns
unbound atom

This is a dummy implementation, which is not used except for reserving a unique address for MAYBEOUTPUT primitive.

Definition at line 1958 of file runtime.c.

1969 {
atom_t rt_stop ( )
Returns
unbound atom

This is a dummy implementation, which is not used except for reserving a unique address for STOP primitive.

Definition at line 1975 of file runtime.c.

1988 {
atom_t rt_dump ( atom_t  source)
Parameters
sourcesource of the command
Returns
unbound atom

This function is used to dump the source of some comands (like OUTPUT).

Definition at line 1993 of file runtime.c.

2017 {
atom_t rt_predump ( atom_t  source)
Parameters
sourcesource of the command
Returns
unbound atom

This function is used to predump the source of user-defined functions and commands. This is done in order to trace the function call before the tracing of function's block.

Definition at line 2022 of file runtime.c.

2044 {
atom_t rt_and ( int  data)
Parameters
datanumber of inputs of AND
Returns
Boolean atom

Implements the primitive AND. The only input contains the number of inputs which are pulled out from the stack. Returns true if all are true false else.

Definition at line 2050 of file runtime.c.

2052  {
2053  RETURN( USE( false_true[0] ) );
2054  }
2055  }
2056  RETURN( USE( false_true[1] ) );
2057 }
2058 
2059 
2060 //===================================================
atom_t rt_or ( int  data)
Parameters
datanumber of inputs of OR
Returns
Boolean atom

Implements the primitive OR. The only input contains the number of inputs which are pulled out from the stack. Returns true if any is true false if all are false.

Definition at line 2079 of file runtime.c.

2081  {
2082  RETURN( USE( false_true[1] ) );
2083  }
2084  }
2085  RETURN( USE( false_true[0] ) );
2086 }
2087 
2088 
2089 //===================================================
atom_t rt_not ( atom_t  data)
Parameters
databoolean argument
Returns
Boolean atom

Outputs true is argument is false and false if argument is true

Definition at line 2106 of file runtime.c.

2119 {
atom_t rt_ignore ( atom_t  data)
Parameters
datavalue to ignore
Returns
unbound atom

Implementation of the primitive command IGNORE. The value in data is ignored and the returned value is the unbound atom

Definition at line 2125 of file runtime.c.

2125  {
2126  RETURN( USE( unbound ) );
2127  }
2128 }
2129 
2130 
2131 //===================================================
atom_t rt_first ( atom_t  data)
Parameters
dataword or list argument
Returns
first element of input as atom

Outputs first letter of argument if it is word or first element of argument if it is list

Definition at line 2148 of file runtime.c.

2150  {
2151  if (IS_EMPTY( data ))
2152  {
2153  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2154  }
2155  RETURN( USE( CAR( data ) ) );
2156  }
2157  if (IS_ANY_WORD( data ))
2158  {
2159  if (LENGTH( data ) == 0)
2160  {
2161  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2162  }
2163 
2164  RETURN( new_subword( data, STRING( data ), 1 ) );
2165  }
2166  if (atom_to_string( data, buff, &buff_len ))
2167  {
2168  if (buff_len == 0)
2169  {
2170  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2171  }
2172 
2173  RETURN( new_word( buff, 1 ) );
2174  }
2175  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2176 }
2177 
2178 
2179 //===================================================
atom_t rt_butfirst ( atom_t  data)
Parameters
dataword or list argument
Returns
all elements of input without first

If argument is word outputs word without first letter if argument is list outputs list without first element

Definition at line 2196 of file runtime.c.

2198  {
2199  if (IS_EMPTY( data ))
2200  {
2201  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2202  }
2203  RETURN( USE( CDR( data ) ) );
2204  }
2205  if (IS_ANY_WORD( data ))
2206  {
2207  if (LENGTH( data ) == 0)
2208  {
2209  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2210  }
2211  RETURN( new_subword( data, STRING( data ) + 1, LENGTH( data ) - 1 ) );
2212  }
2213  if (atom_to_string( data, buff, &buff_len ))
2214  {
2215  if (buff_len == 0)
2216  {
2217  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2218  }
2219 
2220  RETURN( new_word( buff + 1, buff_len - 1 ) );
2221  }
2222  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2223 }
2224 
2225 
2226 //===================================================
atom_t rt_firsts ( atom_t  data)
Parameters
dataA list
Returns
list of first element of each element of input list

Inserts in result first letter of element if it is word or first element of element if it is list

Definition at line 2243 of file runtime.c.

2246  {
2247  append( rt_first( CAR( data ) ), &result, &iter );
2248  data = CDR( data );
2249  }
2250  RETURN( result );
2251 }
2252 
2253 //===================================================
atom_t rt_butfirsts ( atom_t  data)
Parameters
dataA list
Returns
list of all elements of each element of data without first

If element is word inserts in result word without first letter; if element is list inserts in result the list without its first element

Definition at line 2270 of file runtime.c.

2273  {
2274  append( rt_butfirst( CAR( data ) ), &result, &iter );
2275  data = CDR( data );
2276  }
2277  RETURN( result );
2278 }
2279 
2280 
2281 //===================================================
atom_t rt_last ( atom_t  data)
Parameters
dataword or list argument
Returns
last element of input as atom

Outputs last letter of argument if it is word or last element of argument if it is list

Definition at line 2298 of file runtime.c.

2300  {
2301  if (IS_EMPTY( data ))
2302  {
2303  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2304  }
2305  RETURN( USE( get_at_list( data, -1 ) ) );
2306  }
2307  if (IS_ANY_WORD( data ))
2308  {
2309  if (LENGTH( data ) == 0)
2310  {
2311  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2312  }
2313 
2314  RETURN( new_subword( data, STRING( data ) + LENGTH( data ) - 1, 1 ) );
2315  }
2316  if (atom_to_string( data, buff, &buff_len ))
2317  {
2318  if (buff_len == 0)
2319  {
2320  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2321  }
2322 
2323  RETURN( new_word( buff + buff_len - 1, 1 ) );
2324  }
2325  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2326 }
2327 
2328 
2329 //===================================================
atom_t rt_butlast ( atom_t  data)
Parameters
dataword or list argument
Returns
all elements of input without last

If argument is word outputs word without last letter if argument is list outputs list without last element

Definition at line 2346 of file runtime.c.

2348  {
2349  if (IS_EMPTY( data ))
2350  {
2351  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2352  }
2353  RETURN( list_copy_but_last( data ) );
2354  }
2355  if (IS_ANY_WORD( data ))
2356  {
2357  if (LENGTH( data ) == 0)
2358  {
2359  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2360  }
2361  RETURN( new_subword( data, STRING( data ), LENGTH( data ) - 1 ) );
2362  }
2363  if (atom_to_string( data, buff, &buff_len ))
2364  {
2365  if (buff_len == 0)
2366  {
2367  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2368  }
2369 
2370  RETURN( new_word( buff, buff_len - 1 ) );
2371  }
2372  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2373 }
2374 
2375 
2376 //===================================================
atom_t rt_item ( atom_t  data,
atom_t  index 
)
Parameters
dataword or list argument
indexinteger index of element to get
Returns
The element at sepcified index

If argument is word outputs the char at position index if argument is list outputs the element at position index Indexing starts at 1 in both cases

Definition at line 2395 of file runtime.c.

2399  {
2400  RETURN( new_error( ERROR_NOT_A_NUMBER, index ) );
2401  }
2402 
2403  if (IS_LIST( data ))
2404  {
2405  if (IS_EMPTY( data ))
2406  {
2407  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2408  }
2409  RETURN( USE( get_at_list( data, ind - 1 ) ) ); // -1 cause indexing starts from 1
2410  }
2411  if (IS_ANY_WORD( data ))
2412  {
2413  if (LENGTH( data ) < ind)
2414  {
2415  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2416  }
2417 
2418  RETURN( new_subword( data, STRING( data ) + ind - 1, 1 ) );
2419  }
2420  if (atom_to_string( data, buff, &buff_len ))
2421  {
2422  if (buff_len < ind)
2423  {
2424  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2425  }
2426 
2427  RETURN( new_word( buff + ind - 1, 1 ) );
2428  }
2429  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
2430 }
2431 
2432 
2433 
2434 
2435 //===================================================
atom_t rt_if ( int  count)
Parameters
countnumber of parameters
Returns
unbound atom

This is a dummy implementation, which is not used except for reserving a unique address for IF primitive.

Definition at line 2453 of file runtime.c.

2467 {
atom_t rt_repeat ( atom_t  repcount,
atom_t  commands 
)
Parameters
repcountnumber of repetitions
commandscommands to repeat
Returns
unbound atom

This is a dummy implementation, which is not used except for reserving a unique address for REPEAT primitive.

Definition at line 2473 of file runtime.c.

2486 {
atom_t rt_while ( atom_t  commands,
atom_t  condition 
)

dummy implementation of primitive command DO.WHILE

Parameters
conditionrepetition condition
commandscommands to repeat
Returns
unbound atom

This is a dummy implementation, which is not used except for reserving a unique address for WHILE primitive.

Parameters
commandscommands to repeat
conditionrepetition condition
Returns
unbound atom

This is a dummy implementation, which is not used except for reserving a unique address for DO.WHILE primitive.

Definition at line 2492 of file runtime.c.

2505 {
atom_t RUNTIME rt_dowhile ( atom_t  commands,
atom_t  condition 
)

Definition at line 2511 of file runtime.c.

2524 {
atom_t rt_until ( atom_t  condition,
atom_t  commands 
)
Parameters
conditionrepetition condition
commandscommands to repeat
Returns
unbound atom

This is a dummy implementation, which is not used except for reserving a unique address for UNTIL primitive.

Definition at line 2530 of file runtime.c.

2543 {
atom_t rt_dountil ( atom_t  commands,
atom_t  condition 
)
Parameters
commandscommands to repeat
conditionrepetition condition
Returns
unbound atom

This is a dummy implementation, which is not used except for reserving a unique address for DO.UNTIL primitive.

Definition at line 2549 of file runtime.c.

2568 {
atom_t rt_whlchk ( atom_t  source,
atom_t  data 
)
Parameters
datavalue to check
sourcesource of the expression
Returns
error or unbound atom

Checks whether the condition of a while command is valid. Returns error atom is the result is error, or not boolean. Otherwise returns integer atoms containing 0 if the condition is false, and 1 otherwise. The source parameter points to the source where the expression is called. It is used to locate the error position in case of errors.

Definition at line 2573 of file runtime.c.

2576  {
2577  DEUSE( data );
2578  return new_error( ERROR_MISSING_VALUE, source );
2579  }
2580 
2581  int b;
2582  if (!atom_to_boolean( data, &b ))
2583  {
2584  DEUSE( data );
2585  return new_error( ERROR_BOOLEAN_EXPECTED, source );
2586  }
2587 
2588  DEUSE( data );
2589 
2590  return new_integer( b );
2591 }
2592 
2593 
2594 
2595 
2596 //===================================================
void rt_repeat_enter ( int  frame,
int  count 
)
Parameters
framebase frame pointer
countnumber of requested repetitions

This function creates a new repeat node and inserts it in the beginning of the repeat chain. The repeat-node contains the number of repetitions done so far (REPCOUNT) and left to do (REPLIMIT). The base pointer is used to access the repeat chain.

Definition at line 2617 of file runtime.c.

2622  {
2623  // we create the first repeat-node
2624  DEUSE( *chain_ptr );
2625  *chain_ptr = new_list( node, empty_list );
2626  }
2627  else
2628  {
2629  // we add a new repeat-node
2630  *chain_ptr = new_list( node, *chain_ptr );
2631  }
2632 }
2633 
2634 
2635 
2636 //===================================================
atom_t rt_repeat_exit ( int  frame)
Parameters
framebase frame pointer
Returns
unbound atom

This function removes the top-most repeat-node and returns unbound atom.

Definition at line 2654 of file runtime.c.

2655  {
2656 #ifdef SAFEMODE
2657  assert( IS_LIST( *chain_ptr ) );
2658 #endif
2659 
2660  *chain_ptr = behead( *chain_ptr );
2661 
2662  if (IS_EMPTY( *chain_ptr ))
2663  *chain_ptr = USE( unbound );
2664  }
2665 
2666  //printf("exitus repeatus\n");
2667  RETURN( unbound );
2668 }
2669 
2670 
2671 
2672 //===================================================
atom_t rt_repcount ( int  frame)
Parameters
framebase frame pointer
Returns
numeric atom containing repcount value

Repetition count is always stored at the top of the stack, so the implementation of repcount naturally treats the top of the stack as its parameter.

Definition at line 2691 of file runtime.c.

2715 {
atom_t rt_forever ( atom_t  commands)
Parameters
commandscommands to repeat
Returns
unbound atom

This is a dummy implementation, which is not used except for reserving a unique address for FOREVER primitive.

Definition at line 2721 of file runtime.c.

2739 {
void rt_forever_enter ( int  frame)
Parameters
framebase frame pointer

This function creates a new repeat node and inserts it in the beginning of the repeat chain. The repeat-node contains the number of repetitions done so far (REPCOUNT). The limit of repetitions (REPLIMIT) is set to 1, although this value is not used.

The base pointer is used to access the repeat chain.

Definition at line 2744 of file runtime.c.

2749  {
2750  // we create the first repeat-node
2751  DEUSE( *chain_ptr );
2752  *chain_ptr = new_list( node, empty_list );
2753  }
2754  else
2755  {
2756  // we add a new repeat-node
2757  *chain_ptr = new_list( node, *chain_ptr );
2758  }
2759 }
2760 
2761 
2762 
2763 //===================================================
atom_t rt_parse ( atom_t  data)
Parameters
datadata to parse
Returns
parsed data

Implements primitive function PARSE. Returns the input parsed as data.

Definition at line 2780 of file runtime.c.

2795 {
atom_t rt_runparse ( atom_t  data)
Parameters
datadata to parse
Returns
parsed data

Implements primitive function RUNPARSE. Returns the input parsed as commands.

Definition at line 2801 of file runtime.c.

2823 {
atom_t rt_wordp ( atom_t  data)
Parameters
datadata to test
Returns
true if data is word or false if is not

Implements primitive predicate WORDP. Returns true if argument is any word or false if it is not

Definition at line 2829 of file runtime.c.

2829  {
2831  int buff_len = MAX_NUMBER_WORD_LENGTH;
2832 
2833  if (atom_to_string( data, buff, &buff_len ))
2834  {
2835  RETURN( USE( false_true[1] ) );
2836  }
2837  }
2838  RETURN( USE( false_true[0] ) );
2839 }
2840 
2841 
2842 //===================================================
atom_t rt_listp ( atom_t  data)
Parameters
datadata to test
Returns
true if data is list or false if is not

Implements primitive predicate LISTP. Returns true if argument is list or false if it is not

Definition at line 2859 of file runtime.c.

2869 {
atom_t rt_numberp ( atom_t  data)
Parameters
datadata to test
Returns
true if data is number or false if is not

Implements primitive predicate NUMBERP. Returns true if argument is any number or false if it is not

Definition at line 2875 of file runtime.c.

2880  {
2881  RETURN( USE( false_true[1] ) );
2882  }
2883 
2884  // Not a number
2885  RETURN( USE( false_true[0] ) );
2886 }
2887 
2888 
2889 //===================================================
atom_t rt_empty ( atom_t  data)
Parameters
datadata to test
Returns
true if data is empty or false if is not

Implements primitive predicate EMPTYP. Outputs true if argument is empty list or empty word. Outputs false if it is not.

Definition at line 2907 of file runtime.c.

2909  {
2910  RETURN( USE( false_true[1] ) );
2911  }
2912 
2913  // Not a list or empty word
2914  RETURN( USE( false_true[0] ) );
2915 }
2916 
2917 
2918 //===================================================
atom_t rt_memberp ( atom_t  cip,
atom_t  data,
atom_t  elem 
)
Parameters
cipvalue of CASEIGNOREDP
dataData where will search
elemElement which will be searched
Returns
true if elem is in data or false if is not

Implements primitive predicate MEMBERP. If data is list outputs true if data contains elem as an element and false if not If data is a word outputs true if elem is char that is contained in the word data

Definition at line 2940 of file runtime.c.

2947  {
2949  chars_t comp_buffer;
2950  int buff_len = MAX_NUMBER_WORD_LENGTH; // We start with 3 symbols. Actually need 1, but test if there is more
2951  char_t elem_ch;
2952 
2953  // If data is not a list, elem must be one character word
2954  if (IS_ANY_WORD( elem ) && LENGTH( elem ) != 1)
2955  {
2956  RETURN( USE( false_true[0] ) );
2957  }
2958  if (!IS_ANY_WORD( elem ) && (!atom_to_string( elem, buff, &buff_len ) || buff_len != 1))
2959  {
2960  RETURN( USE( false_true[0] ) );
2961  }
2962 
2963  if (buff_len == 1) // elem is one char word -> Store it
2964  {
2965  elem_ch = DEBAR( buff[0] );
2966  }
2967  else
2968  {
2969  elem_ch = DEBAR( STRING( elem )[0] );
2970  }
2971 
2972  if (IS_ANY_WORD( data ))
2973  {
2974  comp_buffer = STRING( data );
2975  buff_len = LENGTH( data );
2976  }
2977  else
2978  {
2979  buff_len = MAX_NUMBER_WORD_LENGTH;
2980  if (!atom_to_string( data, buff, &buff_len ) || buff_len == 0)
2981  {
2982  RETURN( USE( false_true[0] ) ); // data is not a word or empty
2983  }
2984  comp_buffer = buff;
2985  }
2986  while (buff_len--)
2987  {
2988  if (DEBAR( comp_buffer[buff_len] ) == elem_ch)
2989  {
2990  RETURN( USE( false_true[1] ) );
2991  }
2992  }
2993  RETURN( USE( false_true[0] ) );
2994  }
2995 }
2996 
2997 
2998 //===================================================
atom_t rt_word ( int  data)
Parameters
datanumber of inputs of WORD
Returns
New word concatenation of arguments

Implements the primitive WORD. The only input contains the number of inputs which are pulled out from the stack. Returns new word whish is concatenation of all arguments. All arguments must be words.

Definition at line 3018 of file runtime.c.

3022  {
3023  //printf("=======arg="); dumpln(ARGUMENT);
3024  if (IS_ERROR( ARGUMENT ))
3025  {
3026  RETURN( USE(ARGUMENT) );
3027  }
3028 
3029  if (IS_ANY_WORD( ARGUMENT ))
3030  {
3031  total_length += LENGTH( ARGUMENT );
3032  }
3033  else
3034  {
3035  // Assume data can be translated to string.
3036  total_length += MAX_NUMBER_WORD_LENGTH;
3037  }
3038  }
3039 
3040  // Allocate memory
3041  res = create_word( total_length );
3042 
3043  // And copy elements one by one
3044  for (EACH_ARGUMENT)
3045  {
3046  if (IS_ANY_WORD( ARGUMENT ))
3047  {
3048  STRNCPY( STRING( res ) + real_length, STRING( ARGUMENT ), LENGTH( ARGUMENT ) );
3049  real_length += LENGTH( ARGUMENT );
3050  }
3051  else
3052  {
3053  buff_len = MAX_NUMBER_WORD_LENGTH;
3054  if (!atom_to_string( ARGUMENT, buff, &buff_len ))
3055  {
3056  DEUSE( res );
3058  }
3059 
3060  STRNCPY( STRING( res ) + real_length, buff, buff_len );
3061  real_length += buff_len;
3062  }
3063  }
3064 
3065  // If allocated more memory than needed reallocate to free unused
3066  if (real_length != total_length)
3067  {
3068  STRING( res ) = REALLOC( STRING( res ), (real_length + 1) * sizeof (char_t) );
3069  IDLENGTH( res ) = WORD_ID | (real_length << 8);
3070  }
3071 
3072  STRING( res )[real_length] = NULL_CHAR;
3073  RETURN( res );
3074 }
3075 
3076 
3077 //===================================================
atom_t rt_list ( int  data)
Parameters
datanumber of inputs of LIST
Returns
New list containing all arguments

Implements the primitive LIST. The only input contains the number of inputs which are pulled out from the stack. Returns new list with elements all arguments passed to the function.

Definition at line 3097 of file runtime.c.

3098  {
3099  if (IS_ERROR( ARGUMENT ))
3100  {
3101  RETURN( USE(ARGUMENT) );
3102  }
3103  }
3104 
3105  for (EACH_ARGUMENT)
3106  {
3107  append( USE( ARGUMENT ), &res, &iter );
3108  }
3109 
3110  RETURN( res );
3111 }
3112 
3113 
3114 //===================================================
atom_t rt_sent ( int  data)
Parameters
datanumber of inputs of SE
Returns
New list containing all arguments

Implements the primitive SE. The only input contains the number of inputs which are pulled out from the stack. Returns new list with elements all arguments passed to the function if they are not lists. If an argument is list its members are added to result

Definition at line 3135 of file runtime.c.

3135  {
3136  if (IS_ERROR( ARGUMENT ))
3137  {
3138  RETURN( USE(ARGUMENT) );
3139  }
3140  }
3141 
3142  for (EACH_ARGUMENT)
3143  {
3144  if (IS_LIST( ARGUMENT ))
3145  {
3146  atom_t curr = ARGUMENT;
3147 
3148  while (IS_NOT_EMPTY( curr ))
3149  {
3150  test_elem_and_destroy_if_error( curr, res );
3151  append( USE( CAR( curr ) ), &res, &iter );
3152  curr = CDR( curr );
3153  }
3154  }
3155  else
3156  {
3157  append( USE( ARGUMENT ), &res, &iter );
3158  }
3159  }
3160 
3161  RETURN( res );
3162 }
3163 
3164 
3165 //===================================================
atom_t rt_fput ( atom_t  data2,
atom_t  data1 
)
Parameters
data1Element to add
data2List or word
Returns
New list or word containing data2 with data1 at start

Implements the primitive FPUT. Returns data2 with data1 inserted at first position. If data2 is a word, data1 must be one char word.

Definition at line 3184 of file runtime.c.

3187  {
3189  int buff_len2 = MAX_NUMBER_WORD_LENGTH;
3190 
3192  int buff_len1 = MAX_NUMBER_WORD_LENGTH;
3193 
3194  atom_t res;
3195 
3196  /* check parametr correctness */
3197  if (!IS_ANY_WORD( data2 ) && !atom_to_string( data2, buff2, &buff_len2 ))
3198  {
3199  RETURN( new_error( ERROR_NOT_A_WORD, data2 ) );
3200  }
3201 
3202  if ((IS_ANY_WORD( data1 ) && LENGTH( data1 ) != 1) ||
3203  (!atom_to_string( data1, buff1, &buff_len1 ) || buff_len1 != 1))
3204  {
3206  }
3207 
3208  if (IS_ANY_WORD( data2 ))
3209  {
3210  res = create_word( 1 + LENGTH( data2 ) );
3211  STRING( res )[0] = IS_ANY_WORD( data1 ) ? STRING( data1 )[0] : buff1[0];
3212  STRNCPY( STRING( res ) + 1, STRING( data2 ), LENGTH( data2 ) );
3213  }
3214  else
3215  {
3216  res = create_word( 1 + buff_len2 );
3217  STRING( res )[0] = IS_ANY_WORD( data1 ) ? STRING( data1 )[0] : buff1[0];
3218  STRNCPY( STRING( res ) + 1, buff2, buff_len2 );
3219  }
3220 
3221  STRING( res )[LENGTH( res )] = NULL_CHAR;
3222  RETURN( res );
3223  }
3224 }
3225 
3226 
3227 //===================================================
atom_t rt_lput ( atom_t  data2,
atom_t  data1 
)
Parameters
data1Element to add
data2List or word
Returns
New list or word containing data2 with data1 at end

Implements the primitive LPUT. Returns data2 with data1 appended to last position. If data2 is a word, data1 must be one char word.

Definition at line 3246 of file runtime.c.

3249  {
3251  int buff_len2 = MAX_NUMBER_WORD_LENGTH;
3252 
3254  int buff_len1 = MAX_NUMBER_WORD_LENGTH;
3255 
3256  atom_t res;
3257 
3258  /* check parametr correctness */
3259  if (!IS_ANY_WORD( data2 ) && !atom_to_string( data2, buff2, &buff_len2 ))
3260  {
3261  RETURN( new_error( ERROR_NOT_A_WORD, data2 ) );
3262  }
3263 
3264  if ((IS_ANY_WORD( data1 ) && LENGTH( data1 ) != 1) ||
3265  (!atom_to_string( data1, buff1, &buff_len1 ) || buff_len1 != 1))
3266  {
3268  }
3269 
3270  if (IS_ANY_WORD( data2 ))
3271  {
3272  res = create_word( 1 + LENGTH( data2 ) );
3273  STRNCPY( STRING( res ), STRING( data2 ), LENGTH( data2 ) );
3274  STRING( res )[LENGTH( data2 )] = IS_ANY_WORD( data1 ) ? STRING( data1 )[0] : buff1[0];
3275  }
3276  else
3277  {
3278  res = create_word( 1 + buff_len2 );
3279  STRNCPY( STRING( res ), buff2, buff_len2 );
3280  STRING( res )[buff_len2] = IS_ANY_WORD( data1 ) ? STRING( data1 )[0] : buff1[0];
3281  }
3282 
3283  STRING( res )[LENGTH( res )] = NULL_CHAR;
3284  RETURN( res );
3285  }
3286 }
3287 
3288 
3289 //===================================================
atom_t rt_count ( atom_t  data)
Parameters
dataAtom to inspect
Returns
Number of elements in data

Implements the primitive COUNT. Returns number of chars in data if data is word or number of elements in data if data is list

Definition at line 3307 of file runtime.c.

3310  {
3311  RETURN( new_integer( LENGTH( data ) ) );
3312  }
3313  if (IS_LIST( data ))
3314  {
3315  RETURN( new_integer( list_length( data ) ) );
3316  }
3317  if (atom_to_string( data, buff, &buff_len ))
3318  {
3319  RETURN( new_integer( buff_len ) );
3320  }
3322 }
3323 
3324 
3325 //===================================================
atom_t rt_char ( atom_t  data)
Parameters
dataASCII code
Returns
Char coresponding to data

Implements the primitive CHAR. Returns one char word containing symbol with given ASCII code

Definition at line 3342 of file runtime.c.

3343  {
3344  if (x < 0 || x > ((1 << 16) - 1))
3345  {
3347  }
3348  str[0] = (char_t) x;
3349  str[1] = NULL_CHAR;
3350  RETURN( new_word( str, 1 ) );
3351  }
3352 #endif
3353 
3354  if (x < 0 || x > 255)
3355  {
3357  }
3358 
3359  str[0] = DEBAR( (char_t) x );
3360  str[1] = NULL_CHAR;
3361  RETURN( new_word( str, 1 ) );
3362 }
3363 
3364 
3365 
3366 //===================================================
atom_t rt_ascii ( atom_t  data)
Parameters
dataone char word
Returns
ASCII code of data

Implements the primitive ASCII. Returns ASCII code of given char

Definition at line 3383 of file runtime.c.

3387  {
3388  if (LENGTH( data ) != 1)
3389  {
3391  }
3392 #ifdef UNICODE_CHARS
3393  if (!OPTION_TRADITIONAL)
3394  {
3395  RETURN( new_integer( (ushort_t) DEBAR( STRING( data )[0] ) ) );
3396  }
3397 #endif
3398  RETURN( new_integer( (byte_t) DEBAR( STRING( data )[0] ) ) );
3399  }
3400 
3401  if (IS_LIST( data ))
3402  {
3403  RETURN( new_error( ERROR_NOT_A_WORD, data ) );
3404  }
3405 
3406  if (atom_to_string( data, buff, &buff_len ))
3407  {
3408  if (buff_len == 1)
3409  {
3410 #ifdef UNICODE_CHARS
3411  if (!OPTION_TRADITIONAL)
3412  {
3413  RETURN( new_integer( (ushort_t) DEBAR( buff[0] ) ) );
3414  }
3415 #endif
3416  RETURN( new_integer( (byte_t) DEBAR( buff[0] ) ) );
3417  }
3418 
3419  // Word but too long
3421  }
3422  RETURN( new_error( ERROR_NOT_A_WORD, data ) );
3423 }
3424 
3425 
3426 
3427 //===================================================
atom_t rt_lower ( atom_t  data)
Parameters
dataword
Returns
New word all in lowercase letters

Implements the primitive LOWERCASE. Returns word produced from data with replacing all uppercase letters with lowercase letters

Definition at line 3445 of file runtime.c.

3449  {
3450  res = new_word( STRING( data ), LENGTH( data ) );
3451  }
3452  else
3453  {
3455  int buff_len = MAX_NUMBER_WORD_LENGTH;
3456 
3457  if (IS_LIST( data ) || !atom_to_string( data, buff, &buff_len ))
3458  {
3459  RETURN( new_error( ERROR_NOT_A_WORD, data ) );
3460  }
3461  // in case of boolean of scientific float mey be necessery to convert
3462  res = new_word( buff, buff_len );
3463  }
3464 
3465  // proces word and make convertion
3466  for (i = 0; i < LENGTH( res ); ++i)
3467  {
3468  STRING( res )[i] = TOLOWER( DEBAR( STRING( res )[i] ) );
3469  }
3470 
3471  RETURN( res );
3472 }
3473 
3474 
3475 //===================================================
atom_t rt_upper ( atom_t  data)
Parameters
dataword
Returns
New word all in lowercase letters

Implements the primitive UPPERCASE. Returns word produced from data with replacing all lowercase letters with uppercase letters

Definition at line 3493 of file runtime.c.

3497  {
3498  res = new_word( STRING( data ), LENGTH( data ) );
3499  }
3500  else
3501  {
3503  int buff_len = MAX_NUMBER_WORD_LENGTH;
3504 
3505  if (IS_LIST( data ) || !atom_to_string( data, buff, &buff_len ))
3506  {
3507  RETURN( new_error( ERROR_NOT_A_WORD, data ) );
3508  }
3509  // in case of boolean of scientific float mey be necessery to convert
3510  res = new_word( buff, buff_len );
3511  }
3512 
3513  // proces word and make convertion
3514  for (i = 0; i < LENGTH( res ); ++i)
3515  {
3516  STRING( res )[i] = TOUPPER( DEBAR( STRING( res )[i] ) );
3517  }
3518 
3519  RETURN( res );
3520 }
3521 
3522 
3523 //===================================================
atom_t rt_member ( atom_t  cip,
atom_t  elem,
atom_t  data 
)
Parameters
cipvalue of CASEIGNOREDP
dataData where will search
elemElement which will be searched
Returns
Elements of data form first occurence of elem to the end

Implements primitive predicate MEMBER. If data is list outputs list containing all elements of data after first occurence of elem or empty list if elem is not a member of data If data is a word outputs subword of data starting from first occurence of elem to the end or empty word if elem is not a member of data

Definition at line 3547 of file runtime.c.

3548  { // Test all elements of the list for equality with elem
3549  while (!IS_EMPTY( data ))
3550  {
3551  if (atom_equal( cip, CAR( data ), elem ))
3552  RETURN( USE( data ) );
3553  data = CDR( data );
3554  }
3555  RETURN( USE( empty_list ) );
3556  }
3557  else
3558  {
3560  chars_t comp_buffer;
3561  int buff_len = MAX_NUMBER_WORD_LENGTH; // We start with 3 symbols. Actually need 1, but test if there is more
3562  int pos;
3563  char_t elem_ch;
3564 
3565  // If data is not a list, elem must be one character word
3566  if (IS_ANY_WORD( elem ) && LENGTH( elem ) != 1)
3567  {
3569  }
3570  if (!IS_ANY_WORD( elem ) && (!atom_to_string( elem, buff, &buff_len ) || buff_len != 1))
3571  {
3573  }
3574 
3575  if (buff_len == 1) // elem is one char word -> Store it
3576  {
3577  elem_ch = DEBAR( buff[0] );
3578  }
3579  else
3580  {
3581  elem_ch = DEBAR( STRING( elem )[0] );
3582  }
3583 
3584  if (IS_ANY_WORD( data ))
3585  {
3586  comp_buffer = STRING( data );
3587  buff_len = LENGTH( data );
3588  }
3589  else
3590  {
3591  buff_len = MAX_NUMBER_WORD_LENGTH;
3592  if (!atom_to_string( data, buff, &buff_len ) || buff_len == 0)
3593  {
3594  RETURN( new_error( ERROR_NOT_A_WORD, data ) );
3595  }
3596  comp_buffer = buff;
3597  }
3598  pos = 0;
3599  while (pos < buff_len)
3600  {
3601  if (DEBAR( comp_buffer[pos] ) == elem_ch)
3602  {
3603  if (IS_ANY_WORD( data ))
3604  {
3605  RETURN( new_subword( data, comp_buffer + pos, buff_len - pos ) );
3606  }
3607  else
3608  {
3609  RETURN( new_word( comp_buffer + pos, buff_len - pos ) );
3610  }
3611  }
3612  ++pos;
3613  }
3614  RETURN( new_word( buff, 0 ) );
3615  }
3616 }
3617 
3618 
3619 //===================================================
atom_t rt_iseq ( atom_t  to,
atom_t  from 
)
Parameters
fromFirst element of the sequence
toLast element of the sequence
Returns
List form all elements between from and to

Implements primitive predicate ISEQ. Returns a list containing all numbers between from and to. Parameters must be integers.

Definition at line 3638 of file runtime.c.

3642  {
3643  for (; first >= last; --first)
3644  append( new_integer( first ), &list_start, &list_end );
3645  }
3646  else
3647  {
3648  for (; first <= last; ++first)
3649  append( new_integer( first ), &list_start, &list_end );
3650  }
3651  RETURN( list_start );
3652 }
3653 
3654 
3655 //===================================================
atom_t rt_rseq ( atom_t  count,
atom_t  to,
atom_t  from 
)
Parameters
fromFirst element of the sequence
toLast element of the sequence
countNumber of elements in the sequence
Returns
List form count elements between from and to

Implements primitive predicate RSEQ. Returns a list containing count numbers between from and to. All numbers are equally spaced rational.

Definition at line 3675 of file runtime.c.

3682  {
3684  }
3685 
3686  list_start = list_end = empty_list;
3687  if (first > last)
3688  {
3689  for (step = cnt > 1 ? (first - last) / (cnt - 1) : 0; cnt > 0; --cnt, first -= step)
3690  {
3691  append( new_float( first ), &list_start, &list_end );
3692  }
3693  }
3694  else
3695  {
3696  for (step = cnt > 1 ? (last - first) / (cnt - 1) : 0; cnt > 0; --cnt, first += step)
3697  {
3698  append( new_float( first ), &list_start, &list_end );
3699  }
3700  }
3701  RETURN( list_start );
3702 }
3703 
3704 
3705 //===================================================
rt_random ( int  count,
atom_t  data2,
atom_t  data1 
)
Parameters
countnumber of arguments (1 or 2)
data1first argument
data2second argument
Returns
Random number.

Implements the primitive RANDOM If called with one arg outputs a nonnegative integer less than its input first. If input is a list outputs randomly selected element from it If called with two arguments outputs a nonnegative random integer greater than or equal to data1, and less than or equal to data2

Definition at line 3729 of file runtime.c.

3731  {
3733  }
3734 
3735  len = list_length( data2 );
3736  RETURN( USE( get_at_list( data2, rand_num % len ) ) );
3737  }
3738  else
3739  {
3740  int64_t num;
3741  GET_INT( data2, num );
3742 
3743  if (num <= 0)
3744  {
3746  }
3747  RETURN( new_integer( rand_num % num ) );
3748  }
3749  }
3750  else if (count == 2)
3751  {
3752  int64_t start;
3753  int64_t end;
3754 
3755  GET_INT( data1, start );
3756  GET_INT( data2, end );
3757 
3758  if (start > end || start < 0)
3759  {
3761  }
3762  RETURN( new_integer( rand_num % (end - start + 1) + start ) );
3763  }
3764  else
3765  {
3767  }
3768 }
3769 
3770 
3771 //===================================================
atom_t rt_rerandom ( int  count,
atom_t  seed 
)
Parameters
countnumber of arguments (0 or 1)
seednumber to set random seed

Implements the primitive RERANDOM. Makes the results of RANDOM reproducible.

Definition at line 3788 of file runtime.c.

3789  {
3790  rseed = 0;
3791  }
3792  else
3793  {
3795  }
3796 
3797  srand( (uint_t) rseed );
3798  RETURN( unbound );
3799 }
3800 
3801 
3802 //===================================================
atom_t rt_show ( atom_t  pdl,
atom_t  pwl,
atom_t  fpp,
int  data 
)
Parameters
pdlvalue of PRINTDEPTHLIMIT
pwlvalue of PRINTWIDTHLIMIT
fppvalue of FULLPRINTP
datanumber of inputs of SHOW

Implements the primitive SHOW. The only input contains the number of inputs which are pulled out from the stack. Prints input like PRINT except that if an input is a list it is printed inside square brackets

Definition at line 3824 of file runtime.c.

3827  {
3828  if (IS_ERROR( ARGUMENT ))
3829  {
3830  RETURN( USE(ARGUMENT) );
3831  }
3832 
3833  // If list adds square brackets
3834  if (IS_LIST( ARGUMENT ))
3835  {
3836  outter( TEXT( "[" ), 1 );
3837  dump( ARGUMENT );
3838  outter( TEXT( "]" ), 1 );
3839  }
3840  else
3841  {
3842  dump( ARGUMENT );
3843  }
3844  outter( TEXT( " " ), 1 );
3845  }
3846 
3847  outter( TEXT( "\n" ), 1 );
3848  RETURN( unbound );
3849 }
3850 
3851 
3852 //===================================================
atom_t rt_type ( atom_t  pdl,
atom_t  pwl,
atom_t  fpp,
int  data 
)
Parameters
pdlvalue of PRINTDEPTHLIMIT
pwlvalue of PRINTWIDTHLIMIT
fppvalue of FULLPRINTP
datanumber of inputs of TYPE

Implements the primitive TYPE. The only input contains the number of inputs which are pulled out from the stack. Prints input like PRINT except that no new line is printed at the end and no spaces is printed between inputs.

Definition at line 3874 of file runtime.c.

3877  {
3878  if (IS_ERROR( ARGUMENT ))
3879  {
3880  RETURN( USE(ARGUMENT) );
3881  }
3882  dump( ARGUMENT );
3883  }
3884  RETURN( unbound );
3885 }
3886 
3887 
3888 //===================================================
atom_t rt_form ( atom_t  precision,
atom_t  width,
atom_t  num 
)
Parameters
numnumber to be converted
widthwidth in wich number will be printed
precisionprecision with wich number will be printed
Returns
Word representing given num.

Implements the primitive FORM. Outputs string representation of num printed with precision digits after decimal point and in at least width chars If width is more than number length some spaces are inserted in front of the string to fill width chars

Definition at line 3910 of file runtime.c.

3916  {
3917  GET_INT( width, num_width );
3918  format = TEXT( "%*.*lf" );
3919  SPRINT( buff, buff_len, format, (uint_t) num_width, (uint_t) num_prec, number );
3920  }
3921  else
3922  {
3923  if (IS_ANY_WORD( width ))
3924  {
3925  format = STRING( width );
3926  SPRINTF( buff, buff_len, format, number );
3927  }
3928  else
3929  {
3930  RETURN( new_error( ERROR_NOT_A_WORD, width ) );
3931  }
3932  }
3933 
3934  buff_len = STRLEN( buff );
3935  RETURN( new_word( buff, buff_len ) );
3936 }
3937 
3938 
3939 //===================================================
char_t get_format ( chars_t  string)
Parameters
stringa format string
Returns
Format char.

Returns format char or 0 if no format is passed or more than one format specifiers occur.

Definition at line 3956 of file runtime.c.

3957  {
3958  ++elem;
3959  if (elem[0] == TEXT( '%' ))
3960  {
3961  elem += 1;
3962  }
3963  else
3964  {
3965  while (ISDIGIT( *elem ) || *elem == TEXT( '.' ))
3966  {
3967  ++elem;
3968  }
3969  while (*elem == TEXT( 'l' ) || *elem == TEXT( 'u' ) || *elem == TEXT( 'h' ))
3970  ++elem;
3971  }
3972  if (type) return 0;
3973  type = *elem;
3974  }
3975  }
3976  return type;
3977 }
3978 
3979 
3980 //===================================================
atom_t rt_format ( atom_t  format,
atom_t  data 
)
Parameters
datadata to be formated
formatformating string
Returns
Word representing given data according to format string.

Implements the primitive FORMAT. Outputs string representation of data according to format formating string using printf sintax

Definition at line 3999 of file runtime.c.

3999  {
4000  char_t buff[MAX_WORD_LENGTH];
4001  int buff_len = MAX_WORD_LENGTH;
4002  char_t end = STRING( format )[LENGTH( format )];
4003 
4004  STRING( format )[LENGTH( format )] = NULL_CHAR;
4005  char_t format_chr = get_format( STRING( format ) );
4006 
4007  switch (format_chr)
4008  {
4009  // Integer number
4010  case TEXT( 'd' ) : case TEXT( 'i' ) : case TEXT( 'u' ) :
4011 
4012  case TEXT( 'x' ) : case TEXT( 'X' ) : case TEXT( 'o' ) :
4013  {
4014  int64_t i_num;
4015  STRING( format )[LENGTH( format )] = end;
4016  GET_INT( data, i_num );
4017  STRING( format )[LENGTH( format )] = NULL_CHAR;
4018  SPRINTF( buff, buff_len, STRING( format ), i_num );
4019  break;
4020  }
4021  // Floating point number
4022  case TEXT( 'f' ) :
4023  case TEXT( 'e' ) : case TEXT( 'E' ) :
4024  case TEXT( 'g' ) : case TEXT( 'G' ) :
4025 
4026  case TEXT( 'a' ) : case TEXT( 'A' ) :
4027  {
4028  float64_t fl_num;
4029  STRING( format )[LENGTH( format )] = end;
4030  GET_FLOAT( data, fl_num );
4031  STRING( format )[LENGTH( format )] = NULL_CHAR;
4032  SPRINTF( buff, buff_len, STRING( format ), fl_num );
4033  break;
4034  }
4035 
4036  // char
4037 
4038  case TEXT( 'c' ) : case TEXT( 'C' ) :
4039  {
4040  char_t ch;
4041  if (IS_ANY_WORD( data ))
4042  {
4043  if (LENGTH( data ) == 0)
4044  {
4045  STRING( format )[LENGTH( format )] = end;
4046  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
4047  }
4048  ch = STRING( data )[0];
4049  }
4050  else
4051  if (atom_to_string( data, buff, &buff_len ))
4052  {
4053  if (buff_len == 0)
4054  {
4055  STRING( format )[LENGTH( format )] = end;
4056  RETURN( new_error( ERROR_MISSING_VALUE, data ) );
4057  }
4058  ch = buff[0];
4059  }
4060  else
4061  {
4062  STRING( format )[LENGTH( format )] = end;
4063  RETURN( new_error( ERROR_NOT_A_WORD, data ) );
4064  }
4065  buff_len = MAX_WORD_LENGTH;
4066  SPRINTF( buff, buff_len, STRING( format ), ch );
4067  break;
4068  }
4069 
4070  // string
4071 
4072  case TEXT( 's' ) : case TEXT( 'S' ) :
4073  {
4074  if (IS_ANY_WORD( data ))
4075  {
4076  char_t term = STRING( data )[LENGTH( data )];
4077  STRING( data )[LENGTH( data )] = NULL_CHAR;
4078  SPRINTF( buff, buff_len, STRING( format ), STRING( data ) );
4079  STRING( data )[LENGTH( data )] = term;
4080  }
4081  else
4082  {
4083  char_t num_buff[MAX_NUMBER_WORD_LENGTH];
4084  int num_buff_len;
4085 
4086  if (atom_to_string( data, num_buff, &num_buff_len ))
4087  {
4088  SPRINTF( buff, buff_len, STRING( format ), num_buff );
4089  }
4090  else
4091  {
4092  STRING( format )[LENGTH( format )] = end;
4093  RETURN( new_error( ERROR_NOT_A_WORD, data ) );
4094  }
4095  }
4096  break;
4097  }
4098  // pointer
4099 
4100  case TEXT( 'p' ) :
4101  {
4102  SPRINTF( buff, buff_len, STRING( format ), data );
4103  break;
4104  }
4105  default:
4106  {
4107  STRING( format )[LENGTH( format )] = end;
4109  }
4110  }
4111 
4112  STRING( format )[LENGTH( format )] = end;
4113  buff_len = STRLEN( buff );
4114  RETURN( new_word( buff, buff_len ) );
4115  }
4116 }
4117 
4118 
4119 
4120 //===================================================
atom_t rt_formattime ( atom_t  format,
atom_t  data 
)
Parameters
datadata to be formated
formatformating string
Returns
Word representing given data according to format string.

Implements the primitive FORMATTIME. Outputs string representation of data according to date/time format formating string using strftime sintax.

Definition at line 4140 of file runtime.c.

4141  {
4142  RETURN( new_error( ERROR_NOT_A_WORD, format ) );
4143  }
4144 
4145  int64_t time64;
4146  if( !atom_to_int( data, &time64 ) )
4147  {
4149  }
4150  time_t time = time64;
4151 
4152  atom_t formatz = atom_to_real_word( format );
4153 
4154  struct tm *presult;
4155  presult = gmtime( &time );
4156  char_t buf[MAX_WORD_LENGTH];
4157  int len;
4158  if( presult )
4159  len = STRFTIME( buf, MAX_WORD_LENGTH, STRING(formatz), presult );
4160  else
4161  len = 0;
4162 
4163  res = new_word( buf, len );
4164  DEUSE( formatz );
4165 
4166  RETURN( res );
4167 }
4168 
4169 
4170 
4171 //===================================================
atom_t rt_definedp ( int  static_link,
atom_t  parent,
atom_t  data 
)
Parameters
datadata to test
static_linkstatic link from the current frame
parentcurrent parent
Returns
true if data contains the name of a user-defined function

Implements primitive predicate DEFINED?. Returns true if data contains the name of a user-defined function or command.

Definition at line 4191 of file runtime.c.

4212 {
atom_t rt_primitivep ( int  static_link,
atom_t  parent,
atom_t  data 
)
Parameters
datadata to test
static_linkstatic link from the current frame
parentcurrent parent
Returns
true if data contains the name of a primitive function

Implements primitive predicate PRIMiTIVE?. Returns true if data contains the name of a primitive function or command.

Definition at line 4218 of file runtime.c.

4239 {
atom_t rt_namep ( int  static_link,
atom_t  parent,
atom_t  data 
)
Parameters
datadata to test
static_linkstatic link from the current frame
parentcurrent parent
Returns
true if data contains the name of a variable

Implements primitive predicate NAME?. Returns true if data contains the name of a variable.

Definition at line 4245 of file runtime.c.

4277 {
atom_t rt_procedurep ( int  static_link,
atom_t  parent,
atom_t  data 
)
Parameters
datadata to test
static_linkstatic link from the current frame
parentcurrent parent
Returns
true if data contains the name of a function or a command

Implements primitive predicate PROCEDURE?. Returns true if data contains the name of a function or a command.

Definition at line 4283 of file runtime.c.

4304 {
atom_t rt_var_value ( int  static_link,
atom_t  parent,
atom_t  var 
)
Parameters
varthe variable
static_linkstatic link from the current frame
parentcurrent parent
Returns
the value of the variable

This function looks for the value of a variable, somewhere in a stack frame. If the variable is global do not scan the stack.

Definition at line 4310 of file runtime.c.

4329 {
atom_t rt_use_var ( atom_t  source,
atom_t  value 
)
Parameters
sourcethe source code
valuethe variable's value
Returns
the value of the variable

This function increases the reference count of a variable's value and check whether it is acceptible for a value – i.e. it is neither error or unbound.

Definition at line 4382 of file runtime.c.

4404 {
atom_t rt_thing ( int  static_link,
atom_t  parent,
atom_t  data 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
datavariable name
Returns
the value of variable with given name

Implements primitive THING. Returns the value of the variable which name is the value of data. If there is no variable, then return error atom.

Definition at line 4410 of file runtime.c.

4444 {
atom_t rt_reference ( int  static_link,
atom_t  parent,
atom_t  data 
)
Parameters
datavariable name
static_linkstatic link from the current frame
parentcurrent parent
Returns
the value of variable with given name

Implements the : syntax. Returns the value of the variable which name is following the colons. If there is no variable, then return error atom.

Definition at line 4450 of file runtime.c.

4479  {
4480  //printf("var="); dumpln(var);
4481  RETURN( USE( VALUE( var ) ) );
4482  }
4483 
4484  //printf("value="); dumpln(VALUE(var));
4485 
4486  // user-defined variable
4487  RETURN( USE( rt_var_value( static_link, parent, var ) ) );
4488 }
4489 
4490 
4491 //===================================================
atom_t rt_check_inputs ( int  stack_frame)
Parameters
stack_framethe current stack frame
Returns
unbound or error atoms

Checks all external parameters (inputs) whether any of them is error atom. If yes, then return this error. Otherwise, return unbound atom.

Definition at line 4511 of file runtime.c.

4511  {
4512  atom_t data = *(atom_t*)(stack_frame+BASE_OFFSET_PARAMSCOUNT+4*inputs);
4513  if( IS_ERROR(data) )
4514  {
4515  data = USE(data);
4516  if( res==unbound ) res = data;
4517  }
4518  }
4519  RETURN( res );
4520 }
4521 
4522 
4523 //===================================================
atom_t rt_bye ( void  )

Implement command BYE Terminate the program

Definition at line 4537 of file runtime.c.

4548 {
atom_t rt_wait ( atom_t  time)
Parameters
timeTime to wait in 60-ths of second

Implement command WAIT Suspend the program execution for time 60-ths of second and flushes the output buffer.

Definition at line 4554 of file runtime.c.

4555  {
4556 #ifdef WINDOWS
4557  wait_time = (wait_time * 1000) / 60; // convert 60-ths of second to milliseconds
4558  Sleep( wait_time );
4559 #else
4560  wait_time = (wait_time * 1000 * 1000) / 60; // convert 60-ths of second to milliseconds
4561  usleep( wait_time );
4562 #endif
4563  }
4564  RETURN( unbound );
4565 }
4566 
4567 
4568 //===================================================
atom_t rt_ashift ( atom_t  bits,
atom_t  num 
)
Parameters
bitsNumber of bits to shift
numNumber to be shifted
Returns
result of num << bits.

Implement logical operation ASHIFT. num is shifted bits bits to the left. if bits is negative the shift is to the right with sign bit fill

Definition at line 4588 of file runtime.c.

4590  {
4591  RETURN( new_integer( number >> -bits_num ) );
4592  }
4593  else
4594  {
4595  RETURN( new_integer( number << bits_num ) );
4596  }
4597 }
4598 
4599 
4600 //===================================================
atom_t rt_lshift ( atom_t  bits,
atom_t  num 
)
Parameters
bitsNumber of bits to shift
numNumber to be shifted
Returns
result of num << bits.

Implement logical operation LSHIFT. num is shifted bits bits to the left. if bits is negative the shift is to the right with zero bits fill

Definition at line 4620 of file runtime.c.

4622  {
4623  RETURN( new_integer( (int64_t) (((uint64_t) number) >> -bits_num) ) );
4624  }
4625  else
4626  {
4627  RETURN( new_integer( number << bits_num ) );
4628  }
4629 }
4630 
4631 
4632 //===================================================
atom_t rt_bitand ( int  data)
Parameters
datanumber of inputs of BITAND
Returns
binary AND of all arguments

Implement binary operation BITAND. The only input contains the number of inputs which are pulled out from the stack. Returns their binary product (AND)

Definition at line 4650 of file runtime.c.

4650  {
4651  GET_INT( ARGUMENT, x );
4652  acc &= x;
4653  }
4654  RETURN( new_integer( acc ) );
4655 }
4656 
4657 
4658 //===================================================
atom_t rt_bitor ( int  data)
Parameters
datanumber of inputs of BITOR
Returns
binary OR of all arguments

Implement binary operation BITOR. The only input contains the number of inputs which are pulled out from the stack. Returns their binary sum (OR)

Definition at line 4676 of file runtime.c.

4676  {
4677  GET_INT( ARGUMENT, x );
4678  acc |= x;
4679  }
4680  RETURN( new_integer( acc ) );
4681 }
4682 
4683 
4684 
4685 //===================================================
atom_t rt_bitxor ( int  data)
Parameters
datanumber of inputs of BITXOR
Returns
binary XOR of all arguments

Implement binary operation BITXOR. The only input contains the number of inputs which are pulled out from the stack. Returns their binary sum by modulo 2(XOR)

Definition at line 4704 of file runtime.c.

4704  {
4705  GET_INT( ARGUMENT, x );
4706  acc ^= x;
4707  }
4708  RETURN( new_integer( acc ) );
4709 }
4710 
4711 
4712 //===================================================
atom_t rt_bitnot ( atom_t  data)
Parameters
datainteger number.
Returns
binary NOT of the argument

Implement binary operation BITNOT. The only input contains the number to be negated. Returns its binary negation (NOT)

Definition at line 4730 of file runtime.c.

4743 {
atom_t rt_pick ( atom_t  list)
Parameters
lista list
Returns
randomly selected element of list

Implement primitiwe function PICK. Returns randomly selected element of list

Definition at line 4749 of file runtime.c.

4749  {
4750  int len;
4751  int rand_num;
4752  if (IS_EMPTY( list ))
4753  {
4755  }
4756  rand_num = rand( );
4757  len = list_length( list );
4758  RETURN( USE( get_at_list( list, rand_num % len ) ) );
4759  }
4760  RETURN( new_error( ERROR_NOT_A_LIST, list ) );
4761 }
4762 
4763 
4764 //===================================================
atom_t rt_remdup ( atom_t  cip,
atom_t  data 
)
Parameters
cipvalue of CASEIGNOREDP
dataa list or a word
Returns
the list without duplicate elements

Implement primitiwe function REMDUP. Remove all duplicate elements of its input. The element which remain is rightmost.

Definition at line 4783 of file runtime.c.

4786  {
4787  atom_t iter;
4788  atom_t res_iter;
4789 
4790  result = empty_list;
4791  res_iter = result;
4792 
4793  while (!IS_EMPTY(data))
4794  {
4795  iter = CDR(data);
4796  while (!IS_EMPTY(iter))
4797  {
4798  if (atom_equal( cip, CAR(data), CAR( iter ) ))
4799  {
4800  break;
4801  }
4802  iter = CDR( iter );
4803  }
4804  if (IS_EMPTY( iter ))
4805  {
4806  if (IS_EMPTY( res_iter ))
4807  {
4808  result = res_iter = new_list( USE( CAR(data) ), empty_list );
4809  }
4810  else
4811  {
4812  CDR( res_iter ) = new_list( USE( CAR(data) ), empty_list );
4813  res_iter = CDR( res_iter );
4814  }
4815  }
4816  data = CDR(data);
4817  }
4818  }
4819  else // Data is a WORD
4820  {
4821  size_t len, total;
4822  size_t i, j;
4823  int case_ignore;
4824  chars_t word;
4825  atom_t data1;
4826  if (!atom_to_boolean( cip, &case_ignore ))
4827  {
4828  case_ignore = 1;
4829  }
4830  data1 = atom_to_word(data);
4831  if (IS_ERROR(data1))
4832  {
4833  RETURN(data1);
4834  }
4835 
4836  total = len = LENGTH(data1);
4837  word = STRING(data1);
4838  if (case_ignore)
4839  {
4840  for (i = 0; i < total-1; ++i)
4841  {
4842  for (j = i+1; j < total; ++j)
4843  {
4844  if (TOLOWER(DEBAR(word[i]))==TOLOWER(DEBAR(word[j])))
4845  {
4846  --len;
4847  break;
4848  }
4849  }
4850  }
4851  result = create_word(len);
4852  len = 0;
4853  for (i = 0; i < total; ++i)
4854  {
4855  for (j = i+1; j < total; ++j)
4856  {
4857  if (TOLOWER(DEBAR(word[i]))==TOLOWER(DEBAR(word[j])))
4858  {
4859  break;
4860  }
4861  }
4862  if (j >= total)
4863  {
4864  STRING(result)[len++] = word[i];
4865  }
4866  }
4867  }
4868  else
4869  {
4870  for (i = 0; i < total-1; ++i)
4871  {
4872  for (j = i+1; j < total; ++j)
4873  {
4874  if (DEBAR(word[i])==DEBAR(word[j]))
4875  {
4876  --len;
4877  break;
4878  }
4879  }
4880  }
4881  result = create_word(len);
4882  len = 0;
4883  for (i = 0; i < total; ++i)
4884  {
4885  for (j = i+1; j < total; ++j)
4886  {
4887  if (DEBAR(word[i])==DEBAR(word[j]))
4888  {
4889  break;
4890  }
4891  }
4892  if (j >= total)
4893  {
4894  STRING(result)[len++] = word[i];
4895  }
4896  }
4897  }
4898  DEUSE(data1);
4899  }
4900  RETURN(result);
4901 }
4902 
4903 
4904 //===================================================
atom_t rt_remove ( atom_t  cip,
atom_t  data,
atom_t  elem 
)
Parameters
cipvalue of CASEIGNOREDP
dataa list or word
eleman atom to be remowed from list or char to be removed from word
Returns
the input without any occurrence of elem

Implement primitiwe function REMOVE. Return a copy of data where all occurrences of elem are removed

Definition at line 4924 of file runtime.c.

4928  {
4929  result = empty_list;
4930  res_iter = result;
4931 
4932  while (!IS_EMPTY( data ))
4933  {
4934  if (!atom_equal( cip, CAR( data ), elem ))
4935  {
4936  if (IS_EMPTY( res_iter ))
4937  {
4938  result = res_iter = new_list( USE( CAR( data ) ), empty_list );
4939  }
4940  else
4941  {
4942  CDR( res_iter ) = new_list( USE( CAR( data ) ), empty_list );
4943  res_iter = CDR( res_iter );
4944  }
4945  }
4946  data = CDR( data );
4947  }
4948  }
4949  else // data is a word
4950  {
4951  size_t len, total;
4952  size_t i;
4953  int case_ignore;
4954  chars_t word;
4955  atom_t data1;
4956  char_t ch;
4957  if (IS_ERROR(elem))
4958  {
4959  RETURN(USE(elem));
4960  }
4961 
4962  data1 = atom_to_word(elem);
4963  if (IS_ERROR(data1) || LENGTH(data1) != 1)
4964  {
4965  DEUSE(data1);
4967  }
4968  ch = (STRING(data1))[0];
4969  DEUSE(data1);
4970 
4971  if (!atom_to_boolean( cip, &case_ignore ))
4972  {
4973  case_ignore = 1;
4974  }
4975  data1 = atom_to_word(data);
4976  if (IS_ERROR(data1))
4977  {
4978  DEUSE(data1);
4979  RETURN(data);
4980  }
4981  total = len = LENGTH(data1);
4982  word = STRING(data1);
4983  if (case_ignore)
4984  {
4985  ch = TOLOWER(DEBAR(ch));
4986  for (i = 0; i < total; ++i)
4987  {
4988  if (TOLOWER(DEBAR(word[i]))==ch)
4989  {
4990  --len;
4991  }
4992  }
4993  result = create_word(len);
4994  len = 0;
4995  for (i = 0; i < total; ++i)
4996  {
4997  if (TOLOWER(DEBAR(word[i]))!=ch)
4998  {
4999  STRING(result)[len++] = word[i];
5000  }
5001  }
5002  }
5003  else
5004  {
5005  ch = DEBAR(ch);
5006  for (i = 0; i < total; ++i)
5007  {
5008  if (DEBAR(word[i])==ch)
5009  {
5010  --len;
5011  }
5012  }
5013  result = create_word(len);
5014  len = 0;
5015  for (i = 0; i < total; ++i)
5016  {
5017  if (DEBAR(word[i])!=ch)
5018  {
5019  STRING(result)[len++] = word[i];
5020  }
5021  }
5022  }
5023  DEUSE(data1);
5024  }
5025  RETURN(result);
5026 }
5027 
5028 
5029 //===================================================
atom_t rt_reverse ( atom_t  data)
Parameters
dataa list or a word
Returns
a copy of data, but elements are reversed

Implements primitive function REVERSE. Creates a reverse copy of a list or word

Definition at line 5046 of file runtime.c.

5049  {
5050  if (IS_EMPTY( data ))
5051  {
5052  RETURN( data );
5053  }
5054 
5055  result = empty_list;
5056  while (!IS_EMPTY( data ))
5057  {
5058  result = new_list( USE( CAR( data ) ), result );
5059  data = CDR( data );
5060  }
5061  }
5062  else // data must be word
5063  {
5064  int i, n;
5065  data = atom_to_word( data );
5066  if (IS_ERROR( data ))
5067  {
5068  RETURN( data );
5069  }
5070  result = create_word(LENGTH( data ));
5071  n = LENGTH( data );
5072  for (i = 0; i < n; ++i)
5073  {
5074  STRING( result )[n - i - 1] = STRING( data )[i];
5075  }
5076  DEUSE (data);
5077  }
5078 
5079  RETURN( result );
5080 }
5081 
5082 
5083 //===================================================
atom_t rt_rawascii ( atom_t  data)
Parameters
dataone char word
Returns
ASCII code of data

Implements the primitive RAWASCII. Returns ASCII code of given char, but interpred control symbols as themselves

Definition at line 5101 of file runtime.c.

5105  {
5106  if (LENGTH( data ) != 1)
5107  {
5109  }
5110 #ifdef UNICODE_CHARS
5111  if (!OPTION_TRADITIONAL)
5112  {
5113  RETURN( new_integer( (ushort_t) STRING( data )[0] ) );
5114  }
5115 #endif
5116  RETURN( new_integer( (byte_t) STRING( data )[0] ) );
5117  }
5118 
5119  if (IS_LIST( data ))
5120  {
5121  RETURN( new_error( ERROR_NOT_A_WORD, data ) );
5122  }
5123 
5124  if (atom_to_string( data, buff, &buff_len ))
5125  {
5126  if (buff_len == 1)
5127  {
5128 #ifdef UNICODE_CHARS
5129  if (!OPTION_TRADITIONAL)
5130  {
5131  RETURN( new_integer( (ushort_t) buff[0] ) );
5132  }
5133 #endif
5134  RETURN( new_integer( (byte_t) buff[0] ) );
5135  }
5136 
5137  // Word but too long
5139  }
5140  RETURN( new_error( ERROR_NOT_A_WORD, data ) );
5141 }
5142 
5143 
5144 //===================================================
atom_t rt_gensym ( )
Returns
unique word each time it's called

Implements the primitive GENSYM. Returns unique word each time it's called The words are like that G1, G2, G3...

Definition at line 5161 of file runtime.c.

5166  {
5167  sym[temp_len] = TEXT( '0' ) + temp % 10;
5168  }
5169  ++num;
5170  RETURN( new_word( sym, num_len + 1 ) );
5171 }
5172 
5173 
5174 //===================================================
atom_t rt_substringp ( atom_t  cip,
atom_t  data2,
atom_t  data1 
)
Parameters
cipvalue of CASEIGNOREDP
data1String to be search
data2String to search in
Returns
boolean atom

Implements the primitive precicate SUBSTRINGP Returns true if data1 is substring of data2 false if it is not, or any of inputs is not word

Definition at line 5194 of file runtime.c.

5195  {
5196  RETURN( USE(data1) );
5197  }
5198  if (IS_ERROR( data2 ))
5199  {
5200  RETURN( USE(data2) );
5201  }
5202 
5203  // Check for lists - easy way to return FALSE
5204  if (IS_LIST( data1 ) || IS_LIST( data2 ))
5205  {
5206  RETURN( USE( false_true[0] ) );
5207  }
5208 
5209  // Get words from atoms
5210  data1 = atom_to_word( data1 );
5211  if (IS_ERROR( data1 ))
5212  {
5213  RETURN( data1 );
5214  }
5215  data2 = atom_to_word( data2 );
5216  if (IS_ERROR( data2 ))
5217  {
5218  DEUSE( data1 );
5219  RETURN( data2 );
5220  }
5221 
5222  if (!atom_to_boolean( cip, &case_ignore ))
5223  {
5224  case_ignore = 1;
5225  }
5226 
5227  // Here is the comparison
5228  for (pos = 0; pos + LENGTH( data1 ) <= LENGTH( data2 ); ++pos)
5229  {
5230  if (!word_compare( case_ignore, STRING( data2 ) + pos, LENGTH( data1 ),
5231  STRING( data1 ), LENGTH( data1 ) ))
5232  {
5233  result = 1;
5234  break;
5235  }
5236  }
5237 
5238  //clear and return
5239  DEUSE( data1 );
5240  DEUSE( data2 );
5241  RETURN( USE( false_true[result] ) );
5242 }
5243 
5244 
5245 //===================================================
atom_t rt_substring ( atom_t  cip,
atom_t  data2,
atom_t  data1 
)
Parameters
cipvalue of CASEIGNOREDP
data1String to be search
data2String to search in
Returns
boolean atom

Implements the primitive SUBSTRING Returns the position of data1 in data2 if they are words (0 if not found), or generates an error is any of the inputs is not a word.

Definition at line 5266 of file runtime.c.

5267  {
5268  RETURN( USE(data1) );
5269  }
5270  if (IS_ERROR( data2 ))
5271  {
5272  RETURN( USE(data2) );
5273  }
5274 
5275  // Get words from atoms
5276  data1 = atom_to_word( data1 );
5277  if (IS_ERROR( data1 ))
5278  {
5279  RETURN( data1 );
5280  }
5281  data2 = atom_to_word( data2 );
5282  if (IS_ERROR( data2 ))
5283  {
5284  DEUSE( data1 );
5285  RETURN( data2 );
5286  }
5287 
5288  if (!atom_to_boolean( cip, &case_ignore ))
5289  {
5290  case_ignore = 1;
5291  }
5292 
5293  // Here is the search
5294  for (pos = 0; pos + LENGTH( data1 ) <= LENGTH( data2 ); ++pos)
5295  {
5296  if (!word_compare( case_ignore, STRING( data2 ) + pos, LENGTH( data1 ),
5297  STRING( data1 ), LENGTH( data1 ) ))
5298  {
5299  result = pos+1;
5300  break;
5301  }
5302  }
5303 
5304  //clear and return
5305  DEUSE( data1 );
5306  DEUSE( data2 );
5307  RETURN( new_integer(result) );
5308 }
5309 
5310 
5311 //===================================================
atom_t rt_combine ( atom_t  data2,
atom_t  data1 
)
Parameters
data1Element to add
data2List or word
Returns
New list or word containing data2 with data1 at start

Implements the primitive COMBINE. Returns data2 with data1 inserted at front.

Definition at line 5329 of file runtime.c.

5330  {
5331  RETURN( new_list( USE( data1 ), USE( data2 ) ) );
5332  }
5333  data1 = atom_to_word( data1 );
5334  if (IS_ERROR( data1 ))
5335  {
5336  RETURN( data1 );
5337  }
5338  data2 = atom_to_word( data2 );
5339  if (IS_ERROR( data2 ))
5340  {
5341  DEUSE( data1 );
5342  RETURN( data2 );
5343  }
5344 
5345  // Copy the data
5346  res = create_word( LENGTH( data1 ) + LENGTH( data2 ) );
5347  STRNCPY( STRING( res ), STRING( data1 ), LENGTH( data1 ) );
5348  STRNCPY( STRING( res ) + LENGTH( data1 ), STRING( data2 ), LENGTH( data2 ) );
5349  *(STRING( res ) + LENGTH( data1 ) + LENGTH( data2 )) = NULL_CHAR;
5350 
5351  DEUSE( data1 );
5352  DEUSE( data2 );
5353  RETURN( res );
5354 }
5355 
5356 
5357 //===================================================
atom_t rt_quoted ( atom_t  data)
Parameters
dataElement to quote
Returns
quoted input if word

Implements the primitive QUOTED. Returns data if it's a list or data with quotation if is a word.

Definition at line 5374 of file runtime.c.

5403 {
atom_t rt_throw ( int  count,
atom_t  data1,
atom_t  data2 
)
Parameters
countnumber of arguments (1 or 2)
data1first parameter of THROW
data2second parameter of THROW
Returns
unbound or error atom

Implements the THROW primitive: THROW "TOPLEVEL THROW "SYSTEM THROW "ERROR (THROW "ERROR message) THROW tag (THROW tag value)

Definition at line 5409 of file runtime.c.

5413  {
5414  tag = data2;
5415  value = data1;
5416  }
5417 
5418  // THROW "TOPLEVEL
5419  if (same_words( tag, word_toplevel ))
5421 
5422  // THROW "SYSTEM
5423  if (same_words( tag, word_system ))
5425 
5426  // THROW "ERROR
5427  // THROW "ERROR <message>
5428  if (same_words( tag, word_error ))
5429  {
5430  if (count == 1)
5431  {
5433  }
5434  else
5435  {
5437  }
5438  }
5439 
5440  // THROW <tag>
5441  // THROW <tag> <value>
5442  atom_t list = new_list( USE( tag ), new_list( USE( value ), empty_list ) );
5443  atom_t result = new_error( count == 1 ? EXIT_BY_THROW_TAG : EXIT_BY_THROW_TAG_VALUE, list );
5444  DEUSE( list );
5445  RETURN( result );
5446 }
5447 
5448 
5449 
5450 //===================================================
atom_t rt_catch ( atom_t  commands,
atom_t  tag 
)
Parameters
commandscommands monitored by catch
tagcatch tag

Dummy implementation of primitive CATCH.

Definition at line 5466 of file runtime.c.

5490 {
atom_t rt_catchchk ( int  status,
atom_t  tag,
atom_t  data 
)
Parameters
statusoutput status of data
tagcatch's tag
datavalue to check
Returns
error or unbound atom

Checks whether the result of a catch command. If the result is thrown by throw with the same tag, then mask the result and return the thrown data. Results are also masked if the catch tag is ERROR and the thrown calue is an error-meaning error atom.

In all other cases (thrown with another tag or error) return the same result.

Definition at line 5494 of file runtime.c.

5503  {
5504  //catch_output_flag = 0;
5505  DEUSE( tag );
5506 
5507  return data;
5508  }
5509  //printf("CATCH TAG=");dumpln(tag);
5510  //printf("ERRDATA=");dumpln((ERRDATA(data)));
5511  //printf("THROW TAG=");dumpln(CAR(ERRDATA(data)));
5512 
5513  // process true errors
5514  if (ERRCODE( data ) < FIRST_EXIT_CODE || ERRCODE( data ) > LAST_EXIT_CODE)
5515  {
5516  if (!IS_ANY_WORD( tag ))
5517  {
5518  DEUSE( tag );
5519  return data;
5520  }
5521 
5522  if (!same_words( word_error, tag ))
5523  {
5524  DEUSE( tag );
5525  return data;
5526  }
5527 
5528  result = unbound;
5529  goto exit_catch;
5530  }
5531 
5532  // return throw-exception if tags are not (sub)words
5533  if (!IS_ANY_WORD( tag ) || !IS_ANY_WORD( CAR( ERRDATA( data ) ) ))
5534  {
5535  DEUSE( tag );
5536  return data;
5537  }
5538  // return throw-exception is tags are not equal
5539  if (!same_words( tag, CAR( ERRDATA( data ) ) ))
5540  {
5541  DEUSE( tag );
5542  return data;
5543  }
5544 
5545  // tags match or error captured
5546  result = USE( CAR( CDR( ERRDATA( data ) ) ) );
5547 
5548  exit_catch:
5549  //while (REF( data ) > 1) DEUSE( data ); //2009
5550  //DEUSE( last_error );
5551  last_error = data;
5552  //clear_all_errors();
5553  DEUSE( tag );
5554  //printf("result="); dumpln(result);
5555  //printf("last_error(%d)=",REF(last_error)); dumpln(last_error);
5556 
5557  catch_output_flag = 0; // forget any OUTPUT with error
5558  return result;
5559 }
5560 
5561 
5562 
5563 
5564 
5565 //===================================================
atom_t rt_error ( )
Returns
a list describing the last error

Implementation of the primitive function ERROR. Returns a list describing the last error (if any) and then clears the error.

Definition at line 5582 of file runtime.c.

5609  {
5610  //printf("---"); dump_atom(p,1); printf("\n");
5611  //printf(">>>"); dumpln(CAR(p));
5612  if (!IS_EXPRESSION( CAR( p ) )) continue;
5613  //printf("???"); dumpln(CAR(CAR(p)));
5614  atom_t var = find_var( CAR( CAR( p ) ), globals );
5615  if (var && IS_PRIMITIVE( var )) continue;
5616  //printf("!!!\n");
5617  source = CAR( p );
5618  procedure = CAR( source );
5619  }
5620  //printf("--AFTER FOR-->!\n");
5621 
5622  atom_t result;
5623  result = new_list( USE( source ), empty_list );
5624  result = new_list( USE( procedure ), result );
5625  result = new_list( message, result );
5626  result = new_list( code, result );
5627 
5628  //REF(last_error) = 1;
5629  //DEUSE( last_error );
5631  //printf("--BEFORE CLEAR-->!\n");
5632  //clear_all_errors(); //2011.11.30 removed, because causes bug 3445230. now all test cases work fine
5633  //printf("--AFTER CLEAR-->!\n");
5634 
5635  RETURN( result );
5636 }
5637 
5638 
5639 
5640 //===================================================
atom_t rt_tag ( )

Dummy implementation of primitive TAG.

Definition at line 5654 of file runtime.c.

5670 {
atom_t rt_goto ( int  static_link,
atom_t  parent,
atom_t  data,
atom_t  source 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
dataname of variable
sourcesource of GOTO
Returns
unbound or error atom

Implementation of primitive GOTO. Looks for the tag in the local variables. If not found then return an error atom. If found then return the VALUE of the tag-variable.

Definition at line 5676 of file runtime.c.

5696 {
atom_t rt_iftrue ( atom_t  commands)
Parameters
commandscommands to run
Returns
unbound atom

This is a dummy implementation, which is not used except for reserving a unique address for IFTRUE primitive.

Definition at line 5702 of file runtime.c.

5715 {
atom_t rt_iffalse ( atom_t  commands)
Parameters
commandscommands to run
Returns
unbound atom

This is a dummy implementation, which is not used except for reserving a unique address for IFFALSE primitive.

Definition at line 5721 of file runtime.c.

5735 {
atom_t rt_test ( atom_t  condition,
int  frame 
)
Parameters
framebase frame pointer
conditioncondition to store
Returns
unbound atom

Sets the value of local variable at address EBP+BASE_OFFEST_TEST to be the value of condition. This value is later accessed by IFTRUE and IFFALSE primitives.

Definition at line 5741 of file runtime.c.

5757 {
atom_t rt_backslashedp ( atom_t  data)
Parameters
dataone char word
Returns
true if data contains backslashed character

Implements the primitive BACLSLASHED?.

Definition at line 5763 of file runtime.c.

5765  {
5767  }
5768 
5769  char_t ch = *STRING( data );
5770  DEUSE( data );
5771  RETURN( USE( false_true[ch != DEBAR( ch )] ) );
5772 }
5773 
5774 
5775 
5776 
5777 //===================================================
atom_t rt_text ( int  static_link,
atom_t  parent,
atom_t  data 
)
Parameters
datafunction name
static_linkstatic link from the current frame
parentcurrent parent
Returns
a list with the function's commands

Implements primitive TEXT. Returns a list containing the commands of a given function. The list could be accepted by DEFINE primitive.

Definition at line 5797 of file runtime.c.

5817  {
5818  n++;
5819  if (n > RARGS( var ))
5820  element = new_list( USE( NAME( CAR( x ) ) ), element ); // left inputs
5821  else
5822  result = new_list( USE( NAME( CAR( x ) ) ), result ); // right inputs
5823  }
5824 
5825  // if there were left inputs then put them as
5826  // a sublist in front of right inputs
5827  if (IS_NOT_EMPTY( element ))
5828  {
5829  result = new_list( element, result );
5830  element = empty_list;
5831  }
5832 
5833  // pack all inputs as the first element of the result
5834  result = new_list( result, empty_list );
5835  reslast = result;
5836 
5837  // group elements into lines
5838  for (x = BODY( var ); IS_NOT_EMPTY( x ); x = CDR( x ))
5839  {
5840  if (IS_NOT_EMPTY( element ) && GET_FLAGS( x, FLAG_NEWLINE ))
5841  {
5842  append( element, &result, &reslast );
5843  element = empty_list;
5844  elemlast = empty_list;
5845  }
5846  append( USE( CAR( x ) ), &element, &elemlast );
5847  }
5848 
5849  // process any leftovers
5850  if (IS_NOT_EMPTY( element ))
5851  {
5852  append( element, &result, &reslast );
5853  }
5854 
5855  RETURN( result );
5856 }
5857 
5858 
5859 
5860 
5861 //===================================================
atom_t rt_fulltext ( int  static_link,
atom_t  parent,
atom_t  data 
)
Parameters
datafunction name
static_linkstatic link from the current frame
parentcurrent parent
Returns
a list with the function's commands

Implements primitive FULLTEXT. Returns a word containing the function as source. If the source is not avaialble, then return the same result as TEXT.

Definition at line 5882 of file runtime.c.

5923 {
atom_t rt_run ( int  static_link,
atom_t  parent,
atom_t  data,
int  mode 
)
Parameters
datadata to run
static_linkstatic link from the current frame
parentcurrent parent
modeCOMPILE_AS_FUNC or COMPILE_AS_PROC
Returns
var atom containing the compiled code

Implements primitive command/function RUN. Creates a local function with the given body, compiles it, and returns its var atom.

It is supposed that the caller of rt_run() should use the result to do the actual call of the newly compiled code.

If mode is COMPILE_AS_PROC then the compiled code is a list of commands, otherwise it is a single expression.

Definition at line 5929 of file runtime.c.

5943  {
5944  DEUSE( func );
5945  RETURN( x );
5946  }
5947 
5948  //printf("compiled tree="); dump_atom(TREE(func),1); printf("\n");
5949  //printf("-----------EXIT rt_run()---------------\n");
5950  //printf("result="); dumpln(func);
5951  //printf("---------------------------------------\n");
5952  //printf("!!!locals ="); dump_atom(LOCALS(func),1); printf("\n");
5953  //printf("!!!to transfer to parent="); dump_atom(NAME(PARENT(func)),1); printf("\n");
5954  //printf("---------------------------------------\n");
5955 
5956  // wrong place:: transfer all local vars from here to the parent of run
5957  // it is wrong, because transfer should be done after the code is
5958  // executed. currently the code is only compiled
5959  //atom_t a;
5960  //for( a=LOCALS(func); IS_NOT_EMPTY(a); a=CDR(a) )
5961  // {
5962  // //printf(" "); dump_atom(NAME(CAR(a)),1);
5963  //
5964  // }
5965  //printf("\n");
5966  RETURN( func );
5967 }
5968 
5969 
5970 
5971 
5972 //===================================================
atom_t rt_runmacro ( int  static_link,
atom_t  parent,
atom_t  data,
int  mode 
)
Parameters
datadata to run
static_linkstatic link from the current frame
parentcurrent parent
modeCOMPILE_AS_FUNC or COMPILE_AS_PROC
Returns
var atom containing the compiled code

Implements primitive command/function RUNMACRO. Creates a local function with the given body, compiles it as a macro, and returns its var atom.

It is supposed that the caller of rt_runmacro() should use the result to do the actual call of the newly compiled code.

If mode is COMPILE_AS_PROC then the compiled code is a list of commands, otherwise it is a single expression.

Definition at line 6001 of file runtime.c.

6016  {
6017  DEUSE( func );
6018  RETURN( x );
6019  }
6020 
6021  RETURN( func );
6022 }
6023 
6024 
6025 
6026 
6027 //===================================================
atom_t rt_runresult ( int  static_link,
atom_t  parent,
atom_t  data 
)
Parameters
datadata to run
static_linkstatic link from the current frame
parentcurrent parent
Returns
var atom containing the compiled code

Implements primitive command/function RUNRESULT by reusing rt_run() function.

Definition at line 6046 of file runtime.c.

6063 {
atom_t rt_runresult_fix ( atom_t  data)
Parameters
datadata to fix
Returns
fixed atom

Fixes the result of RUNRESULT. If the result is error then return it without change. If it is unbound then return empty list. Otherwise create an one-element list and put data as its element.

Definition at line 6068 of file runtime.c.

6084 {
atom_t rt_define ( int  static_link,
atom_t  parent,
atom_t  value,
atom_t  name 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
namename of function
valuebody of the function

Implements the primitive command DEFINE.

Definition at line 6090 of file runtime.c.

6092  {
6093  DEUSE( word );
6094  RETURN( new_error( ERROR_NOT_A_LIST, value ) );
6095  }
6096 
6097  // create function (similarily to define_user_function)
6098 #ifdef DEBUG_TO_END
6099  printf( "<TO-END-RUNTIME> DEFINING=" );
6100  dumpln( name );
6101 #endif
6102 
6103  // create the function
6104  atom_t function = new_var( word_to, parent, 1 ); //DEUSE(to);
6105  need_descr2( function );
6106  SET_FLAGS( function, FLAG_FUNCTION );
6107  LARGS( function ) = 0;
6108  RARGS( function ) = 0;
6109 
6110  // get lists of left and right inputs
6111  atom_t lefts = empty_list; // left inputs
6112  atom_t rights = empty_list; // right inputs
6113 
6114  if (IS_NOT_EMPTY( value ))
6115  { // there is at least one element
6116  // is it list?
6117  if (IS_LIST( CAR( value ) )) rights = CAR( value );
6118 
6119  // now test for left parameters
6120  if (IS_NOT_EMPTY( rights ) && IS_LIST( CAR( rights ) ))
6121  {
6122  lefts = CAR( rights );
6123  rights = CDR( rights );
6124  }
6125  }
6126 
6127 #ifdef DEBUG_TO_END
6128  printf( "<TO-END-RUNTIME> LEFT PARAMS=" );
6129  dumpln( lefts );
6130  printf( "<TO-END-RUNTIME> RIGHT PARAMS=" );
6131  dumpln( rights );
6132 #endif
6133 
6134  // process left inputs
6135  while (IS_NOT_EMPTY( lefts ))
6136  {
6137  if (!IS_ANY_WORD( CAR( lefts ) ))
6138  {
6139  DEUSE( word );
6140  LOCALS( parent ) = behead( LOCALS( parent ) ); // this DEUSEs function
6141  return new_error( ERROR_NOT_A_WORD, lefts );
6142  }
6143 
6144  atom_t var = new_local_var( CAR( lefts ), function, 0 );
6145  if (IS_ERROR( var ))
6146  {
6147  DEUSE( word );
6148  LOCALS( parent ) = behead( LOCALS( parent ) ); // this DEUSEs function
6149  return var;
6150  }
6151 
6152  SET_FLAGS( var, FLAG_VARIABLE );
6153  LARGS( function )++;
6154 #ifdef SAFE_MODE
6155  assert( LARGS( function ) < 255 );
6156 #endif
6157  lefts = CDR( lefts );
6158  }
6159 
6160  // process right inputs
6161  while (IS_NOT_EMPTY( rights ))
6162  {
6163  if (!IS_ANY_WORD( CAR( rights ) ))
6164  {
6165  DEUSE( word );
6166  LOCALS( parent ) = behead( LOCALS( parent ) ); // this DEUSEs function
6167  return new_error( ERROR_NOT_A_WORD, rights );
6168  }
6169 
6170  atom_t var = new_local_var( CAR( rights ), function, 0 );
6171  if (IS_ERROR( var ))
6172  {
6173  DEUSE( word );
6174  LOCALS( parent ) = behead( LOCALS( parent ) ); // this DEUSEs function
6175  return var;
6176  }
6177 
6178  SET_FLAGS( var, FLAG_VARIABLE );
6179  RARGS( function )++;
6180 #ifdef SAFE_MODE
6181  assert( RARGS( function ) < 255 );
6182 #endif
6183  rights = CDR( rights );
6184  }
6185 
6186 #ifdef DEBUG_TO_END
6187  printf( "<TO-END-RUNTIME> FUNC DEF=" );
6188  dumpln( function );
6189 #endif
6190 
6191 
6192  // set offset of parameters
6193  int offset = BASE_OFFSET_PARAMS; // this is the start offset
6194  atom_t x;
6195  for (x = LOCALS( function ); IS_NOT_EMPTY( x ); x = CDR( x ))
6196  {
6197  //printf("set offset of "); dump(NAME(CAR(x))); printf(" to be %d\n",offset);
6198  OFFSET( CAR( x ) ) = offset;
6199  offset += sizeof ( atom_t);
6200  }
6201 
6202  // the CDR(value) is the body of the function, but it is
6203  // cut into sublists -- each line is a single list. So
6204  // all these list should be combined into one, which will
6205  // become the body of the function
6206  atom_t body = empty_list;
6207  atom_t body_end = empty_list;
6208  atom_t a;
6209  atom_t b;
6210  for (a = CDR( value ); IS_NOT_EMPTY( a ); a = CDR( a ))
6211  {
6212  b = CAR( a );
6213  if (IS_NOT_EMPTY( b ))
6214  { // the first element should have FLAG_NEWLINE set
6215  append( USE( CAR( b ) ), &body, &body_end );
6216  SET_FLAGS( body, FLAG_NEWLINE );
6217  }
6218  for (b = CDR( b ); IS_NOT_EMPTY( b ); b = CDR( b ))
6219  append( USE( CAR( b ) ), &body, &body_end );
6220  }
6221 
6222 #ifdef DEBUG_TO_END
6223  printf( "<TO-END-RUNTIME> FUNC BODY=" );
6224  dumpln( body );
6225 #endif
6226 
6227 
6228 
6229  // check whether the function is already defined
6230  atom_t var = find_runtime_var( word, static_link );
6231  if (var)
6232  {
6233  if (LARGS( var ) != LARGS( function ) || RARGS( var ) != RARGS( function ))
6234  {
6235  LOCALS( parent ) = behead( LOCALS( parent ) ); // this DEUSEs function
6237  return result;
6238  }
6239 
6240  // forget data of the old function and
6241  // reuse data of the new function
6242  DEUSE( FULLSOURCE( var ) );
6243  DEUSE( SOURCE( var ) );
6244  DEUSE( LOCALS( var ) );
6245  DEUSE( BODY( var ) );
6246  DEUSE( TREE( var ) );
6247  DEUSE( BINARY( var ) );
6248 
6249  BODY( var ) = empty_list;
6250  TREE( var ) = empty_list;
6251  BINARY( var ) = empty_list;
6252 
6253  SOURCE( var ) = body;
6254  LOCALS( var ) = USE( LOCALS( function ) );
6255 
6256  LOCALS( parent ) = behead( LOCALS( parent ) );
6257  //DEUSE(function);
6258  function = var;
6259  }
6260  else
6261  {
6262  DEUSE( NAME( function ) );
6263  NAME( function ) = USE( word );
6264  BODY( function ) = empty_list;
6265  }
6266 
6267  //LEVEL( function ) = level;
6268  ADDRESS( function ) = 0;
6269  PRIORITY( function ) = PRIORITY_FUN;
6270 
6271  SOURCE( function ) = body;
6272  FULLSOURCE( function ) = unbound;
6273 
6274  //DEUSE( input );
6275 #ifdef DEBUG_TO_END
6276  printf( "<TO-END> DEFINED FUNCTION " );
6277  dumpln( NAME( function ) );
6278  printf( "<TO-END> SOURCE " );
6279  dumpln( SOURCE( function ) );
6280  printf( "<TO-END> BODY " );
6281  dumpln( BODY( function ) );
6282  printf( "<TO-END> TREE " );
6283  dumpln( TREE( function ) );
6284 #endif
6285 
6286  DEUSE( word );
6287 
6289  if (IS_ERROR( y )) return y;
6290 
6291  return unbound;
6292 }
6293 
6294 
6295 //===================================================
atom_t rt_for ( atom_t  body,
atom_t  limits,
atom_t  var 
)
Parameters
bodybody of FOR command
limitslist of initial and final limits
varname of control variable
Returns
unbound atom

This is a dummy implementation, which is not used except for reserving a unique address for FOR primitive.

Definition at line 6315 of file runtime.c.

6326 {
atom_t rt_libload ( atom_t  data)
Parameters
datafilename of the dynamic library
Returns
Number of library handle

Implements the primitive LIBLOAD. Returns the library handle.

Definition at line 6332 of file runtime.c.

6335  {
6336  RETURN( new_error( ERROR_NOT_A_WORD, data ) );
6337  }
6338 
6339  // convert char_t* into char*
6340  int len = LENGTH( data );
6341  chars_t ptr = STRING( data );
6342  char filename[len + 1+3+1+2];
6343  int i=0;
6344  //#ifndef WINDOWS
6345  //filename[i++] = 'l';
6346  //filename[i++] = 'i';
6347  //filename[i++] = 'b';
6348  //len += 3;
6349  //#endif
6350 
6351  for (; i < len; i++) filename[i] = *(ptr++);
6352  filename[len] = '\0';
6353  //#ifndef WINDOWS
6354  //filename[len++] = '.';
6355  //filename[len++] = 's';
6356  //filename[len++] = 'o';
6357  //filename[len] = '\0';
6358  //#endif
6359 
6360  //dumpln(data);
6361  //fprintf(stderr, "loading library %s\n\n\n",filename);
6362  handle = dlopen( filename, RTLD_LAZY );
6363  //if (!handle) fputs(dlerror(), stderr);
6364  //fprintf(stderr, "\nloaded result=%d.\n",(int)handle);
6365  if( !handle )
6366  {
6367  // searching failed, try again looking in subfolder
6368  // lib of the folder where the compiler is
6369  char buf[PATH_MAX+1];
6371  char* path = dirname(buf);
6372  int pathlen = strlen(path);
6373  strncpy(buf,path,pathlen);
6374 
6375  int filelen = strlen(filename);
6376  if( pathlen+filelen+6 > PATH_MAX ) filelen=0;
6377 #ifdef WINDOWS
6378  strncpy(buf+pathlen,"\\lib\\",5);
6379 #else
6380  strncpy(buf+pathlen,"/lib/",5);
6381 #endif
6382  strncpy(buf+5+pathlen,filename,filelen);
6383  buf[pathlen+5+filelen] = '\0';
6384 
6385  //printf("failed %s, try '%s' while compiler is %s\n",filename,buf,option_compiler_filename);
6386  handle = dlopen( buf, RTLD_LAZY );
6387  }
6388 
6389  return new_integer( (int) handle );
6390 }
6391 
6392 
6393 //===================================================
atom_t rt_libfree ( atom_t  data)
Parameters
datahandle of the dynamic library
Returns
unbound atom

Implements the primitive LIBFREE.

Definition at line 6409 of file runtime.c.

6429 {
atom_t rt_blocksize ( int  static_link,
atom_t  parent,
atom_t  prototype 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
prototypepack prototype
Returns
the pack size in bytes

Implements primitive PACKSIZE. Returns the size of a pack in bytes. The pack is defined by a prototype list. If unknown type is reached then return error atom.

Definition at line 6435 of file runtime.c.

6437  {
6438  RETURN( USE( ATOMS(prototype) ) );
6439  }
6440  else
6441  {
6442  RETURN( new_error(ERROR_NOT_BLOCK_OR_DEF,prototype) );
6443  }
6444 }
6445 
6446 
6447 
6448 //===================================================
atom_t rt_listtoblock ( int  static_link,
atom_t  parent,
atom_t  prototype,
atom_t  data 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
datadata to pack
prototypepack prototype
Returns
memory atom with packed data

Implements primitive LISTTOBLOCK. Creates a memory atom big enough to hold all packed data.

Definition at line 6467 of file runtime.c.

6475  {
6476  DEUSE( memory );
6477  RETURN( res );
6478  }
6479 
6480  RETURN( memory );
6481 }
6482 
6483 
6484 
6485 
6486 //===================================================
atom_t rt_blocktolist ( int  static_link,
atom_t  parent,
atom_t  prototype,
atom_t  data 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
datadata to unpack
prototypepack prototype
Returns
memory atom with packed data

Implements primitive BLOCKTOLIST. It 'reads' packed data from memory atom and returns a list of unpacked data.

Definition at line 6506 of file runtime.c.

6511  {
6512  int64_t addr;
6513  GET_INT( data, addr );
6514  ptr = (void*)(int)addr;
6515  }
6516 
6517  atom_t res = traverse_pack( static_link, parent, prototype, empty_list, ptr, MEM_STRUCT_UNPACK );
6518  return res;
6519 }
6520 
6521 
6522 
6523 //===================================================
atom_t rt_dataaddr ( atom_t  data)
Parameters
dataatom which address is returned
Returns
the address of an atom

Implements primitive DATAADDR. Returns an integer atom which is the address of the data atom.

Definition at line 6540 of file runtime.c.

6556 {
atom_t rt_listintoblock ( int  static_link,
atom_t  parent,
atom_t  prototype,
atom_t  dest,
atom_t  data 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
destdestination for packed data
prototypepack prototype
datadata to pack
Returns
unbound or error atom

Implements primitive PACKTO. Packs data into address specified by dest which must be either a memory atom or an address (i.e. integer atom).

Definition at line 6562 of file runtime.c.

6586 {
atom_t rt_funcaddr ( int  static_link,
atom_t  parent,
atom_t  data 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
datafunction name
Returns
the address of a function with given name

Implements primitive FUNCADDR. Returns the address of the function which name is the value of data. If there is no function, then return error atom.

Definition at line 6592 of file runtime.c.

6624 {
atom_t rt_external ( int  static_link,
atom_t  parent,
atom_t  handle,
atom_t  prototype,
atom_t  name 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
handlehandle of library
prototypeexternal function prototype
namefunction to externalize
Returns
unbound or error atom

Implements primitive EXTERNAL. Creates a trampoline code which prepares the stack by converting atoms into C data types.

atom_t ppp = prototype;

Definition at line 6630 of file runtime.c.

6669  :FLAG_FUNCTION );
6670 
6671  // get external name
6672  atom_t external_name = CAR( prototype );
6673  prototype = CDR( prototype );
6674  if( !IS_ANY_WORD(external_name) )
6675  RETURN( new_error( ERROR_BAD_PROTOTYPE, prototype ) );
6676  //printf("external name = "); dumpln(external_name);
6677 
6678  // check the correct order of parameters
6679  if( list_length(prototype) != RARGS(var) )
6680  RETURN( new_error( ERROR_BAD_PROTOTYPE, prototype ) );
6681 
6682  // now process parameters one-by-one
6683  atom_t params;
6684  int offset = BASE_OFFSET_PARAMS+(RARGS(var)-1)*sizeof(atom_t);
6685  for( ; IS_NOT_EMPTY(prototype); prototype=CDR(prototype) )
6686  {
6687  // get one type from the prototype
6688  type = CAR( prototype );
6689  c_type = get_c_type( static_link, parent, type );
6690  class = c_types[c_type].class;
6691 
6692  if( class==C_TYPE_STRUCT || class==C_TYPE_UNKNOWN )
6693  RETURN( new_error( ERROR_BAD_PROTOTYPE, prototype ) );
6694 
6695  // now find parameter with given offset
6696  for( params=LOCALS(var); IS_NOT_EMPTY(params); params=CDR(params))
6697  {
6698  atom_t param = CAR( params );
6699  if( !IS_VARIABLE(param) ) continue; // functions/commands not allowerd
6700  if( !IS_NORMAL(param) ) continue; // tags/runtimes not allowed
6701  if( OFFSET(param)==offset )
6702  {
6703  VARTYPE( param ) = VAR_TYPE_EXTERNAL+c_type;
6704  //printf(" :::param "); dump(NAME(param)); printf(" is class=%d name=%S\n", c_type, c_types[c_type].name);
6705  break;
6706  }
6707  }
6708 
6709  offset -= sizeof( atom_t );
6710  }
6711 
6712 #ifdef SAFE_MODE
6713  for( params=LOCALS(var); IS_NOT_EMPTY(params); params=CDR(params))
6714  assert( IS_EXTERNAL(CAR(params)) );
6715 #endif
6716 
6717  //printf("search function "); dump(external_name); printf(" in handle "); dumpln(handle);
6718 
6719  // convert char_t* into char*
6720  int len = LENGTH( external_name );
6721  chars_t ptr = STRING( external_name );
6722  char func_name[len + 1];
6723  int i;
6724  for (i = 0; i < len; i++) func_name[i] = *(ptr++);
6725  func_name[len] = '\0';
6726 
6727  void* address = dlsym( (void*)hnd, func_name );
6728 
6729  if( !address )
6730  RETURN( new_error( ERROR_NOT_A_FUNCTION, external_name ) );
6731 
6732  //printf("external address=%x\n",(int)address);
6733 
6734  ADDRESS( var ) = (int)address;
6736 //printf("exit p="); dumpln(ppp);
6737  RETURN( unbound );
6738 }
6739 
6740 
6741 
6742 
6743 //===================================================
atom_t rt_internal ( int  static_link,
atom_t  parent,
atom_t  prototype,
atom_t  name 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
prototypeinternal function prototype
namefunction to internalize
Returns
unbound or error atom

Implements primitive INTERNAL. Creates a trampoline code which prepares the stack by converting C data types into atoms.

Definition at line 6763 of file runtime.c.

6793  :FLAG_FUNCTION );
6794 
6795  // check the correct order of parameters
6796  if( list_length(prototype) != RARGS(var) )
6797  RETURN( new_error( ERROR_BAD_PROTOTYPE, prototype ) );
6798 
6799  // now process parameters one-by-one
6800  atom_t params;
6801  int offset = BASE_OFFSET_PARAMS+(RARGS(var)-1)*sizeof(atom_t);
6802  for( ; IS_NOT_EMPTY(prototype); prototype=CDR(prototype) )
6803  {
6804  // get one type from the prototype
6805  type = CAR( prototype );
6806  c_type = get_c_type( static_link, parent, type );
6807  class = c_types[c_type].class;
6808 
6809  if( class==C_TYPE_STRUCT || class==C_TYPE_UNKNOWN )
6810  RETURN( new_error( ERROR_BAD_PROTOTYPE, prototype ) );
6811 
6812  // now find parameter with given offset
6813  for( params=LOCALS(var); IS_NOT_EMPTY(params); params=CDR(params))
6814  {
6815  atom_t param = CAR( params );
6816  if( !IS_VARIABLE(param) ) continue; // functions/commands not allowerd
6817  if( !IS_NORMAL(param) ) continue; // tags/runtimes not allowed
6818  if( OFFSET(param)==offset )
6819  {
6820  VARTYPE( param ) = VAR_TYPE_INTERNAL+c_type;
6821  //printf(" :::param "); dump(NAME(param)); printf(" is class=%d name=%S offset=%d\n", c_type, c_types[c_type].name,offset);
6822  break;
6823  }
6824  }
6825 
6826  offset -= sizeof( atom_t );
6827  }
6828 
6829 #ifdef SAFE_MODE
6830  for( params=LOCALS(var); IS_NOT_EMPTY(params); params=CDR(params))
6831  assert( IS_INTERNAL(CAR(params)) );
6832 #endif
6833 
6834  compile_internal_function( var, static_link );
6835  RETURN( unbound );
6836 }
6837 
6838 
6839 
6840 
6841 //===================================================
atom_t rt_stackframe ( int  static_link,
atom_t  parent,
atom_t  offset,
atom_t  frame 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
offsetoffset in the stack frame
framestack frame number
Returns
value at offset of a stack frame or error atom

Implements primitive _STACKFRAME. Goes to stack frame number FRAME (0 - current frame, 1 - parent frame, etc.) and returns the value at given OFFSET relative to the stack frame. OFFSET is given in term of words.

Definition at line 6862 of file runtime.c.

6888 {
atom_t rt_stackframeatom ( int  static_link,
atom_t  parent,
atom_t  offset,
atom_t  frame 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
offsetoffset in the stack frame
framestack frame number
Returns
atom at offset of a stack frame or error atom

Implements primitive _STACKFRAMEATOM. Goes to stack frame number FRAME (0 - current frame, 1 - parent frame, etc.) and returns the value at given OFFSET relative to the stack frame. OFFSET is given in term of words. The value is assumed to be an atom.

Definition at line 6894 of file runtime.c.

6915 {
atom_t rt_int3 ( )

This definition just reserves an address for rt_int3, so that compile_function() can easily detect it.

Definition at line 6921 of file runtime.c.

6940 {
atom_t rt_load ( atom_t  data)

It is supposed that the caller of rt_run() should use the result to do the actual call of the newly compiled code.

If mode is COMPILE_AS_PROC then the compiled code is a list of commands, otherwise it is a single expression.

Parameters
dataname of file to load
Returns
var atom containing the compiled code

Implements primitive command LOAD. Creates a local function with the given body, compiles it, and

Definition at line 6946 of file runtime.c.

6956 {
atom_t rt_commandline ( )
Returns
list atom containing command line

Implements primitive function COMMANDLINE. Returns a list containing the command-line arguments.

Definition at line 6962 of file runtime.c.

6976 {
atom_t rt_openfile_mode ( atom_t  filename,
char *  mode,
int  call_mode 
)
Parameters
modeopen mode (read, write, ...)
filenamename of binary file
call_modeCOMPILE_AS_FUNC or COMPILE_AS_PROC
Returns
var atom containing the file handle or error atom

Opens a file stream with given filename and mode. The filename is in an atom, while the mode is in a string.

Definition at line 6982 of file runtime.c.

6991  {
6992  DEUSE( fn );
6993  DEALLOC( file_names[i] );
6994  file_names[i] = NULL;
6995  file_handles[i] = NULL;
6996 
6997  last_os_error = errno;
6998  RETURN( new_error( ERROR_OS_ERROR, filename ) );
6999  }
7000 
7001  DEUSE( fn );
7002 
7003  if( call_mode==COMPILE_AS_FUNC )
7004  {
7005  RETURN( new_integer( (int)file_handles[i] ) );
7006  }
7007  else
7008  {
7009  RETURN( unbound );
7010  }
7011 };
7012 
7013 
7014 
7015 
7016 //===================================================
atom_t rt_openfile ( atom_t  mode,
atom_t  filename,
int  call_mode 
)
Parameters
modeopen mode (read, write, ...)
filenamename of binary file
call_modeCOMPILE_AS_FUNC or COMPILE_AS_PROC
Returns
var atom containing the file handle or error atom

Implements primitive command OPENFILE. Opens a binary file with given filename and mode. Files opened with PACKOPEN should be processed with other PACK-aware functions and commands.

Definition at line 7037 of file runtime.c.

7069 {
atom_t get_file_index ( atom_t  file,
int *  index 
)
Parameters
filefile handle or file name
indexvariable to store the index
Returns
unbound or error atom

Searches for an opened file assuming that file is a file handle. If it cannot be converted to a number, assumes it is a file name. Returns error atom (if getting the handle or the filename failed) or unbound atom if OK. In the latter case index contains the index of the file. If index=-1, then the file is not opened so far.

If error atom is returns, it is already USEed, so the caller should not reUSE it.

Definition at line 7075 of file runtime.c.

7075  { // the filename is a number
7076  *index = find_file_by_handle( (FILE*)(int)handle );
7077  }
7078 
7079  if( *index<0 )
7080  { // the filename may be a string
7081  atom_t fn = atom_to_real_word( file );
7082  if( IS_ERROR(fn) ) {DEUSE(fn); RETURN(USE(file))};
7083  char* ch = FILENAME(STRING(fn));
7084  *index = find_file_by_filename( ch );
7085  DEALLOC( ch );
7086  DEUSE( fn );
7087  }
7088 
7089  //is file opened?
7090  if( *index<0 )
7091  {
7093  }
7094 
7095  RETURN( unbound );
7096 };
7097 
7098 
7099 
7100 //===================================================
atom_t rt_closefile ( atom_t  file)
Parameters
filefile to close
Returns
unbound atom

Implements primitive command CLOSEFILE. Closes a file identified by either by its handle (if file contains a number) or by its name otherwise.

Definition at line 7119 of file runtime.c.

7152 {
atom_t rt_readblock ( int  static_link,
atom_t  parent,
atom_t  size 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
sizesize of the block and number of bytes to read
Returns
memory or error atom or empty list

Implements primitive command READBLOCK. Reads block of bytes from a file opened with OPENFILE and set as reading file with SETREAD. The size of the data being read is measured in bytes. The read data is placed in a newly created memory block.

Returns an empty list if reading failed because of end of file, or if the reading is from the standard input.

Definition at line 7158 of file runtime.c.

7163  { // size is a prototype
7164  sizeatom = rt_blocksize( static_link, parent, size );
7165  if( IS_ERROR(sizeatom) )
7166  {
7167  RETURN( sizeatom );
7168  }
7169  datasize = INTEGER(sizeatom);
7170  }
7171  else
7172  { // size must be an integer
7173  if (!atom_to_int( size, &datasize ))
7174  {
7176  }
7177  sizeatom = USE(size);
7178  }
7179 
7180  atom_t data = new_mem( datasize );
7181 
7182  if( !fread( MEMORY(data), datasize, 1, input_stream ) )
7183  {
7184  DEUSE( data );
7185  DEUSE( sizeatom );
7186  if( errno )
7187  {
7188  errno = EIO;
7189  last_os_error = errno;
7190  return new_error( ERROR_OS_ERROR, size );
7191  }
7192  else
7193  {
7194  data = empty_list;
7195  }
7196  }
7197  else
7198  {
7199  DEUSE( ATOMS(data) );
7200  ATOMS(data) = sizeatom;
7201  }
7202  RETURN( data );
7203 };
7204 
7205 
7206 
7207 //===================================================
atom_t rt_readinblock ( atom_t  block,
int  call_mode 
)
Parameters
blockblock to read data to
call_modeCOMPILE_AS_FUNC or COMPILE_AS_PROC
Returns
memory or error atom or empty list

Implements primitive command READINBLOCK. Reads block of bytes from a file opened with OPENFILE and set as reading file with SETREAD. The size of the data is taken from the memory block where the data is read.

Returns an empty list if reading failed because of end of file, or if the reading is from the standard input.

Definition at line 7232 of file runtime.c.

7234  {
7236  }
7237 
7238  if( !fread( MEMORY(block), INTEGER(ATOMS(block)), 1, input_stream ) )
7239  {
7240  if( errno )
7241  {
7242  errno = EIO;
7243  last_os_error = errno;
7244  return new_error( ERROR_OS_ERROR, block );
7245  }
7246  else
7247  {
7248  if( call_mode==COMPILE_AS_FUNC )
7249  { RETURN( empty_list ); }
7250  else
7251  { RETURN( unbound ); }
7252  }
7253  }
7254 
7255  if( call_mode==COMPILE_AS_FUNC )
7256  { RETURN( USE(block) ); }
7257  else
7258  { RETURN( unbound ); }
7259 };
7260 
7261 
7262 
7263 //===================================================
atom_t rt_writeblock ( atom_t  data)
Parameters
datapacked data to be written
Returns
unbound or error atom

Implements primitive command WRITEBLOCK. Writes a block of bytes to a file opened with OPENFILE and set for writing with SETWRITE. The size of the data being written is taken from the memory block containing the packed data.

Returns an empty list if the output file is the standard output.

Definition at line 7286 of file runtime.c.

7289  {
7290  RETURN( new_error( ERROR_NOT_A_MEM, data ) );
7291  }
7292  if (!atom_to_int( ATOMS(data), &size ))
7293  {
7295  }
7296 
7297  fwrite( MEMORY(data), size, 1, output_stream );
7298  if( errno )
7299  {
7300  last_os_error = errno;
7301  RETURN( new_error( ERROR_OS_ERROR, data ) );
7302  }
7303 
7304  RETURN( unbound );
7305 };
7306 
7307 
7308 
7309 //===================================================
atom_t rt_readchar ( void  )
Returns
Number atom - read char as a word

Implements the primitive function readchar. Reads a single character from the read stream and outputs that character as a word.

Definition at line 7326 of file runtime.c.

7327  {
7328  RETURN( new_word( &ch, 1 ) );
7329  }
7330 }
7331 
7332 
7333 
7334 //===================================================
atom_t rt_readchars ( atom_t  data)
Parameters
datanumber of characters to read
Returns
Number atom - read chars as a word

Implements the primitive function readchars. Reads a given number of characters from the read stream and outputs them as a word.

Definition at line 7352 of file runtime.c.

7356  {
7357  RETURN( new_error( ERROR_NOT_A_NUMBER, data ) );
7358  }
7359 
7360  // Allocate memory
7361  res = create_word( count+1 ); // +1 is for the terminating 0
7362  chs = STRING(res);
7363  while( count )
7364  {
7365  *chs = (char_t)inner();
7366  chs++;
7367  count--;
7368  }
7369  *chs = TEXT('\0');
7370 
7371  RETURN( res );
7372 }
7373 
7374 
7375 
7376 //===================================================
atom_t rt_readrawline ( void  )
Returns
Number atom - read line as a word

Implements the primitive function readrawline. Reads a single line from the read stream and outputs that line as a word.

Definition at line 7393 of file runtime.c.

7397  {
7398  return( empty_list );
7399  }
7400 
7401  while( (ch!=TEXT('\n')) && (ch!=NO_MORE) )
7402  {
7403  if( !bufspace )
7404  {
7405  buffer = REALLOC( buffer, (bufsize+bufstep)*sizeof(char_t) );
7406  bufspace = bufstep;
7407  bufsize = bufsize+bufstep;
7408  bufstep = bufstep+1;
7409  }
7410 
7411  *(buffer+buflen) = ch;
7412  buflen++;
7413  bufspace--;
7414 
7415  ch = inner();
7416  }
7417 
7418  if( !buffer ) return( empty_list );
7419  res = new_word( buffer, buflen );
7420  DEALLOC( buffer );
7421  return res;
7422 }
7423 
7424 
7425 
7426 //===================================================
atom_t rt_readword ( void  )
Returns
Number atom - read line as a word

Implements the primitive function readword. Reads a single line from the read stream and outputs that line as a word. Processes backslashes, vertical bars.

Definition at line 7444 of file runtime.c.

7462 {
atom_t rt_readlist ( void  )
Returns
Number atom - read line as a list

Implements the primitive function readlist. Reads a single line from the read stream and outputs that line as a list. Processes all special characters except semicolon ";".

Definition at line 7468 of file runtime.c.

7487 {
atom_t rt_getenv ( atom_t  data)
Parameters
dataenvironment variable name
Returns
the value of envronment variable

Implements primitive GETENV. Returns the value of the environment variable which name is the value of data. If there is no such variable, then return empty list.

Definition at line 7493 of file runtime.c.

7501  {
7502  chars_t value = ASCII_to_UTF16( asciivalue );
7503  res = new_word( value, -1 );
7504  DEALLOC( value );
7505  }
7506  else
7507  {
7508  res = empty_list;
7509  }
7510 
7511  DEUSE( word );
7512  DEALLOC( varname );
7513  RETURN( res );
7514 }
7515 
7516 
7517 
7518 //===================================================
atom_t rt_getenvs ( )
Returns
a list of all envronment variables

Implements primitive GETENVS. Returns a list of all environment variables.

Definition at line 7534 of file runtime.c.

7539  {
7540  char* var = *env;
7541  char* v=var;
7542  while( (*v!='=') && (*v!='\n') ) v++;
7543  oldv = *v;
7544  *v = '\0';
7545  chars_t uname = ASCII_to_UTF16( var );
7546  chars_t uvalue = ASCII_to_UTF16( v+1 );
7547  *v = oldv;
7548 
7549  atom_t pair = new_list( new_word(uvalue,-1), empty_list );
7550  pair = new_list( new_word(uname,-1), pair );
7551  res = new_list( pair, res );
7552 
7553  DEALLOC( uname );
7554  DEALLOC( uvalue );
7555  env++;
7556  }
7557  RETURN( res );
7558 }
7559 
7560 
7561 //===================================================
atom_t rt_eofp ( void  )
Returns
true or false atom

Implements the primitive function eof?. Outputs true if there are no more characters to be read, or false otherwise.

Definition at line 7578 of file runtime.c.

7589 {
atom_t rt_currentfolder ( void  )
Returns
word atom

Implements the primitive function currentfolder. Outputs a word atom containing the name of the current folder.

Definition at line 7595 of file runtime.c.

7595  {
7596  chars_t pathwc = UNFILENAME( path );
7597  res = new_word(pathwc,-1);
7598  DEALLOC( pathwc);
7599  }
7600  else
7601  {
7602  res = new_os_error_atom( unbound );
7603  }
7604  RETURN( res );
7605 }
7606 
7607 
7608 
7609 //===================================================
atom_t rt_makefolder ( atom_t  name)
Parameters
namename of a folder to make
Returns
unbound or error atom

Implements the primitive function makefolder. Create a folder with given name relative to the current folder. Outputs unbound or error atom.

Definition at line 7627 of file runtime.c.

7660 {
atom_t rt_erasefolder ( atom_t  name)
Parameters
namename of a folder to erase
Returns
unbound or error atom

Implements the primitive function erasefolder. Erases an empty folder with given name relative to the current folder. Outputs unbound or error atom.

Definition at line 7666 of file runtime.c.

7694 {
atom_t rt_changefolder ( atom_t  name)
Parameters
namename of a folder to change to
Returns
unbound or error atom

Implements the primitive function changefolder. Changes the current folder to a given folder. Outputs unbound or error atom.

Definition at line 7700 of file runtime.c.

7728 {
atom_t rt_folderp ( atom_t  name)
Parameters
namename of a folder to test
Returns
boolean or error atom

Implements the primitive function folder?. Returns "true if a folder with the given name exists. Otherwise return "false.

Definition at line 7734 of file runtime.c.

7742  :0 ]);
7743 
7744  DEUSE( word );
7745  DEALLOC( fname );
7746 
7747  RETURN( res );
7748 }
7749 
7750 
7751 
7752 
7753 //===================================================
atom_t rt_renamefolder_or_file ( atom_t  toname,
atom_t  fromname,
int  folders 
)
Parameters
tonamenew name of a folder
fromnameold name of a folder
foldersif !=0, rename a folder, otherwise a file
Returns
unbound or error atom

Renames a folder or a file given its old and new names. Outputs unbound or error atom.

Definition at line 7772 of file runtime.c.

7818 {
atom_t rt_renamefolder ( atom_t  toname,
atom_t  fromname 
)
Parameters
tonamenew name of a folder
fromnameold name of a folder
Returns
unbound or error atom

Implements the primitive function renamefolder. Renames a folder give its old and new names. Outputs unbound or error atom.

Definition at line 7824 of file runtime.c.

7841 {
atom_t rt_renamefile ( atom_t  toname,
atom_t  fromname 
)
Parameters
tonamenew name of a file
fromnameold name of a file
Returns
unbound or error atom

Implements the primitive function renamefile. Renames a file given its old and new names. Outputs unbound or error atom.

Definition at line 7847 of file runtime.c.

7863 {
atom_t rt_folders_or_files ( atom_t  name,
int  folders 
)
Parameters
namename of a folder to scan
foldersif !=0, scans for folders, otherwise for files
Returns
list or error atom

Returns a list of folders' names (if folders!=0) of files' name (if folders==0) in a given folder.

Definition at line 7869 of file runtime.c.

7876  {
7877  // open the folder
7878  DIR *dp;
7879  struct dirent *de;
7880 
7881  dp = opendir( fname );
7882  if( dp )
7883  {
7884  char long_name[PATH_MAX];
7885  int len = strlen( fname );
7886  strcpy( long_name, fname );
7887  long_name[len] = '/';
7888  len++;
7889 
7890  // scan the files one by one
7891  atom_t last = empty_list;
7892  de = readdir( dp );
7893  while( de )
7894  {
7895  struct stat buffer;
7896  strcpy( long_name+len, de->d_name );
7897  int err = stat(long_name,&buffer);
7898  if( err==0 )
7899  {
7900  int ok;
7901  if( folders )
7902  ok = S_ISDIR(buffer.st_mode);
7903  else
7904  ok = S_ISREG(buffer.st_mode);
7905  if( ok )
7906  {
7907  chars_t buf = UNFILENAME(de->d_name);
7908  atom_t word = new_word( buf, -1 );
7909  append( word, &res, &last );
7910  DEALLOC( buf );
7911  }
7912  }
7913  de = readdir( dp );
7914  }
7915  closedir( dp );
7916  }
7917  }
7918 
7919  DEUSE( word );
7920  DEALLOC( fname );
7921 
7922  RETURN( res );
7923 }
7924 
7925 
7926 
7927 //===================================================
atom_t rt_folders ( atom_t  name)
Parameters
namename of a folder to list
Returns
list or error atom

Implements the primitive function folders. Returns a list of folders' names in a given folder.

Definition at line 7944 of file runtime.c.

7957 {
atom_t rt_files ( atom_t  name)
Parameters
namename of a folder to list
Returns
list or error atom

Implements the primitive function files. Returns a list of files' names in a given folder.

Definition at line 7963 of file runtime.c.

7977 {
atom_t rt_erasefile ( atom_t  name)
Parameters
namename of a file to erase
Returns
unbound or error atom

Implements the primitive function erasefile. Erases a file with given name relative to the current folder. Outputs unbound or error atom.

Definition at line 7983 of file runtime.c.

8012 {
atom_t rt_filep ( atom_t  name)
Parameters
namename/path of a file to test
Returns
boolean or error atom

Implements the primitive function file?. Returns "true if a file with the given name or path exists. Otherwise return "false.

Definition at line 8018 of file runtime.c.

8026  :0 ]);
8027 
8028  DEUSE( word );
8029  DEALLOC( fname );
8030 
8031  RETURN( res );
8032 }
8033 
8034 
8035 
8036 //===================================================
atom_t rt_filesize ( atom_t  name)
Parameters
namename of a file
Returns
integer or error atom

Implements the primitive function filesize. Returns size of the file in bytes if the file exists. Otherwise returns -1.

Definition at line 8054 of file runtime.c.

8087 {
atom_t rt_filetimes ( atom_t  name)
Parameters
namename of a file
Returns
list or error atom

Implements the primitive function filetimes. Returns a list of three times (each represented as a number): [creation modification access] If the file does not exist or cannot be accessed then returns an empty list.

Definition at line 8093 of file runtime.c.

8100  {
8101  res = new_list( new_integer( buffer.st_atime ), res );
8102  res = new_list( new_integer( buffer.st_mtime ), res );
8103  res = new_list( new_integer( buffer.st_ctime ), res );
8104  }
8105 
8106  DEUSE( word );
8107  DEALLOC( fname );
8108 
8109  RETURN( res );
8110 }
8111 
8112 
8113 
8114 
8115 //===================================================
atom_t rt_openread ( atom_t  name,
int  call_mode 
)
Parameters
namename of a file
call_modeCOMPILE_AS_FUNC or COMPILE_AS_PROC
Returns
file handle or error atom

Implements the primitive function openread. Returns an integer atom with the file handle or an error atom.

Definition at line 8134 of file runtime.c.

8149 {
atom_t rt_openwrite ( atom_t  name,
int  call_mode 
)
Parameters
namename of a file
call_modeCOMPILE_AS_FUNC or COMPILE_AS_PROC
Returns
file handle or error atom

Implements the primitive function openwrite. Returns an integer atom with the file handle or an error atom.

Definition at line 8155 of file runtime.c.

8171 {
atom_t rt_openappend ( atom_t  name,
int  call_mode 
)
Parameters
namename of a file
call_modeCOMPILE_AS_FUNC or COMPILE_AS_PROC
Returns
file handle or error atom

Implements the primitive function openappend. Returns an integer atom with the file handle or an error atom.

Definition at line 8177 of file runtime.c.

8192 {
atom_t rt_openupdate ( atom_t  name,
int  call_mode 
)
Parameters
namename of a file
call_modeCOMPILE_AS_FUNC or COMPILE_AS_PROC
Returns
file handle or error atom

Implements the primitive function o/c/te. Returns an integer atom with the file handle or an error atom.

Definition at line 8198 of file runtime.c.

8211 {
atom_t rt_setread ( atom_t  file)
Parameters
filefile to set as a reader
Returns
unbound or error atom

Implements primitive command SETREAD. Sets a given file handle as a reader file (i.e. input stream). If file is an empty list, then reset the input stream to the default one (usually stdin).

Definition at line 8217 of file runtime.c.

8218  {
8219  int index;
8220  atom_t res = get_file_index( file, &index );
8221  if( IS_ERROR(res) ) RETURN(res); // USE is done by get_file_index()
8222 
8223  input_stream = file_handles[index];
8224  }
8225 
8226  RETURN( unbound );
8227 };
8228 
8229 
8230 
8231 
8232 //===================================================
atom_t rt_setwrite ( atom_t  file)
Parameters
filefile to set as a writer
Returns
unbound or error atom

Implements primitive command SETWRITE. Sets a given file handle as a writer file (i.e. output stream). If file is an empty list, then reset the output stream to the default one (usually stdout).

Definition at line 8250 of file runtime.c.

8251  {
8252  int index;
8253  atom_t res = get_file_index( file, &index );
8254  if( IS_ERROR(res) ) RETURN(res); // USE is done by get_file_index()
8255 
8256  output_stream = file_handles[index];
8257  }
8258 
8259  RETURN( unbound );
8260 };
8261 
8262 
8263 
8264 
8265 //===================================================
atom_t rt_reader ( )
Returns
empty list or word atom

Implements primitive command READER. Returns the name of the current input stream or an empty list if it is stdin.

Definition at line 8281 of file runtime.c.

8283  {
8284  int i = find_file_by_handle( input_stream );
8285  #ifdef SAFEMODE
8286  assert( i>-1 );
8287  #endif
8288  chars_t name = ASCII_to_UTF16( file_names[i] );
8289  res = new_word( name, -1 );
8290  DEALLOC( name );
8291  }
8292 
8293  RETURN( res );
8294 };
8295 
8296 
8297 
8298 //===================================================
atom_t rt_writer ( )
Returns
empty list or word atom

Implements primitive command WRITER. Returns the name of the current output stream or an empty list if it is stdout.

Definition at line 8314 of file runtime.c.

8316  {
8318  #ifdef SAFEMODE
8319  assert( i>-1 );
8320  #endif
8321  chars_t name = ASCII_to_UTF16( file_names[i] );
8322  res = new_word( name, -1 );
8323  DEALLOC( name );
8324  }
8325 
8326  RETURN( res );
8327 };
8328 
8329 
8330 
8331 //===================================================
atom_t rt_allopen ( )
Returns
empty list atom

Implements primitive command ALLOPEN. Returns a list of the names of all opened files.

Definition at line 8346 of file runtime.c.

8347  {
8348  chars_t name = ASCII_to_UTF16( file_names[i] );
8349  atom_t word = new_word( name, -1 );
8350  DEALLOC( name );
8351 
8352  append( word, &res, &last );
8353  }
8354 
8355  RETURN( res );
8356 };
8357 
8358 
8359 
8360 //===================================================
atom_t rt_closeall ( )
Returns
unbound atom

Implements primitive command CLOSEALL. Closes all opened files, returns unbound atom.

Definition at line 8375 of file runtime.c.

8397 {
atom_t rt_setreadpos ( atom_t  pos)
Parameters
posfile position for the reader
Returns
unbound or error atom

Implements primitive command SETREADPOS. Sets the reading position of the reader (i.e. input stream). Is pos>=0 the position is measured from the beginning of the file, otherwise - from the end.

Definition at line 8403 of file runtime.c.

8405  {
8406  fseek( input_stream, position, SEEK_END );
8407  }
8408 
8409  RETURN( unbound );
8410 };
8411 
8412 
8413 
8414 
8415 //===================================================
atom_t rt_readpos ( )
Returns
integer or error atom

Implements primitive command READPOS. Returns the reading position of the reader (i.e. input stream).

Definition at line 8430 of file runtime.c.

8449 {
atom_t rt_setwritepos ( atom_t  pos)
Parameters
posfile position for the writer
Returns
unbound or error atom

Implements primitive command SETWRITEPOS. Sets the writing position of the writer (i.e. output stream). Is pos>=0 the position is measured from the beginning of the file, otherwise - from the end.

Definition at line 8455 of file runtime.c.

8472 {
atom_t rt_writepos ( )
Returns
integer or error atom

Implements primitive command WRITEPOS. Returns the writinging position of the writer (i.e. output stream).

Definition at line 8478 of file runtime.c.

8494 {
atom_t rt_timezone ( )
Returns
integer atom

Implements primitive function TIEMZONE. Returns the timezone difference with GMT in seconds.

Definition at line 8500 of file runtime.c.

8510 {
atom_t rt_nodribble ( )
Returns
unbound atom

Implements primitive command NODRIBBLE. Closes the dribble file if it is opened.

Definition at line 8516 of file runtime.c.

8535 {
atom_t rt_dribble ( atom_t  filename)
Parameters
filenamename of dribble file
Returns
unbound or error atom

Implements the primitive command DRIBBLE. Opens a dribble text file and returns unbound atom if opening is successful. If there is already a dribble file, first close it and then open a new dribble file.

Definition at line 8541 of file runtime.c.

8546  {
8547  DEUSE( fn );
8548  DEALLOC( file_name );
8549  dribble_handle = NULL;
8550 
8551  last_os_error = errno;
8552  RETURN( new_error( ERROR_OS_ERROR, file ) );
8553  }
8554 
8555  DEALLOC( file_name );
8556  DEUSE( fn );
8557  RETURN( unbound );
8558 };
8559 

Variable Documentation

char* file_names[FOPEN_MAX] = { [0 ... (FOPEN_MAX-1)]=NULL }

Definition at line 251 of file runtime.c.

FILE* file_handles[FOPEN_MAX] = { [0 ... (FOPEN_MAX-1)]=NULL }

Definition at line 252 of file runtime.c.


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