2016-09-28 14:40:37 +00:00
/*
* $ Id $
*
2018-02-07 14:13:13 +00:00
Copyright ( c ) 2016 - 2018 Chung , Hyung - Hwan . All rights reserved .
2016-09-28 14:40:37 +00:00
Redistribution and use in source and binary forms , with or without
modification , are permitted provided that the following conditions
are met :
1. Redistributions of source code must retain the above copyright
notice , this list of conditions and the following disclaimer .
2. Redistributions in binary form must reproduce the above copyright
notice , this list of conditions and the following disclaimer in the
documentation and / or other materials provided with the distribution .
THIS SOFTWARE IS PROVIDED BY THE AUTHOR " AS IS " AND ANY EXPRESS OR
IMPLIED WARRANTIES , INCLUDING , BUT NOT LIMITED TO , THE IMPLIED WARRANTIES
OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED .
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT , INDIRECT ,
INCIDENTAL , SPECIAL , EXEMPLARY , OR CONSEQUENTIAL DAMAGES ( INCLUDING , BUT
NOT LIMITED TO , PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES ; LOSS OF USE ,
DATA , OR PROFITS ; OR BUSINESS INTERRUPTION ) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY , WHETHER IN CONTRACT , STRICT LIABILITY , OR TORT
( INCLUDING NEGLIGENCE OR OTHERWISE ) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE , EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE .
*/
# include "hcl-prv.h"
2018-02-05 10:43:25 +00:00
# include "hcl-opt.h"
2016-09-28 14:40:37 +00:00
# include <stdio.h>
# include <stdlib.h>
# include <string.h>
# include <limits.h>
2018-02-05 10:43:25 +00:00
# include <errno.h>
# include <locale.h>
2016-09-28 14:40:37 +00:00
# if defined(_WIN32)
# include <windows.h>
# include <tchar.h>
2018-03-31 07:10:43 +00:00
# include <io.h>
# include <fcntl.h>
# include <time.h>
# include <signal.h>
2018-11-03 15:57:14 +00:00
2016-09-28 14:40:37 +00:00
# elif defined(__OS2__)
# define INCL_DOSMODULEMGR
# define INCL_DOSPROCESS
# define INCL_DOSERRORS
# include <os2.h>
2018-11-03 15:57:14 +00:00
# elif defined(__DOS__)
2016-10-06 17:49:47 +00:00
# include <dos.h>
2016-10-25 13:44:38 +00:00
# include <time.h>
2016-09-28 14:40:37 +00:00
# elif defined(macintosh)
2016-10-06 17:49:47 +00:00
# include <Timer.h>
2016-09-28 14:40:37 +00:00
# else
2018-02-09 01:13:11 +00:00
2018-11-03 15:57:14 +00:00
# include <sys / types.h>
# include <errno.h>
# include <unistd.h>
# include <fcntl.h>
2016-10-06 17:49:47 +00:00
# if defined(HAVE_TIME_H)
# include <time.h>
# endif
# if defined(HAVE_SYS_TIME_H)
# include <sys / time.h>
# endif
# if defined(HAVE_SIGNAL_H)
# include <signal.h>
# endif
2016-09-28 14:40:37 +00:00
2018-02-09 03:48:30 +00:00
# endif
2016-10-06 17:49:47 +00:00
2016-09-28 14:40:37 +00:00
typedef struct bb_t bb_t ;
struct bb_t
{
char buf [ 1024 ] ;
hcl_oow_t pos ;
hcl_oow_t len ;
2018-02-05 10:43:25 +00:00
2016-09-28 14:40:37 +00:00
FILE * fp ;
2018-02-05 10:43:25 +00:00
hcl_bch_t * fn ;
2016-09-28 14:40:37 +00:00
} ;
typedef struct xtn_t xtn_t ;
struct xtn_t
{
const char * read_path ; /* main source file */
const char * print_path ;
2018-02-05 10:43:25 +00:00
2018-02-08 14:40:56 +00:00
int vm_running ;
2018-02-08 15:04:07 +00:00
int reader_istty ;
2018-03-08 14:18:30 +00:00
hcl_oop_t sym_errstr ;
2016-09-28 14:40:37 +00:00
} ;
/* ========================================================================= */
2018-02-05 10:43:25 +00:00
static const hcl_bch_t * get_base_name ( const hcl_bch_t * path )
{
const hcl_bch_t * p , * last = HCL_NULL ;
for ( p = path ; * p ! = ' \0 ' ; p + + )
{
2018-11-03 15:57:14 +00:00
if ( HCL_IS_PATH_SEP ( * p ) ) last = p ;
2018-02-05 10:43:25 +00:00
}
return ( last = = HCL_NULL ) ? path : ( last + 1 ) ;
}
2018-03-09 05:12:55 +00:00
static HCL_INLINE int open_input ( hcl_t * hcl , hcl_ioinarg_t * arg )
2016-09-28 14:40:37 +00:00
{
2018-02-26 15:24:45 +00:00
xtn_t * xtn = ( xtn_t * ) hcl_getxtn ( hcl ) ;
2018-02-05 10:43:25 +00:00
bb_t * bb = HCL_NULL ;
2016-09-28 14:40:37 +00:00
2018-02-05 10:43:25 +00:00
/* TOOD: support predefined include directory as well */
2016-09-28 14:40:37 +00:00
if ( arg - > includer )
{
/* includee */
2018-02-05 10:43:25 +00:00
hcl_oow_t ucslen , bcslen , parlen ;
const hcl_bch_t * fn , * fb ;
# if defined(HCL_OOCH_IS_UCH)
2021-01-29 17:24:13 +00:00
if ( hcl_convootobcstr ( hcl , arg - > name , & ucslen , HCL_NULL , & bcslen ) < = - 1 ) goto oops ;
2018-02-05 10:43:25 +00:00
# else
2018-04-07 15:54:16 +00:00
bcslen = hcl_count_bcstr ( arg - > name ) ;
2018-02-05 10:43:25 +00:00
# endif
fn = ( ( bb_t * ) arg - > includer - > handle ) - > fn ;
fb = get_base_name ( fn ) ;
parlen = fb - fn ;
2018-02-26 15:24:45 +00:00
bb = ( bb_t * ) hcl_callocmem ( hcl , HCL_SIZEOF ( * bb ) + ( HCL_SIZEOF ( hcl_bch_t ) * ( parlen + bcslen + 1 ) ) ) ;
2018-02-05 10:43:25 +00:00
if ( ! bb ) goto oops ;
bb - > fn = ( hcl_bch_t * ) ( bb + 1 ) ;
2018-04-07 15:54:16 +00:00
hcl_copy_bchars ( bb - > fn , fn , parlen ) ;
2018-02-05 10:43:25 +00:00
# if defined(HCL_OOCH_IS_UCH)
hcl_convootobcstr ( hcl , arg - > name , & ucslen , & bb - > fn [ parlen ] , & bcslen ) ;
# else
2018-04-07 15:54:16 +00:00
hcl_copy_bcstr ( & bb - > fn [ parlen ] , bcslen + 1 , arg - > name ) ;
2018-02-05 10:43:25 +00:00
# endif
2016-09-28 14:40:37 +00:00
}
else
{
/* main stream */
2018-02-05 10:43:25 +00:00
hcl_oow_t pathlen ;
2021-01-29 17:24:13 +00:00
pathlen = hcl_count_bcstr ( xtn - > read_path ) ;
2018-02-05 10:43:25 +00:00
2021-01-29 17:24:13 +00:00
bb = ( bb_t * ) hcl_callocmem ( hcl , HCL_SIZEOF ( * bb ) + ( HCL_SIZEOF ( hcl_bch_t ) * ( pathlen + 1 ) ) ) ;
2018-02-05 10:43:25 +00:00
if ( ! bb ) goto oops ;
bb - > fn = ( hcl_bch_t * ) ( bb + 1 ) ;
2018-04-07 15:54:16 +00:00
hcl_copy_bcstr ( bb - > fn , pathlen + 1 , xtn - > read_path ) ;
2016-09-28 14:40:37 +00:00
}
2018-02-05 10:43:25 +00:00
# if defined(__DOS__) || defined(_WIN32) || defined(__OS2__)
2021-01-30 16:13:27 +00:00
bb - > fp = fopen ( bb - > fn , " rb " ) ;
2018-02-05 10:43:25 +00:00
# else
2021-01-30 16:13:27 +00:00
bb - > fp = fopen ( bb - > fn , " r " ) ;
2018-02-05 10:43:25 +00:00
# endif
if ( ! bb - > fp )
2016-09-28 14:40:37 +00:00
{
2018-02-05 10:43:25 +00:00
hcl_seterrnum ( hcl , HCL_EIOERR ) ;
goto oops ;
2016-09-28 14:40:37 +00:00
}
2018-02-08 15:04:07 +00:00
if ( ! arg - > includer )
{
2018-03-31 07:10:43 +00:00
# if defined(HAVE_ISATTY)
2018-02-08 15:04:07 +00:00
xtn - > reader_istty = isatty ( fileno ( bb - > fp ) ) ;
2018-03-31 07:10:43 +00:00
# endif
2018-02-08 15:04:07 +00:00
}
2016-09-28 14:40:37 +00:00
arg - > handle = bb ;
2021-01-30 16:13:27 +00:00
/* HACK */
if ( ! arg - > includer )
{
HCL_ASSERT ( hcl , arg - > name = = HCL_NULL ) ;
arg - > name = hcl_dupbtooocstr ( hcl , xtn - > read_path , HCL_NULL ) ;
/* ignore duplication failure */
/* TODO: change the type of arg->name from const hcl_ooch_t* to hcl_ooch_t*.
* change its specification from [ IN ] only to [ INOUT ] in hcl_ioinarg_t . */
}
/* END HACK */
2016-09-28 14:40:37 +00:00
return 0 ;
2018-02-05 10:43:25 +00:00
oops :
if ( bb )
{
if ( bb - > fp ) fclose ( bb - > fp ) ;
hcl_freemem ( hcl , bb ) ;
}
return - 1 ;
2016-09-28 14:40:37 +00:00
}
2018-02-05 10:43:25 +00:00
2018-03-09 05:12:55 +00:00
static HCL_INLINE int close_input ( hcl_t * hcl , hcl_ioinarg_t * arg )
2016-09-28 14:40:37 +00:00
{
2018-02-26 15:24:45 +00:00
/*xtn_t* xtn = (xtn_t*)hcl_getxtn(hcl);*/
2016-09-28 14:40:37 +00:00
bb_t * bb ;
bb = ( bb_t * ) arg - > handle ;
2018-02-05 10:43:25 +00:00
HCL_ASSERT ( hcl , bb ! = HCL_NULL & & bb - > fp ! = HCL_NULL ) ;
2016-09-28 14:40:37 +00:00
2021-01-30 16:13:27 +00:00
/* HACK */
if ( ! arg - > includer & & arg - > name )
{
hcl_freemem ( hcl , arg - > name ) ;
arg - > name = HCL_NULL ;
}
/* END HACK */
2018-02-05 10:43:25 +00:00
fclose ( bb - > fp ) ;
2016-09-28 14:40:37 +00:00
hcl_freemem ( hcl , bb ) ;
2018-02-05 10:43:25 +00:00
arg - > handle = HCL_NULL ;
2016-09-28 14:40:37 +00:00
return 0 ;
}
2018-03-09 05:12:55 +00:00
static HCL_INLINE int read_input ( hcl_t * hcl , hcl_ioinarg_t * arg )
2016-09-28 14:40:37 +00:00
{
2018-02-26 15:24:45 +00:00
/*xtn_t* xtn = (xtn_t*)hcl_getxtn(hcl);*/
2016-09-28 14:40:37 +00:00
bb_t * bb ;
hcl_oow_t bcslen , ucslen , remlen ;
int x ;
bb = ( bb_t * ) arg - > handle ;
2018-02-05 10:43:25 +00:00
HCL_ASSERT ( hcl , bb ! = HCL_NULL & & bb - > fp ! = HCL_NULL ) ;
2016-09-28 14:40:37 +00:00
do
{
x = fgetc ( bb - > fp ) ;
if ( x = = EOF )
{
if ( ferror ( ( FILE * ) bb - > fp ) )
{
hcl_seterrnum ( hcl , HCL_EIOERR ) ;
return - 1 ;
}
break ;
}
bb - > buf [ bb - > len + + ] = x ;
}
while ( bb - > len < HCL_COUNTOF ( bb - > buf ) & & x ! = ' \r ' & & x ! = ' \n ' ) ;
2018-02-05 10:43:25 +00:00
# if defined(HCL_OOCH_IS_UCH)
2016-09-28 14:40:37 +00:00
bcslen = bb - > len ;
ucslen = HCL_COUNTOF ( arg - > buf ) ;
2021-01-29 17:24:13 +00:00
x = hcl_convbtooochars ( hcl , bb - > buf , & bcslen , arg - > buf , & ucslen ) ;
2018-02-05 10:43:25 +00:00
if ( x < = - 1 & & ucslen < = 0 ) return - 1 ;
/* if ucslen is greater than 0, i see that some characters have been
* converted properly */
# else
bcslen = ( bb - > len < HCL_COUNTOF ( arg - > buf ) ) ? bb - > len : HCL_COUNTOF ( arg - > buf ) ;
ucslen = bcslen ;
2018-04-07 15:54:16 +00:00
hcl_copy_bchars ( arg - > buf , bb - > buf , bcslen ) ;
2018-02-05 10:43:25 +00:00
# endif
2016-09-28 14:40:37 +00:00
remlen = bb - > len - bcslen ;
if ( remlen > 0 ) memmove ( bb - > buf , & bb - > buf [ bcslen ] , remlen ) ;
bb - > len = remlen ;
2018-03-09 05:05:09 +00:00
arg - > xlen = ucslen ;
return 0 ;
2016-09-28 14:40:37 +00:00
}
2018-03-09 05:12:55 +00:00
static int read_handler ( hcl_t * hcl , hcl_iocmd_t cmd , void * arg )
2016-09-28 14:40:37 +00:00
{
switch ( cmd )
{
case HCL_IO_OPEN :
2021-01-29 17:24:13 +00:00
return open_input ( hcl , ( hcl_ioinarg_t * ) arg ) ;
2016-09-28 14:40:37 +00:00
case HCL_IO_CLOSE :
2021-01-29 17:24:13 +00:00
return close_input ( hcl , ( hcl_ioinarg_t * ) arg ) ;
2016-09-28 14:40:37 +00:00
case HCL_IO_READ :
2021-01-29 17:24:13 +00:00
return read_input ( hcl , ( hcl_ioinarg_t * ) arg ) ;
2016-09-28 14:40:37 +00:00
2019-04-17 05:37:56 +00:00
case HCL_IO_FLUSH :
/* no effect on an input stream */
return 0 ;
2016-09-28 14:40:37 +00:00
default :
2018-02-05 10:43:25 +00:00
hcl_seterrnum ( hcl , HCL_EINTERN ) ;
2016-09-28 14:40:37 +00:00
return - 1 ;
}
}
2021-01-29 17:24:13 +00:00
static HCL_INLINE int open_output ( hcl_t * hcl , hcl_iooutarg_t * arg )
2016-09-28 14:40:37 +00:00
{
2018-02-26 15:24:45 +00:00
xtn_t * xtn = ( xtn_t * ) hcl_getxtn ( hcl ) ;
2016-09-28 14:40:37 +00:00
FILE * fp ;
# if defined(__MSDOS__) || defined(_WIN32) || defined(__OS2__)
2021-01-29 17:24:13 +00:00
if ( xtn - > print_path ) fp = fopen ( xtn - > print_path , " wb " ) ;
2016-09-28 14:40:37 +00:00
else fp = stdout ;
# else
2021-01-29 17:24:13 +00:00
if ( xtn - > print_path ) fp = fopen ( xtn - > print_path , " w " ) ;
2016-09-28 14:40:37 +00:00
else fp = stdout ;
# endif
if ( ! fp )
{
hcl_seterrnum ( hcl , HCL_EIOERR ) ;
return - 1 ;
}
arg - > handle = fp ;
return 0 ;
}
2018-03-09 05:12:55 +00:00
static HCL_INLINE int close_output ( hcl_t * hcl , hcl_iooutarg_t * arg )
2016-09-28 14:40:37 +00:00
{
2018-02-26 15:24:45 +00:00
/*xtn_t* xtn = (xtn_t*)hcl_getxtn(hcl);*/
2016-09-28 14:40:37 +00:00
FILE * fp ;
fp = ( FILE * ) arg - > handle ;
2018-02-05 10:43:25 +00:00
HCL_ASSERT ( hcl , fp ! = HCL_NULL ) ;
2016-09-28 14:40:37 +00:00
2018-03-01 14:47:12 +00:00
if ( fp ! = stdout ) fclose ( fp ) ;
2016-09-28 14:40:37 +00:00
arg - > handle = HCL_NULL ;
return 0 ;
}
2018-03-09 05:12:55 +00:00
static HCL_INLINE int write_output ( hcl_t * hcl , hcl_iooutarg_t * arg )
2016-09-28 14:40:37 +00:00
{
2018-02-26 15:24:45 +00:00
/*xtn_t* xtn = (xtn_t*)hcl_getxtn(hcl);*/
2016-09-28 14:40:37 +00:00
hcl_bch_t bcsbuf [ 1024 ] ;
hcl_oow_t bcslen , ucslen , donelen ;
int x ;
donelen = 0 ;
do
{
2018-03-01 14:47:12 +00:00
# if defined(HCL_OOCH_IS_UCH)
2016-09-28 14:40:37 +00:00
bcslen = HCL_COUNTOF ( bcsbuf ) ;
ucslen = arg - > len - donelen ;
2018-03-09 05:05:09 +00:00
x = hcl_convootobchars ( hcl , & arg - > ptr [ donelen ] , & ucslen , bcsbuf , & bcslen ) ;
2018-02-05 10:43:25 +00:00
if ( x < = - 1 & & ucslen < = 0 ) return - 1 ;
2018-03-01 14:47:12 +00:00
# else
2018-02-05 10:43:25 +00:00
bcslen = HCL_COUNTOF ( bcsbuf ) ;
ucslen = arg - > len - donelen ;
if ( ucslen > bcslen ) ucslen = bcslen ;
else if ( ucslen < bcslen ) bcslen = ucslen ;
2018-04-07 15:54:16 +00:00
hcl_copy_bchars ( bcsbuf , & arg - > ptr [ donelen ] , bcslen ) ;
2018-03-01 14:47:12 +00:00
# endif
2016-09-28 14:40:37 +00:00
2018-03-09 05:05:09 +00:00
if ( fwrite ( bcsbuf , HCL_SIZEOF ( bcsbuf [ 0 ] ) , bcslen , ( FILE * ) arg - > handle ) < bcslen )
2016-09-28 14:40:37 +00:00
{
hcl_seterrnum ( hcl , HCL_EIOERR ) ;
return - 1 ;
}
donelen + = ucslen ;
}
while ( donelen < arg - > len ) ;
2018-03-09 05:05:09 +00:00
arg - > xlen = arg - > len ;
return 0 ;
2016-09-28 14:40:37 +00:00
}
2019-04-17 05:37:56 +00:00
static HCL_INLINE int flush_output ( hcl_t * hcl , hcl_iooutarg_t * arg )
{
FILE * fp ;
fp = ( FILE * ) arg - > handle ;
HCL_ASSERT ( hcl , fp ! = HCL_NULL ) ;
fflush ( fp ) ;
return 0 ;
}
2018-03-09 05:12:55 +00:00
static int print_handler ( hcl_t * hcl , hcl_iocmd_t cmd , void * arg )
2016-09-28 14:40:37 +00:00
{
switch ( cmd )
{
case HCL_IO_OPEN :
2019-04-17 05:37:56 +00:00
return open_output ( hcl , ( hcl_iooutarg_t * ) arg ) ;
2016-09-28 14:40:37 +00:00
case HCL_IO_CLOSE :
2019-04-17 05:37:56 +00:00
return close_output ( hcl , ( hcl_iooutarg_t * ) arg ) ;
2016-09-28 14:40:37 +00:00
case HCL_IO_WRITE :
2019-04-17 05:37:56 +00:00
return write_output ( hcl , ( hcl_iooutarg_t * ) arg ) ;
case HCL_IO_FLUSH :
return flush_output ( hcl , ( hcl_iooutarg_t * ) arg ) ;
2016-09-28 14:40:37 +00:00
default :
2018-02-05 10:43:25 +00:00
hcl_seterrnum ( hcl , HCL_EINTERN ) ;
2016-09-28 14:40:37 +00:00
return - 1 ;
}
}
/* ========================================================================= */
2018-11-02 14:15:28 +00:00
static int vm_startup ( hcl_t * hcl )
2018-03-10 17:53:44 +00:00
{
xtn_t * xtn = ( xtn_t * ) hcl_getxtn ( hcl ) ;
2018-02-08 14:40:56 +00:00
xtn - > vm_running = 1 ;
return 0 ;
}
static void vm_cleanup ( hcl_t * hcl )
{
2018-03-31 07:10:43 +00:00
xtn_t * xtn = ( xtn_t * ) hcl_getxtn ( hcl ) ;
2018-11-02 14:15:28 +00:00
xtn - > vm_running = 0 ;
2018-02-08 14:40:56 +00:00
}
2018-03-11 11:16:28 +00:00
/*
static void vm_checkbc ( hcl_t * hcl , hcl_oob_t bcode )
{
}
*/
2018-03-08 14:18:30 +00:00
static void gc_hcl ( hcl_t * hcl )
{
xtn_t * xtn = ( xtn_t * ) hcl_getxtn ( hcl ) ;
if ( xtn - > sym_errstr ) xtn - > sym_errstr = hcl_moveoop ( hcl , xtn - > sym_errstr ) ;
}
2018-03-10 17:53:44 +00:00
/* ========================================================================= */
2018-02-05 10:43:25 +00:00
static int handle_logopt ( hcl_t * hcl , const hcl_bch_t * str )
{
2021-02-07 17:57:35 +00:00
hcl_ooch_t * xstr , * cm , * flt ;
2018-04-26 04:39:20 +00:00
hcl_bitmask_t logmask ;
2018-02-05 10:43:25 +00:00
2021-02-07 17:57:35 +00:00
xstr = hcl_dupbtooochars ( hcl , str , hcl_count_bcstr ( str ) , HCL_NULL ) ;
if ( ! xstr )
{
fprintf ( stderr , " ERROR: out of memory in duplicating %s \n " , str ) ;
return - 1 ;
}
cm = hcl_find_oochar_in_oocstr ( xstr , ' , ' ) ;
2018-02-05 10:43:25 +00:00
if ( cm )
{
/* i duplicate this string for open() below as open() doesn't
* accept a length - bounded string */
2021-02-07 17:57:35 +00:00
cm = hcl_find_oochar_in_oocstr ( xstr , ' , ' ) ;
2018-02-05 10:43:25 +00:00
* cm = ' \0 ' ;
2019-04-16 15:46:00 +00:00
logmask = 0 ;
2018-02-05 10:43:25 +00:00
do
{
flt = cm + 1 ;
2021-02-07 17:57:35 +00:00
cm = hcl_find_oochar_in_oocstr ( flt , ' , ' ) ;
2018-02-05 10:43:25 +00:00
if ( cm ) * cm = ' \0 ' ;
2021-02-07 17:57:35 +00:00
if ( hcl_comp_oocstr_bcstr ( flt , " app " ) = = 0 ) logmask | = HCL_LOG_APP ;
else if ( hcl_comp_oocstr_bcstr ( flt , " compiler " ) = = 0 ) logmask | = HCL_LOG_COMPILER ;
else if ( hcl_comp_oocstr_bcstr ( flt , " vm " ) = = 0 ) logmask | = HCL_LOG_VM ;
else if ( hcl_comp_oocstr_bcstr ( flt , " mnemonic " ) = = 0 ) logmask | = HCL_LOG_MNEMONIC ;
else if ( hcl_comp_oocstr_bcstr ( flt , " gc " ) = = 0 ) logmask | = HCL_LOG_GC ;
else if ( hcl_comp_oocstr_bcstr ( flt , " ic " ) = = 0 ) logmask | = HCL_LOG_IC ;
else if ( hcl_comp_oocstr_bcstr ( flt , " primitive " ) = = 0 ) logmask | = HCL_LOG_PRIMITIVE ;
else if ( hcl_comp_oocstr_bcstr ( flt , " fatal " ) = = 0 ) logmask | = HCL_LOG_FATAL ;
else if ( hcl_comp_oocstr_bcstr ( flt , " error " ) = = 0 ) logmask | = HCL_LOG_ERROR ;
else if ( hcl_comp_oocstr_bcstr ( flt , " warn " ) = = 0 ) logmask | = HCL_LOG_WARN ;
else if ( hcl_comp_oocstr_bcstr ( flt , " info " ) = = 0 ) logmask | = HCL_LOG_INFO ;
else if ( hcl_comp_oocstr_bcstr ( flt , " debug " ) = = 0 ) logmask | = HCL_LOG_DEBUG ;
else if ( hcl_comp_oocstr_bcstr ( flt , " fatal+ " ) = = 0 ) logmask | = HCL_LOG_FATAL ;
else if ( hcl_comp_oocstr_bcstr ( flt , " error+ " ) = = 0 ) logmask | = HCL_LOG_FATAL | HCL_LOG_ERROR ;
else if ( hcl_comp_oocstr_bcstr ( flt , " warn+ " ) = = 0 ) logmask | = HCL_LOG_FATAL | HCL_LOG_ERROR | HCL_LOG_WARN ;
else if ( hcl_comp_oocstr_bcstr ( flt , " info+ " ) = = 0 ) logmask | = HCL_LOG_FATAL | HCL_LOG_ERROR | HCL_LOG_WARN | HCL_LOG_INFO ;
else if ( hcl_comp_oocstr_bcstr ( flt , " debug+ " ) = = 0 ) logmask | = HCL_LOG_FATAL | HCL_LOG_ERROR | HCL_LOG_WARN | HCL_LOG_INFO | HCL_LOG_DEBUG ;
2018-02-05 10:43:25 +00:00
else
{
2021-02-07 17:57:35 +00:00
fprintf ( stderr , " ERROR: invalid value - %s \n " , str ) ;
hcl_freemem ( hcl , xstr ) ;
2018-02-05 10:43:25 +00:00
return - 1 ;
}
}
while ( cm ) ;
2018-03-17 11:57:02 +00:00
if ( ! ( logmask & HCL_LOG_ALL_TYPES ) ) logmask | = HCL_LOG_ALL_TYPES ; /* no types specified. force to all types */
if ( ! ( logmask & HCL_LOG_ALL_LEVELS ) ) logmask | = HCL_LOG_ALL_LEVELS ; /* no levels specified. force to all levels */
2018-02-05 10:43:25 +00:00
}
else
{
2018-03-17 11:57:02 +00:00
logmask = HCL_LOG_ALL_LEVELS | HCL_LOG_ALL_TYPES ;
2018-02-05 10:43:25 +00:00
}
2021-02-07 17:57:35 +00:00
hcl_setoption ( hcl , HCL_LOG_TARGET , xstr ) ;
hcl_freemem ( hcl , xstr ) ;
2018-02-05 10:43:25 +00:00
2019-04-16 15:46:00 +00:00
hcl_setoption ( hcl , HCL_LOG_MASK , & logmask ) ;
2018-02-05 10:43:25 +00:00
return 0 ;
}
2018-02-21 09:30:18 +00:00
# if defined(HCL_BUILD_DEBUG)
2018-02-05 10:43:25 +00:00
static int handle_dbgopt ( hcl_t * hcl , const hcl_bch_t * str )
{
2021-01-15 09:12:28 +00:00
/*xtn_t* xtn = (xtn_t*)hcl_getxtn(hcl);*/
2018-02-05 10:43:25 +00:00
const hcl_bch_t * cm , * flt ;
hcl_oow_t len ;
2018-04-26 04:39:20 +00:00
hcl_bitmask_t trait , dbgopt = 0 ;
2018-02-05 10:43:25 +00:00
cm = str - 1 ;
do
{
flt = cm + 1 ;
2018-04-07 15:54:16 +00:00
cm = hcl_find_bchar_in_bcstr ( flt , ' , ' ) ;
len = cm ? ( cm - flt ) : hcl_count_bcstr ( flt ) ;
2020-09-28 15:44:04 +00:00
if ( hcl_comp_bchars_bcstr ( flt , len , " gc " ) = = 0 ) dbgopt | = HCL_TRAIT_DEBUG_GC ;
2021-02-01 03:32:09 +00:00
else if ( hcl_comp_bchars_bcstr ( flt , len , " bigint " ) = = 0 ) dbgopt | = HCL_TRAIT_DEBUG_BIGINT ;
2018-02-05 10:43:25 +00:00
else
{
fprintf ( stderr , " ERROR: unknown debug option value - %.*s \n " , ( int ) len , flt ) ;
return - 1 ;
}
}
while ( cm ) ;
hcl_getoption ( hcl , HCL_TRAIT , & trait ) ;
trait | = dbgopt ;
hcl_setoption ( hcl , HCL_TRAIT , & trait ) ;
return 0 ;
}
# endif
2016-10-06 17:49:47 +00:00
/* ========================================================================= */
static hcl_t * g_hcl = HCL_NULL ;
/* ========================================================================= */
/* ========================================================================= */
2018-03-31 07:10:43 +00:00
# if defined(_WIN32) || defined(__MSDOS__) || defined(__OS2__) || defined(macintosh)
2018-03-10 17:53:44 +00:00
typedef void ( * signal_handler_t ) ( int ) ;
# elif defined(macintosh)
2018-03-31 07:10:43 +00:00
typedef void ( * signal_handler_t ) ( int ) ; /* TODO: */
2018-10-14 10:28:28 +00:00
# elif defined(SA_SIGINFO)
2018-03-10 17:53:44 +00:00
typedef void ( * signal_handler_t ) ( int , siginfo_t * , void * ) ;
2018-10-14 10:28:28 +00:00
# else
typedef void ( * signal_handler_t ) ( int ) ;
2018-03-10 17:53:44 +00:00
# endif
2018-03-31 07:10:43 +00:00
# if defined(_WIN32) || defined(__MSDOS__) || defined(__OS2__)
static void handle_sigint ( int sig )
{
if ( g_hcl ) hcl_abort ( g_hcl ) ;
}
2018-03-10 17:53:44 +00:00
# elif defined(macintosh)
2018-03-31 07:10:43 +00:00
/* TODO */
2018-10-14 10:28:28 +00:00
# elif defined(SA_SIGINFO)
2018-03-10 17:53:44 +00:00
static void handle_sigint ( int sig , siginfo_t * siginfo , void * ctx )
{
if ( g_hcl ) hcl_abort ( g_hcl ) ;
}
2018-10-14 10:28:28 +00:00
# else
static void handle_sigint ( int sig )
{
if ( g_hcl ) hcl_abort ( g_hcl ) ;
}
2018-03-10 17:53:44 +00:00
# endif
static void set_signal ( int sig , signal_handler_t handler )
{
2018-03-31 07:10:43 +00:00
# if defined(_WIN32) || defined(__MSDOS__) || defined(__OS2__)
signal ( sig , handler ) ;
2018-03-10 17:53:44 +00:00
# elif defined(macintosh)
/* TODO: implement this */
# else
struct sigaction sa ;
memset ( & sa , 0 , sizeof ( sa ) ) ;
/*sa.sa_handler = handler;*/
2018-10-14 10:28:28 +00:00
# if defined(SA_SIGINFO)
2018-03-10 17:53:44 +00:00
sa . sa_flags = SA_SIGINFO ;
sa . sa_sigaction = handler ;
2018-10-14 10:28:28 +00:00
# else
sa . sa_handler = handler ;
# endif
2018-03-10 17:53:44 +00:00
sigemptyset ( & sa . sa_mask ) ;
sigaction ( sig , & sa , NULL ) ;
# endif
}
static void set_signal_to_default ( int sig )
{
2018-03-31 07:10:43 +00:00
# if defined(_WIN32) || defined(__MSDOS__) || defined(__OS2__)
signal ( sig , SIG_DFL ) ;
2018-03-10 17:53:44 +00:00
# elif defined(macintosh)
/* TODO: implement this */
# else
struct sigaction sa ;
memset ( & sa , 0 , sizeof ( sa ) ) ;
sa . sa_handler = SIG_DFL ;
sa . sa_flags = 0 ;
sigemptyset ( & sa . sa_mask ) ;
sigaction ( sig , & sa , NULL ) ;
# endif
}
2016-09-28 14:40:37 +00:00
/* ========================================================================= */
static void print_synerr ( hcl_t * hcl )
{
hcl_synerr_t synerr ;
xtn_t * xtn ;
2018-02-26 15:24:45 +00:00
xtn = ( xtn_t * ) hcl_getxtn ( hcl ) ;
2016-09-28 14:40:37 +00:00
hcl_getsynerr ( hcl , & synerr ) ;
2018-02-05 10:43:25 +00:00
hcl_logbfmt ( hcl , HCL_LOG_STDERR , " ERROR: " ) ;
2016-09-28 14:40:37 +00:00
if ( synerr . loc . file )
{
2018-02-05 10:43:25 +00:00
hcl_logbfmt ( hcl , HCL_LOG_STDERR , " %js " , synerr . loc . file ) ;
2016-09-28 14:40:37 +00:00
}
else
{
2018-02-05 10:43:25 +00:00
hcl_logbfmt ( hcl , HCL_LOG_STDERR , " %s " , xtn - > read_path ) ;
2016-09-28 14:40:37 +00:00
}
2018-02-07 13:55:22 +00:00
hcl_logbfmt ( hcl , HCL_LOG_STDERR , " [%zu,%zu] %js " ,
synerr . loc . line , synerr . loc . colm ,
( hcl_geterrmsg ( hcl ) ! = hcl_geterrstr ( hcl ) ? hcl_geterrmsg ( hcl ) : hcl_geterrstr ( hcl ) )
) ;
2018-02-05 10:43:25 +00:00
2016-09-28 14:40:37 +00:00
if ( synerr . tgt . len > 0 )
{
2021-01-22 14:43:47 +00:00
hcl_logbfmt ( hcl , HCL_LOG_STDERR , " - %.*js " , synerr . tgt . len , synerr . tgt . val ) ;
2016-09-28 14:40:37 +00:00
}
2018-02-05 10:43:25 +00:00
hcl_logbfmt ( hcl , HCL_LOG_STDERR , " \n " ) ;
2016-09-28 14:40:37 +00:00
}
2021-01-01 07:34:21 +00:00
# define DEFAULT_HEAPSIZE 512000ul
2018-02-05 10:43:25 +00:00
2018-03-13 10:20:33 +00:00
int main ( int argc , char * argv [ ] )
2016-09-28 14:40:37 +00:00
{
2018-04-25 04:12:13 +00:00
hcl_t * hcl = HCL_NULL ;
2016-09-28 14:40:37 +00:00
xtn_t * xtn ;
2018-02-05 10:43:25 +00:00
hcl_cb_t hclcb ;
hcl_bci_t c ;
static hcl_bopt_lng_t lopt [ ] =
{
2018-02-21 09:30:18 +00:00
# if defined(HCL_BUILD_DEBUG)
2021-01-01 07:34:21 +00:00
{ " :debug " , ' \0 ' } ,
2018-02-05 10:43:25 +00:00
# endif
2021-01-01 07:34:21 +00:00
{ " :heapsize " , ' \0 ' } ,
{ " :log " , ' l ' } ,
{ " large-pages " , ' \0 ' } ,
2018-02-05 10:43:25 +00:00
{ HCL_NULL , ' \0 ' }
} ;
static hcl_bopt_t opt =
{
2021-01-01 07:34:21 +00:00
" l:v " ,
2018-02-05 10:43:25 +00:00
lopt
} ;
const char * logopt = HCL_NULL ;
2021-01-01 07:34:21 +00:00
hcl_oow_t heapsize = DEFAULT_HEAPSIZE ;
2019-04-16 09:35:56 +00:00
int verbose = 0 ;
2018-03-01 14:47:12 +00:00
int large_pages = 0 ;
2018-02-05 10:43:25 +00:00
2018-02-21 09:30:18 +00:00
# if defined(HCL_BUILD_DEBUG)
2018-02-05 10:43:25 +00:00
const char * dbgopt = HCL_NULL ;
# endif
setlocale ( LC_ALL , " " ) ;
2016-09-28 14:40:37 +00:00
# if !defined(macintosh)
if ( argc < 2 )
{
2018-02-05 10:43:25 +00:00
print_usage :
2016-09-28 14:40:37 +00:00
fprintf ( stderr , " Usage: %s filename ... \n " , argv [ 0 ] ) ;
return - 1 ;
}
2018-02-05 10:43:25 +00:00
while ( ( c = hcl_getbopt ( argc , argv , & opt ) ) ! = HCL_BCI_EOF )
{
switch ( c )
{
case ' l ' :
logopt = opt . arg ;
break ;
2019-04-16 09:35:56 +00:00
case ' v ' :
verbose = 1 ;
break ;
2018-02-05 10:43:25 +00:00
case ' \0 ' :
2021-01-01 07:34:21 +00:00
if ( hcl_comp_bcstr ( opt . lngopt , " heapsize " ) = = 0 )
{
heapsize = strtoul ( opt . arg , HCL_NULL , 0 ) ;
break ;
}
else if ( hcl_comp_bcstr ( opt . lngopt , " large-pages " ) = = 0 )
2018-03-01 14:47:12 +00:00
{
large_pages = 1 ;
break ;
}
2018-02-21 09:30:18 +00:00
# if defined(HCL_BUILD_DEBUG)
2018-04-07 15:54:16 +00:00
else if ( hcl_comp_bcstr ( opt . lngopt , " debug " ) = = 0 )
2018-02-05 10:43:25 +00:00
{
dbgopt = opt . arg ;
break ;
}
# endif
goto print_usage ;
case ' : ' :
if ( opt . lngopt )
fprintf ( stderr , " bad argument for '%s' \n " , opt . lngopt ) ;
else
fprintf ( stderr , " bad argument for '%c' \n " , opt . opt ) ;
return - 1 ;
default :
goto print_usage ;
}
}
if ( opt . ind > = argc ) goto print_usage ;
2016-09-28 14:40:37 +00:00
# endif
2021-02-07 17:57:35 +00:00
hcl = hcl_openstd ( HCL_SIZEOF ( xtn_t ) , heapsize , HCL_NULL ) ;
if ( HCL_UNLIKELY ( ! hcl ) )
2016-09-28 14:40:37 +00:00
{
2018-04-25 04:12:13 +00:00
printf ( " ERROR: cannot open hcl \n " ) ;
goto oops ;
2016-09-28 14:40:37 +00:00
}
2021-02-07 17:57:35 +00:00
2016-09-28 14:40:37 +00:00
{
hcl_oow_t tab_size ;
tab_size = 5000 ;
hcl_setoption ( hcl , HCL_SYMTAB_SIZE , & tab_size ) ;
tab_size = 5000 ;
hcl_setoption ( hcl , HCL_SYSDIC_SIZE , & tab_size ) ;
tab_size = 600 ;
hcl_setoption ( hcl , HCL_PROCSTK_SIZE , & tab_size ) ;
}
{
2018-04-26 04:39:20 +00:00
hcl_bitmask_t trait = 0 ;
2016-09-28 14:40:37 +00:00
2020-09-28 15:44:04 +00:00
/*trait |= HCL_TRAIT_NOGC;*/
trait | = HCL_TRAIT_AWAIT_PROCS ;
2016-09-28 14:40:37 +00:00
hcl_setoption ( hcl , HCL_TRAIT , & trait ) ;
2018-02-05 10:43:25 +00:00
/* disable GC logs */
2018-02-09 16:10:29 +00:00
/*trait = ~HCL_LOG_GC;
hcl_setoption ( hcl , HCL_LOG_MASK , & trait ) ; */
2016-09-28 14:40:37 +00:00
}
2019-04-16 15:46:00 +00:00
xtn = ( xtn_t * ) hcl_getxtn ( hcl ) ;
2018-02-05 10:43:25 +00:00
memset ( & hclcb , 0 , HCL_SIZEOF ( hclcb ) ) ;
2018-03-08 14:18:30 +00:00
hclcb . gc = gc_hcl ;
2018-03-10 17:53:44 +00:00
hclcb . vm_startup = vm_startup ;
hclcb . vm_cleanup = vm_cleanup ;
2018-03-11 11:16:28 +00:00
/*hclcb.vm_checkbc = vm_checkbc;*/
2018-02-05 10:43:25 +00:00
hcl_regcb ( hcl , & hclcb ) ;
if ( logopt )
{
2019-04-16 15:46:00 +00:00
if ( handle_logopt ( hcl , logopt ) < = - 1 ) goto oops ;
2018-02-05 10:43:25 +00:00
}
2018-02-21 09:30:18 +00:00
# if defined(HCL_BUILD_DEBUG)
2018-02-05 10:43:25 +00:00
if ( dbgopt )
{
2018-04-25 04:12:13 +00:00
if ( handle_dbgopt ( hcl , dbgopt ) < = - 1 ) goto oops ;
2018-02-05 10:43:25 +00:00
}
# endif
2016-09-28 14:40:37 +00:00
if ( hcl_ignite ( hcl ) < = - 1 )
{
2018-02-05 15:59:32 +00:00
hcl_logbfmt ( hcl , HCL_LOG_STDERR , " cannot ignite hcl - [%d] %js \n " , hcl_geterrnum ( hcl ) , hcl_geterrmsg ( hcl ) ) ;
2018-04-25 04:12:13 +00:00
goto oops ;
2016-09-28 14:40:37 +00:00
}
2016-10-06 17:49:47 +00:00
if ( hcl_addbuiltinprims ( hcl ) < = - 1 )
{
2018-02-05 15:59:32 +00:00
hcl_logbfmt ( hcl , HCL_LOG_STDERR , " cannot add builtin primitives - [%d] %js \n " , hcl_geterrnum ( hcl ) , hcl_geterrmsg ( hcl ) ) ;
2018-04-25 04:12:13 +00:00
goto oops ;
2016-10-06 17:49:47 +00:00
}
2018-02-05 10:43:25 +00:00
xtn - > read_path = argv [ opt . ind + + ] ;
if ( opt . ind < argc ) xtn - > print_path = argv [ opt . ind + + ] ;
2016-09-28 14:40:37 +00:00
2018-02-20 14:10:09 +00:00
if ( hcl_attachio ( hcl , read_handler , print_handler ) < = - 1 )
2016-09-28 14:40:37 +00:00
{
2021-01-29 17:24:13 +00:00
hcl_logbfmt ( hcl , HCL_LOG_STDERR , " ERROR: cannot attach IO streams - [%d] %js \n " , hcl_geterrnum ( hcl ) , hcl_geterrmsg ( hcl ) ) ;
2018-04-25 04:12:13 +00:00
goto oops ;
2016-09-28 14:40:37 +00:00
}
2018-03-08 14:18:30 +00:00
{
hcl_ooch_t errstr [ ] = { ' E ' , ' R ' , ' R ' , ' S ' , ' T ' , ' R ' } ;
xtn - > sym_errstr = hcl_makesymbol ( hcl , errstr , 6 ) ;
if ( ! xtn - > sym_errstr )
{
hcl_logbfmt ( hcl , HCL_LOG_STDERR , " ERROR: cannot create the ERRSTR symbol - [%d] %js \n " , hcl_geterrnum ( hcl ) , hcl_geterrmsg ( hcl ) ) ;
2018-04-25 04:12:13 +00:00
goto oops ;
2018-03-08 14:18:30 +00:00
}
HCL_OBJ_SET_FLAGS_KERNEL ( xtn - > sym_errstr , 1 ) ;
}
2018-03-10 17:53:44 +00:00
/* -- from this point onward, any failure leads to jumping to the oops label
* - - instead of returning - 1 immediately . - - */
set_signal ( SIGINT , handle_sigint ) ;
2019-06-02 06:42:47 +00:00
#if 0
2019-06-02 05:06:08 +00:00
hcl_prbfmt ( hcl , " this is good %s %10hs %hs \n " , " whole new world. 1234567890 from this point onward, any failure leasd to jumping to oops label " , " as이거 좋은거잖아dkfjsdakfjsadklfjasd " , " 1111 " ) ;
2019-06-02 06:42:47 +00:00
{
hcl_uch_t fmt [ ] = { ' G ' , ' G ' , ' % ' , ' l ' , ' s ' , ' a ' , ' b ' , ' c ' , ' - ' , ' - ' , ' % ' , ' 0 ' , ' 2 ' , ' 0 ' , ' x ' , ' \0 ' } ;
hcl_uch_t ustr [ ] = { ' A ' , ' B ' , ' C ' , ' X ' , ' Y ' , ' Z ' , ' Q ' , ' Q ' , ' \0 ' } ;
hcl_prufmt ( hcl , fmt , ustr , 0x6789 ) ;
hcl_logufmt ( hcl , HCL_LOG_WARN , fmt , ustr , 0x6789 ) ;
}
# endif
2020-10-15 12:57:05 +00:00
#if 0
2020-10-08 09:25:54 +00:00
// TODO: change the option name
// in the INTERACTIVE mode, the compiler generates MAKE_FUNCTION for lambda functions.
2021-01-26 10:10:18 +00:00
// in the non-INTERACTIVE mode, the compiler generates MAKE_BLOCK for lambda functions.
2020-10-05 09:37:26 +00:00
{
hcl_bitmask_t trait ;
hcl_getoption ( hcl , HCL_TRAIT , & trait ) ;
trait | = HCL_TRAIT_INTERACTIVE ;
hcl_setoption ( hcl , HCL_TRAIT , & trait ) ;
}
2020-10-07 08:06:49 +00:00
# endif
2020-09-28 15:44:04 +00:00
2021-01-22 14:43:47 +00:00
while ( 1 )
2021-01-15 09:12:28 +00:00
{
2021-01-22 14:43:47 +00:00
hcl_cnode_t * obj ;
int n ;
2021-01-29 08:35:31 +00:00
/*
static int count = 0 ;
if ( count % 5 = = 0 ) hcl_reset ( hcl ) ;
count + + ;
*/
2021-01-29 08:40:10 +00:00
obj = hcl_read ( hcl ) ;
2021-01-22 14:43:47 +00:00
if ( ! obj )
2021-01-15 09:12:28 +00:00
{
2021-01-22 14:43:47 +00:00
if ( hcl - > errnum = = HCL_EFINIS )
{
/* end of input */
break ;
}
else if ( hcl - > errnum = = HCL_ESYNERR )
{
print_synerr ( hcl ) ;
if ( xtn - > reader_istty & & hcl_getsynerrnum ( hcl ) ! = HCL_SYNERR_EOF )
{
/* TODO: drain remaining data in the reader including the actual inputstream and buffered data in hcl */
continue ;
}
}
else
2021-01-15 09:12:28 +00:00
{
2021-01-22 14:43:47 +00:00
hcl_logbfmt ( hcl , HCL_LOG_STDERR , " ERROR: cannot read object - [%d] %js \n " , hcl_geterrnum ( hcl ) , hcl_geterrmsg ( hcl ) ) ;
2021-01-15 09:12:28 +00:00
}
2021-01-22 14:43:47 +00:00
goto oops ;
2021-01-15 09:12:28 +00:00
}
2021-01-22 14:43:47 +00:00
if ( xtn - > reader_istty )
2021-01-15 09:12:28 +00:00
{
2021-01-22 14:43:47 +00:00
/* clear the byte code buffer */
/* TODO: create a proper function for this and call it */
hcl - > code . bc . len = 0 ;
hcl - > code . lit . len = 0 ;
2021-01-15 09:12:28 +00:00
}
2021-01-17 17:45:39 +00:00
2021-01-22 14:43:47 +00:00
if ( verbose ) hcl_prbfmt ( hcl , " \n " ) ; /* flush the output buffer by hcl_print above */
2021-01-29 08:40:10 +00:00
n = hcl_compile ( hcl , obj ) ;
2021-01-22 14:43:47 +00:00
hcl_freecnode ( hcl , obj ) ; /* not needed any more */
if ( n < = - 1 )
2021-01-17 17:45:39 +00:00
{
if ( hcl - > errnum = = HCL_ESYNERR )
{
print_synerr ( hcl ) ;
}
else
{
hcl_logbfmt ( hcl , HCL_LOG_STDERR , " ERROR: cannot compile object - [%d] %js \n " , hcl_geterrnum ( hcl ) , hcl_geterrmsg ( hcl ) ) ;
}
2021-01-22 14:43:47 +00:00
/* carry on? */
if ( ! xtn - > reader_istty ) goto oops ;
2021-01-17 17:45:39 +00:00
}
2021-01-22 14:43:47 +00:00
else if ( xtn - > reader_istty )
2021-01-17 17:45:39 +00:00
{
2021-01-22 14:43:47 +00:00
/* interactive mode */
hcl_oop_t retv ;
2021-01-17 17:45:39 +00:00
hcl_decode ( hcl , 0 , hcl_getbclen ( hcl ) ) ;
2021-01-22 14:43:47 +00:00
HCL_LOG0 ( hcl , HCL_LOG_MNEMONIC , " ------------------------------------------ \n " ) ;
g_hcl = hcl ;
//setup_tick ();
2021-01-17 17:45:39 +00:00
2021-01-22 14:43:47 +00:00
retv = hcl_execute ( hcl ) ;
2021-01-15 09:12:28 +00:00
2021-01-22 14:43:47 +00:00
/* flush pending output data in the interactive mode(e.g. printf without a newline) */
hcl_flushio ( hcl ) ;
if ( ! retv )
{
hcl_logbfmt ( hcl , HCL_LOG_STDERR , " ERROR: cannot execute - [%d] %js \n " , hcl_geterrnum ( hcl ) , hcl_geterrmsg ( hcl ) ) ;
}
else
{
/* print the result in the interactive mode regardless 'verbose' */
2021-01-29 17:24:13 +00:00
hcl_logbfmt ( hcl , HCL_LOG_STDOUT , " %O \n " , retv ) ; /* TODO: show this go to the output handler?? */
2021-01-22 14:43:47 +00:00
/*
* print the value of ERRSTR .
hcl_oop_cons_t cons = hcl_getatsysdic ( hcl , xtn - > sym_errstr ) ;
if ( cons )
{
HCL_ASSERT ( hcl , HCL_IS_CONS ( hcl , cons ) ) ;
HCL_ASSERT ( hcl , HCL_CONS_CAR ( cons ) = = xtn - > sym_errstr ) ;
hcl_print ( hcl , HCL_CONS_CDR ( cons ) ) ;
}
*/
}
//cancel_tick();
g_hcl = HCL_NULL ;
}
}
2018-02-08 07:40:27 +00:00
2020-10-13 14:44:00 +00:00
if ( ! xtn - > reader_istty & & hcl_getbclen ( hcl ) > 0 )
2018-02-08 15:04:07 +00:00
{
2018-02-22 12:57:31 +00:00
hcl_oop_t retv ;
2018-03-11 11:16:28 +00:00
hcl_decode ( hcl , 0 , hcl_getbclen ( hcl ) ) ;
HCL_LOG2 ( hcl , HCL_LOG_MNEMONIC , " BYTECODES bclen = > %zu lflen => %zu \n " , hcl_getbclen ( hcl ) , hcl_getlflen ( hcl ) ) ;
2018-02-08 15:04:07 +00:00
g_hcl = hcl ;
2018-03-11 11:16:28 +00:00
/*setup_tick ();*/
2018-02-22 12:57:31 +00:00
retv = hcl_execute ( hcl ) ;
if ( ! retv )
2018-02-08 15:04:07 +00:00
{
hcl_logbfmt ( hcl , HCL_LOG_STDERR , " ERROR: cannot execute - [%d] %js \n " , hcl_geterrnum ( hcl ) , hcl_geterrmsg ( hcl ) ) ;
}
2019-04-16 15:46:00 +00:00
else if ( verbose )
2018-02-22 07:41:03 +00:00
{
2019-04-16 15:46:00 +00:00
hcl_logbfmt ( hcl , HCL_LOG_STDERR , " EXECUTION OK - EXITED WITH %O \n " , retv ) ;
2018-02-22 07:41:03 +00:00
}
2018-02-22 12:57:31 +00:00
2018-03-11 11:16:28 +00:00
/*cancel_tick();*/
2018-02-08 15:04:07 +00:00
g_hcl = HCL_NULL ;
/*hcl_dumpsymtab (hcl);*/
}
2020-10-13 14:44:00 +00:00
2018-03-10 17:53:44 +00:00
set_signal_to_default ( SIGINT ) ;
2018-02-09 17:15:31 +00:00
hcl_close ( hcl ) ;
2018-04-25 04:12:13 +00:00
2016-09-28 14:40:37 +00:00
return 0 ;
2018-02-09 17:15:31 +00:00
oops :
2018-04-25 04:12:13 +00:00
set_signal_to_default ( SIGINT ) ; /* harmless to call multiple times without set_signal() */
if ( hcl ) hcl_close ( hcl ) ;
2018-02-09 17:15:31 +00:00
return - 1 ;
2016-09-28 14:40:37 +00:00
}