2021-01-15 09:12:28 +00:00
/*
* $ Id $
*
Copyright ( c ) 2016 - 2018 Chung , Hyung - Hwan . All rights reserved .
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"
enum
{
VAR_NAMED ,
2021-11-23 14:42:20 +00:00
VAR_INDEXED ,
2021-11-23 15:52:01 +00:00
VAR_INST ,
VAR_CLASS
} ;
enum
{
VAR_ACCESS_PUSH ,
VAR_ACCESS_POP ,
VAR_ACCESS_STORE
2021-01-15 09:12:28 +00:00
} ;
# define TV_BUFFER_ALIGN 256
# define BLK_INFO_BUFFER_ALIGN 128
/* --------------------------------------------
( defun plus ( x y )
( printf " plus %d %d \n " x y )
( defun minus ( x y )
( printf " minus %d %d \n " x y )
( - x y )
)
( + x y )
)
( defun dummy ( q )
( printf " %s \n " q )
)
( plus 10 20 )
< - - - - minus is now available
( minus 10 1 )
literals - - >
//
// characeter 'A'
// "string"
// B"byte string"
// array ---> #[ ] or [ ] ? constant or not? dynamic???
// hash table - dictionary ---> #{ } or { } <--- ambuguity with blocks...
// the rest must be manipulated with code...
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
2021-01-21 14:59:01 +00:00
static int copy_string_to ( hcl_t * hcl , const hcl_oocs_t * src , hcl_oocs_t * dst , hcl_oow_t * dstcapa , int append , hcl_ooch_t delim_char )
2021-01-15 09:12:28 +00:00
{
2021-01-17 17:45:39 +00:00
hcl_oow_t len , pos ;
2021-01-15 09:12:28 +00:00
2021-01-17 17:45:39 +00:00
if ( append )
{
2021-01-21 14:59:01 +00:00
pos = dst - > len ;
len = dst - > len + src - > len ;
2021-01-17 17:45:39 +00:00
if ( delim_char ! = ' \0 ' ) len + + ;
}
else
{
pos = 0 ;
len = src - > len ;
}
2021-01-15 09:12:28 +00:00
2021-01-21 14:59:01 +00:00
if ( len > = * dstcapa )
2021-01-15 09:12:28 +00:00
{
2021-01-17 17:45:39 +00:00
hcl_ooch_t * tmp ;
hcl_oow_t capa ;
capa = HCL_ALIGN ( len + 1 , TV_BUFFER_ALIGN ) ;
2021-01-21 14:59:01 +00:00
tmp = ( hcl_ooch_t * ) hcl_reallocmem ( hcl , dst - > ptr , HCL_SIZEOF ( * tmp ) * capa ) ;
2021-01-17 17:45:39 +00:00
if ( HCL_UNLIKELY ( ! tmp ) ) return - 1 ;
2021-01-21 14:59:01 +00:00
dst - > ptr = tmp ;
* dstcapa = capa - 1 ;
2021-01-15 09:12:28 +00:00
}
2021-01-21 14:59:01 +00:00
if ( append & & delim_char ! = ' \0 ' ) dst - > ptr [ pos + + ] = delim_char ;
hcl_copy_oochars ( & dst - > ptr [ pos ] , src - > ptr , src - > len ) ;
dst - > ptr [ len ] = ' \0 ' ;
dst - > len = len ;
2021-01-17 17:45:39 +00:00
return 0 ;
}
2021-01-21 14:59:01 +00:00
static int __find_word_in_string ( const hcl_oocs_t * haystack , const hcl_oocs_t * name , int last , hcl_oow_t * xindex )
2021-01-17 17:45:39 +00:00
{
/* this function is inefficient. but considering the typical number
* of arguments and temporary variables , the inefficiency can be
* ignored in my opinion . the overhead to maintain the reverse lookup
* table from a name to an index should be greater than this simple
* inefficient lookup */
hcl_ooch_t * t , * e ;
hcl_oow_t index , i , found ;
t = haystack - > ptr ;
e = t + haystack - > len ;
index = 0 ;
found = HCL_TYPE_MAX ( hcl_oow_t ) ;
while ( t < e )
2021-01-15 09:12:28 +00:00
{
2021-01-17 17:45:39 +00:00
while ( t < e & & * t = = ' ' ) t + + ;
2021-01-15 09:12:28 +00:00
2021-01-17 17:45:39 +00:00
for ( i = 0 ; i < name - > len ; i + + )
{
if ( t > = e | | name - > ptr [ i ] ! = * t ) goto unmatched ;
t + + ;
}
if ( t > = e | | * t = = ' ' )
{
if ( last )
{
2021-11-21 16:02:39 +00:00
/* if last is true, find the last matching entry */
2021-01-17 17:45:39 +00:00
found = index ;
}
else
{
if ( xindex ) * xindex = index ;
2021-01-21 14:59:01 +00:00
return 0 ; /* found */
2021-01-17 17:45:39 +00:00
}
}
2021-01-15 09:12:28 +00:00
2021-01-17 17:45:39 +00:00
unmatched :
while ( t < e )
{
if ( * t = = ' ' )
{
t + + ;
break ;
}
t + + ;
}
index + + ;
2021-01-15 09:12:28 +00:00
}
2021-01-17 17:45:39 +00:00
if ( found ! = HCL_TYPE_MAX ( hcl_oow_t ) )
{
if ( xindex ) * xindex = found ;
2021-04-22 00:00:12 +00:00
return 0 ; /* found */
2021-01-17 17:45:39 +00:00
}
2021-01-15 09:12:28 +00:00
2021-01-21 14:59:01 +00:00
return - 1 ; /* not found */
2021-01-15 09:12:28 +00:00
}
2021-01-17 17:45:39 +00:00
static int add_temporary_variable ( hcl_t * hcl , const hcl_oocs_t * name , hcl_oow_t dup_check_start )
2021-01-15 09:12:28 +00:00
{
2021-01-21 14:59:01 +00:00
hcl_oocs_t s ;
int x ;
2021-01-15 09:12:28 +00:00
2021-02-01 13:20:46 +00:00
s . ptr = hcl - > c - > tv . s . ptr + dup_check_start ;
s . len = hcl - > c - > tv . s . len - dup_check_start ;
2021-01-21 14:59:01 +00:00
if ( __find_word_in_string ( & s , name , 0 , HCL_NULL ) > = 0 )
2021-01-15 09:12:28 +00:00
{
2021-01-21 14:59:01 +00:00
hcl_seterrnum ( hcl , HCL_EEXIST ) ;
return - 1 ;
2021-01-15 09:12:28 +00:00
}
2021-02-01 13:20:46 +00:00
x = copy_string_to ( hcl , name , & hcl - > c - > tv . s , & hcl - > c - > tv . capa , 1 , ' ' ) ;
if ( HCL_LIKELY ( x > = 0 ) ) hcl - > c - > tv . wcount + + ;
2021-01-21 14:59:01 +00:00
return x ;
2021-01-15 09:12:28 +00:00
}
2021-04-22 09:35:26 +00:00
static int kill_temporary_variables ( hcl_t * hcl , hcl_oow_t start_wpos , hcl_oow_t end_wpos )
2021-04-22 00:00:12 +00:00
{
/* this function doesn't remove the added temporary variable nor does it lower the word count.
* it simply changes a word at the given postion to some garbage characters so that
* the variable can ' t be found in the search */
/* TODO: .... */
return 0 ;
}
2021-04-22 09:35:26 +00:00
static void kill_temporary_variable_at_offset ( hcl_t * hcl , hcl_oow_t offset )
2021-01-15 09:12:28 +00:00
{
2021-04-22 09:35:26 +00:00
/* this is a hacky function. it's better to implement kill_temporary_variables() which uses word positions */
HCL_ASSERT ( hcl , offset < hcl - > c - > tv . s . len ) ;
HCL_ASSERT ( hcl , hcl - > c - > tv . s . ptr [ offset ] ! = ' ' ) ;
2022-01-03 17:59:55 +00:00
hcl - > c - > tv . s . ptr [ offset ] = ' ( ' ; /* HACK!! put a special character which can't form a variable name */
2021-04-09 01:23:08 +00:00
}
2021-11-23 14:42:20 +00:00
static int find_variable_backward ( hcl_t * hcl , const hcl_oocs_t * name , hcl_var_info_t * vi )
2021-11-21 16:02:39 +00:00
{
2021-11-23 15:52:01 +00:00
hcl_oow_t i , j ;
2021-11-21 16:02:39 +00:00
2021-11-21 16:16:59 +00:00
HCL_ASSERT ( hcl , hcl - > c - > fnblk . depth > = 0 ) ;
HCL_ASSERT ( hcl , hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] . tmprlen = = hcl - > c - > tv . s . len ) ;
2021-11-21 16:02:39 +00:00
/* depth begins at -1. so it is the actual index. let the looping begin at depth + 1
* to avoid an extra exit check without it */
for ( i = hcl - > c - > fnblk . depth + 1 ; i > 0 ; )
{
2021-11-23 14:42:20 +00:00
hcl_fnblk_info_t * fbi ;
hcl_oocs_t haystack ;
hcl_oow_t parent_tmprcnt , parent_tmprlen , index ;
2021-11-21 16:02:39 +00:00
fbi = & hcl - > c - > fnblk . info [ - - i ] ;
2021-11-23 14:42:20 +00:00
if ( fbi - > clsblk_top > = 0 )
{
/* this function block has a class defined */
hcl_clsblk_info_t * clsbi ;
2021-11-23 15:52:01 +00:00
for ( j = fbi - > clsblk_top + 1 ; j > fbi - > clsblk_base ; )
2021-11-23 14:42:20 +00:00
{
2021-11-23 15:52:01 +00:00
clsbi = & hcl - > c - > clsblk . info [ - - j ] ;
2021-11-26 14:55:50 +00:00
if ( i < hcl - > c - > fnblk . depth & & clsbi - > ivars_str )
2021-11-23 15:52:01 +00:00
{
haystack . ptr = clsbi - > ivars_str ;
haystack . len = hcl_count_oocstr ( clsbi - > ivars_str ) ;
if ( __find_word_in_string ( & haystack , name , 1 , & index ) > = 0 )
{
vi - > type = VAR_INST ;
vi - > ctx_offset = 0 ;
vi - > index_in_ctx = index ;
HCL_INFO6 ( hcl , " FOUND INST VAR [%.*js]...[%.*js]................ ===> ctx_offset %d index %d \n " ,
haystack . len , haystack . ptr , name - > len , name - > ptr , ( int ) ( vi - > ctx_offset ) , ( int ) vi - > index_in_ctx ) ;
return 0 ;
}
}
if ( clsbi - > cvars_str )
{
haystack . ptr = clsbi - > cvars_str ;
haystack . len = hcl_count_oocstr ( clsbi - > cvars_str ) ;
if ( __find_word_in_string ( & haystack , name , 1 , & index ) > = 0 )
{
vi - > type = VAR_CLASS ;
vi - > ctx_offset = 0 ;
vi - > index_in_ctx = index ;
HCL_INFO6 ( hcl , " FOUND CLASS VAR [%.*js]...[%.*js]................ ===> ctx_offset %d index %d \n " ,
haystack . len , haystack . ptr , name - > len , name - > ptr , ( int ) ( vi - > ctx_offset ) , ( int ) vi - > index_in_ctx ) ;
return 0 ;
}
}
2021-11-23 14:42:20 +00:00
}
2021-11-23 15:52:01 +00:00
2021-11-26 14:55:50 +00:00
if ( i = = hcl - > c - > fnblk . depth )
{
/* this condition indicates that the current function level contains a class defintion
* and this variable is looked up inside the class defintion */
HCL_INFO2 ( hcl , " CLASS NAMED VAR [%.*js] \n " , name - > len , name - > ptr ) ;
vi - > type = VAR_CLASS ; //_NAMED; // TODO: create VAR_CLASS_NAMED???
vi - > ctx_offset = 0 ;
vi - > index_in_ctx = 0 ;
}
2021-11-23 14:42:20 +00:00
break ;
}
2021-11-21 16:16:59 +00:00
if ( HCL_LIKELY ( i > 0 ) )
2021-11-21 16:02:39 +00:00
{
parent_tmprlen = hcl - > c - > fnblk . info [ i - 1 ] . tmprlen ;
parent_tmprcnt = hcl - > c - > fnblk . info [ i - 1 ] . tmprcnt ;
}
else
{
parent_tmprlen = 0 ;
parent_tmprcnt = 0 ;
}
/* narrow the search scope to the current block */
haystack . ptr = & hcl - > c - > tv . s . ptr [ parent_tmprlen ] ;
haystack . len = fbi - > tmprlen - parent_tmprlen ;
if ( __find_word_in_string ( & haystack , name , 1 , & index ) > = 0 )
{
/* temporary variables or arguments */
vi - > type = VAR_INDEXED ;
vi - > ctx_offset = hcl - > c - > fnblk . depth - i ; /* context offset */
vi - > index_in_ctx = index ;
2021-11-23 14:42:20 +00:00
//HCL_INFO4 (hcl, "FOUND ...[%.*js]................ ===> ctx_offset %d index %d\n", name->len, name->ptr, (int)(vi->ctx_offset), (int)vi->index_in_ctx);
2021-11-23 02:37:58 +00:00
2021-11-23 14:42:20 +00:00
if ( vi - > ctx_offset > 0 )
2021-11-23 02:37:58 +00:00
{
/* the current function block accesses temporaries in an outer function block */
hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] . access_outer = 1 ;
/* temporaries in an outer function block is accessed by the current function block */
hcl - > c - > fnblk . info [ i - 1 ] . accessed_by_inner = 1 ;
}
2021-11-21 16:02:39 +00:00
return 0 ;
}
}
2021-12-12 16:09:31 +00:00
HCL_INFO2 ( hcl , " NOT FOUND => %.*js \n " , name - > len , name - > ptr ) ;
2021-11-21 16:02:39 +00:00
return - 1 ;
}
2021-01-17 17:45:39 +00:00
/* ========================================================================= */
static int add_literal ( hcl_t * hcl , hcl_oop_t obj , hcl_oow_t * index )
{
hcl_oow_t capa , i , lfbase = 0 ;
2021-04-09 01:23:08 +00:00
lfbase = ( hcl - > option . trait & HCL_TRAIT_INTERACTIVE ) ? hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] . lfbase : 0 ;
2021-01-17 17:45:39 +00:00
/* TODO: speed up the following duplicate check loop */
for ( i = lfbase ; i < hcl - > code . lit . len ; i + + )
{
/* this removes redundancy of symbols, characters, and integers. */
if ( ( ( hcl_oop_oop_t ) hcl - > code . lit . arr ) - > slot [ i ] = = obj )
{
* index = i - lfbase ;
return i ;
}
}
capa = HCL_OBJ_GET_SIZE ( hcl - > code . lit . arr ) ;
if ( hcl - > code . lit . len > = capa )
{
hcl_oop_t tmp ;
hcl_oow_t newcapa ;
newcapa = HCL_ALIGN ( capa + 1 , HCL_LIT_BUFFER_ALIGN ) ;
tmp = hcl_remakengcarray ( hcl , ( hcl_oop_t ) hcl - > code . lit . arr , newcapa ) ;
if ( ! tmp ) return - 1 ;
hcl - > code . lit . arr = ( hcl_oop_oop_t ) tmp ;
}
* index = hcl - > code . lit . len - lfbase ;
( ( hcl_oop_oop_t ) hcl - > code . lit . arr ) - > slot [ hcl - > code . lit . len + + ] = obj ;
return 0 ;
}
2021-01-15 09:12:28 +00:00
/* ========================================================================= */
static HCL_INLINE void patch_instruction ( hcl_t * hcl , hcl_oow_t index , hcl_oob_t bc )
{
HCL_ASSERT ( hcl , index < hcl - > code . bc . len ) ;
hcl - > code . bc . ptr [ index ] = bc ;
}
static int emit_byte_instruction ( hcl_t * hcl , hcl_oob_t bc , const hcl_ioloc_t * srcloc )
{
/* the context object has the ip field. it should be representable
* in a small integer . for simplicity , limit the total byte code length
* to fit in a small integer . because ' ip ' points to the next instruction
* to execute , the upper bound should be ( max - 1 ) so that ' ip ' stays
* at the max when incremented */
if ( hcl - > code . bc . len = = HCL_SMOOI_MAX - 1 )
{
hcl_seterrnum ( hcl , HCL_EBCFULL ) ; /* byte code full/too big */
return - 1 ;
}
if ( hcl - > code . bc . len > = hcl - > code . bc . capa )
{
hcl_oow_t newcapa ;
hcl_oob_t * tmp ;
2021-02-01 03:32:09 +00:00
hcl_dbgi_t * tmp2 ;
2021-01-15 09:12:28 +00:00
newcapa = HCL_ALIGN ( hcl - > code . bc . capa + 1 , HCL_BC_BUFFER_ALIGN ) ;
tmp = ( hcl_oob_t * ) hcl_reallocmem ( hcl , hcl - > code . bc . ptr , HCL_SIZEOF ( * tmp ) * newcapa ) ;
if ( HCL_UNLIKELY ( ! tmp ) ) return - 1 ;
2021-02-01 03:32:09 +00:00
tmp2 = ( hcl_dbgi_t * ) hcl_reallocmem ( hcl , hcl - > code . dbgi , HCL_SIZEOF ( * tmp2 ) * newcapa ) ;
2021-01-15 09:12:28 +00:00
if ( HCL_UNLIKELY ( ! tmp2 ) )
{
hcl_freemem ( hcl , tmp ) ;
return - 1 ;
}
HCL_MEMSET ( & tmp2 [ hcl - > code . bc . capa ] , 0 , HCL_SIZEOF ( * tmp2 ) * ( newcapa - hcl - > code . bc . capa ) ) ;
hcl - > code . bc . ptr = tmp ;
hcl - > code . bc . capa = newcapa ;
2021-02-01 03:32:09 +00:00
hcl - > code . dbgi = tmp2 ;
2021-01-15 09:12:28 +00:00
}
hcl - > code . bc . ptr [ hcl - > code . bc . len ] = bc ;
if ( srcloc )
{
2021-02-01 03:32:09 +00:00
hcl - > code . dbgi [ hcl - > code . bc . len ] . fname = srcloc - > file ;
hcl - > code . dbgi [ hcl - > code . bc . len ] . sline = srcloc - > line ;
2021-01-15 09:12:28 +00:00
}
hcl - > code . bc . len + + ;
return 0 ;
}
2021-01-17 17:45:39 +00:00
/*
COMMENTED OUT TEMPORARILY
2021-01-15 09:12:28 +00:00
int hcl_emitbyteinstruction ( hcl_t * hcl , hcl_oob_t bc )
{
return emit_byte_instruction ( hcl , bc , HCL_NULL ) ;
2021-01-17 17:45:39 +00:00
} */
2021-01-15 09:12:28 +00:00
2021-01-27 16:11:56 +00:00
static int emit_single_param_instruction ( hcl_t * hcl , int cmd , hcl_oow_t param_1 , const hcl_ioloc_t * srcloc )
2021-01-15 09:12:28 +00:00
{
hcl_oob_t bc ;
switch ( cmd )
{
case HCL_CODE_PUSH_INSTVAR_0 :
case HCL_CODE_STORE_INTO_INSTVAR_0 :
case HCL_CODE_POP_INTO_INSTVAR_0 :
case HCL_CODE_PUSH_TEMPVAR_0 :
case HCL_CODE_STORE_INTO_TEMPVAR_0 :
case HCL_CODE_POP_INTO_TEMPVAR_0 :
if ( param_1 < 8 )
{
/* low 3 bits to hold the parameter */
bc = ( hcl_oob_t ) ( cmd & 0xF8 ) | ( hcl_oob_t ) param_1 ;
goto write_short ;
}
else
{
/* convert the code to a long version */
bc = cmd | 0x80 ;
goto write_long ;
}
case HCL_CODE_PUSH_LITERAL_0 :
if ( param_1 < 8 )
{
/* low 3 bits to hold the parameter */
bc = ( hcl_oob_t ) ( cmd & 0xF8 ) | ( hcl_oob_t ) param_1 ;
goto write_short ;
}
else if ( param_1 < = MAX_CODE_PARAM )
{
bc = HCL_CODE_PUSH_LITERAL_X ; /* cmd | 0x80 */
goto write_long ;
}
else
{
bc = HCL_CODE_PUSH_LITERAL_X2 ; /* HCL_CODE_PUSH_LITERAL_4 | 0x80 */
goto write_long2 ;
}
case HCL_CODE_PUSH_OBJECT_0 :
case HCL_CODE_STORE_INTO_OBJECT_0 :
case HCL_CODE_POP_INTO_OBJECT_0 :
case HCL_CODE_JUMP_FORWARD_0 :
case HCL_CODE_JUMP_BACKWARD_0 :
case HCL_CODE_CALL_0 :
if ( param_1 < 4 )
{
/* low 2 bits to hold the parameter */
bc = ( hcl_oob_t ) ( cmd & 0xFC ) | ( hcl_oob_t ) param_1 ;
goto write_short ;
}
else
{
/* convert the code to a long version */
bc = cmd | 0x80 ;
goto write_long ;
}
case HCL_CODE_JUMP_FORWARD_IF_TRUE :
case HCL_CODE_JUMP_FORWARD_IF_FALSE :
case HCL_CODE_JUMP2_FORWARD_IF_TRUE :
case HCL_CODE_JUMP2_FORWARD_IF_FALSE :
case HCL_CODE_JUMP2_FORWARD :
2021-01-24 15:45:28 +00:00
case HCL_CODE_JUMP_BACKWARD_IF_TRUE :
case HCL_CODE_JUMP_BACKWARD_IF_FALSE :
case HCL_CODE_JUMP2_BACKWARD_IF_TRUE :
case HCL_CODE_JUMP2_BACKWARD_IF_FALSE :
2021-01-15 09:12:28 +00:00
case HCL_CODE_JUMP2_BACKWARD :
2022-01-01 14:58:57 +00:00
case HCL_CODE_PUSH_CLSVAR_X :
case HCL_CODE_STORE_INTO_CLSVAR_X :
case HCL_CODE_POP_INTO_CLSVAR_X :
2021-04-11 15:08:27 +00:00
case HCL_CODE_TRY_ENTER :
case HCL_CODE_TRY_ENTER2 :
2021-01-15 09:12:28 +00:00
case HCL_CODE_PUSH_INTLIT :
case HCL_CODE_PUSH_NEGINTLIT :
case HCL_CODE_PUSH_CHARLIT :
case HCL_CODE_MAKE_DIC : /* TODO: don't these need write_long2? */
case HCL_CODE_MAKE_ARRAY :
case HCL_CODE_MAKE_BYTEARRAY :
case HCL_CODE_POP_INTO_ARRAY :
case HCL_CODE_POP_INTO_BYTEARRAY :
bc = cmd ;
goto write_long ;
}
2021-05-15 05:31:36 +00:00
hcl_seterrbfmt ( hcl , HCL_EINVAL , " unhandled single-parameter instruction %u " , ( unsigned int ) cmd ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
write_short :
2021-01-27 16:11:56 +00:00
if ( emit_byte_instruction ( hcl , bc , srcloc ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
return 0 ;
write_long :
if ( param_1 > MAX_CODE_PARAM )
{
2021-05-15 05:31:36 +00:00
hcl_seterrbfmt ( hcl , HCL_ERANGE , " parameter too large to single-parameter instruction %u " , ( unsigned int ) cmd ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-29 12:39:31 +00:00
# if (HCL_CODE_LONG_PARAM_SIZE == 2)
2021-01-27 16:11:56 +00:00
if ( emit_byte_instruction ( hcl , bc , srcloc ) < = - 1 | |
2021-01-15 09:12:28 +00:00
emit_byte_instruction ( hcl , ( param_1 > > 8 ) & 0xFF , HCL_NULL ) < = - 1 | |
emit_byte_instruction ( hcl , param_1 & 0xFF , HCL_NULL ) < = - 1 ) return - 1 ;
# else
2021-01-27 16:11:56 +00:00
if ( emit_byte_instruction ( hcl , bc , srcloc ) < = - 1 | |
2021-01-15 09:12:28 +00:00
emit_byte_instruction ( hcl , param_1 , HCL_NULL ) < = - 1 ) return - 1 ;
# endif
return 0 ;
write_long2 :
if ( param_1 > MAX_CODE_PARAM2 )
{
2021-05-15 05:31:36 +00:00
hcl_seterrbfmt ( hcl , HCL_ERANGE , " parameter too large to single-parameter instruction %u " , ( unsigned int ) cmd ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-29 12:39:31 +00:00
# if (HCL_CODE_LONG_PARAM_SIZE == 2)
2021-01-27 16:11:56 +00:00
if ( emit_byte_instruction ( hcl , bc , srcloc ) < = - 1 | |
2021-01-15 09:12:28 +00:00
emit_byte_instruction ( hcl , ( param_1 > > 24 ) & 0xFF , HCL_NULL ) < = - 1 | |
emit_byte_instruction ( hcl , ( param_1 > > 16 ) & 0xFF , HCL_NULL ) < = - 1 | |
emit_byte_instruction ( hcl , ( param_1 > > 8 ) & 0xFF , HCL_NULL ) < = - 1 | |
2021-05-05 17:37:26 +00:00
emit_byte_instruction ( hcl , ( param_1 > > 0 ) & 0xFF , HCL_NULL ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
# else
2021-01-27 16:11:56 +00:00
if ( emit_byte_instruction ( hcl , bc , srcloc ) < = - 1 | |
2021-01-15 09:12:28 +00:00
emit_byte_instruction ( hcl , ( param_1 > > 8 ) & 0xFF , HCL_NULL ) < = - 1 | |
2021-05-05 17:37:26 +00:00
emit_byte_instruction ( hcl , ( param_1 > > 0 ) & 0xFF , HCL_NULL ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
# endif
return 0 ;
}
2021-01-28 08:17:50 +00:00
static int emit_double_param_instruction ( hcl_t * hcl , int cmd , hcl_oow_t param_1 , hcl_oow_t param_2 , const hcl_ioloc_t * srcloc )
2021-01-15 09:12:28 +00:00
{
hcl_oob_t bc ;
switch ( cmd )
{
case HCL_CODE_STORE_INTO_CTXTEMPVAR_0 :
case HCL_CODE_POP_INTO_CTXTEMPVAR_0 :
case HCL_CODE_PUSH_CTXTEMPVAR_0 :
case HCL_CODE_PUSH_OBJVAR_0 :
case HCL_CODE_STORE_INTO_OBJVAR_0 :
case HCL_CODE_POP_INTO_OBJVAR_0 :
case HCL_CODE_SEND_MESSAGE_0 :
case HCL_CODE_SEND_MESSAGE_TO_SUPER_0 :
if ( param_1 < 4 & & param_2 < 0xFF )
{
/* low 2 bits of the instruction code is the first parameter */
bc = ( hcl_oob_t ) ( cmd & 0xFC ) | ( hcl_oob_t ) param_1 ;
goto write_short ;
}
else
{
/* convert the code to a long version */
bc = cmd | 0x80 ;
goto write_long ;
}
2021-05-06 17:44:58 +00:00
/* MAKE_FUNCTION is a quad-parameter instruction.
* The caller must emit two more parameters after the call to this function .
* however the instruction format is the same up to the second
* parameters between MAKE_FUNCTION and MAKE_BLOCK .
*/
case HCL_CODE_MAKE_BLOCK :
case HCL_CODE_MAKE_FUNCTION :
2021-05-15 05:31:36 +00:00
case HCL_CODE_CALL_R :
2021-05-06 17:44:58 +00:00
bc = cmd ;
goto write_long ;
2021-01-15 09:12:28 +00:00
}
2021-05-15 05:31:36 +00:00
hcl_seterrbfmt ( hcl , HCL_EINVAL , " unhandled double-parameter instruction %u " , ( unsigned int ) cmd ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
write_short :
2021-01-28 08:17:50 +00:00
if ( emit_byte_instruction ( hcl , bc , srcloc ) < = - 1 | |
2021-01-15 09:12:28 +00:00
emit_byte_instruction ( hcl , param_2 , HCL_NULL ) < = - 1 ) return - 1 ;
return 0 ;
write_long :
if ( param_1 > MAX_CODE_PARAM | | param_2 > MAX_CODE_PARAM )
{
2021-11-23 14:42:20 +00:00
hcl_seterrbfmt ( hcl , HCL_ERANGE , " parameter too large to double-parameter instruction 0x%u - param_1 0x%zu param_2 0x%zu " , ( unsigned int ) cmd , param_1 , param_2 ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-29 12:39:31 +00:00
# if (HCL_CODE_LONG_PARAM_SIZE == 2)
2021-01-28 08:17:50 +00:00
if ( emit_byte_instruction ( hcl , bc , srcloc ) < = - 1 | |
2021-05-06 17:44:58 +00:00
emit_byte_instruction ( hcl , ( param_1 > > 8 ) & 0xFF , HCL_NULL ) < = - 1 | |
2021-01-15 09:12:28 +00:00
emit_byte_instruction ( hcl , param_1 & 0xFF , HCL_NULL ) < = - 1 | |
2021-05-06 17:44:58 +00:00
emit_byte_instruction ( hcl , ( param_2 > > 8 ) & 0xFF , HCL_NULL ) < = - 1 | |
2021-01-15 09:12:28 +00:00
emit_byte_instruction ( hcl , param_2 & 0xFF , HCL_NULL ) < = - 1 ) return - 1 ;
# else
2021-01-28 08:17:50 +00:00
if ( emit_byte_instruction ( hcl , bc , srcloc ) < = - 1 | |
2021-01-15 09:12:28 +00:00
emit_byte_instruction ( hcl , param_1 , HCL_NULL ) < = - 1 | |
emit_byte_instruction ( hcl , param_2 , HCL_NULL ) < = - 1 ) return - 1 ;
# endif
return 0 ;
}
static HCL_INLINE int emit_long_param ( hcl_t * hcl , hcl_oow_t param )
{
if ( param > MAX_CODE_PARAM )
{
hcl_seterrnum ( hcl , HCL_ERANGE ) ;
return - 1 ;
}
2021-01-29 12:39:31 +00:00
# if (HCL_CODE_LONG_PARAM_SIZE == 2)
2021-01-15 09:12:28 +00:00
return ( emit_byte_instruction ( hcl , param > > 8 , HCL_NULL ) < = - 1 | |
emit_byte_instruction ( hcl , param & 0xFF , HCL_NULL ) < = - 1 ) ? - 1 : 0 ;
# else
return emit_byte_instruction ( hcl , param_1 , HCL_NULL ) ;
# endif
}
2021-01-28 10:09:38 +00:00
static int emit_push_literal ( hcl_t * hcl , hcl_oop_t obj , const hcl_ioloc_t * srcloc )
2021-01-15 09:12:28 +00:00
{
hcl_oow_t index ;
if ( HCL_OOP_IS_SMOOI ( obj ) )
{
hcl_ooi_t i ;
i = HCL_OOP_TO_SMOOI ( obj ) ;
switch ( i )
{
case - 1 :
2021-01-28 10:09:38 +00:00
return emit_byte_instruction ( hcl , HCL_CODE_PUSH_NEGONE , srcloc ) ;
2021-01-15 09:12:28 +00:00
case 0 :
2021-01-28 10:09:38 +00:00
return emit_byte_instruction ( hcl , HCL_CODE_PUSH_ZERO , srcloc ) ;
2021-01-15 09:12:28 +00:00
case 1 :
2021-01-28 10:09:38 +00:00
return emit_byte_instruction ( hcl , HCL_CODE_PUSH_ONE , srcloc ) ;
2021-01-15 09:12:28 +00:00
case 2 :
2021-01-28 10:09:38 +00:00
return emit_byte_instruction ( hcl , HCL_CODE_PUSH_TWO , srcloc ) ;
2021-01-15 09:12:28 +00:00
}
if ( i > = 0 & & i < = MAX_CODE_PARAM )
{
2021-01-28 10:09:38 +00:00
return emit_single_param_instruction ( hcl , HCL_CODE_PUSH_INTLIT , i , srcloc ) ;
2021-01-15 09:12:28 +00:00
}
else if ( i < 0 & & i > = - ( hcl_ooi_t ) MAX_CODE_PARAM )
{
2021-01-28 10:09:38 +00:00
return emit_single_param_instruction ( hcl , HCL_CODE_PUSH_NEGINTLIT , - i , srcloc ) ;
2021-01-15 09:12:28 +00:00
}
}
else if ( HCL_OOP_IS_CHAR ( obj ) )
{
hcl_ooch_t i ;
i = HCL_OOP_TO_CHAR ( obj ) ;
if ( i > = 0 & & i < = MAX_CODE_PARAM )
2021-01-28 10:09:38 +00:00
return emit_single_param_instruction ( hcl , HCL_CODE_PUSH_CHARLIT , i , srcloc ) ;
2021-01-15 09:12:28 +00:00
}
if ( add_literal ( hcl , obj , & index ) < = - 1 | |
2021-01-28 10:09:38 +00:00
emit_single_param_instruction ( hcl , HCL_CODE_PUSH_LITERAL_0 , index , srcloc ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
return 0 ;
}
static HCL_INLINE void patch_long_jump ( hcl_t * hcl , hcl_ooi_t jip , hcl_ooi_t jump_offset )
{
if ( jump_offset > MAX_CODE_JUMP )
{
/* switch to JUMP2 instruction to allow a bigger jump offset.
* up to twice MAX_CODE_JUMP only */
HCL_ASSERT ( hcl , jump_offset < = MAX_CODE_JUMP * 2 ) ;
HCL_ASSERT ( hcl , hcl - > code . bc . ptr [ jip ] = = HCL_CODE_JUMP_FORWARD_X | |
hcl - > code . bc . ptr [ jip ] = = HCL_CODE_JUMP_FORWARD_IF_TRUE | |
2021-01-24 15:45:28 +00:00
hcl - > code . bc . ptr [ jip ] = = HCL_CODE_JUMP_FORWARD_IF_FALSE | |
hcl - > code . bc . ptr [ jip ] = = HCL_CODE_JUMP_BACKWARD_X | |
hcl - > code . bc . ptr [ jip ] = = HCL_CODE_JUMP_BACKWARD_IF_TRUE | |
2021-04-11 15:08:27 +00:00
hcl - > code . bc . ptr [ jip ] = = HCL_CODE_JUMP_BACKWARD_IF_FALSE | |
hcl - > code . bc . ptr [ jip ] = = HCL_CODE_TRY_ENTER ) ;
2021-01-15 09:12:28 +00:00
/* JUMP2 instructions are chosen to be greater than its JUMP counterpart by 1 */
patch_instruction ( hcl , jip , hcl - > code . bc . ptr [ jip ] + 1 ) ;
jump_offset - = MAX_CODE_JUMP ;
}
2021-01-29 12:39:31 +00:00
# if (HCL_CODE_LONG_PARAM_SIZE == 2)
2021-01-15 09:12:28 +00:00
patch_instruction ( hcl , jip + 1 , jump_offset > > 8 ) ;
patch_instruction ( hcl , jip + 2 , jump_offset & 0xFF ) ;
# else
patch_instruction ( hcl , jip + 1 , jump_offset ) ;
# endif
}
static HCL_INLINE void patch_long_param ( hcl_t * hcl , hcl_ooi_t ip , hcl_oow_t param )
{
2021-01-29 12:39:31 +00:00
# if (HCL_CODE_LONG_PARAM_SIZE == 2)
2021-01-15 09:12:28 +00:00
patch_instruction ( hcl , ip , param > > 8 ) ;
patch_instruction ( hcl , ip + 1 , param & 0xFF ) ;
# else
patch_instruction ( hcl , ip , param ) ;
# endif
}
2021-05-06 17:44:58 +00:00
static HCL_INLINE void patch_double_long_params ( hcl_t * hcl , hcl_ooi_t ip , hcl_oow_t param_1 , hcl_oow_t param_2 )
2021-04-22 09:35:26 +00:00
{
# if (HCL_CODE_LONG_PARAM_SIZE == 2)
2021-05-06 17:44:58 +00:00
patch_instruction ( hcl , ip , param_1 > > 8 ) ;
patch_instruction ( hcl , ip + 1 , param_1 & 0xFF ) ;
patch_instruction ( hcl , ip + 2 , param_2 > > 8 ) ;
patch_instruction ( hcl , ip + 3 , param_2 & 0xFF ) ;
2021-04-22 09:35:26 +00:00
# else
2021-05-06 17:44:58 +00:00
patch_instruction ( hcl , ip , param_1 ) ;
patch_instruction ( hcl , ip + 1 , param_2 ) ;
# endif
}
static HCL_INLINE void patch_double_long_params_with_oow ( hcl_t * hcl , hcl_ooi_t ip , hcl_oow_t param )
{
# if (HCL_CODE_LONG_PARAM_SIZE == 2)
patch_instruction ( hcl , ip , ( param > > 24 ) & 0xFF ) ;
patch_instruction ( hcl , ip + 1 , ( param > > 16 ) & 0xFF ) ;
patch_instruction ( hcl , ip + 2 , ( param > > 8 ) & 0xFF ) ;
patch_instruction ( hcl , ip + 3 , ( param > > 0 ) & 0xFF ) ;
# else
patch_instruction ( hcl , ip , ( param > > 8 ) & 9 xFF ) ;
patch_instruction ( hcl , ip + 1 , ( param > > 0 ) & 0xFF ) ;
2021-04-22 09:35:26 +00:00
# endif
}
2021-11-23 15:52:01 +00:00
static int emit_variable_access ( hcl_t * hcl , int mode , const hcl_var_info_t * vi , const hcl_ioloc_t * srcloc )
2021-11-23 14:42:20 +00:00
{
2021-12-24 00:05:58 +00:00
static hcl_oob_t inst_map [ ] [ 3 ] =
2021-11-23 15:52:01 +00:00
{
{ HCL_CODE_PUSH_CTXTEMPVAR_0 , HCL_CODE_POP_INTO_CTXTEMPVAR_0 , HCL_CODE_STORE_INTO_CTXTEMPVAR_0 } ,
2021-11-26 14:55:50 +00:00
{ HCL_CODE_PUSH_INSTVAR_0 , HCL_CODE_POP_INTO_INSTVAR_0 , HCL_CODE_STORE_INTO_INSTVAR_0 } ,
{ HCL_CODE_PUSH_OBJVAR_0 , HCL_CODE_POP_INTO_OBJVAR_0 , HCL_CODE_STORE_INTO_OBJVAR_0 } ,
2021-11-23 15:52:01 +00:00
} ;
switch ( vi - > type )
{
case VAR_INDEXED :
return emit_double_param_instruction ( hcl , inst_map [ 0 ] [ mode ] , vi - > ctx_offset , vi - > index_in_ctx , srcloc ) ;
case VAR_INST :
2021-11-24 02:45:28 +00:00
HCL_ASSERT ( hcl , vi - > ctx_offset = = 0 ) ;
return emit_single_param_instruction ( hcl , inst_map [ 1 ] [ mode ] , vi - > index_in_ctx , srcloc ) ;
2021-11-26 14:55:50 +00:00
case VAR_CLASS :
HCL_ASSERT ( hcl , vi - > ctx_offset = = 0 ) ;
2021-12-12 16:09:31 +00:00
//return emit_double_param_instruction(hcl, inst_map[2][mode], vi->index_in_ctx, <<index to the class name in literal table>>, srcloc);
2021-11-23 15:52:01 +00:00
}
return - 1 ;
2021-11-23 14:42:20 +00:00
}
2021-01-17 17:45:39 +00:00
2021-04-22 09:35:26 +00:00
/* ========================================================================= */
static int push_cblk ( hcl_t * hcl , const hcl_ioloc_t * errloc , hcl_cblk_type_t type )
{
hcl_oow_t new_depth ;
HCL_ASSERT ( hcl , hcl - > c - > cblk . depth > = - 1 ) ;
if ( hcl - > c - > cblk . depth = = HCL_TYPE_MAX ( hcl_ooi_t ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BLKDEPTH , errloc , HCL_NULL , " control block depth too deep " ) ;
return - 1 ;
}
new_depth = hcl - > c - > cblk . depth + 1 ;
if ( hcl - > c - > cblk . depth > = hcl - > c - > cblk . info_capa )
{
hcl_cblk_info_t * tmp ;
hcl_oow_t newcapa ;
newcapa = HCL_ALIGN ( new_depth + 1 , BLK_INFO_BUFFER_ALIGN ) ;
tmp = ( hcl_cblk_info_t * ) hcl_reallocmem ( hcl , hcl - > c - > cblk . info , newcapa * HCL_SIZEOF ( * tmp ) ) ;
if ( HCL_UNLIKELY ( ! tmp ) ) return - 1 ;
hcl - > c - > cblk . info_capa = newcapa ;
hcl - > c - > cblk . info = tmp ;
}
HCL_MEMSET ( & hcl - > c - > cblk . info [ new_depth ] , 0 , HCL_SIZEOF ( hcl - > c - > cblk . info [ new_depth ] ) ) ;
hcl - > c - > cblk . info [ new_depth ] . _type = type ;
hcl - > c - > cblk . depth = new_depth ;
return 0 ;
}
static void pop_cblk ( hcl_t * hcl )
{
2021-06-18 18:54:50 +00:00
HCL_ASSERT ( hcl , hcl - > c - > cblk . depth > = 0 ) ; /* depth is of a signed type */
2021-04-22 09:35:26 +00:00
/* a control block stays inside a function block.
* the control block stack must not be popped past the starting base
* of the owning function block */
HCL_ASSERT ( hcl , hcl - > c - > cblk . depth - 1 > = hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] . cblk_base ) ;
hcl - > c - > cblk . depth - - ;
}
2022-01-03 17:59:55 +00:00
static int push_clsblk ( hcl_t * hcl , const hcl_ioloc_t * errloc , hcl_oow_t nivars , hcl_oow_t ncvars , const hcl_ooch_t * ivars_str , hcl_oow_t ivars_strlen , const hcl_ooch_t * cvars_str , hcl_oow_t cvars_strlen )
2021-06-07 01:11:17 +00:00
{
hcl_oow_t new_depth ;
2021-06-18 18:54:50 +00:00
hcl_clsblk_info_t * ci ;
hcl_fnblk_info_t * fbi ;
2021-06-07 01:11:17 +00:00
HCL_ASSERT ( hcl , hcl - > c - > clsblk . depth > = - 1 ) ;
if ( hcl - > c - > clsblk . depth = = HCL_TYPE_MAX ( hcl_ooi_t ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BLKDEPTH , errloc , HCL_NULL , " class block depth too deep " ) ;
return - 1 ;
}
new_depth = hcl - > c - > clsblk . depth + 1 ;
if ( hcl - > c - > clsblk . depth > = hcl - > c - > clsblk . info_capa )
{
hcl_clsblk_info_t * tmp ;
hcl_oow_t newcapa ;
newcapa = HCL_ALIGN ( new_depth + 1 , BLK_INFO_BUFFER_ALIGN ) ;
tmp = ( hcl_clsblk_info_t * ) hcl_reallocmem ( hcl , hcl - > c - > clsblk . info , newcapa * HCL_SIZEOF ( * tmp ) ) ;
if ( HCL_UNLIKELY ( ! tmp ) ) return - 1 ;
2021-06-18 18:54:50 +00:00
2021-06-07 01:11:17 +00:00
hcl - > c - > clsblk . info_capa = newcapa ;
hcl - > c - > clsblk . info = tmp ;
}
2021-06-18 18:54:50 +00:00
ci = & hcl - > c - > clsblk . info [ new_depth ] ;
HCL_MEMSET ( ci , 0 , HCL_SIZEOF ( * ci ) ) ;
ci - > nivars = nivars ;
ci - > ncvars = ncvars ;
2021-06-07 01:11:17 +00:00
2021-12-24 00:05:58 +00:00
if ( nivars > 0 )
2021-06-27 17:47:51 +00:00
{
2021-12-24 00:05:58 +00:00
HCL_ASSERT ( hcl , ivars_str ! = HCL_NULL ) ;
2022-01-03 17:59:55 +00:00
ci - > ivars_str = hcl_dupoochars ( hcl , ivars_str , ivars_strlen ) ;
2021-06-27 17:47:51 +00:00
if ( HCL_UNLIKELY ( ! ci - > ivars_str ) ) return - 1 ;
}
2021-12-24 00:05:58 +00:00
if ( ncvars > 0 )
2021-06-27 17:47:51 +00:00
{
2021-12-24 00:05:58 +00:00
HCL_ASSERT ( hcl , cvars_str ! = HCL_NULL ) ;
2022-01-03 17:59:55 +00:00
ci - > cvars_str = hcl_dupoochars ( hcl , cvars_str , cvars_strlen ) ;
2021-06-27 17:47:51 +00:00
if ( HCL_UNLIKELY ( ! ci - > cvars_str ) )
{
if ( ci - > ivars_str ) hcl_freemem ( hcl , ci - > ivars_str ) ;
return - 1 ;
}
}
2021-06-07 01:11:17 +00:00
/* remember the function block depth before the class block is entered */
2021-06-18 18:54:50 +00:00
ci - > fnblk_base = hcl - > c - > fnblk . depth ;
/* attach the class block to the current function block */
fbi = & hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] ;
if ( fbi - > clsblk_base < = - 1 ) fbi - > clsblk_base = new_depth ;
fbi - > clsblk_top = new_depth ;
2021-06-07 01:11:17 +00:00
hcl - > c - > clsblk . depth = new_depth ;
return 0 ;
}
static void pop_clsblk ( hcl_t * hcl )
{
2021-06-18 18:54:50 +00:00
hcl_fnblk_info_t * fbi ;
2021-06-27 17:47:51 +00:00
hcl_clsblk_info_t * cbi ;
2021-06-18 18:54:50 +00:00
HCL_ASSERT ( hcl , hcl - > c - > clsblk . depth > = 0 ) ; /* depth is of a signed type */
HCL_ASSERT ( hcl , hcl - > c - > fnblk . depth > = 0 ) ;
fbi = & hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] ;
HCL_ASSERT ( hcl , fbi - > clsblk_base > = 0 & & fbi - > clsblk_top > = 0 & & fbi - > clsblk_top > = fbi - > clsblk_base ) ;
HCL_ASSERT ( hcl , fbi - > clsblk_top = = hcl - > c - > clsblk . depth ) ;
if ( fbi - > clsblk_top = = fbi - > clsblk_base )
{
2021-06-27 17:47:51 +00:00
/* the first class block inside a function block */
2021-06-18 18:54:50 +00:00
fbi - > clsblk_base = - 1 ;
fbi - > clsblk_top = - 1 ;
}
else
{
fbi - > clsblk_top - - ;
}
2021-06-27 17:47:51 +00:00
cbi = & hcl - > c - > clsblk . info [ hcl - > c - > clsblk . depth ] ;
if ( cbi - > cvars_str )
{
hcl_freemem ( hcl , cbi - > cvars_str ) ;
cbi - > cvars_str = HCL_NULL ;
}
if ( cbi - > ivars_str )
{
hcl_freemem ( hcl , cbi - > ivars_str ) ;
cbi - > ivars_str = HCL_NULL ;
}
2021-06-07 01:11:17 +00:00
hcl - > c - > clsblk . depth - - ;
}
2021-06-27 17:47:51 +00:00
static int push_fnblk ( hcl_t * hcl , const hcl_ioloc_t * errloc ,
hcl_oow_t tmpr_va , hcl_oow_t tmpr_nargs , hcl_oow_t tmpr_nrvars , hcl_oow_t tmpr_nlvars ,
hcl_oow_t tmpr_count , hcl_oow_t tmpr_len , hcl_oow_t make_inst_pos , hcl_oow_t lfbase )
{
hcl_oow_t new_depth ;
hcl_fnblk_info_t * fbi ;
HCL_ASSERT ( hcl , hcl - > c - > fnblk . depth > = - 1 ) ;
if ( hcl - > c - > fnblk . depth = = HCL_TYPE_MAX ( hcl_ooi_t ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BLKDEPTH , errloc , HCL_NULL , " function block depth too deep " ) ;
return - 1 ;
}
new_depth = hcl - > c - > fnblk . depth + 1 ;
if ( hcl - > c - > fnblk . depth > = hcl - > c - > fnblk . info_capa )
{
hcl_fnblk_info_t * tmp ;
hcl_oow_t newcapa ;
newcapa = HCL_ALIGN ( new_depth + 1 , BLK_INFO_BUFFER_ALIGN ) ;
tmp = ( hcl_fnblk_info_t * ) hcl_reallocmem ( hcl , hcl - > c - > fnblk . info , newcapa * HCL_SIZEOF ( * tmp ) ) ;
if ( HCL_UNLIKELY ( ! tmp ) ) return - 1 ;
hcl - > c - > fnblk . info_capa = newcapa ;
hcl - > c - > fnblk . info = tmp ;
}
fbi = & hcl - > c - > fnblk . info [ new_depth ] ;
HCL_MEMSET ( fbi , 0 , HCL_SIZEOF ( * fbi ) ) ;
fbi - > tmprlen = tmpr_len ;
fbi - > tmprcnt = tmpr_count ;
fbi - > tmpr_va = tmpr_va ;
fbi - > tmpr_nargs = tmpr_nargs ;
fbi - > tmpr_nrvars = tmpr_nrvars ;
fbi - > tmpr_nlvars = tmpr_nlvars ;
/* remember the control block depth before the function block is entered */
fbi - > cblk_base = hcl - > c - > cblk . depth ;
/* no class block when the funtion block is entered */
fbi - > clsblk_base = - 1 ;
fbi - > clsblk_top = - 1 ;
fbi - > make_inst_pos = make_inst_pos ;
fbi - > lfbase = lfbase ;
fbi - > access_outer = 0 ;
fbi - > accessed_by_inner = 0 ;
hcl - > c - > fnblk . depth = new_depth ;
return 0 ;
}
static void clear_fnblk_inners ( hcl_t * hcl )
{
hcl_fnblk_info_t * fbi ;
fbi = & hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] ;
while ( hcl - > c - > cblk . depth > fbi - > cblk_base ) pop_cblk ( hcl ) ;
while ( ! ( fbi - > clsblk_base < = - 1 & & fbi - > clsblk_top < = - 1 ) ) pop_clsblk ( hcl ) ;
}
static void pop_fnblk ( hcl_t * hcl )
{
hcl_fnblk_info_t * fbi ;
HCL_ASSERT ( hcl , hcl - > c - > fnblk . depth > = 0 ) ;
/* if pop_cblk() has been called properly, the following assertion must be true
* and the assignment on the next line isn ' t necessary */
clear_fnblk_inners ( hcl ) ;
fbi = & hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] ;
2021-11-26 15:17:09 +00:00
HCL_ASSERT ( hcl , hcl - > c - > cblk . depth = = fbi - > cblk_base ) ;
2021-06-27 17:47:51 +00:00
HCL_ASSERT ( hcl , fbi - > clsblk_base < = - 1 & & fbi - > clsblk_top < = - 1 ) ;
hcl - > c - > cblk . depth = fbi - > cblk_base ;
/* keep hcl->code.lit.len without restoration */
hcl - > c - > fnblk . depth - - ;
if ( hcl - > c - > fnblk . depth > = 0 )
{
hcl - > c - > tv . s . len = hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] . tmprlen ;
hcl - > c - > tv . wcount = hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] . tmprcnt ;
}
else
{
hcl - > c - > tv . s . len = 0 ;
hcl - > c - > tv . wcount = 0 ;
}
if ( fbi - > make_inst_pos < hcl - > code . bc . len )
{
hcl_oow_t tmpr_mask ;
/* patch the temporaries mask parameter for the MAKE_BLOCK or MAKE_FUNCTION instruction */
HCL_ASSERT ( hcl , hcl - > code . bc . ptr [ fbi - > make_inst_pos ] = = HCL_CODE_MAKE_BLOCK | |
hcl - > code . bc . ptr [ fbi - > make_inst_pos ] = = HCL_CODE_MAKE_FUNCTION ) ;
/* the total number of temporaries in this function block must be the sum of
* the number of arguments , return variables and local variables */
HCL_ASSERT ( hcl , fbi - > tmprcnt - hcl - > c - > tv . wcount = = fbi - > tmpr_nargs + fbi - > tmpr_nrvars + fbi - > tmpr_nlvars ) ;
/* the temporaries mask is a bit-mask that encodes the counts of different temporary variables.
* and it ' s split to two intruction parameters when used with MAKE_BLOCK and MAKE_FUNCTION */
tmpr_mask = ENCODE_BLKTMPR_MASK ( fbi - > tmpr_va , fbi - > tmpr_nargs , fbi - > tmpr_nrvars , fbi - > tmpr_nlvars ) ;
patch_double_long_params_with_oow ( hcl , fbi - > make_inst_pos + 1 , tmpr_mask ) ;
}
}
2021-01-15 09:12:28 +00:00
/* ========================================================================= */
2021-01-17 17:45:39 +00:00
static HCL_INLINE int _insert_cframe ( hcl_t * hcl , hcl_ooi_t index , int opcode , hcl_cnode_t * operand )
2021-01-15 09:12:28 +00:00
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * tmp ;
2021-01-15 09:12:28 +00:00
HCL_ASSERT ( hcl , index > = 0 ) ;
2021-01-29 09:41:39 +00:00
hcl - > c - > cfs . top + + ;
HCL_ASSERT ( hcl , hcl - > c - > cfs . top > = 0 ) ;
HCL_ASSERT ( hcl , index < = hcl - > c - > cfs . top ) ;
2021-01-15 09:12:28 +00:00
2021-01-29 09:41:39 +00:00
if ( ( hcl_oow_t ) hcl - > c - > cfs . top > = hcl - > c - > cfs . capa )
2021-01-15 09:12:28 +00:00
{
hcl_oow_t newcapa ;
2021-01-29 09:41:39 +00:00
newcapa = HCL_ALIGN ( hcl - > c - > cfs . top + 256 , 256 ) ; /* TODO: adjust this capacity */
tmp = ( hcl_cframe_t * ) hcl_reallocmem ( hcl , hcl - > c - > cfs . ptr , newcapa * HCL_SIZEOF ( * tmp ) ) ;
2021-01-15 09:12:28 +00:00
if ( HCL_UNLIKELY ( ! tmp ) )
{
2021-01-29 09:41:39 +00:00
hcl - > c - > cfs . top - - ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-29 09:41:39 +00:00
hcl - > c - > cfs . capa = newcapa ;
hcl - > c - > cfs . ptr = tmp ;
2021-01-15 09:12:28 +00:00
}
2021-01-29 09:41:39 +00:00
if ( index < hcl - > c - > cfs . top )
2021-01-15 09:12:28 +00:00
{
2021-01-29 09:41:39 +00:00
HCL_MEMMOVE ( & hcl - > c - > cfs . ptr [ index + 1 ] , & hcl - > c - > cfs . ptr [ index ] , ( hcl - > c - > cfs . top - index ) * HCL_SIZEOF ( * tmp ) ) ;
2021-01-15 09:12:28 +00:00
}
2021-01-29 09:41:39 +00:00
tmp = & hcl - > c - > cfs . ptr [ index ] ;
2021-01-15 09:12:28 +00:00
tmp - > opcode = opcode ;
tmp - > operand = operand ;
2021-01-28 10:09:38 +00:00
HCL_MEMSET ( & tmp - > u , 0 , HCL_SIZEOF ( tmp - > u ) ) ;
2021-01-15 09:12:28 +00:00
return 0 ;
}
2021-01-17 17:45:39 +00:00
static int insert_cframe ( hcl_t * hcl , hcl_ooi_t index , int opcode , hcl_cnode_t * operand )
2021-01-15 09:12:28 +00:00
{
2021-01-29 09:41:39 +00:00
if ( hcl - > c - > cfs . top = = HCL_TYPE_MAX ( hcl_ooi_t ) )
2021-01-15 09:12:28 +00:00
{
hcl_seterrnum ( hcl , HCL_EFRMFLOOD ) ;
return - 1 ;
}
return _insert_cframe ( hcl , index , opcode , operand ) ;
}
2021-01-17 17:45:39 +00:00
static int push_cframe ( hcl_t * hcl , int opcode , hcl_cnode_t * operand )
2021-01-15 09:12:28 +00:00
{
2021-01-29 09:41:39 +00:00
if ( hcl - > c - > cfs . top = = HCL_TYPE_MAX ( hcl_ooi_t ) )
2021-01-15 09:12:28 +00:00
{
hcl_seterrnum ( hcl , HCL_EFRMFLOOD ) ;
return - 1 ;
}
2021-01-29 09:41:39 +00:00
return _insert_cframe ( hcl , hcl - > c - > cfs . top + 1 , opcode , operand ) ;
2021-01-15 09:12:28 +00:00
}
static HCL_INLINE void pop_cframe ( hcl_t * hcl )
{
2021-01-29 09:41:39 +00:00
HCL_ASSERT ( hcl , hcl - > c - > cfs . top > = 0 ) ;
hcl - > c - > cfs . top - - ;
2021-01-15 09:12:28 +00:00
}
# define PUSH_CFRAME(hcl,opcode,operand) \
do { if ( push_cframe ( hcl , opcode , operand ) < = - 1 ) return - 1 ; } while ( 0 )
# define INSERT_CFRAME(hcl,index,opcode,operand) \
do { if ( insert_cframe ( hcl , index , opcode , operand ) < = - 1 ) return - 1 ; } while ( 0 )
# define POP_CFRAME(hcl) pop_cframe(hcl)
2021-01-29 09:41:39 +00:00
# define POP_ALL_CFRAMES(hcl) (hcl->c->cfs.top = -1)
2021-01-15 09:12:28 +00:00
2021-01-29 09:41:39 +00:00
# define GET_TOP_CFRAME_INDEX(hcl) (hcl->c->cfs.top)
2021-01-15 09:12:28 +00:00
2021-01-29 09:41:39 +00:00
# define GET_TOP_CFRAME(hcl) (&hcl->c->cfs.ptr[hcl->c->cfs.top])
2021-01-15 09:12:28 +00:00
2021-01-29 09:41:39 +00:00
# define GET_CFRAME(hcl,index) (&hcl->c->cfs.ptr[index])
2021-01-15 09:12:28 +00:00
# define SWITCH_TOP_CFRAME(hcl,_opcode,_operand) \
do { \
2021-01-29 09:41:39 +00:00
hcl_cframe_t * _cf = GET_TOP_CFRAME ( hcl ) ; \
2021-01-15 09:12:28 +00:00
_cf - > opcode = _opcode ; \
_cf - > operand = _operand ; \
} while ( 0 ) ;
# define SWITCH_CFRAME(hcl,_index,_opcode,_operand) \
do { \
2021-01-29 09:41:39 +00:00
hcl_cframe_t * _cf = GET_CFRAME ( hcl , _index ) ; \
2021-01-15 09:12:28 +00:00
_cf - > opcode = _opcode ; \
_cf - > operand = _operand ; \
} while ( 0 ) ;
2021-01-17 17:45:39 +00:00
static int push_subcframe ( hcl_t * hcl , int opcode , hcl_cnode_t * operand )
2021-01-15 09:12:28 +00:00
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf , tmp ;
2021-01-15 09:12:28 +00:00
cf = GET_TOP_CFRAME ( hcl ) ;
tmp = * cf ;
cf - > opcode = opcode ;
cf - > operand = operand ;
2021-01-28 07:25:05 +00:00
if ( push_cframe ( hcl , tmp . opcode , tmp . operand ) < = - 1 ) return - 1 ;
cf = GET_TOP_CFRAME ( hcl ) ;
cf - > u = tmp . u ; /* copy the extra information */
return 0 ;
2021-01-15 09:12:28 +00:00
}
2021-01-29 09:41:39 +00:00
static HCL_INLINE hcl_cframe_t * find_cframe_from_top ( hcl_t * hcl , int opcode )
2021-01-15 09:12:28 +00:00
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
hcl_ooi_t i ;
2021-01-29 09:41:39 +00:00
for ( i = hcl - > c - > cfs . top ; i > = 0 ; i - - )
2021-01-15 09:12:28 +00:00
{
2021-01-29 09:41:39 +00:00
cf = & hcl - > c - > cfs . ptr [ i ] ;
2021-01-15 09:12:28 +00:00
if ( cf - > opcode = = opcode ) return cf ;
}
return HCL_NULL ;
}
# define PUSH_SUBCFRAME(hcl,opcode,operand) \
do { if ( push_subcframe ( hcl , opcode , operand ) < = - 1 ) return - 1 ; } while ( 0 )
2021-01-29 09:41:39 +00:00
# define GET_SUBCFRAME(hcl) (&hcl->c->cfs.ptr[hcl->c->cfs.top - 1])
2021-01-15 09:12:28 +00:00
enum
{
COP_COMPILE_OBJECT ,
2021-05-15 05:31:36 +00:00
COP_COMPILE_OBJECT_R ,
2021-01-15 09:12:28 +00:00
2021-02-18 15:48:44 +00:00
COP_COMPILE_ARGUMENT_LIST ,
2021-01-15 09:12:28 +00:00
COP_COMPILE_OBJECT_LIST ,
2021-06-18 18:54:50 +00:00
COP_COMPILE_OBJECT_LIST_TAIL ,
2021-01-15 09:12:28 +00:00
COP_COMPILE_IF_OBJECT_LIST ,
COP_COMPILE_IF_OBJECT_LIST_TAIL ,
2021-02-18 15:48:44 +00:00
COP_COMPILE_TRY_OBJECT_LIST ,
COP_COMPILE_TRY_OBJECT_LIST_TAIL ,
2021-01-15 09:12:28 +00:00
COP_COMPILE_ARRAY_LIST ,
COP_COMPILE_BYTEARRAY_LIST ,
COP_COMPILE_DIC_LIST ,
COP_COMPILE_QLIST , /* compile data list */
2021-02-22 09:20:45 +00:00
COP_COMPILE_ELIF ,
COP_COMPILE_ELSE ,
COP_COMPILE_CATCH ,
2021-06-25 15:19:11 +00:00
COP_COMPILE_AND_P1 ,
COP_COMPILE_AND_P2 ,
COP_COMPILE_BREAK_P1 ,
COP_COMPILE_OR_P1 ,
COP_COMPILE_OR_P2 ,
COP_COMPILE_CLASS_P1 ,
COP_COMPILE_CLASS_P2 ,
2021-12-12 16:09:31 +00:00
COP_COMPILE_CLASS_P3 ,
2021-01-15 09:12:28 +00:00
COP_EMIT_CALL ,
COP_EMIT_MAKE_ARRAY ,
COP_EMIT_MAKE_BYTEARRAY ,
COP_EMIT_MAKE_DIC ,
2021-01-24 15:45:28 +00:00
COP_EMIT_MAKE_CONS ,
2021-01-15 09:12:28 +00:00
COP_EMIT_POP_INTO_ARRAY ,
COP_EMIT_POP_INTO_BYTEARRAY ,
COP_EMIT_POP_INTO_DIC ,
2021-01-24 15:45:28 +00:00
COP_EMIT_POP_INTO_CONS ,
COP_EMIT_POP_INTO_CONS_END ,
COP_EMIT_POP_INTO_CONS_CDR ,
2021-01-15 09:12:28 +00:00
COP_EMIT_LAMBDA ,
COP_EMIT_POP_STACKTOP ,
COP_EMIT_RETURN ,
COP_EMIT_SET ,
2021-02-28 17:00:28 +00:00
COP_EMIT_THROW ,
2021-01-15 09:12:28 +00:00
COP_POST_IF_COND ,
COP_POST_IF_BODY ,
COP_POST_UNTIL_BODY ,
COP_POST_UNTIL_COND ,
COP_POST_WHILE_BODY ,
COP_POST_WHILE_COND ,
2021-02-22 09:20:45 +00:00
COP_POST_TRY ,
COP_POST_CATCH ,
2021-02-01 13:20:46 +00:00
COP_POST_LAMBDA ,
2021-01-15 09:12:28 +00:00
} ;
/* ========================================================================= */
2021-01-19 14:07:42 +00:00
2021-01-17 17:45:39 +00:00
static int compile_and ( hcl_t * hcl , hcl_cnode_t * src )
2021-01-15 09:12:28 +00:00
{
2021-01-19 14:07:42 +00:00
hcl_cnode_t * obj , * expr ;
2021-01-15 09:12:28 +00:00
2021-01-19 14:07:42 +00:00
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS ( src ) ) ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( HCL_CNODE_CONS_CAR ( src ) , HCL_SYNCODE_AND ) ) ;
2021-01-15 09:12:28 +00:00
2021-01-19 14:07:42 +00:00
obj = HCL_CNODE_CONS_CDR ( src ) ;
2021-01-15 09:12:28 +00:00
2021-01-19 14:07:42 +00:00
if ( ! obj )
2021-01-15 09:12:28 +00:00
{
/* no value */
2021-01-19 14:07:42 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " no expression specified in and " ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-19 14:07:42 +00:00
else if ( ! HCL_CNODE_IS_CONS ( obj ) )
2021-01-15 09:12:28 +00:00
{
2021-01-19 14:07:42 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in and " ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-17 17:45:39 +00:00
/* TODO: optimization - eat away all true expressions */
2021-01-19 14:07:42 +00:00
expr = HCL_CNODE_CONS_CAR ( obj ) ;
obj = HCL_CNODE_CONS_CDR ( obj ) ;
2021-01-15 09:12:28 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT , expr ) ; /* 1 */
2021-06-25 15:19:11 +00:00
if ( obj ) PUSH_SUBCFRAME ( hcl , COP_COMPILE_AND_P1 , obj ) ; /* 2 */
2021-02-22 09:20:45 +00:00
return 0 ;
}
2021-06-25 15:19:11 +00:00
static HCL_INLINE int compile_and_p1 ( hcl_t * hcl )
2021-02-22 09:20:45 +00:00
{
hcl_cnode_t * obj , * expr ;
hcl_cframe_t * cf ;
hcl_ooi_t jump_inst_pos ;
cf = GET_TOP_CFRAME ( hcl ) ;
2021-06-25 15:19:11 +00:00
HCL_ASSERT ( hcl , cf - > opcode = = COP_COMPILE_AND_P1 ) ;
2021-02-22 09:20:45 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
/* TODO: optimization - eat away all true expressions */
obj = cf - > operand ;
if ( ! HCL_CNODE_IS_CONS ( obj ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in and " ) ;
return - 1 ;
}
HCL_ASSERT ( hcl , hcl - > code . bc . len < HCL_SMOOI_MAX ) ;
jump_inst_pos = hcl - > code . bc . len ;
2021-06-25 15:19:11 +00:00
/* this conditional jump make evaluation short-circuited. the actual jump point is to be patched in compile_and_p2() */
2021-02-22 09:20:45 +00:00
if ( emit_single_param_instruction ( hcl , HCL_CODE_JUMP_FORWARD_IF_FALSE , MAX_CODE_JUMP , HCL_CNODE_GET_LOC ( obj ) ) < = - 1 ) return - 1 ;
if ( emit_byte_instruction ( hcl , HCL_CODE_POP_STACKTOP , HCL_CNODE_GET_LOC ( obj ) ) < = - 1 ) return - 1 ;
expr = HCL_CNODE_CONS_CAR ( obj ) ;
obj = HCL_CNODE_CONS_CDR ( obj ) ;
2021-06-25 15:19:11 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT , expr ) ; /* 1 - compile the current part */
2021-02-22 09:20:45 +00:00
2021-06-25 15:19:11 +00:00
PUSH_SUBCFRAME ( hcl , COP_COMPILE_AND_P2 , expr ) ; /* 3 - patch the conditional jump instruction */
2021-02-22 09:20:45 +00:00
cf = GET_SUBCFRAME ( hcl ) ;
cf - > u . post_and . jump_inst_pos = jump_inst_pos ;
2021-06-25 15:19:11 +00:00
if ( obj ) PUSH_SUBCFRAME ( hcl , COP_COMPILE_AND_P1 , obj ) ; /* 2 - recurse to compile remaining parts */
2021-02-22 09:20:45 +00:00
return 0 ;
}
2021-06-25 15:19:11 +00:00
static HCL_INLINE int compile_and_p2 ( hcl_t * hcl )
2021-02-22 09:20:45 +00:00
{
hcl_cframe_t * cf ;
hcl_ooi_t jip ;
hcl_oow_t jump_offset ;
cf = GET_TOP_CFRAME ( hcl ) ;
2021-06-25 15:19:11 +00:00
HCL_ASSERT ( hcl , cf - > opcode = = COP_COMPILE_AND_P2 ) ;
2021-02-22 09:20:45 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
HCL_ASSERT ( hcl , hcl - > code . bc . len < HCL_SMOOI_MAX ) ;
jip = cf - > u . post_and . jump_inst_pos ;
2021-06-25 15:19:11 +00:00
/* patch the jump insruction emitted after each expression inside the 'and' expression
* the jump make evaluation short - circuited . */
2021-02-22 09:20:45 +00:00
jump_offset = hcl - > code . bc . len - jip - ( HCL_CODE_LONG_PARAM_SIZE + 1 ) ;
patch_long_jump ( hcl , jip , jump_offset ) ;
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
POP_CFRAME ( hcl ) ;
2021-01-15 09:12:28 +00:00
return 0 ;
}
2021-02-22 09:20:45 +00:00
/* ========================================================================= */
2021-01-19 14:07:42 +00:00
static int compile_or ( hcl_t * hcl , hcl_cnode_t * src )
2021-01-15 09:12:28 +00:00
{
2021-01-19 14:07:42 +00:00
hcl_cnode_t * obj , * expr ;
2021-01-15 09:12:28 +00:00
2021-01-19 14:07:42 +00:00
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS ( src ) ) ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( HCL_CNODE_CONS_CAR ( src ) , HCL_SYNCODE_OR ) ) ;
2021-01-15 09:12:28 +00:00
2021-01-19 14:07:42 +00:00
obj = HCL_CNODE_CONS_CDR ( src ) ;
2021-01-15 09:12:28 +00:00
2021-01-19 14:07:42 +00:00
if ( ! obj )
2021-01-15 09:12:28 +00:00
{
/* no value */
2021-01-19 14:07:42 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " no expression specified in or " ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-19 14:07:42 +00:00
else if ( ! HCL_CNODE_IS_CONS ( obj ) )
2021-01-15 09:12:28 +00:00
{
2021-01-19 14:07:42 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in and " ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
/* TODO: optimization - eat away all false expressions */
2021-01-19 14:07:42 +00:00
expr = HCL_CNODE_CONS_CAR ( obj ) ;
obj = HCL_CNODE_CONS_CDR ( obj ) ;
2021-01-15 09:12:28 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT , expr ) ; /* 1 */
2021-06-25 15:19:11 +00:00
PUSH_SUBCFRAME ( hcl , COP_COMPILE_OR_P1 , obj ) ; /* 2 */
2021-02-22 09:20:45 +00:00
return 0 ;
}
2021-06-25 15:19:11 +00:00
static HCL_INLINE int compile_or_p1 ( hcl_t * hcl )
2021-02-22 09:20:45 +00:00
{
hcl_cnode_t * obj , * expr ;
hcl_cframe_t * cf ;
hcl_ooi_t jump_inst_pos ;
cf = GET_TOP_CFRAME ( hcl ) ;
2021-06-25 15:19:11 +00:00
HCL_ASSERT ( hcl , cf - > opcode = = COP_COMPILE_OR_P1 ) ;
2021-02-22 09:20:45 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
/* TODO: optimization - eat away all false expressions */
obj = cf - > operand ;
if ( ! HCL_CNODE_IS_CONS ( obj ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in or " ) ;
return - 1 ;
}
HCL_ASSERT ( hcl , hcl - > code . bc . len < HCL_SMOOI_MAX ) ;
jump_inst_pos = hcl - > code . bc . len ;
2021-06-25 15:19:11 +00:00
/* this conditional jump makes evaluation short-circuited. the actual jump point is to be patched in compile_or_p2() */
2021-02-22 09:20:45 +00:00
if ( emit_single_param_instruction ( hcl , HCL_CODE_JUMP_FORWARD_IF_TRUE , MAX_CODE_JUMP , HCL_CNODE_GET_LOC ( obj ) ) < = - 1 ) return - 1 ;
if ( emit_byte_instruction ( hcl , HCL_CODE_POP_STACKTOP , HCL_CNODE_GET_LOC ( obj ) ) < = - 1 ) return - 1 ;
expr = HCL_CNODE_CONS_CAR ( obj ) ;
obj = HCL_CNODE_CONS_CDR ( obj ) ;
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT , expr ) ; /* 1 */
2021-06-25 15:19:11 +00:00
PUSH_SUBCFRAME ( hcl , COP_COMPILE_OR_P2 , expr ) ; /* 3 */
2021-02-22 09:20:45 +00:00
cf = GET_SUBCFRAME ( hcl ) ;
cf - > u . post_or . jump_inst_pos = jump_inst_pos ;
2021-06-25 15:19:11 +00:00
if ( obj ) PUSH_SUBCFRAME ( hcl , COP_COMPILE_OR_P1 , obj ) ; /* 2 */
2021-02-22 09:20:45 +00:00
return 0 ;
}
2021-06-25 15:19:11 +00:00
static HCL_INLINE int compile_or_p2 ( hcl_t * hcl )
2021-02-22 09:20:45 +00:00
{
hcl_cframe_t * cf ;
hcl_ooi_t jip ;
hcl_oow_t jump_offset ;
cf = GET_TOP_CFRAME ( hcl ) ;
2021-06-25 15:19:11 +00:00
HCL_ASSERT ( hcl , cf - > opcode = = COP_COMPILE_OR_P2 ) ;
2021-02-22 09:20:45 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
HCL_ASSERT ( hcl , hcl - > code . bc . len < HCL_SMOOI_MAX ) ;
jip = cf - > u . post_or . jump_inst_pos ;
/* patch the jump insruction emitted after each expression inside the 'and' expression */
jump_offset = hcl - > code . bc . len - jip - ( HCL_CODE_LONG_PARAM_SIZE + 1 ) ;
patch_long_jump ( hcl , jip , jump_offset ) ;
POP_CFRAME ( hcl ) ;
2021-01-15 09:12:28 +00:00
return 0 ;
}
2021-02-22 09:20:45 +00:00
/* ========================================================================= */
2021-01-19 14:07:42 +00:00
static int compile_break ( hcl_t * hcl , hcl_cnode_t * src )
2021-01-15 09:12:28 +00:00
{
/* (break) */
2021-01-29 08:13:18 +00:00
hcl_cnode_t * cmd , * obj ;
2021-01-15 09:12:28 +00:00
hcl_ooi_t i ;
2021-01-19 14:07:42 +00:00
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS ( src ) ) ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( HCL_CNODE_CONS_CAR ( src ) , HCL_SYNCODE_BREAK ) ) ;
2021-01-15 09:12:28 +00:00
2021-01-29 08:13:18 +00:00
cmd = HCL_CNODE_CONS_CAR ( src ) ;
2021-01-19 14:07:42 +00:00
obj = HCL_CNODE_CONS_CDR ( src ) ;
if ( obj )
2021-01-15 09:12:28 +00:00
{
2021-01-19 14:07:42 +00:00
if ( HCL_CNODE_IS_CONS ( obj ) )
2021-01-15 09:12:28 +00:00
{
2021-01-29 08:13:18 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( obj ) , HCL_NULL , " redundant argument in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
}
else
{
2021-01-29 08:13:18 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
}
return - 1 ;
}
2021-04-09 08:22:40 +00:00
for ( i = hcl - > c - > cblk . depth ; i > hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] . cblk_base ; - - i )
{
2021-06-18 18:54:50 +00:00
switch ( hcl - > c - > cblk . info [ i ] . _type )
2021-04-09 08:22:40 +00:00
{
2021-06-18 18:54:50 +00:00
case HCL_CBLK_TYPE_LOOP :
goto inside_loop ;
case HCL_CBLK_TYPE_TRY :
/*must emit an instruction to exit from the try loop.*/
if ( emit_byte_instruction ( hcl , HCL_CODE_TRY_EXIT , HCL_CNODE_GET_LOC ( src ) ) < = - 1 ) return - 1 ;
break ;
2021-04-11 15:45:01 +00:00
2021-06-18 18:54:50 +00:00
case HCL_CBLK_TYPE_CLASS :
2021-06-19 17:19:24 +00:00
if ( emit_byte_instruction ( hcl , HCL_CODE_CLASS_EXIT , HCL_CNODE_GET_LOC ( src ) ) < = - 1 ) return - 1 ;
2021-06-18 18:54:50 +00:00
break ;
2021-04-09 08:22:40 +00:00
}
}
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BREAK , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " %.*js outside loop " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
inside_loop :
2021-01-29 09:41:39 +00:00
for ( i = hcl - > c - > cfs . top ; i > = 0 ; - - i )
2021-01-15 09:12:28 +00:00
{
2021-01-29 09:41:39 +00:00
const hcl_cframe_t * tcf ;
tcf = & hcl - > c - > cfs . ptr [ i ] ;
2021-01-15 09:12:28 +00:00
if ( tcf - > opcode = = COP_EMIT_LAMBDA ) break ; /* seems to cross lambda boundary */
if ( tcf - > opcode = = COP_POST_UNTIL_BODY | | tcf - > opcode = = COP_POST_WHILE_BODY )
{
hcl_ooi_t jump_inst_pos ;
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
/* (break) is not really a function call. but to make it look like a
* function call , i generate PUSH_NIL so nil becomes a return value .
* ( set x ( until # f ( break ) ) )
* x will get nill . */
2021-12-24 00:05:58 +00:00
if ( emit_byte_instruction ( hcl , HCL_CODE_PUSH_NIL , HCL_CNODE_GET_LOC ( cmd ) ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
/* TODO: study if supporting expression after break is good like return. (break (+ 10 20)) */
HCL_ASSERT ( hcl , hcl - > code . bc . len < HCL_SMOOI_MAX ) ;
jump_inst_pos = hcl - > code . bc . len ;
2021-01-29 08:13:18 +00:00
if ( emit_single_param_instruction ( hcl , HCL_CODE_JUMP_FORWARD_0 , MAX_CODE_JUMP , HCL_CNODE_GET_LOC ( cmd ) ) < = - 1 ) return - 1 ;
2021-06-25 15:19:11 +00:00
INSERT_CFRAME ( hcl , i , COP_COMPILE_BREAK_P1 , cmd ) ;
2021-01-29 08:13:18 +00:00
cf = GET_CFRAME ( hcl , i ) ;
cf - > u . _break . jump_inst_pos = jump_inst_pos ;
POP_CFRAME ( hcl ) ;
return 0 ;
}
}
2021-04-09 08:22:40 +00:00
/* this part must no be reached. if a loop control block is found,
* there must exist a COP_POST_UNTIL_BODY or COP_POST_WHILE_BODY frame */
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_INTERN , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " internal error in compiling %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-29 08:13:18 +00:00
return - 1 ;
}
2021-06-25 15:19:11 +00:00
static int compile_break_p1 ( hcl_t * hcl )
2021-02-22 09:20:45 +00:00
{
hcl_cframe_t * cf ;
hcl_ooi_t jip , jump_offset ;
cf = GET_TOP_CFRAME ( hcl ) ;
2021-06-25 15:19:11 +00:00
HCL_ASSERT ( hcl , cf - > opcode = = COP_COMPILE_BREAK_P1 ) ;
2021-02-22 09:20:45 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
jip = cf - > u . _break . jump_inst_pos ; ;
/* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD instruction */
jump_offset = hcl - > code . bc . len - jip - ( HCL_CODE_LONG_PARAM_SIZE + 1 ) ;
/* no explicit about jump_offset. because break can only place inside
* a loop , the same check in post_while_body ( ) must assert
* this break jump_offset to be small enough */
HCL_ASSERT ( hcl , jump_offset < = MAX_CODE_JUMP * 2 ) ;
patch_long_jump ( hcl , jip , jump_offset ) ;
POP_CFRAME ( hcl ) ;
return 0 ;
}
/* ========================================================================= */
2021-01-29 08:13:18 +00:00
static int compile_continue ( hcl_t * hcl , hcl_cnode_t * src )
{
/* (continue) */
hcl_cnode_t * cmd , * obj ;
hcl_ooi_t i ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS ( src ) ) ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( HCL_CNODE_CONS_CAR ( src ) , HCL_SYNCODE_CONTINUE ) ) ;
cmd = HCL_CNODE_CONS_CAR ( src ) ;
obj = HCL_CNODE_CONS_CDR ( src ) ;
if ( obj )
{
if ( HCL_CNODE_IS_CONS ( obj ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( obj ) , HCL_NULL , " redundant argument in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
}
else
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
}
return - 1 ;
}
2021-04-09 08:22:40 +00:00
for ( i = hcl - > c - > cblk . depth ; i > hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] . cblk_base ; - - i )
{
2021-06-18 18:54:50 +00:00
switch ( hcl - > c - > cblk . info [ i ] . _type )
2021-04-09 08:22:40 +00:00
{
2021-06-18 18:54:50 +00:00
case HCL_CBLK_TYPE_LOOP :
goto inside_loop ;
case HCL_CBLK_TYPE_TRY :
/*must emit an instruction to exit from the try loop.*/
if ( emit_byte_instruction ( hcl , HCL_CODE_TRY_EXIT , HCL_CNODE_GET_LOC ( src ) ) < = - 1 ) return - 1 ;
break ;
case HCL_CBLK_TYPE_CLASS :
if ( emit_byte_instruction ( hcl , HCL_CODE_CLASS_EXIT , HCL_CNODE_GET_LOC ( src ) ) < = - 1 ) return - 1 ;
break ;
2021-04-09 08:22:40 +00:00
}
}
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BREAK , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " %.*js outside loop " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
inside_loop :
2021-01-29 09:41:39 +00:00
for ( i = hcl - > c - > cfs . top ; i > = 0 ; - - i )
2021-01-29 08:13:18 +00:00
{
2021-01-29 09:41:39 +00:00
const hcl_cframe_t * tcf ;
tcf = & hcl - > c - > cfs . ptr [ i ] ;
2021-01-29 08:13:18 +00:00
if ( tcf - > opcode = = COP_EMIT_LAMBDA ) break ; /* seems to cross lambda boundary */
if ( tcf - > opcode = = COP_POST_UNTIL_BODY | | tcf - > opcode = = COP_POST_WHILE_BODY )
{
hcl_ooi_t jump_offset ;
HCL_ASSERT ( hcl , hcl - > code . bc . len < HCL_SMOOI_MAX ) ;
jump_offset = hcl - > code . bc . len - tcf - > u . post_while . cond_pos + 1 ;
2021-01-29 12:39:31 +00:00
if ( jump_offset > 3 ) jump_offset + = HCL_CODE_LONG_PARAM_SIZE ;
2021-01-29 08:13:18 +00:00
if ( emit_single_param_instruction ( hcl , HCL_CODE_JUMP_BACKWARD_0 , jump_offset , HCL_CNODE_GET_LOC ( cmd ) ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
POP_CFRAME ( hcl ) ;
return 0 ;
}
}
2021-04-09 08:22:40 +00:00
/* this part must no be reached. if a loop control block is found,
* there must exist a COP_POST_UNTIL_BODY or COP_POST_WHILE_BODY frame */
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_INTERN , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " internal error in compiling %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-02-22 09:20:45 +00:00
/* ========================================================================= */
2021-02-18 15:48:44 +00:00
static int compile_do ( hcl_t * hcl , hcl_cnode_t * src )
{
hcl_cnode_t * cmd , * obj ;
/* (do
* ( + 10 20 )
* ( * 2 30 )
* . . .
* )
* you can use this to combine multiple expressions to a single expression
*/
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS ( src ) ) ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( HCL_CNODE_CONS_CAR ( src ) , HCL_SYNCODE_DO ) ) ;
cmd = HCL_CNODE_CONS_CDR ( src ) ;
obj = HCL_CNODE_CONS_CDR ( src ) ;
if ( ! obj )
{
/* no value */
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " no expression specified in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
else if ( ! HCL_CNODE_IS_CONS ( obj ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT_LIST , obj ) ;
return 0 ;
}
2021-02-22 09:20:45 +00:00
/* ========================================================================= */
2021-01-22 14:43:47 +00:00
static int compile_if ( hcl_t * hcl , hcl_cnode_t * src )
2021-01-15 09:12:28 +00:00
{
2021-01-22 14:43:47 +00:00
hcl_cnode_t * cmd , * obj , * cond ;
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
2021-01-22 14:43:47 +00:00
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS ( src ) ) ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( HCL_CNODE_CONS_CAR ( src ) , HCL_SYNCODE_IF ) ) ;
2021-01-15 09:12:28 +00:00
/* (if (< 20 30)
2021-01-22 14:43:47 +00:00
* ( perform this )
* ( perform that )
2021-01-15 09:12:28 +00:00
* elif ( < 20 30 )
2021-01-22 14:43:47 +00:00
* ( perform it )
2021-01-15 09:12:28 +00:00
* else
2021-01-22 14:43:47 +00:00
* ( perform this finally )
2021-01-15 09:12:28 +00:00
* )
*/
2021-01-22 14:43:47 +00:00
cmd = HCL_CNODE_CONS_CAR ( src ) ;
obj = HCL_CNODE_CONS_CDR ( src ) ;
2021-01-15 09:12:28 +00:00
2021-01-22 14:43:47 +00:00
if ( ! obj )
2021-01-15 09:12:28 +00:00
{
/* no value */
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " no condition specified in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-22 14:43:47 +00:00
else if ( ! HCL_CNODE_IS_CONS ( obj ) )
2021-01-15 09:12:28 +00:00
{
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-22 14:43:47 +00:00
cond = HCL_CNODE_CONS_CAR ( obj ) ;
obj = HCL_CNODE_CONS_CDR ( obj ) ;
2021-01-15 09:12:28 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT , cond ) ; /* 1 */
PUSH_SUBCFRAME ( hcl , COP_POST_IF_COND , obj ) ; /* 2 */
2021-01-27 08:47:08 +00:00
cf = GET_SUBCFRAME ( hcl ) ;
2021-01-15 09:12:28 +00:00
cf - > u . post_if . body_pos = - 1 ; /* unknown yet */
2021-02-18 15:48:44 +00:00
cf - > u . post_if . jump_inst_pos = - 1 ; /* not needed */
2021-01-22 14:43:47 +00:00
cf - > u . post_if . start_loc = * HCL_CNODE_GET_LOC ( src ) ;
2021-01-15 09:12:28 +00:00
/* TODO: OPTIMIZATION:
* pass information on the conditional if it ' s an absoluate true or absolute false to
* eliminate some code . . i can ' t eliminate code because there can be else or elif . . .
* if absoluate true , don ' t need else or other elif part
* if absoluate false , else or other elif part is needed .
*/
return 0 ;
}
2021-02-22 09:20:45 +00:00
static HCL_INLINE int patch_nearest_post_if_body ( hcl_t * hcl , hcl_cnode_t * cmd )
2021-01-15 09:12:28 +00:00
{
2021-02-22 09:20:45 +00:00
hcl_ooi_t jump_inst_pos , body_pos ;
hcl_ooi_t jip , jump_offset ;
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
cf = find_cframe_from_top ( hcl , COP_POST_IF_BODY ) ;
HCL_ASSERT ( hcl , cf ! = HCL_NULL ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_POST_IF_BODY ) ;
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
/* jump instruction position of the JUMP_FORWARD_IF_FALSE after the conditional of the previous if or elif*/
jip = cf - > u . post_if . jump_inst_pos ;
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
if ( hcl - > code . bc . len < = cf - > u . post_if . body_pos )
2021-01-15 09:12:28 +00:00
{
2021-02-22 09:20:45 +00:00
/* the if body is empty. */
if ( emit_byte_instruction ( hcl , HCL_CODE_PUSH_NIL , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
}
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
HCL_ASSERT ( hcl , hcl - > code . bc . len < HCL_SMOOI_MAX ) ;
jump_inst_pos = hcl - > code . bc . len ;
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
/* emit jump_forward before the beginning of the else block.
* this is to make the earlier if or elif block to skip
* the else part . it is to be patched in post_else_body ( ) . */
if ( emit_single_param_instruction ( hcl , HCL_CODE_JUMP_FORWARD_0 , MAX_CODE_JUMP , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
/* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD instruction */
jump_offset = hcl - > code . bc . len - jip - ( HCL_CODE_LONG_PARAM_SIZE + 1 ) ;
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
if ( jump_offset > MAX_CODE_JUMP * 2 )
2021-01-15 09:12:28 +00:00
{
2021-02-22 09:20:45 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_IFFLOOD , HCL_CNODE_GET_LOC ( cmd ) , HCL_NULL , " code in %.*js too big - size %zu " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) , jump_offset ) ;
return - 1 ;
2021-01-15 09:12:28 +00:00
}
2021-02-22 09:20:45 +00:00
patch_long_jump ( hcl , jip , jump_offset ) ;
/* beginning of the elif/else block code */
/* to drop the result of the conditional when the conditional is false */
if ( emit_byte_instruction ( hcl , HCL_CODE_POP_STACKTOP , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
/* this is the actual beginning */
HCL_ASSERT ( hcl , hcl - > code . bc . len < HCL_SMOOI_MAX ) ;
body_pos = hcl - > code . bc . len ;
/* modify the POST_IF_BODY frame */
HCL_ASSERT ( hcl , cf - > opcode = = COP_POST_IF_BODY ) ;
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
cf - > u . post_if . body_pos = body_pos ;
cf - > u . post_if . jump_inst_pos = jump_inst_pos ;
return 0 ;
}
static HCL_INLINE int compile_elif ( hcl_t * hcl )
{
hcl_cnode_t * cmd , * obj , * cond , * src ;
hcl_cframe_t * cf ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_COMPILE_ELIF ) ;
src = cf - > operand ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS ( src ) ) ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( HCL_CNODE_CONS_CAR ( src ) , HCL_SYNCODE_ELIF ) ) ;
cmd = HCL_CNODE_CONS_CAR ( src ) ;
obj = HCL_CNODE_CONS_CDR ( src ) ;
2021-01-15 09:12:28 +00:00
2021-01-21 14:59:01 +00:00
if ( ! obj )
2021-01-15 09:12:28 +00:00
{
2021-02-22 09:20:45 +00:00
/* no value */
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " no condition in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-21 14:59:01 +00:00
else if ( ! HCL_CNODE_IS_CONS ( obj ) )
2021-01-15 09:12:28 +00:00
{
2021-02-22 09:20:45 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-02-22 09:20:45 +00:00
cond = HCL_CNODE_CONS_CAR ( obj ) ;
obj = HCL_CNODE_CONS_CDR ( obj ) ;
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT , cond ) ; /* 1 */
PUSH_SUBCFRAME ( hcl , COP_POST_IF_COND , obj ) ; /* 2 */
cf = GET_SUBCFRAME ( hcl ) ;
cf - > u . post_if . body_pos = - 1 ; /* unknown yet */
cf - > u . post_if . jump_inst_pos = - 1 ; /* not needed */
cf - > u . post_if . start_loc = * HCL_CNODE_GET_LOC ( src ) ;
return patch_nearest_post_if_body ( hcl , cmd ) ;
}
static HCL_INLINE int compile_else ( hcl_t * hcl )
{
hcl_cnode_t * cmd , * obj , * src ;
hcl_cframe_t * cf ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_COMPILE_ELSE ) ;
src = cf - > operand ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS ( src ) ) ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( HCL_CNODE_CONS_CAR ( src ) , HCL_SYNCODE_ELSE ) ) ;
cmd = HCL_CNODE_CONS_CAR ( src ) ;
obj = HCL_CNODE_CONS_CDR ( src ) ;
if ( obj & & ! HCL_CNODE_IS_CONS ( obj ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
else
{
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT_LIST , obj ) ;
}
return patch_nearest_post_if_body ( hcl , cmd ) ;
}
2021-05-29 05:44:29 +00:00
/* ========================================================================= */
2021-05-31 08:59:18 +00:00
2021-06-27 17:47:51 +00:00
static int collect_vardcl ( hcl_t * hcl , hcl_cnode_t * obj , hcl_cnode_t * * nextobj , hcl_oow_t tv_dup_check_start , hcl_oow_t * nvardcls , const hcl_bch_t * desc )
{
2022-01-03 17:59:55 +00:00
/* process a single variable declaration list */
2021-06-27 17:47:51 +00:00
hcl_oow_t ndcls = 0 ;
2022-01-03 17:59:55 +00:00
hcl_cnode_t * dcl ;
2021-06-27 17:47:51 +00:00
2022-01-03 17:59:55 +00:00
dcl = HCL_CNODE_CONS_CAR ( obj ) ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS_CONCODED ( dcl , HCL_CONCODE_VLIST ) ) ;
hcl_cnode_t * var ;
do
2021-06-27 17:47:51 +00:00
{
2022-01-03 17:59:55 +00:00
var = HCL_CNODE_CONS_CAR ( dcl ) ;
#if 0
if ( ! HCL_CNODE_IS_SYMBOL ( var ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGNAME , HCL_CNODE_GET_LOC ( var ) , HCL_CNODE_GET_TOK ( var ) , " local variable not a symbol " ) ;
return - 1 ;
}
2021-06-27 17:47:51 +00:00
2022-01-03 17:59:55 +00:00
if ( HCL_CNODE_IS_SYMBOL ( var ) & & HCL_CNODE_SYMBOL_SYNCODE ( var ) /* || HCL_OBJ_GET_FLAGS_KERNEL(var) >= 2 */ )
2021-06-27 17:47:51 +00:00
{
2022-01-03 17:59:55 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BANNEDARGNAME , HCL_CNODE_GET_LOC ( var ) , HCL_CNODE_GET_TOK ( var ) , " special symbol not to be declared as a local variable " ) ;
return - 1 ;
}
# else
/* the above checks are not needed as the reader guarantees the followings */
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_PLAIN ( var ) ) ;
# endif
if ( add_temporary_variable ( hcl , HCL_CNODE_GET_TOK ( var ) , tv_dup_check_start ) < = - 1 )
{
if ( hcl - > errnum = = HCL_EEXIST )
2021-06-27 17:47:51 +00:00
{
2022-01-03 17:59:55 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGNAMEDUP , HCL_CNODE_GET_LOC ( var ) , HCL_CNODE_GET_TOK ( var ) , " duplicate %hs variable " , desc ) ;
}
return - 1 ;
}
ndcls + + ;
2021-06-27 17:47:51 +00:00
2022-01-03 17:59:55 +00:00
dcl = HCL_CNODE_CONS_CDR ( dcl ) ;
if ( ! dcl ) break ;
2021-06-27 17:47:51 +00:00
2022-01-03 17:59:55 +00:00
if ( ! HCL_CNODE_IS_CONS ( dcl ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( dcl ) , HCL_CNODE_GET_TOK ( dcl ) , " redundant cdr in %hs variable list " , desc ) ;
return - 1 ;
}
}
while ( 1 ) ;
* nextobj = HCL_CNODE_CONS_CDR ( obj ) ;
* nvardcls = ndcls ;
return 0 ;
}
2021-06-27 17:47:51 +00:00
2022-01-03 17:59:55 +00:00
static int collect_vardcls ( hcl_t * hcl , hcl_cnode_t * obj , hcl_cnode_t * * nextobj , hcl_oow_t tv_dup_check_start , hcl_oow_t * nvardcls , const hcl_bch_t * desc )
{
/* process zero or more variable declaration lists in a row */
2021-06-27 17:47:51 +00:00
2022-01-03 17:59:55 +00:00
hcl_oow_t ndcls = 0 ;
2021-06-27 17:47:51 +00:00
2022-01-03 17:59:55 +00:00
while ( obj & & HCL_CNODE_IS_CONS ( obj ) )
{
hcl_cnode_t * dcl ;
hcl_oow_t dclcount ;
dcl = HCL_CNODE_CONS_CAR ( obj ) ;
if ( ! HCL_CNODE_IS_CONS_CONCODED ( dcl , HCL_CONCODE_VLIST ) ) break ;
if ( collect_vardcl ( hcl , obj , & obj , tv_dup_check_start , & dclcount , desc ) < = - 1 ) return - 1 ;
ndcls + = dclcount ;
2021-06-27 17:47:51 +00:00
}
* nvardcls = ndcls ;
* nextobj = obj ;
return 0 ;
}
2021-05-31 16:20:18 +00:00
static int check_if_plain_cnode ( hcl_t * hcl , hcl_cnode_t * obj , hcl_cnode_t * prev , hcl_cnode_t * container , hcl_synerrnum_t errnum , const hcl_bch_t * bname )
2021-05-31 08:59:18 +00:00
{
if ( ! obj )
{
2021-05-31 16:20:18 +00:00
hcl_setsynerrbfmt ( hcl , errnum , HCL_CNODE_GET_LOC ( prev ) , HCL_NULL , " no %hs in %.*js " , bname , HCL_CNODE_GET_TOKLEN ( container ) , HCL_CNODE_GET_TOKPTR ( container ) ) ;
2021-05-31 08:59:18 +00:00
return - 1 ;
}
else if ( ! HCL_CNODE_IS_CONS ( obj ) )
{
2021-05-31 16:20:18 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( prev ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr where %.*js is expected in %.*js " , bname , HCL_CNODE_GET_TOKLEN ( container ) , HCL_CNODE_GET_TOKPTR ( container ) ) ;
2021-05-31 08:59:18 +00:00
return - 1 ;
}
return 0 ;
}
2021-06-27 17:47:51 +00:00
/*
2021-05-29 05:44:29 +00:00
( defclass A
| x y | ; instance variables
| : : : x y z | ; class variables < - - - how to initialize the class variables ? ? ?
2021-06-01 09:50:35 +00:00
; everything inside defclass after the variable declarations are normal expressions .
; however , the resolution of some variables will fall under the enclosing class .
( set x 20 )
( printf " normal statement .... \n " ) ;
( defun new ( a b c )
2021-05-29 05:44:29 +00:00
( printf " %O \n " self ) ; self is A
( set obj super . new )
( obj . init a b c )
; ( obj . x 10 )
; ( obj . y 20 )
( return obj )
)
)
( defclass B : : : A ; A is a parent class
2021-06-01 09:50:35 +00:00
| p q |
2021-05-29 05:44:29 +00:00
. . . .
)
2021-06-27 17:47:51 +00:00
*/
2021-06-25 15:19:11 +00:00
static int compile_class ( hcl_t * hcl , hcl_cnode_t * src )
{
hcl_cnode_t * cmd , * obj ;
hcl_cnode_t * class_name ;
hcl_cframe_t * cf ;
cmd = HCL_CNODE_CONS_CAR ( src ) ;
obj = HCL_CNODE_CONS_CDR ( src ) ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( cmd , HCL_SYNCODE_DEFCLASS ) ) ;
class_name = HCL_NULL ;
if ( check_if_plain_cnode ( hcl , obj , src , cmd , HCL_SYNERR_VARNAME , " class name " ) < = - 1 ) return - 1 ;
class_name = HCL_CNODE_CONS_CAR ( obj ) ;
if ( HCL_CNODE_IS_SYMBOL ( class_name ) )
{
/* TODO: make the classname optional? */
/* defclass followed by a class name */
if ( HCL_CNODE_SYMBOL_SYNCODE ( class_name ) ) /*|| HCL_OBJ_GET_FLAGS_KERNEL(class_name) >= 1) */
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BANNEDVARNAME , HCL_CNODE_GET_LOC ( class_name ) , HCL_CNODE_GET_TOK ( class_name ) , " special symbol not to be used as a class name " ) ;
return - 1 ;
}
obj = HCL_CNODE_CONS_CDR ( obj ) ;
}
if ( obj )
{
2022-01-03 17:59:55 +00:00
hcl_cnode_t * tmp , * dcl ;
2021-06-25 15:19:11 +00:00
tmp = HCL_CNODE_CONS_CAR ( obj ) ;
if ( ! HCL_CNODE_IS_TRPCOLONS ( tmp ) ) goto no_superclass ;
2022-01-03 17:59:55 +00:00
tmp = obj ;
obj = HCL_CNODE_CONS_CDR ( obj ) ;
if ( ! obj | | ! HCL_CNODE_IS_CONS ( obj ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_EOX , HCL_CNODE_GET_LOC ( tmp ) , HCL_NULL , " no expression or declaration after triple colons " ) ;
return - 1 ;
}
2021-06-25 15:19:11 +00:00
2022-01-03 17:59:55 +00:00
/* if the tricolons symbol is followed by a variable declaration list,
* there is no superclass */
dcl = HCL_CNODE_CONS_CAR ( obj ) ;
if ( HCL_CNODE_IS_CONS_CONCODED ( dcl , HCL_CONCODE_VLIST ) )
{
obj = tmp ; /* rewind to the cons cell of the triple colons */
goto no_superclass ;
2021-06-25 15:19:11 +00:00
}
2022-01-03 17:59:55 +00:00
/* superclass part */
tmp = HCL_CNODE_CONS_CAR ( obj ) ;
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT , tmp ) ; /* 1 - superclass expression */
PUSH_SUBCFRAME ( hcl , COP_COMPILE_CLASS_P2 , class_name ) ; /* 3 - class name */
cf = GET_SUBCFRAME ( hcl ) ;
cf - > u . _class . nsuperclasses = 0 ; /* unsed for CLASS_P2 */
cf - > u . _class . start_loc = * HCL_CNODE_GET_LOC ( src ) ; /* TODO: use *HCL_CNODE_GET_LOC(cmd) instead? */
obj = HCL_CNODE_CONS_CDR ( obj ) ;
PUSH_SUBCFRAME ( hcl , COP_COMPILE_CLASS_P1 , obj ) ; /* 2 - variables declaraions and actual body */
cf = GET_SUBCFRAME ( hcl ) ;
cf - > u . _class . nsuperclasses = 1 ; /* this one needs to change if we support multiple superclasses... */
2021-06-25 15:19:11 +00:00
}
else
{
no_superclass :
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_CLASS_P1 , obj ) ; /* 1 */
cf = GET_TOP_CFRAME ( hcl ) ;
cf - > u . _class . nsuperclasses = 0 ; /* this one needs to change if we support multiple superclasses... */
cf - > u . _class . start_loc = * HCL_CNODE_GET_LOC ( src ) ; /* TODO: use *HCL_CNODE_GET_LOC(cmd) instead? */
PUSH_SUBCFRAME ( hcl , COP_COMPILE_CLASS_P2 , class_name ) ; /* 2 */
cf = GET_SUBCFRAME ( hcl ) ;
cf - > u . _class . nsuperclasses = 0 ; /* unsed for CLASS_P2 */
cf - > u . _class . start_loc = * HCL_CNODE_GET_LOC ( src ) ; /* TODO: use *HCL_CNODE_GET_LOC(cmd) instead? */
}
return 0 ;
}
static HCL_INLINE int compile_class_p1 ( hcl_t * hcl )
{
/* collect information about declared variables */
hcl_cframe_t * cf ;
hcl_cnode_t * obj ;
2022-01-03 17:59:55 +00:00
hcl_oow_t nivars , ncvars , saved_tv_wcount , tv_dup_check_start , cv_dup_check_start ;
2021-06-25 15:19:11 +00:00
cf = GET_TOP_CFRAME ( hcl ) ;
obj = cf - > operand ;
2021-06-27 17:47:51 +00:00
saved_tv_wcount = hcl - > c - > tv . wcount ;
2021-11-21 16:02:39 +00:00
tv_dup_check_start = hcl - > c - > tv . s . len ;
2021-06-25 15:19:11 +00:00
2022-01-03 17:59:55 +00:00
cv_dup_check_start = hcl - > c - > tv . s . len ; // this is buggy... correct this...
2021-06-27 17:47:51 +00:00
nivars = ncvars = 0 ;
2022-01-03 17:59:55 +00:00
2021-11-21 16:02:39 +00:00
/* use the temporary variable collection buffer for convenience when scanning
* instance variables and class variables */
2022-01-03 17:59:55 +00:00
while ( obj & & HCL_CNODE_IS_CONS ( obj ) )
{
hcl_cnode_t * tmp , * tmp2 ;
hcl_oow_t dclcount ;
/*
( defclass X : : : T
: : : | a b c | ; class variables
)
( defclass X
: : : T | a b c | ; instance varaiables .
)
( defclass X
: : : | a b c | ; class variables
)
*/
tmp2 = obj ;
tmp = HCL_CNODE_CONS_CAR ( obj ) ;
if ( HCL_CNODE_IS_TRPCOLONS ( tmp ) )
{
obj = HCL_CNODE_CONS_CDR ( obj ) ;
if ( ! obj | | ! HCL_CNODE_IS_CONS ( obj ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_EOX , HCL_CNODE_GET_LOC ( tmp ) , HCL_NULL , " no expression or declaration after triple colons " ) ;
return - 1 ;
}
tmp = HCL_CNODE_CONS_CAR ( obj ) ;
if ( ! HCL_CNODE_IS_CONS_CONCODED ( tmp , HCL_CONCODE_VLIST ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_EOX , HCL_CNODE_GET_LOC ( tmp ) , HCL_NULL , " no declaration after triple colons " ) ;
return - 1 ;
}
if ( collect_vardcl ( hcl , obj , & obj , tv_dup_check_start , & dclcount , " class " ) < = - 1 ) return - 1 ;
ncvars + = dclcount ;
}
else
{
if ( ! HCL_CNODE_IS_CONS_CONCODED ( tmp , HCL_CONCODE_VLIST ) ) break ;
if ( collect_vardcl ( hcl , obj , & obj , tv_dup_check_start , & dclcount , " instance " ) < = - 1 ) return - 1 ;
nivars + = dclcount ;
}
}
2021-06-25 15:19:11 +00:00
if ( nivars > 0 )
{
2022-01-03 17:59:55 +00:00
hcl_oop_t tmp ;
2021-06-29 11:51:08 +00:00
if ( nivars > HCL_SMOOI_MAX )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARFLOOD , HCL_CNODE_GET_LOC ( cf - > operand ) , HCL_NULL , " too many(%zu) instance variables " , nivars ) ;
goto oops ;
}
2021-06-27 17:47:51 +00:00
/* set starting point past the added space (+1 to index, -1 to length) */
2021-11-21 16:02:39 +00:00
tmp = hcl_makestring ( hcl , & hcl - > c - > tv . s . ptr [ tv_dup_check_start + 1 ] , hcl - > c - > tv . s . len - tv_dup_check_start - 1 , 0 ) ;
2021-06-27 17:47:51 +00:00
if ( HCL_UNLIKELY ( ! tmp ) ) goto oops ;
if ( emit_push_literal ( hcl , tmp , & cf - > u . _class . start_loc ) < = - 1 ) goto oops ;
2021-06-25 15:19:11 +00:00
}
if ( ncvars > 0 )
{
2022-01-03 17:59:55 +00:00
hcl_oop_t tmp ;
2021-06-29 11:51:08 +00:00
if ( ncvars > HCL_SMOOI_MAX )
{
/* TOOD: change the error location ?? */
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARFLOOD , HCL_CNODE_GET_LOC ( cf - > operand ) , HCL_NULL , " too many(%zu) class variables " , ncvars ) ;
goto oops ;
}
2022-01-03 17:59:55 +00:00
tmp = hcl_makestring ( hcl , & hcl - > c - > tv . s . ptr [ cv_dup_check_start + 1 ] , hcl - > c - > tv . s . len - cv_dup_check_start - 1 , 0 ) ;
2021-06-27 17:47:51 +00:00
if ( HCL_UNLIKELY ( ! tmp ) ) goto oops ;
if ( emit_push_literal ( hcl , tmp , & cf - > u . _class . start_loc ) < = - 1 ) goto oops ;
2021-06-25 15:19:11 +00:00
}
2021-11-21 16:02:39 +00:00
2022-01-03 17:59:55 +00:00
if ( push_clsblk ( hcl , & cf - > u . _class . start_loc , nivars , ncvars ,
& hcl - > c - > tv . s . ptr [ tv_dup_check_start + 1 ] , 0 , /* TODO: wrong length.... */
& hcl - > c - > tv . s . ptr [ cv_dup_check_start + 1 ] , hcl - > c - > tv . s . len - cv_dup_check_start - 1 ) < = - 1 ) goto oops ;
2021-11-21 16:02:39 +00:00
2021-12-26 14:59:34 +00:00
/* discard the instance variables and class variables in the temporary variable collection buffer
2021-11-21 16:02:39 +00:00
* because they have been pushed to the class block structure */
hcl - > c - > tv . s . len = tv_dup_check_start ;
hcl - > c - > tv . wcount = saved_tv_wcount ;
2021-06-25 15:19:11 +00:00
2021-06-25 16:07:29 +00:00
/* class_enter nsuperclasses, nivars, ncvars */
2021-06-27 17:47:51 +00:00
if ( emit_byte_instruction ( hcl , HCL_CODE_CLASS_ENTER , & cf - > u . _class . start_loc ) < = - 1 ) goto oops ;
if ( emit_long_param ( hcl , cf - > u . _class . nsuperclasses ) < = - 1 ) goto oops ;
if ( emit_long_param ( hcl , nivars ) < = - 1 ) goto oops ;
if ( emit_long_param ( hcl , ncvars ) < = - 1 ) goto oops ;
2021-06-25 15:19:11 +00:00
2021-12-24 00:05:58 +00:00
/* remember the first byte code position to be emitted for the body of
* this class . this posistion is used for empty class body check at the
* end of the class before ' class_exit ' is generated */
hcl - > c - > clsblk . info [ hcl - > c - > clsblk . depth ] . class_start_inst_pos = hcl - > code . bc . len ;
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT_LIST , obj ) ;
2021-06-25 15:19:11 +00:00
return 0 ;
2021-06-27 17:47:51 +00:00
oops :
2021-11-21 16:02:39 +00:00
hcl - > c - > tv . s . len = tv_dup_check_start ;
2021-06-27 17:47:51 +00:00
hcl - > c - > tv . wcount = saved_tv_wcount ;
return - 1 ;
2021-06-25 15:19:11 +00:00
}
2021-06-01 09:50:35 +00:00
2021-12-12 16:09:31 +00:00
static HCL_INLINE int compile_class_p3 ( hcl_t * hcl )
{
hcl_cframe_t * cf ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_COMPILE_CLASS_P3 ) ;
/* should i make the assignment in POST? or after variable declarations immediately? */
/* TODO: emit instruction to store into the class name...? */
/* TODO: NEED TO EMIT POP_STACKTOP???? IN THIS CASE CLASS_EXIT MUST PUSH SOMETHING? */
if ( emit_byte_instruction ( hcl , HCL_CODE_CLASS_EXIT , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
2021-12-24 00:05:58 +00:00
2021-12-12 16:09:31 +00:00
POP_CFRAME ( hcl ) ;
return 0 ;
}
2021-06-25 15:19:11 +00:00
static HCL_INLINE int compile_class_p2 ( hcl_t * hcl )
2021-06-01 09:50:35 +00:00
{
hcl_cframe_t * cf ;
cf = GET_TOP_CFRAME ( hcl ) ;
2021-06-25 15:19:11 +00:00
HCL_ASSERT ( hcl , cf - > opcode = = COP_COMPILE_CLASS_P2 ) ;
2021-12-12 16:09:31 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-06-01 09:50:35 +00:00
2021-12-24 00:05:58 +00:00
if ( hcl - > code . bc . len > hcl - > c - > clsblk . info [ hcl - > c - > clsblk . depth ] . class_start_inst_pos )
{
/* no instructions generated after the class_enter instruction */
if ( emit_byte_instruction ( hcl , HCL_CODE_POP_STACKTOP , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
}
2021-12-12 16:09:31 +00:00
pop_clsblk ( hcl ) ; /* end of the class block */
2021-06-01 09:50:35 +00:00
2021-12-24 00:05:58 +00:00
if ( emit_byte_instruction ( hcl , HCL_CODE_CLASS_PUSH_EXIT , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
2021-12-12 16:09:31 +00:00
// if (cf->operand)
2021-06-01 09:50:35 +00:00
{
2021-12-12 16:09:31 +00:00
/* (defclass X() ; this x refers to a variable in the outer scope.
2022-01-03 17:59:55 +00:00
* : : : | t1 t2 x |
* ( set x 10 ) ; this x refers to the class variable .
2021-06-01 09:50:35 +00:00
* )
*
* the block has been exited ( blk . depth - - ) before finding ' x ' in the outer scope .
*/
hcl_cnode_t * class_name = cf - > operand ;
2021-11-23 14:42:20 +00:00
hcl_var_info_t vi ;
2021-06-01 09:50:35 +00:00
2021-12-12 16:09:31 +00:00
if ( find_variable_backward ( hcl , HCL_CNODE_GET_TOK ( class_name ) , & vi ) < = - 1 )
2021-06-01 09:50:35 +00:00
{
2021-12-12 16:09:31 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_EMIT_SET , class_name ) ;
2021-06-01 09:50:35 +00:00
cf = GET_TOP_CFRAME ( hcl ) ;
2021-11-23 14:42:20 +00:00
cf - > u . set . vi . type = VAR_NAMED ;
2021-06-01 09:50:35 +00:00
}
else
{
2021-12-12 16:09:31 +00:00
//HCL_ASSERT (hcl, index <= HCL_SMOOI_MAX);
SWITCH_TOP_CFRAME ( hcl , COP_EMIT_SET , class_name ) ;
2021-06-01 09:50:35 +00:00
cf = GET_TOP_CFRAME ( hcl ) ;
2021-11-23 14:42:20 +00:00
cf - > u . set . vi = vi ;
2021-06-01 09:50:35 +00:00
}
2021-11-23 15:52:01 +00:00
cf - > u . set . mode = VAR_ACCESS_STORE ;
2021-12-12 16:09:31 +00:00
#if 0
PUSH_SUBCFRAME ( hcl , COP_COMPILE_CLASS_P3 , cf - > operand ) ;
2021-06-01 09:50:35 +00:00
}
else
{
2021-12-12 16:09:31 +00:00
//POP_CFRAME (hcl);
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_CLASS_P3 , cf - > operand ) ;
2021-06-01 09:50:35 +00:00
# endif
2021-12-12 16:09:31 +00:00
}
2021-06-01 09:50:35 +00:00
2021-05-29 05:44:29 +00:00
return 0 ;
}
2021-12-12 16:09:31 +00:00
2021-02-22 09:20:45 +00:00
/* ========================================================================= */
static int compile_lambda ( hcl_t * hcl , hcl_cnode_t * src , int defun )
{
hcl_cnode_t * cmd , * obj , * args ;
2021-05-07 08:53:01 +00:00
hcl_oow_t va , nargs , nrvars , nlvars ;
2021-02-22 09:20:45 +00:00
hcl_ooi_t jump_inst_pos , lfbase_pos , lfsize_pos ;
hcl_oow_t saved_tv_wcount , tv_dup_start ;
hcl_cnode_t * defun_name ;
hcl_cframe_t * cf ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS ( src ) ) ;
saved_tv_wcount = hcl - > c - > tv . wcount ;
cmd = HCL_CNODE_CONS_CAR ( src ) ;
obj = HCL_CNODE_CONS_CDR ( src ) ;
if ( defun )
{
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( cmd , HCL_SYNCODE_DEFUN ) ) ;
if ( ! obj )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGNAMELIST , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " no name in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
else if ( ! HCL_CNODE_IS_CONS ( obj ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
defun_name = HCL_CNODE_CONS_CAR ( obj ) ;
if ( ! HCL_CNODE_IS_SYMBOL ( defun_name ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARNAME , HCL_CNODE_GET_LOC ( defun_name ) , HCL_CNODE_GET_TOK ( defun_name ) , " name not a symbol in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
if ( HCL_CNODE_SYMBOL_SYNCODE ( defun_name ) ) /*|| HCL_OBJ_GET_FLAGS_KERNEL(defun_name) >= 1) */
{
2021-05-31 08:59:18 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BANNEDVARNAME , HCL_CNODE_GET_LOC ( defun_name ) , HCL_CNODE_GET_TOK ( defun_name ) , " special symbol not to be used as a function name " ) ;
2021-02-22 09:20:45 +00:00
return - 1 ;
}
obj = HCL_CNODE_CONS_CDR ( obj ) ;
}
else
{
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( cmd , HCL_SYNCODE_LAMBDA ) ) ;
defun_name = HCL_NULL ;
}
if ( ! obj )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGNAMELIST , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " no argument list in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
else if ( ! HCL_CNODE_IS_CONS ( obj ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in argument list in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
2021-05-01 11:26:59 +00:00
/* process the argument list */
2021-05-07 08:53:01 +00:00
va = 0 ;
2021-05-09 15:32:54 +00:00
nargs = 0 ;
nrvars = 0 ;
2021-02-22 09:20:45 +00:00
args = HCL_CNODE_CONS_CAR ( obj ) ;
HCL_ASSERT ( hcl , args ! = HCL_NULL ) ;
if ( HCL_CNODE_IS_ELIST_CONCODED ( args , HCL_CONCODE_XLIST ) )
{
2021-04-18 18:02:02 +00:00
/* empty list - no argument - (lambda () (+ 10 20)) */
2021-02-22 09:20:45 +00:00
}
2021-02-01 13:20:46 +00:00
else if ( ! HCL_CNODE_IS_CONS ( args ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGNAMELIST , HCL_CNODE_GET_LOC ( args ) , HCL_CNODE_GET_TOK ( args ) , " not an argument list in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
2021-01-15 09:12:28 +00:00
else
{
2021-01-21 14:59:01 +00:00
hcl_cnode_t * arg , * dcl ;
2021-05-09 15:32:54 +00:00
int in_ret_args = 0 ;
2021-01-15 09:12:28 +00:00
2021-02-01 13:20:46 +00:00
tv_dup_start = hcl - > c - > tv . s . len ;
2021-01-21 14:59:01 +00:00
dcl = args ;
2021-01-15 09:12:28 +00:00
do
{
2021-01-21 14:59:01 +00:00
arg = HCL_CNODE_CONS_CAR ( dcl ) ;
2021-05-09 15:32:54 +00:00
if ( in_ret_args )
2021-01-15 09:12:28 +00:00
{
2021-05-09 15:32:54 +00:00
if ( ! HCL_CNODE_IS_SYMBOL ( arg ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARNAME , HCL_CNODE_GET_LOC ( arg ) , HCL_CNODE_GET_TOK ( arg ) , " return variable not a symbol in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
2021-01-15 09:12:28 +00:00
2021-05-09 15:32:54 +00:00
if ( HCL_CNODE_IS_SYMBOL ( arg ) & & HCL_CNODE_SYMBOL_SYNCODE ( arg ) /* || HCL_OBJ_GET_FLAGS_KERNEL(arg) >= 2 */ )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BANNEDVARNAME , HCL_CNODE_GET_LOC ( arg ) , HCL_CNODE_GET_TOK ( arg ) , " special symbol not to be declared as a return variable in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
if ( add_temporary_variable ( hcl , HCL_CNODE_GET_TOK ( arg ) , tv_dup_start ) < = - 1 )
{
if ( hcl - > errnum = = HCL_EEXIST )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARNAMEDUP , HCL_CNODE_GET_LOC ( arg ) , HCL_CNODE_GET_TOK ( arg ) , " return variable duplicate in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
}
return - 1 ;
}
nrvars + + ;
}
else if ( va )
2021-01-15 09:12:28 +00:00
{
2021-05-09 15:32:54 +00:00
if ( HCL_CNODE_IS_TRPCOLONS ( arg ) )
{
in_ret_args = 1 ;
}
else
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_CNODE , HCL_CNODE_GET_LOC ( arg ) , HCL_CNODE_GET_TOK ( arg ) , " unexpected element in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
2021-01-15 09:12:28 +00:00
}
2021-05-09 15:32:54 +00:00
else
2021-01-15 09:12:28 +00:00
{
2021-05-09 15:32:54 +00:00
if ( HCL_CNODE_IS_TRPCOLONS ( arg ) )
2021-01-15 09:12:28 +00:00
{
2021-05-09 15:32:54 +00:00
in_ret_args = 1 ;
}
else if ( HCL_CNODE_IS_ELLIPSIS ( arg ) )
{
va = 1 ;
}
else if ( ! HCL_CNODE_IS_SYMBOL ( arg ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGNAME , HCL_CNODE_GET_LOC ( arg ) , HCL_CNODE_GET_TOK ( arg ) , " argument not a symbol in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
else
{
if ( HCL_CNODE_IS_SYMBOL ( arg ) & & HCL_CNODE_SYMBOL_SYNCODE ( arg ) /* || HCL_OBJ_GET_FLAGS_KERNEL(arg) >= 2 */ )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BANNEDARGNAME , HCL_CNODE_GET_LOC ( arg ) , HCL_CNODE_GET_TOK ( arg ) , " special symbol not to be declared as an argument in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
if ( add_temporary_variable ( hcl , HCL_CNODE_GET_TOK ( arg ) , tv_dup_start ) < = - 1 )
{
if ( hcl - > errnum = = HCL_EEXIST )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGNAMEDUP , HCL_CNODE_GET_LOC ( arg ) , HCL_CNODE_GET_TOK ( arg ) , " argument duplicate in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
}
return - 1 ;
}
nargs + + ;
2021-01-15 09:12:28 +00:00
}
}
2021-01-21 14:59:01 +00:00
dcl = HCL_CNODE_CONS_CDR ( dcl ) ;
if ( ! dcl ) break ;
if ( ! HCL_CNODE_IS_CONS ( dcl ) )
2021-01-15 09:12:28 +00:00
{
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( dcl ) , HCL_CNODE_GET_TOK ( dcl ) , " redundant cdr in argument list in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-21 14:59:01 +00:00
return - 1 ;
2021-01-15 09:12:28 +00:00
}
}
while ( 1 ) ;
}
if ( nargs > MAX_CODE_NBLKARGS ) /*TODO: change this limit to max call argument count */
{
/* while an integer object is pused to indicate the number of
* block arguments , evaluation which is done by message passing
* limits the number of arguments that can be passed . so the
* check is implemented */
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGFLOOD , HCL_CNODE_GET_LOC ( args ) , HCL_NULL , " too many(%zu) arguments in %.*js " , nargs , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-05-06 17:44:58 +00:00
if ( nrvars > MAX_CODE_NBLKLVARS )
{
2021-05-09 15:32:54 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARFLOOD , HCL_CNODE_GET_LOC ( args ) , HCL_NULL , " too many(%zu) return variables in %.*js " , nrvars , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-05-06 17:44:58 +00:00
return - 1 ;
}
HCL_ASSERT ( hcl , nargs + nrvars = = hcl - > c - > tv . wcount - saved_tv_wcount ) ;
2021-01-21 14:59:01 +00:00
obj = HCL_CNODE_CONS_CDR ( obj ) ;
2021-02-01 13:20:46 +00:00
tv_dup_start = hcl - > c - > tv . s . len ;
2022-01-03 17:59:55 +00:00
if ( collect_vardcls ( hcl , obj , & obj , tv_dup_start , & nlvars , " local " ) < = - 1 ) return - 1 ;
2021-05-04 09:48:19 +00:00
if ( nlvars > MAX_CODE_NBLKLVARS )
2021-01-15 09:12:28 +00:00
{
2021-05-04 09:48:19 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARFLOOD , HCL_CNODE_GET_LOC ( args ) , HCL_NULL , " too many(%zu) variables in %.*js " , nlvars , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-05-06 17:44:58 +00:00
HCL_ASSERT ( hcl , nargs + nrvars + nlvars = = hcl - > c - > tv . wcount - saved_tv_wcount ) ;
2021-05-04 09:48:19 +00:00
2021-05-07 08:53:01 +00:00
if ( push_fnblk ( hcl , HCL_CNODE_GET_LOC ( src ) , va , nargs , nrvars , nlvars , hcl - > c - > tv . wcount , hcl - > c - > tv . s . len , hcl - > code . bc . len , hcl - > code . lit . len ) < = - 1 ) return - 1 ;
2021-11-21 16:02:39 +00:00
2021-01-15 09:12:28 +00:00
if ( hcl - > option . trait & HCL_TRAIT_INTERACTIVE )
{
2021-05-06 17:44:58 +00:00
/* MAKE_FUNCTION tmpr_mask_1 tmpr_mask_2 lfbase lfsize */
if ( emit_double_param_instruction ( hcl , HCL_CODE_MAKE_FUNCTION , 0 , 0 , HCL_CNODE_GET_LOC ( cmd ) ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
lfbase_pos = hcl - > code . bc . len ;
2021-04-09 01:23:08 +00:00
if ( emit_long_param ( hcl , hcl - > code . lit . len - hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth - 1 ] . lfbase ) < = - 1 ) return - 1 ; /* literal frame base */
2021-01-15 09:12:28 +00:00
lfsize_pos = hcl - > code . bc . len ; /* literal frame size */
if ( emit_long_param ( hcl , 0 ) < = - 1 ) return - 1 ;
}
else
{
2021-05-06 17:44:58 +00:00
/* MAKE_BLOCK tmpr_mask_1 tmpr_mask_2 - will patch tmpr_mask in pop_fnblk() */
if ( emit_double_param_instruction ( hcl , HCL_CODE_MAKE_BLOCK , 0 , 0 , HCL_CNODE_GET_LOC ( cmd ) ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
}
HCL_ASSERT ( hcl , hcl - > code . bc . len < HCL_SMOOI_MAX ) ; /* guaranteed in emit_byte_instruction() */
jump_inst_pos = hcl - > code . bc . len ;
/* specifying MAX_CODE_JUMP causes emit_single_param_instruction() to
* produce the long jump instruction ( HCL_CODE_JUMP_FORWARD_X ) */
2021-01-28 08:17:50 +00:00
if ( emit_single_param_instruction ( hcl , HCL_CODE_JUMP_FORWARD_0 , MAX_CODE_JUMP , HCL_CNODE_GET_LOC ( cmd ) ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
2021-02-01 13:20:46 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT_LIST , obj ) ; /* 1 */
PUSH_SUBCFRAME ( hcl , COP_POST_LAMBDA , defun_name ) ; /* 3*/
2021-01-15 09:12:28 +00:00
2021-02-01 13:20:46 +00:00
PUSH_SUBCFRAME ( hcl , COP_EMIT_LAMBDA , src ) ; /* 2 */
2021-01-22 14:43:47 +00:00
cf = GET_SUBCFRAME ( hcl ) ;
2021-01-27 08:47:08 +00:00
cf - > u . lambda . jump_inst_pos = jump_inst_pos ;
2021-01-22 14:43:47 +00:00
2021-01-15 09:12:28 +00:00
if ( hcl - > option . trait & HCL_TRAIT_INTERACTIVE )
{
cf - > u . lambda . lfbase_pos = lfbase_pos ;
cf - > u . lambda . lfsize_pos = lfsize_pos ;
}
return 0 ;
}
2021-01-27 08:47:08 +00:00
static int compile_return ( hcl_t * hcl , hcl_cnode_t * src , int ret_from_home )
2021-01-15 09:12:28 +00:00
{
2021-01-21 14:59:01 +00:00
hcl_cnode_t * obj , * val ;
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-05-13 15:54:30 +00:00
hcl_fnblk_info_t * fbi ;
2021-06-18 19:07:36 +00:00
hcl_ooi_t i ;
2021-01-15 09:12:28 +00:00
2021-01-21 14:59:01 +00:00
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS ( src ) ) ;
2021-01-24 15:45:28 +00:00
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( HCL_CNODE_CONS_CAR ( src ) , HCL_SYNCODE_RETURN ) | |
HCL_CNODE_IS_SYMBOL_SYNCODED ( HCL_CNODE_CONS_CAR ( src ) , HCL_SYNCODE_RETURN_FROM_HOME ) ) ;
2021-01-15 09:12:28 +00:00
2021-05-13 15:54:30 +00:00
fbi = & hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] ;
2021-01-21 14:59:01 +00:00
obj = HCL_CNODE_CONS_CDR ( src ) ;
2021-01-15 09:12:28 +00:00
2021-06-18 19:07:36 +00:00
for ( i = hcl - > c - > cblk . depth ; i > hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] . cblk_base ; - - i )
{
switch ( hcl - > c - > cblk . info [ i ] . _type )
{
2021-06-19 17:19:24 +00:00
case HCL_CBLK_TYPE_LOOP :
/* do nothing */
break ;
2021-06-18 19:07:36 +00:00
case HCL_CBLK_TYPE_TRY :
if ( emit_byte_instruction ( hcl , HCL_CODE_TRY_EXIT , HCL_CNODE_GET_LOC ( src ) ) < = - 1 ) return - 1 ;
break ;
case HCL_CBLK_TYPE_CLASS :
2021-06-19 17:19:24 +00:00
if ( emit_byte_instruction ( hcl , HCL_CODE_CLASS_EXIT , HCL_CNODE_GET_LOC ( src ) ) < = - 1 ) return - 1 ;
2021-06-18 19:07:36 +00:00
break ;
}
}
2021-05-13 15:54:30 +00:00
if ( fbi - > tmpr_nrvars > 0 )
2021-01-15 09:12:28 +00:00
{
2021-01-21 14:59:01 +00:00
hcl_cnode_t * tmp = HCL_CNODE_CONS_CAR ( src ) ;
2021-05-13 15:54:30 +00:00
if ( ret_from_home )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BANNED , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " %.*js not compatible with return variables " , HCL_CNODE_GET_TOKLEN ( tmp ) , HCL_CNODE_GET_TOKPTR ( tmp ) ) ;
return - 1 ;
}
/* if a return variable are specified in the current function block, the return statement must not be followed by a return value */
if ( obj )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BANNED , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " use of return value in %.*js not compatible with return variables " , HCL_CNODE_GET_TOKLEN ( tmp ) , HCL_CNODE_GET_TOKPTR ( tmp ) ) ;
return - 1 ;
}
/* TODO: pop stack if this is not the first statement... */
if ( emit_byte_instruction ( hcl , HCL_CODE_PUSH_RETURN_R , HCL_CNODE_GET_LOC ( tmp ) ) < = - 1 ) return - 1 ;
POP_CFRAME ( hcl ) ;
2021-01-15 09:12:28 +00:00
}
2021-05-13 15:54:30 +00:00
else
2021-01-15 09:12:28 +00:00
{
2021-05-13 15:54:30 +00:00
if ( ! obj )
{
/* TODO: should i allow (return)? does it return the last value on the stack? */
/* no value */
hcl_cnode_t * tmp = HCL_CNODE_CONS_CAR ( src ) ;
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " no value specified in %.*js " , HCL_CNODE_GET_TOKLEN ( tmp ) , HCL_CNODE_GET_TOKPTR ( tmp ) ) ;
return - 1 ;
}
else if ( ! HCL_CNODE_IS_CONS ( obj ) )
{
hcl_cnode_t * tmp = HCL_CNODE_CONS_CAR ( src ) ;
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in %.*js " , HCL_CNODE_GET_TOKLEN ( tmp ) , HCL_CNODE_GET_TOKPTR ( tmp ) ) ;
return - 1 ;
}
2021-01-15 09:12:28 +00:00
2021-05-13 15:54:30 +00:00
val = HCL_CNODE_CONS_CAR ( obj ) ;
2021-01-15 09:12:28 +00:00
2021-05-13 15:54:30 +00:00
obj = HCL_CNODE_CONS_CDR ( obj ) ;
if ( obj )
{
hcl_cnode_t * tmp = HCL_CNODE_CONS_CAR ( src ) ;
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " more than 1 argument in %.*js " , HCL_CNODE_GET_TOKLEN ( tmp ) , HCL_CNODE_GET_TOKPTR ( tmp ) ) ;
return - 1 ;
}
2021-01-15 09:12:28 +00:00
2021-05-13 15:54:30 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT , val ) ;
2021-01-15 09:12:28 +00:00
2021-05-13 15:54:30 +00:00
PUSH_SUBCFRAME ( hcl , COP_EMIT_RETURN , src ) ;
cf = GET_SUBCFRAME ( hcl ) ;
cf - > u . _return . from_home = ret_from_home ;
}
2021-01-15 09:12:28 +00:00
return 0 ;
}
2021-01-22 14:43:47 +00:00
static int compile_set ( hcl_t * hcl , hcl_cnode_t * src )
2021-01-15 09:12:28 +00:00
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-22 14:43:47 +00:00
hcl_cnode_t * cmd , * obj , * var , * val ;
2021-11-23 14:42:20 +00:00
hcl_var_info_t vi ;
2021-01-15 09:12:28 +00:00
2021-01-22 14:43:47 +00:00
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS ( src ) ) ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( HCL_CNODE_CONS_CAR ( src ) , HCL_SYNCODE_SET ) ) ;
2021-01-15 09:12:28 +00:00
2021-01-22 14:43:47 +00:00
cmd = HCL_CNODE_CONS_CAR ( src ) ;
obj = HCL_CNODE_CONS_CDR ( src ) ;
2021-01-15 09:12:28 +00:00
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
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARNAME , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " no variable name in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-22 14:43:47 +00:00
else if ( ! HCL_CNODE_IS_CONS ( obj ) )
2021-01-15 09:12:28 +00:00
{
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-22 14:43:47 +00:00
var = HCL_CNODE_CONS_CAR ( obj ) ;
if ( ! HCL_CNODE_IS_SYMBOL ( var ) )
2021-01-15 09:12:28 +00:00
{
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARNAME , HCL_CNODE_GET_LOC ( var ) , HCL_CNODE_GET_TOK ( var ) , " variable name not a symbol in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-22 14:43:47 +00:00
if ( HCL_CNODE_SYMBOL_SYNCODE ( var ) /* || HCL_OBJ_GET_FLAGS_KERNEL(var) >= 2*/ )
2021-01-15 09:12:28 +00:00
{
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BANNEDVARNAME , HCL_CNODE_GET_LOC ( var ) , HCL_CNODE_GET_TOK ( var ) , " special symbol not to be used as a variable name in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-22 14:43:47 +00:00
obj = HCL_CNODE_CONS_CDR ( obj ) ;
if ( ! obj )
2021-01-15 09:12:28 +00:00
{
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " no value specified in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-22 14:43:47 +00:00
else if ( ! HCL_CNODE_IS_CONS ( obj ) )
2021-01-15 09:12:28 +00:00
{
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-22 14:43:47 +00:00
val = HCL_CNODE_CONS_CAR ( obj ) ;
2021-01-15 09:12:28 +00:00
2021-01-22 14:43:47 +00:00
obj = HCL_CNODE_CONS_CDR ( obj ) ;
if ( obj )
2021-01-15 09:12:28 +00:00
{
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " too many arguments to %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT , val ) ;
2021-11-23 14:42:20 +00:00
if ( find_variable_backward ( hcl , HCL_CNODE_GET_TOK ( var ) , & vi ) < = - 1 )
2021-01-15 09:12:28 +00:00
{
PUSH_SUBCFRAME ( hcl , COP_EMIT_SET , var ) ; /* set doesn't evaluate the variable name */
cf = GET_SUBCFRAME ( hcl ) ;
2021-11-23 14:42:20 +00:00
cf - > u . set . vi . type = VAR_NAMED ;
2021-01-15 09:12:28 +00:00
}
else
{
/* the check in compile_lambda() must ensure this condition */
2021-01-28 08:17:50 +00:00
PUSH_SUBCFRAME ( hcl , COP_EMIT_SET , cmd ) ;
2021-01-15 09:12:28 +00:00
cf = GET_SUBCFRAME ( hcl ) ;
2021-11-23 14:42:20 +00:00
cf - > u . set . vi = vi ;
2021-01-15 09:12:28 +00:00
}
2021-11-23 15:52:01 +00:00
cf - > u . set . mode = VAR_ACCESS_STORE ;
2021-05-15 05:31:36 +00:00
return 0 ;
}
static int compile_set_r ( hcl_t * hcl , hcl_cnode_t * src )
{
hcl_cframe_t * cf ;
hcl_cnode_t * cmd , * obj , * var , * val , * var_start ;
hcl_oow_t index , nvars , i ;
2021-11-23 14:42:20 +00:00
hcl_var_info_t vi ;
2021-05-15 05:31:36 +00:00
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS ( src ) ) ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( HCL_CNODE_CONS_CAR ( src ) , HCL_SYNCODE_SET_R ) ) ;
cmd = HCL_CNODE_CONS_CAR ( src ) ;
obj = HCL_CNODE_CONS_CDR ( src ) ;
if ( ! obj )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARNAME , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " no variable name in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
else if ( ! HCL_CNODE_IS_CONS ( obj ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
nvars = 0 ;
var_start = obj ;
do
{
var = HCL_CNODE_CONS_CAR ( obj ) ;
if ( ! HCL_CNODE_IS_SYMBOL ( var ) )
{
if ( nvars > 0 ) break ;
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARNAME , HCL_CNODE_GET_LOC ( var ) , HCL_CNODE_GET_TOK ( var ) , " variable name not a symbol in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
if ( HCL_CNODE_SYMBOL_SYNCODE ( var ) /* || HCL_OBJ_GET_FLAGS_KERNEL(var) >= 2*/ )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BANNEDVARNAME , HCL_CNODE_GET_LOC ( var ) , HCL_CNODE_GET_TOK ( var ) , " special symbol not to be used as a variable name in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
nvars + + ;
obj = HCL_CNODE_CONS_CDR ( obj ) ;
}
while ( obj ) ;
if ( ! obj )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " no value specified in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
else if ( ! HCL_CNODE_IS_CONS ( obj ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
val = HCL_CNODE_CONS_CAR ( obj ) ;
obj = HCL_CNODE_CONS_CDR ( obj ) ;
if ( obj )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " too many arguments to %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT_R , val ) ;
cf = GET_TOP_CFRAME ( hcl ) ;
cf - > u . obj_r . nrets = nvars ;
for ( i = 0 , obj = var_start ; i < nvars ; i + + , obj = HCL_CNODE_CONS_CDR ( obj ) )
{
var = HCL_CNODE_CONS_CAR ( obj ) ;
2021-11-23 14:42:20 +00:00
if ( find_variable_backward ( hcl , HCL_CNODE_GET_TOK ( var ) , & vi ) < = - 1 )
2021-05-15 05:31:36 +00:00
{
PUSH_SUBCFRAME ( hcl , COP_EMIT_SET , var ) ; /* set_r doesn't evaluate the variable name */
cf = GET_SUBCFRAME ( hcl ) ;
2021-11-23 14:42:20 +00:00
cf - > u . set . vi . type = VAR_NAMED ;
2021-05-15 05:31:36 +00:00
}
else
{
/* the check in compile_lambda() must ensure this condition */
2021-11-23 14:42:20 +00:00
HCL_ASSERT ( hcl , index < = HCL_SMOOI_MAX ) ;
2021-05-15 05:31:36 +00:00
PUSH_SUBCFRAME ( hcl , COP_EMIT_SET , cmd ) ;
cf = GET_SUBCFRAME ( hcl ) ;
2021-11-23 14:42:20 +00:00
cf - > u . set . vi = vi ;
2021-05-15 05:31:36 +00:00
}
2021-11-23 15:52:01 +00:00
cf - > u . set . mode = ( i > 0 ) ? VAR_ACCESS_STORE : VAR_ACCESS_POP ; /* STORE_INTO or POP_INTO */
2021-05-15 05:31:36 +00:00
}
2021-01-15 09:12:28 +00:00
return 0 ;
}
2021-02-22 09:20:45 +00:00
/* ========================================================================= */
2021-02-18 15:48:44 +00:00
static int compile_try ( hcl_t * hcl , hcl_cnode_t * src )
2021-01-15 09:12:28 +00:00
{
2021-02-22 09:20:45 +00:00
hcl_cnode_t * cmd , * obj ;
2021-02-18 15:48:44 +00:00
hcl_cframe_t * cf ;
2021-02-21 16:55:45 +00:00
hcl_ooi_t jump_inst_pos ;
2021-01-15 09:12:28 +00:00
2021-01-22 14:43:47 +00:00
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS ( src ) ) ;
2021-01-15 09:12:28 +00:00
2021-02-18 15:48:44 +00:00
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( HCL_CNODE_CONS_CAR ( src ) , HCL_SYNCODE_TRY ) ) ;
/* (try
* ( perform this )
* ( perform that )
2021-03-30 05:37:00 +00:00
* ( throw 10 )
2021-02-18 15:48:44 +00:00
* catch ( x )
* ( perform xxx )
* ( perform yyy )
* )
*/
2021-01-22 14:43:47 +00:00
cmd = HCL_CNODE_CONS_CDR ( src ) ;
obj = HCL_CNODE_CONS_CDR ( src ) ;
2021-01-15 09:12:28 +00:00
2021-01-22 14:43:47 +00:00
if ( ! obj )
2021-01-15 09:12:28 +00:00
{
/* no value */
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " no expression specified in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-22 14:43:47 +00:00
else if ( ! HCL_CNODE_IS_CONS ( obj ) )
2021-01-15 09:12:28 +00:00
{
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-04-22 09:35:26 +00:00
2021-04-11 15:08:27 +00:00
if ( push_cblk ( hcl , HCL_CNODE_GET_LOC ( src ) , HCL_CBLK_TYPE_TRY ) < = - 1 ) return - 1 ;
2021-02-22 09:20:45 +00:00
/* TODO: HCL_TRAIT_INTERACTIVE??? */
2021-02-21 16:55:45 +00:00
jump_inst_pos = hcl - > code . bc . len ;
2021-04-11 15:08:27 +00:00
if ( emit_single_param_instruction ( hcl , HCL_CODE_TRY_ENTER , MAX_CODE_JUMP , HCL_CNODE_GET_LOC ( cmd ) ) < = - 1 ) return - 1 ;
2021-02-21 16:55:45 +00:00
2021-02-22 09:20:45 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_TRY_OBJECT_LIST , obj ) ; /* 1*/
PUSH_SUBCFRAME ( hcl , COP_POST_TRY , cmd ) ; /* 2 */
2021-02-21 16:55:45 +00:00
cf = GET_SUBCFRAME ( hcl ) ;
2021-04-22 09:35:26 +00:00
cf - > u . post_try . jump_inst_pos = jump_inst_pos ;
2021-02-22 09:20:45 +00:00
return 0 ;
}
2021-04-11 15:45:01 +00:00
static HCL_INLINE int patch_nearest_post_try ( hcl_t * hcl , hcl_ooi_t * catch_skip_jip )
2021-02-22 09:20:45 +00:00
{
hcl_ooi_t jip , block_code_size ;
hcl_cframe_t * cf ;
cf = find_cframe_from_top ( hcl , COP_POST_TRY ) ;
HCL_ASSERT ( hcl , cf ! = HCL_NULL ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_POST_TRY ) ;
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-04-22 09:35:26 +00:00
jip = cf - > u . post_try . jump_inst_pos ;
2021-02-22 09:20:45 +00:00
/* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD instruction */
block_code_size = hcl - > code . bc . len - jip - ( HCL_CODE_LONG_PARAM_SIZE + 1 ) ;
if ( block_code_size = = 0 )
{
/* no body in try */
/* TODO: is this correct??? */
if ( emit_byte_instruction ( hcl , HCL_CODE_PUSH_NIL , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
}
2021-04-11 15:45:01 +00:00
if ( emit_byte_instruction ( hcl , HCL_CODE_TRY_EXIT , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
* catch_skip_jip = hcl - > code . bc . len ;
if ( emit_single_param_instruction ( hcl , HCL_CODE_JUMP_FORWARD_0 , MAX_CODE_JUMP , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
2021-02-22 09:20:45 +00:00
2021-04-11 15:08:27 +00:00
/* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD instruction */
block_code_size = hcl - > code . bc . len - jip - ( HCL_CODE_LONG_PARAM_SIZE + 1 ) ;
2021-02-22 09:20:45 +00:00
if ( block_code_size > MAX_CODE_JUMP * 2 )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BLKFLOOD , HCL_CNODE_GET_LOC ( cf - > operand ) , HCL_NULL , " code too big - size %zu " , block_code_size ) ;
return - 1 ;
}
2021-04-11 15:08:27 +00:00
patch_long_jump ( hcl , jip , block_code_size ) ; /* patch TRY_ENTER */
2021-02-22 09:20:45 +00:00
return 0 ;
}
static HCL_INLINE int compile_catch ( hcl_t * hcl )
{
2021-04-20 16:17:15 +00:00
hcl_cnode_t * cmd , * obj , * src , * exarg ;
2021-02-22 09:20:45 +00:00
hcl_cframe_t * cf ;
hcl_ooi_t jump_inst_pos ;
2021-11-23 14:42:20 +00:00
hcl_oow_t exarg_offset ;
hcl_var_info_t vi ;
2021-05-06 14:47:37 +00:00
hcl_fnblk_info_t * fbi ;
2021-12-26 14:59:34 +00:00
hcl_oow_t par_tmprcnt ;
2021-02-22 09:20:45 +00:00
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_COMPILE_CATCH ) ;
src = cf - > operand ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS ( src ) ) ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( HCL_CNODE_CONS_CAR ( src ) , HCL_SYNCODE_CATCH ) ) ;
cmd = HCL_CNODE_CONS_CAR ( src ) ;
obj = HCL_CNODE_CONS_CDR ( src ) ;
if ( ! obj )
{
2021-04-20 16:17:15 +00:00
/* TODO: change error code */
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARNAME , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " no exception variable in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-02-22 09:20:45 +00:00
return - 1 ;
}
2021-04-11 15:08:27 +00:00
else if ( ! HCL_CNODE_IS_CONS ( obj ) )
2021-02-22 09:20:45 +00:00
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
2021-04-20 16:17:15 +00:00
exarg = HCL_CNODE_CONS_CAR ( obj ) ;
if ( HCL_CNODE_IS_ELIST_CONCODED ( exarg , HCL_CONCODE_XLIST ) | | ! HCL_CNODE_IS_CONS ( exarg ) | | hcl_countcnodecons ( hcl , exarg ) ! = 1 )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARNAME , HCL_CNODE_GET_LOC ( exarg ) , HCL_NULL , " not single exception variable in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
exarg = HCL_CNODE_CONS_CAR ( exarg ) ;
if ( ! HCL_CNODE_IS_SYMBOL ( exarg ) | | HCL_CNODE_SYMBOL_SYNCODE ( exarg ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARNAME , HCL_CNODE_GET_LOC ( exarg ) , HCL_CNODE_GET_TOK ( exarg ) , " invalid exception variable name in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
return - 1 ;
}
2021-04-22 00:00:12 +00:00
2021-05-06 14:47:37 +00:00
/* add the exception variable to the local variable list. increase the number of local variables */
2021-04-22 09:35:26 +00:00
exarg_offset = hcl - > c - > tv . s . len + 1 ; /* when the variable name is added, its offset will be the current length + 1 for a space character added */
2021-11-23 14:42:20 +00:00
2021-12-26 16:00:08 +00:00
if ( hcl - > c - > fnblk . depth > 0 )
2021-12-26 14:59:34 +00:00
{
fbi = & hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth - 1 ] ; /* parent block */
par_tmprcnt = fbi - > tmprcnt ;
}
else
{
par_tmprcnt = 0 ;
}
2021-12-26 16:37:54 +00:00
/* fill the variable information structure as if it's found by find_variable_backward().
* we know it ' s the last variable as add_temporary_variable ( ) is called below .
* there is no need to call find_variable_backward ( ) */
vi . type = VAR_INDEXED ;
vi . ctx_offset = 0 ;
vi . index_in_ctx = hcl - > c - > tv . wcount - par_tmprcnt ;
if ( add_temporary_variable ( hcl , HCL_CNODE_GET_TOK ( exarg ) , hcl - > c - > tv . s . len ) < = - 1 ) return - 1 ;
2021-12-26 14:59:34 +00:00
2021-05-06 14:47:37 +00:00
fbi = & hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] ;
HCL_ASSERT ( hcl , fbi - > tmprlen = = hcl - > c - > tv . s . len - HCL_CNODE_GET_TOKLEN ( exarg ) - 1 ) ;
2021-12-26 16:37:54 +00:00
HCL_ASSERT ( hcl , fbi - > tmprcnt = = vi . index_in_ctx + par_tmprcnt ) ;
2021-05-06 14:47:37 +00:00
fbi - > tmprlen = hcl - > c - > tv . s . len ;
fbi - > tmprcnt = hcl - > c - > tv . wcount ;
fbi - > tmpr_nlvars = fbi - > tmpr_nlvars + 1 ;
2021-12-26 14:59:34 +00:00
HCL_ASSERT ( hcl , fbi - > tmpr_nargs + fbi - > tmpr_nrvars + fbi - > tmpr_nlvars = = fbi - > tmprcnt - par_tmprcnt ) ;
2021-04-20 16:17:15 +00:00
obj = HCL_CNODE_CONS_CDR ( obj ) ;
2021-04-18 18:02:02 +00:00
/* jump_inst_pos hold the instruction pointer that skips the catch block at the end of the try block */
patch_nearest_post_try ( hcl , & jump_inst_pos ) ;
2021-02-22 09:20:45 +00:00
2021-04-23 07:17:40 +00:00
/* produce an instruction to store the exception value to an exception variable pushed by the 'throw' instruction */
2021-11-23 15:52:01 +00:00
if ( emit_variable_access ( hcl , VAR_ACCESS_POP , & vi , HCL_CNODE_GET_LOC ( src ) ) < = - 1 ) return - 1 ;
2021-04-23 07:17:40 +00:00
2021-02-22 09:20:45 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT_LIST , obj ) ;
PUSH_SUBCFRAME ( hcl , COP_POST_CATCH , cmd ) ;
cf = GET_SUBCFRAME ( hcl ) ;
2021-04-22 09:35:26 +00:00
cf - > u . post_catch . jump_inst_pos = jump_inst_pos ;
2021-12-26 14:59:34 +00:00
cf - > u . post_catch . exarg_offset = exarg_offset ; /* there is only 1 exception variable. using the offset is easier than to use the variable position */
2021-02-22 09:20:45 +00:00
return 0 ;
}
static HCL_INLINE int post_try ( hcl_t * hcl )
{
/* TODO: */
2021-04-11 15:45:01 +00:00
pop_cblk ( hcl ) ;
2021-02-22 09:20:45 +00:00
POP_CFRAME ( hcl ) ;
return 0 ;
}
static HCL_INLINE int post_catch ( hcl_t * hcl )
{
hcl_ooi_t jip , block_code_size ;
hcl_cframe_t * cf ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf ! = HCL_NULL ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_POST_CATCH ) ;
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-04-22 09:35:26 +00:00
jip = cf - > u . post_catch . jump_inst_pos ; /* jump instruction position between the try block and the catch block */
2021-02-22 09:20:45 +00:00
/* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD instruction */
block_code_size = hcl - > code . bc . len - jip - ( HCL_CODE_LONG_PARAM_SIZE + 1 ) ;
if ( block_code_size = = 0 )
{
/* no body in try */
/* TODO: is this correct??? */
if ( emit_byte_instruction ( hcl , HCL_CODE_PUSH_NIL , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
block_code_size + + ;
}
if ( block_code_size > MAX_CODE_JUMP * 2 )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BLKFLOOD , HCL_CNODE_GET_LOC ( cf - > operand ) , HCL_NULL , " code too big - size %zu " , block_code_size ) ;
return - 1 ;
}
2021-04-11 15:45:01 +00:00
patch_long_jump ( hcl , jip , block_code_size ) ; /* patch the jump between the try block and the catch block */
2021-04-22 09:35:26 +00:00
2021-12-26 14:59:34 +00:00
/* make the exception variable unsearchable outside the catch block.
* the variable entity is still be accounted into the local variable list . */
2021-04-22 09:35:26 +00:00
kill_temporary_variable_at_offset ( hcl , cf - > u . post_catch . exarg_offset ) ;
2021-02-22 09:20:45 +00:00
POP_CFRAME ( hcl ) ;
2021-01-15 09:12:28 +00:00
return 0 ;
}
2021-02-28 06:43:22 +00:00
static int compile_throw ( hcl_t * hcl , hcl_cnode_t * src )
{
2021-02-28 17:00:28 +00:00
hcl_cnode_t * obj , * val ;
2021-12-24 00:05:58 +00:00
/*hcl_cframe_t* cf;*/
2021-02-28 06:43:22 +00:00
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS ( src ) ) ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( HCL_CNODE_CONS_CAR ( src ) , HCL_SYNCODE_THROW ) ) ;
obj = HCL_CNODE_CONS_CDR ( src ) ;
if ( ! obj )
{
2021-02-28 17:00:28 +00:00
/* TODO: should i allow (throw)? does it return the last value on the stack? */
2021-02-28 06:43:22 +00:00
/* no value */
2021-02-28 17:00:28 +00:00
hcl_cnode_t * tmp = HCL_CNODE_CONS_CAR ( src ) ;
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " no value specified in %.*js " , HCL_CNODE_GET_TOKLEN ( tmp ) , HCL_CNODE_GET_TOKPTR ( tmp ) ) ;
2021-02-28 06:43:22 +00:00
return - 1 ;
}
else if ( ! HCL_CNODE_IS_CONS ( obj ) )
{
2021-02-28 17:00:28 +00:00
hcl_cnode_t * tmp = HCL_CNODE_CONS_CAR ( src ) ;
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in %.*js " , HCL_CNODE_GET_TOKLEN ( tmp ) , HCL_CNODE_GET_TOKPTR ( tmp ) ) ;
return - 1 ;
}
val = HCL_CNODE_CONS_CAR ( obj ) ;
obj = HCL_CNODE_CONS_CDR ( obj ) ;
if ( obj )
{
hcl_cnode_t * tmp = HCL_CNODE_CONS_CAR ( src ) ;
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " more than 1 argument in %.*js " , HCL_CNODE_GET_TOKLEN ( tmp ) , HCL_CNODE_GET_TOKPTR ( tmp ) ) ;
2021-02-28 06:43:22 +00:00
return - 1 ;
}
2021-04-14 16:20:18 +00:00
/* throw can be located anywhere, however,
* if there is no outer try - catch , it ends up with a fatal runtime error */
2021-02-28 17:00:28 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT , val ) ;
PUSH_SUBCFRAME ( hcl , COP_EMIT_THROW , src ) ;
/*cf = GET_SUBCFRAME(hcl);*/
2021-02-28 06:43:22 +00:00
return 0 ;
}
2021-02-22 09:20:45 +00:00
/* ========================================================================= */
2021-01-22 14:43:47 +00:00
static int compile_while ( hcl_t * hcl , hcl_cnode_t * src , int next_cop )
2021-01-15 09:12:28 +00:00
{
/* (while (xxxx) ... )
* ( until ( xxxx ) . . . ) */
2021-01-22 14:43:47 +00:00
hcl_cnode_t * cmd , * obj , * cond ;
2021-01-15 09:12:28 +00:00
hcl_oow_t cond_pos ;
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
2021-01-22 14:43:47 +00:00
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS ( src ) ) ;
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL_SYNCODED ( HCL_CNODE_CONS_CAR ( src ) , HCL_SYNCODE_UNTIL ) | |
HCL_CNODE_IS_SYMBOL_SYNCODED ( HCL_CNODE_CONS_CAR ( src ) , HCL_SYNCODE_WHILE ) ) ;
2021-01-15 09:12:28 +00:00
HCL_ASSERT ( hcl , next_cop = = COP_POST_UNTIL_COND | | next_cop = = COP_POST_WHILE_COND ) ;
2021-01-22 14:43:47 +00:00
cmd = HCL_CNODE_CONS_CAR ( src ) ;
obj = HCL_CNODE_CONS_CDR ( src ) ;
2021-01-15 09:12:28 +00:00
2021-01-22 14:43:47 +00:00
if ( ! obj )
2021-01-15 09:12:28 +00:00
{
/* no value */
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( src ) , HCL_NULL , " no loop condition specified in %.*js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-22 14:43:47 +00:00
else if ( ! HCL_CNODE_IS_CONS ( obj ) )
2021-01-15 09:12:28 +00:00
{
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " redundant cdr in %*.js " , HCL_CNODE_GET_TOKLEN ( cmd ) , HCL_CNODE_GET_TOKPTR ( cmd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-04-09 08:22:40 +00:00
if ( push_cblk ( hcl , HCL_CNODE_GET_LOC ( src ) , HCL_CBLK_TYPE_LOOP ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
HCL_ASSERT ( hcl , hcl - > code . bc . len < HCL_SMOOI_MAX ) ;
cond_pos = hcl - > code . bc . len ; /* position where the bytecode for the conditional is emitted */
2021-01-22 14:43:47 +00:00
cond = HCL_CNODE_CONS_CAR ( obj ) ;
2021-01-15 09:12:28 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT , cond ) ; /* 1 */
2021-01-28 10:09:38 +00:00
/* pass the cons cell branching to the conditional and the body. see post_while_cond() for the reason */
2021-01-15 09:12:28 +00:00
PUSH_SUBCFRAME ( hcl , next_cop , obj ) ; /* 2 */
2021-01-27 08:47:08 +00:00
cf = GET_SUBCFRAME ( hcl ) ;
2021-01-15 09:12:28 +00:00
cf - > u . post_while . cond_pos = cond_pos ;
cf - > u . post_while . body_pos = - 1 ; /* unknown yet*/
2021-01-28 10:09:38 +00:00
cf - > u . post_while . jump_inst_pos = - 1 ; /* not needed */
2021-01-22 14:43:47 +00:00
cf - > u . post_while . start_loc = * HCL_CNODE_GET_LOC ( src ) ;
2021-01-15 09:12:28 +00:00
return 0 ;
}
2021-02-18 15:48:44 +00:00
2021-01-15 09:12:28 +00:00
/* ========================================================================= */
2021-01-19 14:07:42 +00:00
static int compile_cons_array_expression ( hcl_t * hcl , hcl_cnode_t * obj )
2021-01-15 09:12:28 +00:00
{
/* [ ] */
hcl_ooi_t nargs ;
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
2021-01-19 14:07:42 +00:00
nargs = hcl_countcnodecons ( hcl , obj ) ;
2021-01-15 09:12:28 +00:00
if ( nargs > MAX_CODE_PARAM )
{
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGFLOOD , HCL_CNODE_GET_LOC ( obj ) , HCL_NULL , " too many(%zd) elements in array " , nargs ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-28 07:25:05 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_EMIT_MAKE_ARRAY , obj ) ;
cf = GET_TOP_CFRAME ( hcl ) ;
cf - > u . array_list . index = nargs ;
2021-01-15 09:12:28 +00:00
/* redundant cdr check is performed inside compile_object_list() */
PUSH_SUBCFRAME ( hcl , COP_COMPILE_ARRAY_LIST , obj ) ;
cf = GET_SUBCFRAME ( hcl ) ;
cf - > u . array_list . index = 0 ;
return 0 ;
}
2021-01-19 14:07:42 +00:00
static int compile_cons_bytearray_expression ( hcl_t * hcl , hcl_cnode_t * obj )
2021-01-15 09:12:28 +00:00
{
/* #[ ] - e.g. #[1, 2, 3] or #[ 1 2 3 ] */
hcl_ooi_t nargs ;
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
2021-01-19 14:07:42 +00:00
nargs = hcl_countcnodecons ( hcl , obj ) ;
2021-01-15 09:12:28 +00:00
if ( nargs > MAX_CODE_PARAM )
{
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGFLOOD , HCL_CNODE_GET_LOC ( obj ) , HCL_NULL , " too many(%zd) elements in byte-array " , nargs ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-28 07:25:05 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_EMIT_MAKE_BYTEARRAY , obj ) ;
cf = GET_TOP_CFRAME ( hcl ) ;
cf - > u . bytearray_list . index = nargs ;
2021-01-15 09:12:28 +00:00
/* redundant cdr check is performed inside compile_object_list() */
PUSH_SUBCFRAME ( hcl , COP_COMPILE_BYTEARRAY_LIST , obj ) ;
cf = GET_SUBCFRAME ( hcl ) ;
cf - > u . bytearray_list . index = 0 ;
return 0 ;
}
2021-01-19 14:07:42 +00:00
static int compile_cons_dic_expression ( hcl_t * hcl , hcl_cnode_t * obj )
2021-01-15 09:12:28 +00:00
{
/* { } - e.g. {1:2, 3:4,"abc":def, "hwaddr":"00:00:00:01"} or { 1 2 3 4 } */
hcl_ooi_t nargs ;
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
2021-01-19 14:07:42 +00:00
nargs = hcl_countcnodecons ( hcl , obj ) ;
2021-01-15 09:12:28 +00:00
if ( nargs > MAX_CODE_PARAM )
{
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGFLOOD , HCL_CNODE_GET_LOC ( obj ) , HCL_NULL , " too many(%zd) elements in dictionary " , nargs ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-28 07:25:05 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_EMIT_MAKE_DIC , obj ) ;
cf = GET_TOP_CFRAME ( hcl ) ;
cf - > u . dic_list . index = nargs > > 1 ; /* only the half */
2021-01-15 09:12:28 +00:00
/* redundant cdr check is performed inside compile_object_list() */
PUSH_SUBCFRAME ( hcl , COP_COMPILE_DIC_LIST , obj ) ;
return 0 ;
}
2021-01-19 14:07:42 +00:00
static int compile_cons_qlist_expression ( hcl_t * hcl , hcl_cnode_t * obj )
2021-01-15 09:12:28 +00:00
{
/* #( 1 2 3 )
2021-01-24 15:45:28 +00:00
* # ( 1 ( + 2 3 ) 5 ) - - > # ( 1 5 5 )
2021-01-15 09:12:28 +00:00
* */
2021-01-28 07:25:05 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_EMIT_MAKE_CONS , obj ) ;
2021-01-15 09:12:28 +00:00
PUSH_SUBCFRAME ( hcl , COP_COMPILE_QLIST , obj ) ;
return 0 ;
}
2021-05-15 05:31:36 +00:00
static int compile_cons_xlist_expression ( hcl_t * hcl , hcl_cnode_t * obj , int nrets )
2021-01-15 09:12:28 +00:00
{
2021-01-17 17:45:39 +00:00
hcl_cnode_t * car ;
2021-01-15 09:12:28 +00:00
int syncode ; /* syntax code of the first element */
/* a valid function call
* ( function - name argument - list )
* function - name can be :
* a symbol .
* another function call .
* if the name is another function call , i can ' t know if the
* function name will be valid at the compile time .
*/
2021-01-19 14:07:42 +00:00
HCL_ASSERT ( hcl , HCL_CNODE_IS_CONS_CONCODED ( obj , HCL_CONCODE_XLIST ) ) ;
2021-01-15 09:12:28 +00:00
2021-01-19 14:07:42 +00:00
car = HCL_CNODE_CONS_CAR ( obj ) ;
if ( HCL_CNODE_IS_SYMBOL ( car ) & & ( syncode = HCL_CNODE_SYMBOL_SYNCODE ( car ) ) )
2021-01-15 09:12:28 +00:00
{
2021-05-15 05:31:36 +00:00
if ( nrets > 0 )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_CALLABLE , HCL_CNODE_GET_LOC ( car ) , HCL_CNODE_GET_TOK ( car ) , " not a function with return-variables " ) ;
return - 1 ;
}
2021-01-15 09:12:28 +00:00
switch ( syncode )
{
case HCL_SYNCODE_AND :
if ( compile_and ( hcl , obj ) < = - 1 ) return - 1 ;
break ;
case HCL_SYNCODE_BREAK :
2021-01-17 17:45:39 +00:00
/* (break) */
2021-01-15 09:12:28 +00:00
if ( compile_break ( hcl , obj ) < = - 1 ) return - 1 ;
break ;
2021-02-18 15:48:44 +00:00
case HCL_SYNCODE_CATCH :
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ELIF , HCL_CNODE_GET_LOC ( car ) , HCL_CNODE_GET_TOK ( car ) , " catch without try " ) ;
return - 1 ;
2021-01-29 08:13:18 +00:00
case HCL_SYNCODE_CONTINUE :
/* (continue)*/
if ( compile_continue ( hcl , obj ) < = - 1 ) return - 1 ;
break ;
2021-05-29 05:44:29 +00:00
case HCL_SYNCODE_DEFCLASS :
2021-06-01 09:50:35 +00:00
if ( compile_class ( hcl , obj ) < = - 1 ) return - 1 ;
2021-05-29 05:44:29 +00:00
break ;
2021-01-15 09:12:28 +00:00
case HCL_SYNCODE_DEFUN :
if ( compile_lambda ( hcl , obj , 1 ) < = - 1 ) return - 1 ;
break ;
case HCL_SYNCODE_DO :
if ( compile_do ( hcl , obj ) < = - 1 ) return - 1 ;
break ;
case HCL_SYNCODE_ELSE :
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ELSE , HCL_CNODE_GET_LOC ( car ) , HCL_CNODE_GET_TOK ( car ) , " else without if " ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
case HCL_SYNCODE_ELIF :
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ELIF , HCL_CNODE_GET_LOC ( car ) , HCL_CNODE_GET_TOK ( car ) , " elif without if " ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
case HCL_SYNCODE_IF :
if ( compile_if ( hcl , obj ) < = - 1 ) return - 1 ;
break ;
case HCL_SYNCODE_LAMBDA :
/* (lambda (x y) (+ x y)) */
if ( compile_lambda ( hcl , obj , 0 ) < = - 1 ) return - 1 ;
break ;
2021-01-22 14:43:47 +00:00
2021-01-15 09:12:28 +00:00
case HCL_SYNCODE_OR :
if ( compile_or ( hcl , obj ) < = - 1 ) return - 1 ;
break ;
case HCL_SYNCODE_SET :
/* (set x 10)
* ( set x ( lambda ( x y ) ( + x y ) ) */
if ( compile_set ( hcl , obj ) < = - 1 ) return - 1 ;
break ;
2021-05-15 05:31:36 +00:00
case HCL_SYNCODE_SET_R :
/* (set-r a b (func 10 20)) */
if ( compile_set_r ( hcl , obj ) < = - 1 ) return - 1 ;
break ;
2021-01-15 09:12:28 +00:00
case HCL_SYNCODE_RETURN :
/* (return 10)
* ( return ( + 10 20 ) ) */
if ( compile_return ( hcl , obj , 0 ) < = - 1 ) return - 1 ;
break ;
case HCL_SYNCODE_RETURN_FROM_HOME :
if ( compile_return ( hcl , obj , 1 ) < = - 1 ) return - 1 ;
break ;
2021-02-28 06:43:22 +00:00
case HCL_SYNCODE_THROW :
if ( compile_throw ( hcl , obj ) < = - 1 ) return - 1 ;
break ;
2021-02-18 15:48:44 +00:00
case HCL_SYNCODE_TRY :
if ( compile_try ( hcl , obj ) < = - 1 ) return - 1 ;
break ;
2021-01-15 09:12:28 +00:00
case HCL_SYNCODE_UNTIL :
if ( compile_while ( hcl , obj , COP_POST_UNTIL_COND ) < = - 1 ) return - 1 ;
break ;
case HCL_SYNCODE_WHILE :
if ( compile_while ( hcl , obj , COP_POST_WHILE_COND ) < = - 1 ) return - 1 ;
break ;
default :
HCL_DEBUG3 ( hcl , " Internal error - unknown syncode %d at %s:%d \n " , syncode , __FILE__ , __LINE__ ) ;
2021-01-19 14:07:42 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_INTERN , HCL_CNODE_GET_LOC ( car ) , HCL_NULL , " internal error - unknown syncode %d " , syncode ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
}
2021-01-22 15:07:47 +00:00
else if ( HCL_CNODE_IS_SYMBOL ( car ) | | HCL_CNODE_IS_DSYMBOL ( car ) | | HCL_CNODE_IS_CONS_CONCODED ( car , HCL_CONCODE_XLIST ) )
2021-01-15 09:12:28 +00:00
{
/* normal function call
* ( < operator > < operand1 > . . . ) */
hcl_ooi_t nargs ;
hcl_ooi_t oldtop ;
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-19 14:07:42 +00:00
hcl_cnode_t * cdr ;
2021-01-15 09:12:28 +00:00
/* NOTE: cframe management functions don't use the object memory.
* many operations can be performed without taking GC into account */
/* store the position of COP_EMIT_CALL to be produced with
* SWITCH_TOP_CFRAME ( ) in oldtop for argument count patching
* further down */
oldtop = GET_TOP_CFRAME_INDEX ( hcl ) ;
HCL_ASSERT ( hcl , oldtop > = 0 ) ;
2021-01-28 08:17:50 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_EMIT_CALL , car ) ;
2021-01-15 09:12:28 +00:00
/* compile <operator> */
PUSH_CFRAME ( hcl , COP_COMPILE_OBJECT , car ) ;
/* compile <operand1> ... etc */
2021-01-19 14:07:42 +00:00
cdr = HCL_CNODE_CONS_CDR ( obj ) ;
2021-01-15 09:12:28 +00:00
2021-01-19 14:07:42 +00:00
if ( ! cdr )
2021-01-15 09:12:28 +00:00
{
nargs = 0 ;
}
else
{
2021-01-19 14:07:42 +00:00
if ( ! HCL_CNODE_IS_CONS ( cdr ) )
2021-01-15 09:12:28 +00:00
{
/* (funname . 10) */
2021-01-19 14:07:42 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( cdr ) , HCL_CNODE_GET_TOK ( cdr ) , " redundant cdr in function call " ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-19 14:07:42 +00:00
nargs = hcl_countcnodecons ( hcl , cdr ) ;
2021-01-15 09:12:28 +00:00
if ( nargs > MAX_CODE_PARAM )
{
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGFLOOD , HCL_CNODE_GET_LOC ( cdr ) , HCL_NULL , " too many(%zd) parameters in function call " , nargs ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
}
2021-01-22 15:07:47 +00:00
if ( HCL_CNODE_IS_SYMBOL ( car ) | | HCL_CNODE_IS_DSYMBOL ( car ) )
2021-01-15 09:12:28 +00:00
{
2021-01-28 08:17:50 +00:00
hcl_oop_cons_t sdc ;
2021-01-15 09:12:28 +00:00
/* only symbols are added to the system dictionary.
* perform this lookup only if car is a symbol */
2021-01-22 14:43:47 +00:00
sdc = hcl_lookupsysdicforsymbol_noseterr ( hcl , HCL_CNODE_GET_TOK ( car ) ) ;
2021-01-15 09:12:28 +00:00
if ( sdc )
{
hcl_oop_word_t sdv ;
sdv = ( hcl_oop_word_t ) HCL_CONS_CDR ( sdc ) ;
if ( HCL_IS_PRIM ( hcl , sdv ) )
{
if ( nargs < sdv - > slot [ 1 ] | | nargs > sdv - > slot [ 2 ] )
{
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ARGCOUNT , HCL_CNODE_GET_LOC ( car ) , HCL_NULL ,
" parameters count(%zd) mismatch in function call - %.*js - expecting %zu-%zu parameters " , nargs , HCL_CNODE_GET_TOKLEN ( car ) , HCL_CNODE_GET_TOKPTR ( car ) , sdv - > slot [ 1 ] , sdv - > slot [ 2 ] ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
}
}
}
/* redundant cdr check is performed inside compile_object_list() */
PUSH_SUBCFRAME ( hcl , COP_COMPILE_ARGUMENT_LIST , cdr ) ;
/* patch the argument count in the operand field of the COP_EMIT_CALL frame */
cf = GET_CFRAME ( hcl , oldtop ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_EMIT_CALL ) ;
2021-01-28 08:17:50 +00:00
cf - > u . call . index = nargs ;
2021-05-15 05:31:36 +00:00
cf - > u . call . nrets = nrets ;
2021-01-15 09:12:28 +00:00
}
else
{
2021-01-19 14:07:42 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_CALLABLE , HCL_CNODE_GET_LOC ( car ) , HCL_CNODE_GET_TOK ( car ) , " invalid callable in function call " ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
return 0 ;
}
2021-01-17 17:45:39 +00:00
static HCL_INLINE int compile_symbol ( hcl_t * hcl , hcl_cnode_t * obj )
2021-01-15 09:12:28 +00:00
{
2021-11-23 14:42:20 +00:00
hcl_var_info_t vi ;
2021-01-15 09:12:28 +00:00
2021-01-19 14:07:42 +00:00
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL ( obj ) ) ;
2021-01-15 09:12:28 +00:00
2021-01-21 14:59:01 +00:00
if ( HCL_CNODE_SYMBOL_SYNCODE ( obj ) )
2021-01-15 09:12:28 +00:00
{
2021-01-25 14:24:00 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BANNEDVARNAME , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " special symbol not to be used as a variable name " ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-11-23 02:37:58 +00:00
2021-01-15 09:12:28 +00:00
/* check if a symbol is a local variable */
2021-11-23 02:37:58 +00:00
if ( find_variable_backward ( hcl , HCL_CNODE_GET_TOK ( obj ) , & vi ) < = - 1 )
2021-01-15 09:12:28 +00:00
{
2021-01-17 17:45:39 +00:00
hcl_oop_t sym , cons ;
2021-11-23 02:37:58 +00:00
hcl_oow_t index ;
2021-01-15 09:12:28 +00:00
/* TODO: if i require all variables to be declared, this part is not needed and should handle it as an error */
/* TODO: change the scheme... allow declaration??? */
/* global variable */
2021-01-19 14:07:42 +00:00
sym = hcl_makesymbol ( hcl , HCL_CNODE_GET_TOKPTR ( obj ) , HCL_CNODE_GET_TOKLEN ( obj ) ) ;
2021-01-17 17:45:39 +00:00
if ( HCL_UNLIKELY ( ! sym ) ) return - 1 ;
cons = ( hcl_oop_t ) hcl_getatsysdic ( hcl , sym ) ;
2021-01-15 09:12:28 +00:00
if ( ! cons )
{
2021-01-17 17:45:39 +00:00
cons = ( hcl_oop_t ) hcl_putatsysdic ( hcl , sym , hcl - > _nil ) ;
if ( HCL_UNLIKELY ( ! cons ) ) return - 1 ;
2021-01-15 09:12:28 +00:00
}
/* add the entire cons pair to the literal frame */
if ( add_literal ( hcl , cons , & index ) < = - 1 | |
2021-01-29 08:13:18 +00:00
emit_single_param_instruction ( hcl , HCL_CODE_PUSH_OBJECT_0 , index , HCL_CNODE_GET_LOC ( obj ) ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
return 0 ;
}
else
{
2021-12-12 16:09:31 +00:00
HCL_ASSERT ( hcl , vi . type ! = VAR_NAMED ) ;
2021-11-23 15:52:01 +00:00
return emit_variable_access ( hcl , VAR_ACCESS_PUSH , & vi , HCL_CNODE_GET_LOC ( obj ) ) ;
2021-01-15 09:12:28 +00:00
}
}
2021-01-22 14:43:47 +00:00
static HCL_INLINE int compile_dsymbol ( hcl_t * hcl , hcl_cnode_t * obj )
{
2021-01-22 15:07:47 +00:00
hcl_oop_t sym , cons ;
hcl_oow_t index ;
/* TODO: need a total revamp on the dotted symbols.
* must differentiate module access and dictioary member access . . .
* must implementate dictionary member access syntax . . . */
2021-06-29 11:51:08 +00:00
{ /* HACK FOR NOW */
const hcl_ooch_t * sep ;
sep = hcl_find_oochar ( HCL_CNODE_GET_TOKPTR ( obj ) , HCL_CNODE_GET_TOKLEN ( obj ) , ' . ' ) ;
HCL_ASSERT ( hcl , sep ! = HCL_NULL ) ;
if ( hcl_comp_oochars_bcstr ( HCL_CNODE_GET_TOKPTR ( obj ) , sep - HCL_CNODE_GET_TOKPTR ( obj ) , " self " ) = = 0 )
{
/* instance variable? or instance method? */
HCL_DEBUG1 ( hcl , " >>>> instance variable or method %js \n " , sep + 1 ) ;
}
/* TODO: super? */
}
2021-01-22 15:07:47 +00:00
sym = hcl_makesymbol ( hcl , HCL_CNODE_GET_TOKPTR ( obj ) , HCL_CNODE_GET_TOKLEN ( obj ) ) ;
if ( HCL_UNLIKELY ( ! sym ) ) return - 1 ;
cons = ( hcl_oop_t ) hcl_getatsysdic ( hcl , sym ) ;
if ( ! cons )
{
/* query the module for information if it is the first time
* when the dotted symbol is seen */
hcl_pfbase_t * pfbase ;
hcl_mod_t * mod ;
hcl_oop_t val ;
unsigned int kernel_bits ;
pfbase = hcl_querymod ( hcl , HCL_CNODE_GET_TOKPTR ( obj ) , HCL_CNODE_GET_TOKLEN ( obj ) , & mod ) ;
if ( ! pfbase )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARNAME , HCL_CNODE_GET_LOC ( obj ) , HCL_CNODE_GET_TOK ( obj ) , " unknown dotted symbol " ) ;
return - 1 ;
}
hcl_pushvolat ( hcl , & sym ) ;
switch ( pfbase - > type )
{
case HCL_PFBASE_FUNC :
kernel_bits = 2 ;
val = hcl_makeprim ( hcl , pfbase - > handler , pfbase - > minargs , pfbase - > maxargs , mod ) ;
break ;
case HCL_PFBASE_VAR :
kernel_bits = 1 ;
val = hcl - > _nil ;
break ;
case HCL_PFBASE_CONST :
/* TODO: create a value from the pfbase information. it needs to get extended first
* can i make use of pfbase - > handler type - cast to a differnt type ? */
kernel_bits = 2 ;
val = hcl - > _nil ;
break ;
default :
hcl_popvolat ( hcl ) ;
hcl_seterrbfmt ( hcl , HCL_EINVAL , " invalid pfbase type - %d \n " , pfbase - > type ) ;
return - 1 ;
}
if ( ! val | | ! ( cons = ( hcl_oop_t ) hcl_putatsysdic ( hcl , sym , val ) ) )
{
hcl_popvolat ( hcl ) ;
return - 1 ;
}
hcl_popvolat ( hcl ) ;
/* make this dotted symbol special that it can't get changed
* to a different value */
HCL_OBJ_SET_FLAGS_KERNEL ( sym , kernel_bits ) ;
}
if ( add_literal ( hcl , cons , & index ) < = - 1 | |
2021-01-29 08:13:18 +00:00
emit_single_param_instruction ( hcl , HCL_CODE_PUSH_OBJECT_0 , index , HCL_CNODE_GET_LOC ( obj ) ) < = - 1 ) return - 1 ;
2021-01-22 15:07:47 +00:00
return 0 ;
2021-01-22 14:43:47 +00:00
}
2021-01-17 17:45:39 +00:00
static hcl_oop_t string_to_num ( hcl_t * hcl , hcl_oocs_t * str , const hcl_ioloc_t * loc , int radixed )
{
int negsign , base ;
const hcl_ooch_t * ptr , * end ;
negsign = 0 ;
ptr = str - > ptr ,
end = str - > ptr + str - > len ;
HCL_ASSERT ( hcl , ptr < end ) ;
if ( * ptr = = ' + ' | | * ptr = = ' - ' )
{
negsign = * ptr - ' + ' ;
ptr + + ;
}
#if 0
if ( radixed )
{
/* 16r1234, 2r1111 */
HCL_ASSERT ( hcl , ptr < end ) ;
base = 0 ;
do
{
base = base * 10 + CHAR_TO_NUM ( * ptr , 10 ) ;
ptr + + ;
}
while ( * ptr ! = ' r ' ) ;
ptr + + ;
}
else base = 10 ;
# else
if ( radixed )
{
/* #xFF80, #b1111 */
HCL_ASSERT ( hcl , ptr < end ) ;
if ( * ptr ! = ' # ' )
{
2021-01-19 14:07:42 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_RADIX , loc , str , " radixed number not starting with # " ) ;
2021-01-17 17:45:39 +00:00
return HCL_NULL ;
}
ptr + + ; /* skip '#' */
if ( * ptr = = ' x ' ) base = 16 ;
else if ( * ptr = = ' o ' ) base = 8 ;
else if ( * ptr = = ' b ' ) base = 2 ;
else
{
2021-01-19 14:07:42 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_RADIX , loc , str , " invalid radix specifier %c " , * ptr ) ;
2021-01-17 17:45:39 +00:00
return HCL_NULL ;
}
ptr + + ;
}
else base = 10 ;
# endif
/* TODO: handle floating point numbers ... etc */
if ( negsign ) base = - base ;
return hcl_strtoint ( hcl , ptr , end - ptr , base ) ;
}
static hcl_oop_t string_to_fpdec ( hcl_t * hcl , hcl_oocs_t * str , const hcl_ioloc_t * loc )
{
hcl_oow_t pos ;
hcl_oow_t scale = 0 ;
hcl_oop_t v ;
pos = str - > len ;
while ( pos > 0 )
{
pos - - ;
if ( str - > ptr [ pos ] = = ' . ' )
{
scale = str - > len - pos - 1 ;
if ( scale > HCL_SMOOI_MAX )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_NUMRANGE , loc , str , " too many digits after decimal point " ) ;
return HCL_NULL ;
}
HCL_ASSERT ( hcl , scale > 0 ) ;
/*if (scale > 0)*/ HCL_MEMMOVE ( & str - > ptr [ pos ] , & str - > ptr [ pos + 1 ] , scale * HCL_SIZEOF ( str - > ptr [ 0 ] ) ) ; /* remove the decimal point */
break ;
}
}
/* if no decimal point is included or no digit after the point , you must not call this function */
HCL_ASSERT ( hcl , scale > 0 ) ;
v = hcl_strtoint ( hcl , str - > ptr , str - > len - 1 , 10 ) ;
if ( HCL_UNLIKELY ( ! v ) ) return HCL_NULL ;
return hcl_makefpdec ( hcl , v , scale ) ;
}
2021-01-15 09:12:28 +00:00
static int compile_object ( hcl_t * hcl )
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-17 17:45:39 +00:00
hcl_cnode_t * oprnd ;
hcl_oop_t lit ;
2021-01-15 09:12:28 +00:00
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_COMPILE_OBJECT ) ;
2021-01-28 10:09:38 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-01-15 09:12:28 +00:00
2021-01-17 17:45:39 +00:00
oprnd = cf - > operand ;
2021-01-25 15:23:24 +00:00
redo :
2021-01-19 14:07:42 +00:00
switch ( HCL_CNODE_GET_TYPE ( oprnd ) )
2021-01-15 09:12:28 +00:00
{
2021-01-17 17:45:39 +00:00
case HCL_CNODE_NIL :
2021-01-29 08:13:18 +00:00
if ( emit_byte_instruction ( hcl , HCL_CODE_PUSH_NIL , HCL_CNODE_GET_LOC ( oprnd ) ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
goto done ;
2021-01-17 17:45:39 +00:00
case HCL_CNODE_TRUE :
2021-01-29 08:13:18 +00:00
if ( emit_byte_instruction ( hcl , HCL_CODE_PUSH_TRUE , HCL_CNODE_GET_LOC ( oprnd ) ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
goto done ;
2021-01-17 17:45:39 +00:00
case HCL_CNODE_FALSE :
2021-01-29 08:13:18 +00:00
if ( emit_byte_instruction ( hcl , HCL_CODE_PUSH_FALSE , HCL_CNODE_GET_LOC ( oprnd ) ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
goto done ;
2021-01-17 17:45:39 +00:00
case HCL_CNODE_CHARLIT :
lit = HCL_CHAR_TO_OOP ( oprnd - > u . charlit . v ) ;
goto literal ;
case HCL_CNODE_STRLIT :
2021-01-19 14:07:42 +00:00
lit = hcl_makestring ( hcl , HCL_CNODE_GET_TOKPTR ( oprnd ) , HCL_CNODE_GET_TOKLEN ( oprnd ) , 0 ) ;
2021-01-17 17:45:39 +00:00
if ( HCL_UNLIKELY ( ! lit ) ) return - 1 ;
goto literal ;
case HCL_CNODE_NUMLIT :
2021-01-19 14:07:42 +00:00
lit = string_to_num ( hcl , HCL_CNODE_GET_TOK ( oprnd ) , HCL_CNODE_GET_LOC ( oprnd ) , 0 ) ;
2021-01-17 17:45:39 +00:00
if ( HCL_UNLIKELY ( ! lit ) ) return - 1 ;
goto literal ;
case HCL_CNODE_RADNUMLIT :
2021-01-19 14:07:42 +00:00
lit = string_to_num ( hcl , HCL_CNODE_GET_TOK ( oprnd ) , HCL_CNODE_GET_LOC ( oprnd ) , 1 ) ;
2021-01-17 17:45:39 +00:00
if ( HCL_UNLIKELY ( ! lit ) ) return - 1 ;
goto literal ;
case HCL_CNODE_FPDECLIT :
2021-01-19 14:07:42 +00:00
lit = string_to_fpdec ( hcl , HCL_CNODE_GET_TOK ( oprnd ) , HCL_CNODE_GET_LOC ( oprnd ) ) ;
2021-01-17 17:45:39 +00:00
if ( HCL_UNLIKELY ( ! lit ) ) return - 1 ;
goto literal ;
case HCL_CNODE_SMPTRLIT :
lit = HCL_SMPTR_TO_OOP ( oprnd - > u . smptrlit . v ) ;
goto literal ;
case HCL_CNODE_ERRLIT :
lit = HCL_ERROR_TO_OOP ( oprnd - > u . errlit . v ) ;
goto literal ;
case HCL_CNODE_SYMBOL :
if ( compile_symbol ( hcl , oprnd ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
goto done ;
2021-01-17 17:45:39 +00:00
case HCL_CNODE_DSYMBOL :
if ( compile_dsymbol ( hcl , oprnd ) < = - 1 ) return - 1 ;
goto done ;
2021-01-19 14:07:42 +00:00
case HCL_CNODE_CONS :
2021-01-15 09:12:28 +00:00
{
2021-01-19 14:07:42 +00:00
switch ( HCL_CNODE_CONS_CONCODE ( oprnd ) )
2021-01-15 09:12:28 +00:00
{
2021-01-17 17:45:39 +00:00
case HCL_CONCODE_XLIST :
2021-05-15 05:31:36 +00:00
if ( compile_cons_xlist_expression ( hcl , oprnd , 0 ) < = - 1 ) return - 1 ;
2021-01-17 17:45:39 +00:00
break ;
2021-01-27 16:11:56 +00:00
2021-01-15 09:12:28 +00:00
case HCL_CONCODE_ARRAY :
2021-01-19 14:07:42 +00:00
if ( compile_cons_array_expression ( hcl , oprnd ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
break ;
2021-01-27 16:11:56 +00:00
2021-01-15 09:12:28 +00:00
case HCL_CONCODE_BYTEARRAY :
2021-01-19 14:07:42 +00:00
if ( compile_cons_bytearray_expression ( hcl , oprnd ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
break ;
2021-01-27 16:11:56 +00:00
2021-01-15 09:12:28 +00:00
case HCL_CONCODE_DIC :
2021-01-19 14:07:42 +00:00
if ( compile_cons_dic_expression ( hcl , oprnd ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
break ;
2021-01-27 16:11:56 +00:00
2021-01-17 17:45:39 +00:00
case HCL_CONCODE_QLIST :
2021-01-24 15:45:28 +00:00
if ( compile_cons_qlist_expression ( hcl , oprnd ) < = - 1 ) return - 1 ;
break ;
2021-01-27 16:11:56 +00:00
2021-01-19 14:07:42 +00:00
case HCL_CONCODE_VLIST :
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARDCLBANNED , HCL_CNODE_GET_LOC ( oprnd ) , HCL_NULL , " variable declaration disallowed " ) ;
return - 1 ;
default :
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_INTERN , HCL_CNODE_GET_LOC ( oprnd ) , HCL_NULL , " internal error - unknown cons type %d " , HCL_CNODE_CONS_CONCODE ( oprnd ) ) ;
return - 1 ;
}
break ;
}
2021-01-25 15:23:24 +00:00
case HCL_CNODE_ELIST :
2021-01-19 14:07:42 +00:00
{
/* empty list */
2021-01-25 15:23:24 +00:00
switch ( HCL_CNODE_ELIST_CONCODE ( oprnd ) )
2021-01-19 14:07:42 +00:00
{
case HCL_CONCODE_XLIST :
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARDCLBANNED , HCL_CNODE_GET_LOC ( oprnd ) , HCL_NULL , " empty executable list " ) ;
return - 1 ;
case HCL_CONCODE_ARRAY :
2021-01-27 16:11:56 +00:00
if ( emit_single_param_instruction ( hcl , HCL_CODE_MAKE_ARRAY , 0 , HCL_CNODE_GET_LOC ( oprnd ) ) < = - 1 ) return - 1 ;
2021-01-19 14:07:42 +00:00
goto done ;
case HCL_CONCODE_BYTEARRAY :
2021-01-27 16:11:56 +00:00
if ( emit_single_param_instruction ( hcl , HCL_CODE_MAKE_BYTEARRAY , 0 , HCL_CNODE_GET_LOC ( oprnd ) ) < = - 1 ) return - 1 ;
2021-01-19 14:07:42 +00:00
goto done ;
case HCL_CONCODE_DIC :
2021-01-27 16:11:56 +00:00
if ( emit_single_param_instruction ( hcl , HCL_CODE_MAKE_DIC , 16 , HCL_CNODE_GET_LOC ( oprnd ) ) < = - 1 ) return - 1 ;
2021-01-19 14:07:42 +00:00
goto done ;
case HCL_CONCODE_QLIST :
2021-01-27 16:11:56 +00:00
if ( emit_byte_instruction ( hcl , HCL_CODE_PUSH_NIL , HCL_CNODE_GET_LOC ( oprnd ) ) < = - 1 ) return - 1 ;
2021-01-19 14:07:42 +00:00
goto done ;
2021-01-17 17:45:39 +00:00
case HCL_CONCODE_VLIST :
2021-05-09 15:32:54 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_VARDCLBANNED , HCL_CNODE_GET_LOC ( oprnd ) , HCL_NULL , " variable declaration disallowed " ) ;
2021-01-17 17:45:39 +00:00
return - 1 ;
2021-01-15 09:12:28 +00:00
default :
2021-01-19 14:07:42 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_INTERN , HCL_CNODE_GET_LOC ( oprnd ) , HCL_NULL , " internal error - unknown list type %d " , HCL_CNODE_CONS_CONCODE ( oprnd ) ) ;
2021-01-17 17:45:39 +00:00
return - 1 ;
2021-01-15 09:12:28 +00:00
}
2021-01-19 14:07:42 +00:00
break ;
2021-01-15 09:12:28 +00:00
}
2021-01-25 15:23:24 +00:00
case HCL_CNODE_SHELL :
/* a shell node is just a wrapper of an actual node */
oprnd = oprnd - > u . shell . obj ;
goto redo ;
2021-05-07 08:53:01 +00:00
case HCL_CNODE_ELLIPSIS :
2021-05-09 15:32:54 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_ELLIPSISBANNED , HCL_CNODE_GET_LOC ( oprnd ) , HCL_CNODE_GET_TOK ( oprnd ) , " ellipsis disallowed in this context " , HCL_CNODE_GET_TYPE ( oprnd ) ) ;
2021-05-07 08:53:01 +00:00
return - 1 ;
2021-05-09 15:32:54 +00:00
case HCL_CNODE_TRPCOLONS :
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_TRPCOLONSBANNED , HCL_CNODE_GET_LOC ( oprnd ) , HCL_CNODE_GET_TOK ( oprnd ) , " triple colons disallowed in this context " , HCL_CNODE_GET_TYPE ( oprnd ) ) ;
return - 1 ;
2021-05-07 08:53:01 +00:00
2021-01-19 14:07:42 +00:00
default :
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_INTERN , HCL_CNODE_GET_LOC ( oprnd ) , HCL_CNODE_GET_TOK ( oprnd ) , " internal error - unexpected object type %d " , HCL_CNODE_GET_TYPE ( oprnd ) ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-05-15 05:31:36 +00:00
/* the control reaches here in case a compile_xxxx() functionse.g. compile_cons_xlist_expression) is called.
* such a function removes the top cframe . so POP_CFRAME ( ) needs not be called here */
2021-01-15 09:12:28 +00:00
return 0 ;
literal :
2021-01-28 10:09:38 +00:00
if ( emit_push_literal ( hcl , lit , HCL_CNODE_GET_LOC ( oprnd ) ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
done :
POP_CFRAME ( hcl ) ;
return 0 ;
}
2021-05-15 05:31:36 +00:00
static int compile_object_r ( hcl_t * hcl )
{
hcl_cframe_t * cf ;
hcl_cnode_t * oprnd ;
hcl_oop_t lit ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_COMPILE_OBJECT_R ) ;
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
oprnd = cf - > operand ;
if ( ! HCL_CNODE_IS_CONS_CONCODED ( oprnd , HCL_CONCODE_XLIST ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BANNED , HCL_CNODE_GET_LOC ( oprnd ) , HCL_NULL , " non-function call disallowed " ) ;
return - 1 ;
}
return compile_cons_xlist_expression ( hcl , oprnd , cf - > u . obj_r . nrets ) ;
}
2021-01-15 09:12:28 +00:00
static int compile_object_list ( hcl_t * hcl )
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-19 14:07:42 +00:00
hcl_cnode_t * oprnd ;
2021-01-15 09:12:28 +00:00
int cop ;
cf = GET_TOP_CFRAME ( hcl ) ;
2021-02-18 15:48:44 +00:00
HCL_ASSERT ( hcl , cf - > opcode = = COP_COMPILE_ARGUMENT_LIST | |
cf - > opcode = = COP_COMPILE_OBJECT_LIST | |
cf - > opcode = = COP_COMPILE_OBJECT_LIST_TAIL | |
2021-01-15 09:12:28 +00:00
cf - > opcode = = COP_COMPILE_IF_OBJECT_LIST | |
cf - > opcode = = COP_COMPILE_IF_OBJECT_LIST_TAIL | |
2021-02-18 15:48:44 +00:00
cf - > opcode = = COP_COMPILE_TRY_OBJECT_LIST | |
cf - > opcode = = COP_COMPILE_TRY_OBJECT_LIST_TAIL ) ;
2021-01-15 09:12:28 +00:00
cop = cf - > opcode ;
2021-01-19 14:07:42 +00:00
oprnd = cf - > operand ;
2021-01-15 09:12:28 +00:00
2021-01-19 14:07:42 +00:00
if ( ! oprnd )
2021-01-15 09:12:28 +00:00
{
POP_CFRAME ( hcl ) ;
}
else
{
2021-01-19 14:07:42 +00:00
hcl_cnode_t * car , * cdr ;
2021-01-15 09:12:28 +00:00
2022-01-03 17:59:55 +00:00
#if 0
2021-01-15 09:12:28 +00:00
if ( cop ! = COP_COMPILE_ARGUMENT_LIST )
{
/* eliminate unnecessary non-function calls. keep the last one */
2021-01-19 14:07:42 +00:00
while ( HCL_CNODE_IS_CONS ( oprnd ) )
2021-01-15 09:12:28 +00:00
{
2021-01-19 14:07:42 +00:00
cdr = HCL_CNODE_CONS_CDR ( oprnd ) ;
if ( ! cdr ) break ; /* keep the last one */
2021-01-15 09:12:28 +00:00
2021-01-19 14:07:42 +00:00
if ( HCL_CNODE_IS_CONS ( cdr ) )
2021-01-15 09:12:28 +00:00
{
/* look ahead */
/* keep the last one before elif or else... */
2021-01-19 14:07:42 +00:00
car = HCL_CNODE_CONS_CAR ( cdr ) ;
if ( HCL_CNODE_IS_SYMBOL ( car ) & & HCL_CNODE_SYMBOL_SYNCODE ( car ) ) break ;
2021-01-15 09:12:28 +00:00
}
2021-01-19 14:07:42 +00:00
car = HCL_CNODE_CONS_CAR ( oprnd ) ;
2022-01-03 17:59:55 +00:00
/* this optimization is buggy for now... need to perfect the break condition here */
if ( HCL_CNODE_IS_CONS ( car ) | | ( HCL_CNODE_IS_SYMBOL ( car ) & & HCL_CNODE_SYMBOL_SYNCODE ( car ) ) | | HCL_CNODE_IS_ELLIPSIS ( car ) | | HCL_CNODE_IS_TRPCOLONS ( car ) ) break ;
2021-01-19 14:07:42 +00:00
oprnd = cdr ;
2021-01-15 09:12:28 +00:00
}
2021-01-19 14:07:42 +00:00
HCL_ASSERT ( hcl , oprnd ! = HCL_NULL ) ;
2021-01-15 09:12:28 +00:00
}
2022-01-03 17:59:55 +00:00
# endif
2021-01-19 14:07:42 +00:00
if ( ! HCL_CNODE_IS_CONS ( oprnd ) )
2021-01-15 09:12:28 +00:00
{
2021-01-19 14:07:42 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( oprnd ) , HCL_CNODE_GET_TOK ( oprnd ) , " redundant cdr in the object list " ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
2021-01-19 14:07:42 +00:00
car = HCL_CNODE_CONS_CAR ( oprnd ) ;
cdr = HCL_CNODE_CONS_CDR ( oprnd ) ;
2021-01-15 09:12:28 +00:00
if ( cop = = COP_COMPILE_IF_OBJECT_LIST | | cop = = COP_COMPILE_IF_OBJECT_LIST_TAIL )
{
2021-01-19 14:07:42 +00:00
if ( HCL_CNODE_IS_SYMBOL_SYNCODED ( car , HCL_SYNCODE_ELIF ) )
2021-01-15 09:12:28 +00:00
{
2021-02-22 09:20:45 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_ELIF , oprnd ) ;
2021-01-15 09:12:28 +00:00
goto done ;
}
2021-01-19 14:07:42 +00:00
else if ( HCL_CNODE_IS_SYMBOL_SYNCODED ( car , HCL_SYNCODE_ELSE ) )
2021-01-15 09:12:28 +00:00
{
2021-02-22 09:20:45 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_ELSE , oprnd ) ;
2021-01-15 09:12:28 +00:00
goto done ;
}
}
2021-02-18 15:48:44 +00:00
else if ( cop = = COP_COMPILE_TRY_OBJECT_LIST | | cop = = COP_COMPILE_TRY_OBJECT_LIST_TAIL )
{
if ( HCL_CNODE_IS_SYMBOL_SYNCODED ( car , HCL_SYNCODE_CATCH ) )
{
2021-02-22 09:20:45 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_CATCH , oprnd ) ;
2021-02-18 15:48:44 +00:00
goto done ;
}
}
2021-01-15 09:12:28 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT , car ) ;
2021-01-19 14:07:42 +00:00
if ( cdr )
2021-01-15 09:12:28 +00:00
{
/* there is a next statement to compile
*
* ( + 1 2 3 ) - argument list . 1 , 2 , 3 pushed must remain in
* the stack until the function ' + ' is called .
*
* ( lambda ( x y ) ( + x 10 ) ( + y 20 ) )
* - the result of ( + x 10 ) should be popped before ( + y 20 )
* is executed
*
* for the latter , inject POP_STACKTOP after each object evaluation
* except the last .
*/
int nextcop ;
nextcop = ( cop = = COP_COMPILE_OBJECT_LIST ) ? COP_COMPILE_OBJECT_LIST_TAIL :
2021-02-18 15:48:44 +00:00
( cop = = COP_COMPILE_IF_OBJECT_LIST ) ? COP_COMPILE_IF_OBJECT_LIST_TAIL :
( cop = = COP_COMPILE_TRY_OBJECT_LIST ) ? COP_COMPILE_TRY_OBJECT_LIST_TAIL : cop ;
2021-01-15 09:12:28 +00:00
PUSH_SUBCFRAME ( hcl , nextcop , cdr ) ;
}
if ( cop = = COP_COMPILE_OBJECT_LIST_TAIL | |
2021-02-18 15:48:44 +00:00
cop = = COP_COMPILE_IF_OBJECT_LIST_TAIL | |
cop = = COP_COMPILE_TRY_OBJECT_LIST_TAIL )
2021-01-15 09:12:28 +00:00
{
/* emit POP_STACKTOP before evaluating the second objects
2021-06-01 09:50:35 +00:00
* and onwards . this goes above COP_COMPILE_OBJECT . */
2021-05-15 05:31:36 +00:00
/* TODO: if the previous operators is known to divert execution flow, it may skip this.
* for instance , some ' RETURN " or 'JUMP' operators */
2021-01-29 08:13:18 +00:00
PUSH_CFRAME ( hcl , COP_EMIT_POP_STACKTOP , oprnd ) ;
2021-02-22 09:20:45 +00:00
}
2021-02-18 15:48:44 +00:00
}
2021-02-22 09:20:45 +00:00
done :
return 0 ;
2021-02-18 15:48:44 +00:00
}
2021-02-22 09:20:45 +00:00
static int compile_array_list ( hcl_t * hcl )
2021-02-18 15:48:44 +00:00
{
hcl_cframe_t * cf ;
2021-02-22 09:20:45 +00:00
hcl_cnode_t * oprnd ;
2021-02-18 15:48:44 +00:00
cf = GET_TOP_CFRAME ( hcl ) ;
2021-02-22 09:20:45 +00:00
HCL_ASSERT ( hcl , cf - > opcode = = COP_COMPILE_ARRAY_LIST ) ;
2021-02-18 15:48:44 +00:00
2021-02-22 09:20:45 +00:00
oprnd = cf - > operand ;
2021-02-18 15:48:44 +00:00
2021-02-22 09:20:45 +00:00
if ( ! oprnd )
2021-01-15 09:12:28 +00:00
{
2021-02-22 09:20:45 +00:00
POP_CFRAME ( hcl ) ;
2021-01-22 14:43:47 +00:00
}
2021-02-22 09:20:45 +00:00
else
2021-01-22 14:43:47 +00:00
{
2021-02-22 09:20:45 +00:00
hcl_cnode_t * car , * cdr ;
hcl_ooi_t oldidx ;
if ( ! HCL_CNODE_IS_CONS ( oprnd ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( oprnd ) , HCL_CNODE_GET_TOK ( oprnd ) , " redundant cdr in the array list " ) ;
return - 1 ;
}
car = HCL_CNODE_CONS_CAR ( oprnd ) ;
cdr = HCL_CNODE_CONS_CDR ( oprnd ) ;
oldidx = cf - > u . array_list . index ;
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT , car ) ;
if ( cdr )
{
PUSH_SUBCFRAME ( hcl , COP_COMPILE_ARRAY_LIST , cdr ) ;
cf = GET_SUBCFRAME ( hcl ) ;
cf - > u . array_list . index = oldidx + 1 ;
}
PUSH_SUBCFRAME ( hcl , COP_EMIT_POP_INTO_ARRAY , car ) ;
cf = GET_SUBCFRAME ( hcl ) ;
cf - > u . array_list . index = oldidx ;
2021-01-15 09:12:28 +00:00
}
2021-02-18 15:48:44 +00:00
return 0 ;
2021-01-15 09:12:28 +00:00
}
2021-02-22 09:20:45 +00:00
static int compile_bytearray_list ( hcl_t * hcl )
2021-01-15 09:12:28 +00:00
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-02-22 09:20:45 +00:00
hcl_cnode_t * oprnd ;
2021-01-15 09:12:28 +00:00
cf = GET_TOP_CFRAME ( hcl ) ;
2021-02-22 09:20:45 +00:00
HCL_ASSERT ( hcl , cf - > opcode = = COP_COMPILE_BYTEARRAY_LIST ) ;
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
oprnd = cf - > operand ;
if ( ! oprnd )
2021-01-15 09:12:28 +00:00
{
2021-02-22 09:20:45 +00:00
POP_CFRAME ( hcl ) ;
2021-01-15 09:12:28 +00:00
}
2021-02-22 09:20:45 +00:00
else
{
hcl_cnode_t * car , * cdr ;
hcl_ooi_t oldidx ;
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
if ( ! HCL_CNODE_IS_CONS ( oprnd ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( oprnd ) , HCL_CNODE_GET_TOK ( oprnd ) , " redundant cdr in the byte-array list " ) ;
return - 1 ;
}
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
car = HCL_CNODE_CONS_CAR ( oprnd ) ;
cdr = HCL_CNODE_CONS_CDR ( oprnd ) ;
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
oldidx = cf - > u . bytearray_list . index ;
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT , car ) ;
if ( cdr )
{
PUSH_SUBCFRAME ( hcl , COP_COMPILE_BYTEARRAY_LIST , cdr ) ;
cf = GET_SUBCFRAME ( hcl ) ;
cf - > u . bytearray_list . index = oldidx + 1 ;
}
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
PUSH_SUBCFRAME ( hcl , COP_EMIT_POP_INTO_BYTEARRAY , car ) ;
cf = GET_SUBCFRAME ( hcl ) ;
cf - > u . bytearray_list . index = oldidx ;
}
2021-01-15 09:12:28 +00:00
return 0 ;
}
2021-02-22 09:20:45 +00:00
static int compile_dic_list ( hcl_t * hcl )
2021-01-15 09:12:28 +00:00
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-02-22 09:20:45 +00:00
hcl_cnode_t * oprnd ;
2021-01-15 09:12:28 +00:00
cf = GET_TOP_CFRAME ( hcl ) ;
2021-02-22 09:20:45 +00:00
HCL_ASSERT ( hcl , cf - > opcode = = COP_COMPILE_DIC_LIST ) ;
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
oprnd = cf - > operand ;
2021-01-28 10:09:38 +00:00
2021-02-22 09:20:45 +00:00
if ( ! oprnd )
2021-01-15 09:12:28 +00:00
{
2021-02-22 09:20:45 +00:00
POP_CFRAME ( hcl ) ;
2021-01-15 09:12:28 +00:00
}
2021-02-22 09:20:45 +00:00
else
{
hcl_cnode_t * car , * cdr , * cadr , * cddr ;
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
if ( ! HCL_CNODE_IS_CONS ( oprnd ) )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_DOTBANNED , HCL_CNODE_GET_LOC ( oprnd ) , HCL_CNODE_GET_TOK ( oprnd ) , " redundant cdr in the dictionary list " ) ;
return - 1 ;
}
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
car = HCL_CNODE_CONS_CAR ( oprnd ) ;
cdr = HCL_CNODE_CONS_CDR ( oprnd ) ;
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT , car ) ;
if ( ! cdr )
{
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_UNBALKV , HCL_CNODE_GET_LOC ( car ) , HCL_NULL , " no value for key %.*js " , HCL_CNODE_GET_TOKLEN ( car ) , HCL_CNODE_GET_TOKPTR ( car ) ) ;
return - 1 ;
}
cadr = HCL_CNODE_CONS_CAR ( cdr ) ;
cddr = HCL_CNODE_CONS_CDR ( cdr ) ;
2021-01-28 10:09:38 +00:00
2021-02-22 09:20:45 +00:00
if ( cddr )
{
PUSH_SUBCFRAME ( hcl , COP_COMPILE_DIC_LIST , cddr ) ;
}
2021-01-28 10:09:38 +00:00
2021-02-22 09:20:45 +00:00
PUSH_SUBCFRAME ( hcl , COP_EMIT_POP_INTO_DIC , cdr ) ;
PUSH_SUBCFRAME ( hcl , COP_COMPILE_OBJECT , cadr ) ;
}
2021-01-15 09:12:28 +00:00
return 0 ;
}
2021-02-22 09:20:45 +00:00
static int compile_qlist ( hcl_t * hcl )
2021-01-15 09:12:28 +00:00
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-02-22 09:20:45 +00:00
hcl_cnode_t * oprnd ;
2021-01-15 09:12:28 +00:00
cf = GET_TOP_CFRAME ( hcl ) ;
2021-02-22 09:20:45 +00:00
HCL_ASSERT ( hcl , cf - > opcode = = COP_COMPILE_QLIST ) ;
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
oprnd = cf - > operand ;
2021-01-15 09:12:28 +00:00
2021-02-22 09:20:45 +00:00
if ( ! oprnd )
{
POP_CFRAME ( hcl ) ;
}
else
{
if ( ! HCL_CNODE_IS_CONS ( oprnd ) )
{
/* the last element after . */
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT , oprnd ) ;
PUSH_SUBCFRAME ( hcl , COP_EMIT_POP_INTO_CONS_CDR , oprnd ) ;
}
else
{
hcl_cnode_t * car , * cdr ;
car = HCL_CNODE_CONS_CAR ( oprnd ) ;
cdr = HCL_CNODE_CONS_CDR ( oprnd ) ;
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT , car ) ; /* 1 */
if ( cdr )
{
PUSH_SUBCFRAME ( hcl , COP_COMPILE_QLIST , cdr ) ; /* 3 */
PUSH_SUBCFRAME ( hcl , COP_EMIT_POP_INTO_CONS , car ) ; /* 2 */
}
else
{
/* the last element */
PUSH_SUBCFRAME ( hcl , COP_EMIT_POP_INTO_CONS_END , car ) ; /* 2 */
}
}
}
2021-01-15 09:12:28 +00:00
return 0 ;
}
/* ========================================================================= */
static HCL_INLINE int post_if_cond ( hcl_t * hcl )
{
2021-02-18 15:48:44 +00:00
hcl_cframe_t * cf , * cf2 ;
2021-01-15 09:12:28 +00:00
hcl_ooi_t jump_inst_pos ;
hcl_ooi_t body_pos ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_POST_IF_COND ) ;
2021-02-18 15:48:44 +00:00
/* cf->operand can be HCL_NULL in these expressions
* ( if true )
* ( if false )
* ( if true 20 elif false )
*/
/*HCL_ASSERT (hcl, cf->operand != HCL_NULL);*/
2021-01-15 09:12:28 +00:00
HCL_ASSERT ( hcl , hcl - > code . bc . len < HCL_SMOOI_MAX ) ;
jump_inst_pos = hcl - > code . bc . len ;
2021-02-18 15:48:44 +00:00
if ( emit_single_param_instruction ( hcl , HCL_CODE_JUMP_FORWARD_IF_FALSE , MAX_CODE_JUMP , & cf - > u . post_if . start_loc ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
/* to drop the result of the conditional when it is true */
2021-02-18 15:48:44 +00:00
if ( emit_byte_instruction ( hcl , HCL_CODE_POP_STACKTOP , & cf - > u . post_if . start_loc ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
HCL_ASSERT ( hcl , hcl - > code . bc . len < HCL_SMOOI_MAX ) ;
body_pos = hcl - > code . bc . len ;
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_IF_OBJECT_LIST , cf - > operand ) ; /* 1 */
2021-01-28 08:17:50 +00:00
PUSH_SUBCFRAME ( hcl , COP_POST_IF_BODY , cf - > operand ) ; /* 2 */
2021-02-18 15:48:44 +00:00
cf2 = GET_SUBCFRAME ( hcl ) ;
cf2 - > u . post_if . body_pos = body_pos ;
cf2 - > u . post_if . jump_inst_pos = jump_inst_pos ;
cf2 - > u . post_if . start_loc = cf - > u . post_if . start_loc ;
2021-01-15 09:12:28 +00:00
return 0 ;
}
static HCL_INLINE int post_if_body ( hcl_t * hcl )
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
hcl_ooi_t jip ;
hcl_oow_t jump_offset ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_POST_IF_BODY ) ;
2021-02-18 15:48:44 +00:00
/* cf->operand can be HCL_NULL in these expressions
* ( if true )
* ( if false )
* ( if true 20 elif false )
*/
/*HCL_ASSERT (hcl, cf->operand != HCL_NULL);*/
2021-01-15 09:12:28 +00:00
2021-01-28 08:17:50 +00:00
jip = cf - > u . post_if . jump_inst_pos ;
2021-01-15 09:12:28 +00:00
if ( hcl - > code . bc . len < = cf - > u . post_if . body_pos )
{
/* if body is empty */
2021-02-18 15:48:44 +00:00
if ( emit_byte_instruction ( hcl , HCL_CODE_PUSH_NIL , & cf - > u . post_if . start_loc ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
}
/* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD_IF_FALSE instruction */
2021-01-29 12:39:31 +00:00
jump_offset = hcl - > code . bc . len - jip - ( HCL_CODE_LONG_PARAM_SIZE + 1 ) ;
2021-01-15 09:12:28 +00:00
if ( jump_offset > MAX_CODE_JUMP * 2 )
{
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_IFFLOOD , & cf - > u . post_if . start_loc , HCL_NULL , " code too big - size %zu " , jump_offset ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
patch_long_jump ( hcl , jip , jump_offset ) ;
POP_CFRAME ( hcl ) ;
return 0 ;
}
/* ========================================================================= */
static HCL_INLINE int post_while_cond ( hcl_t * hcl )
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
hcl_ooi_t jump_inst_pos ;
hcl_ooi_t cond_pos , body_pos ;
2021-01-22 14:43:47 +00:00
hcl_ioloc_t start_loc ;
2021-01-15 09:12:28 +00:00
int jump_inst , next_cop ;
2021-01-28 10:09:38 +00:00
hcl_cnode_t * cond , * body ;
2021-01-15 09:12:28 +00:00
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_POST_UNTIL_COND | | cf - > opcode = = COP_POST_WHILE_COND ) ;
2021-01-28 10:09:38 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
/* the caller must pass the cons cell branching to the conditinal and the body
* if the body cell is given , things gets complicated because the body part can be HCL_NULL .
* for instance , the body part is empty in ( while ( < i 1 ) ) */
cond = HCL_CNODE_CONS_CAR ( cf - > operand ) ;
body = HCL_CNODE_CONS_CDR ( cf - > operand ) ;
2021-01-15 09:12:28 +00:00
cond_pos = cf - > u . post_while . cond_pos ;
2021-01-22 14:43:47 +00:00
start_loc = cf - > u . post_while . start_loc ;
2021-01-15 09:12:28 +00:00
HCL_ASSERT ( hcl , hcl - > code . bc . len < HCL_SMOOI_MAX ) ;
jump_inst_pos = hcl - > code . bc . len ;
if ( cf - > opcode = = COP_POST_UNTIL_COND )
{
jump_inst = HCL_CODE_JUMP_FORWARD_IF_TRUE ;
next_cop = COP_POST_UNTIL_BODY ;
}
else
{
jump_inst = HCL_CODE_JUMP_FORWARD_IF_FALSE ;
next_cop = COP_POST_WHILE_BODY ;
}
2021-01-28 10:09:38 +00:00
if ( emit_single_param_instruction ( hcl , jump_inst , MAX_CODE_JUMP , HCL_CNODE_GET_LOC ( cond ) ) < = - 1 ) return - 1 ;
if ( emit_byte_instruction ( hcl , HCL_CODE_POP_STACKTOP , HCL_CNODE_GET_LOC ( cond ) ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
HCL_ASSERT ( hcl , hcl - > code . bc . len < HCL_SMOOI_MAX ) ;
body_pos = hcl - > code . bc . len ;
2021-01-28 10:09:38 +00:00
if ( body )
{
SWITCH_TOP_CFRAME ( hcl , COP_COMPILE_OBJECT_LIST , body ) ; /* 1 */
PUSH_SUBCFRAME ( hcl , next_cop , cf - > operand ) ; /* 2 */
cf = GET_SUBCFRAME ( hcl ) ;
}
else
{
/* the body is empty */
SWITCH_TOP_CFRAME ( hcl , next_cop , cond ) ; /* 2 */
cf = GET_TOP_CFRAME ( hcl ) ;
}
2021-01-15 09:12:28 +00:00
cf - > u . post_while . cond_pos = cond_pos ;
cf - > u . post_while . body_pos = body_pos ;
2021-01-28 10:09:38 +00:00
cf - > u . post_while . jump_inst_pos = jump_inst_pos ;
2021-01-22 14:43:47 +00:00
cf - > u . post_while . start_loc = start_loc ;
2021-01-28 10:09:38 +00:00
2021-01-15 09:12:28 +00:00
return 0 ;
}
static HCL_INLINE int post_while_body ( hcl_t * hcl )
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
hcl_ooi_t jip ;
hcl_ooi_t jump_offset ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_POST_UNTIL_BODY | | cf - > opcode = = COP_POST_WHILE_BODY ) ;
2021-01-28 10:09:38 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-01-15 09:12:28 +00:00
HCL_ASSERT ( hcl , hcl - > code . bc . len > = cf - > u . post_while . cond_pos ) ;
if ( hcl - > code . bc . len > cf - > u . post_while . body_pos )
{
/* some code exist after POP_STACKTOP after JUMP_FORWARD_IF_TRUE/FALSE.
* ( until # f ) = >
* push_false
* jump_forward_if_true XXXX
* pop_stacktop < - - 1 ) emitted in post_while_cond ( ) ;
* jump_backward YYYY < - - 2 ) emitted below
* pop_stacktop
* this check prevents another pop_stacktop between 1 ) and 2 )
*/
2021-01-28 10:09:38 +00:00
if ( emit_byte_instruction ( hcl , HCL_CODE_POP_STACKTOP , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
}
HCL_ASSERT ( hcl , hcl - > code . bc . len < HCL_SMOOI_MAX ) ;
jump_offset = hcl - > code . bc . len - cf - > u . post_while . cond_pos + 1 ;
2021-01-29 12:39:31 +00:00
if ( jump_offset > 3 ) jump_offset + = HCL_CODE_LONG_PARAM_SIZE ;
2021-01-28 10:09:38 +00:00
if ( emit_single_param_instruction ( hcl , HCL_CODE_JUMP_BACKWARD_0 , jump_offset , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
2021-01-28 10:09:38 +00:00
jip = cf - > u . post_while . jump_inst_pos ;
2021-01-15 09:12:28 +00:00
/* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD_IF_FALSE/JUMP_FORWARD_IF_TRUE instruction */
2021-01-29 12:39:31 +00:00
jump_offset = hcl - > code . bc . len - jip - ( HCL_CODE_LONG_PARAM_SIZE + 1 ) ;
2021-01-15 09:12:28 +00:00
if ( jump_offset > MAX_CODE_JUMP * 2 )
{
2021-01-22 14:43:47 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BLKFLOOD , & cf - > u . post_while . start_loc , HCL_NULL , " code too big - size %zu " , jump_offset ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
patch_long_jump ( hcl , jip , jump_offset ) ;
POP_CFRAME ( hcl ) ;
2021-04-09 08:22:40 +00:00
HCL_ASSERT ( hcl , hcl - > c - > cblk . info [ hcl - > c - > cblk . depth ] . _type = = HCL_CBLK_TYPE_LOOP ) ;
pop_cblk ( hcl ) ;
2021-01-15 09:12:28 +00:00
return 0 ;
}
/* ========================================================================= */
static HCL_INLINE int emit_call ( hcl_t * hcl )
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
int n ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_EMIT_CALL ) ;
2021-01-28 08:17:50 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-01-15 09:12:28 +00:00
2021-05-15 05:31:36 +00:00
if ( cf - > u . call . nrets > 0 )
{
n = emit_double_param_instruction ( hcl , HCL_CODE_CALL_R , cf - > u . call . index , cf - > u . call . nrets , HCL_CNODE_GET_LOC ( cf - > operand ) ) ;
}
else
{
n = emit_single_param_instruction ( hcl , HCL_CODE_CALL_0 , cf - > u . call . index , HCL_CNODE_GET_LOC ( cf - > operand ) ) ;
}
2021-01-15 09:12:28 +00:00
POP_CFRAME ( hcl ) ;
return n ;
}
2021-02-01 13:20:46 +00:00
/* ========================================================================= */
2021-01-15 09:12:28 +00:00
static HCL_INLINE int emit_make_array ( hcl_t * hcl )
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
int n ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_EMIT_MAKE_ARRAY ) ;
2021-01-28 07:25:05 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-01-15 09:12:28 +00:00
2021-01-28 07:25:05 +00:00
n = emit_single_param_instruction ( hcl , HCL_CODE_MAKE_ARRAY , cf - > u . array_list . index , HCL_CNODE_GET_LOC ( cf - > operand ) ) ;
2021-01-15 09:12:28 +00:00
POP_CFRAME ( hcl ) ;
return n ;
}
static HCL_INLINE int emit_make_bytearray ( hcl_t * hcl )
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
int n ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_EMIT_MAKE_BYTEARRAY ) ;
2021-01-28 07:25:05 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-01-15 09:12:28 +00:00
2021-01-28 07:25:05 +00:00
n = emit_single_param_instruction ( hcl , HCL_CODE_MAKE_BYTEARRAY , cf - > u . bytearray_list . index , HCL_CNODE_GET_LOC ( cf - > operand ) ) ;
2021-01-15 09:12:28 +00:00
POP_CFRAME ( hcl ) ;
return n ;
}
static HCL_INLINE int emit_make_dic ( hcl_t * hcl )
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
int n ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_EMIT_MAKE_DIC ) ;
2021-01-28 07:25:05 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-01-15 09:12:28 +00:00
2021-01-28 07:25:05 +00:00
n = emit_single_param_instruction ( hcl , HCL_CODE_MAKE_DIC , cf - > u . dic_list . index , HCL_CNODE_GET_LOC ( cf - > operand ) ) ;
2021-01-15 09:12:28 +00:00
POP_CFRAME ( hcl ) ;
return n ;
}
2021-01-24 15:45:28 +00:00
static HCL_INLINE int emit_make_cons ( hcl_t * hcl )
2021-01-15 09:12:28 +00:00
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
int n ;
cf = GET_TOP_CFRAME ( hcl ) ;
2021-01-24 15:45:28 +00:00
HCL_ASSERT ( hcl , cf - > opcode = = COP_EMIT_MAKE_CONS ) ;
2021-01-28 07:25:05 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-01-15 09:12:28 +00:00
2021-01-28 07:25:05 +00:00
n = emit_byte_instruction ( hcl , HCL_CODE_MAKE_CONS , HCL_CNODE_GET_LOC ( cf - > operand ) ) ;
2021-01-15 09:12:28 +00:00
POP_CFRAME ( hcl ) ;
return n ;
}
static HCL_INLINE int emit_pop_into_array ( hcl_t * hcl )
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
int n ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_EMIT_POP_INTO_ARRAY ) ;
2021-01-27 16:01:36 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-01-15 09:12:28 +00:00
2021-01-27 16:11:56 +00:00
n = emit_single_param_instruction ( hcl , HCL_CODE_POP_INTO_ARRAY , cf - > u . array_list . index , HCL_CNODE_GET_LOC ( cf - > operand ) ) ;
2021-01-15 09:12:28 +00:00
POP_CFRAME ( hcl ) ;
return n ;
}
static HCL_INLINE int emit_pop_into_bytearray ( hcl_t * hcl )
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
int n ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_EMIT_POP_INTO_BYTEARRAY ) ;
2021-01-27 16:01:36 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-01-15 09:12:28 +00:00
2021-01-27 16:11:56 +00:00
n = emit_single_param_instruction ( hcl , HCL_CODE_POP_INTO_BYTEARRAY , cf - > u . bytearray_list . index , HCL_CNODE_GET_LOC ( cf - > operand ) ) ;
2021-01-15 09:12:28 +00:00
POP_CFRAME ( hcl ) ;
return n ;
}
static HCL_INLINE int emit_pop_into_dic ( hcl_t * hcl )
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
int n ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_EMIT_POP_INTO_DIC ) ;
2021-01-27 16:01:36 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-01-15 09:12:28 +00:00
2021-01-27 16:01:36 +00:00
n = emit_byte_instruction ( hcl , HCL_CODE_POP_INTO_DIC , HCL_CNODE_GET_LOC ( cf - > operand ) ) ;
2021-01-15 09:12:28 +00:00
POP_CFRAME ( hcl ) ;
return n ;
}
2021-01-24 15:45:28 +00:00
static HCL_INLINE int emit_pop_into_cons ( hcl_t * hcl , int cmd )
2021-01-15 09:12:28 +00:00
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
int n ;
cf = GET_TOP_CFRAME ( hcl ) ;
2021-01-24 15:45:28 +00:00
HCL_ASSERT ( hcl , cf - > opcode = = COP_EMIT_POP_INTO_CONS | |
cf - > opcode = = COP_EMIT_POP_INTO_CONS_END | |
cf - > opcode = = COP_EMIT_POP_INTO_CONS_CDR ) ;
2021-01-27 08:47:08 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-01-15 09:12:28 +00:00
2021-01-27 08:47:08 +00:00
n = emit_byte_instruction ( hcl , cmd , HCL_CNODE_GET_LOC ( cf - > operand ) ) ;
2021-01-15 09:12:28 +00:00
POP_CFRAME ( hcl ) ;
return n ;
}
2021-02-01 13:20:46 +00:00
/* ========================================================================= */
2021-01-15 09:12:28 +00:00
static HCL_INLINE int emit_lambda ( hcl_t * hcl )
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
hcl_oow_t block_code_size , lfsize ;
hcl_ooi_t jip ;
2021-05-13 14:43:40 +00:00
hcl_fnblk_info_t * fbi ;
2021-01-15 09:12:28 +00:00
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_EMIT_LAMBDA ) ;
2021-01-27 08:47:08 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-01-15 09:12:28 +00:00
2021-05-13 14:43:40 +00:00
fbi = & hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] ;
2021-01-27 08:47:08 +00:00
jip = cf - > u . lambda . jump_inst_pos ;
2021-01-15 09:12:28 +00:00
if ( hcl - > option . trait & HCL_TRAIT_INTERACTIVE )
2021-04-09 01:23:08 +00:00
lfsize = hcl - > code . lit . len - hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] . lfbase ;
2021-01-15 09:12:28 +00:00
/* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD instruction */
2021-01-29 12:39:31 +00:00
block_code_size = hcl - > code . bc . len - jip - ( HCL_CODE_LONG_PARAM_SIZE + 1 ) ;
2021-01-15 09:12:28 +00:00
2021-05-13 14:43:40 +00:00
if ( fbi - > tmpr_nrvars > 0 )
{
/* this function block defines one or more return variables */
if ( block_code_size > 0 )
{
if ( emit_byte_instruction ( hcl , HCL_CODE_POP_STACKTOP , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
block_code_size + + ;
}
if ( emit_byte_instruction ( hcl , HCL_CODE_PUSH_RETURN_R , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
block_code_size + + ;
}
2021-05-13 14:43:40 +00:00
else
{
if ( block_code_size = = 0 )
{
/* no body in lambda - (lambda (a b c)) */
/* TODO: is this correct??? */
if ( emit_byte_instruction ( hcl , HCL_CODE_PUSH_NIL , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
block_code_size + + ;
}
2021-01-15 09:12:28 +00:00
2021-05-13 14:43:40 +00:00
if ( emit_byte_instruction ( hcl , HCL_CODE_RETURN_FROM_BLOCK , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
block_code_size + + ;
}
2021-01-15 09:12:28 +00:00
if ( block_code_size > MAX_CODE_JUMP * 2 )
{
2021-01-27 08:47:08 +00:00
hcl_setsynerrbfmt ( hcl , HCL_SYNERR_BLKFLOOD , HCL_CNODE_GET_LOC ( cf - > operand ) , HCL_NULL , " code too big - size %zu " , block_code_size ) ;
2021-01-15 09:12:28 +00:00
return - 1 ;
}
patch_long_jump ( hcl , jip , block_code_size ) ;
if ( hcl - > option . trait & HCL_TRAIT_INTERACTIVE )
patch_long_param ( hcl , cf - > u . lambda . lfsize_pos , lfsize ) ;
POP_CFRAME ( hcl ) ;
return 0 ;
}
2021-02-01 13:20:46 +00:00
static HCL_INLINE int post_lambda ( hcl_t * hcl )
{
hcl_cframe_t * cf ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_POST_LAMBDA ) ;
2021-04-09 01:23:08 +00:00
/*hcl->c->fnblk.depth--;
hcl - > c - > tv . s . len = hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] . tmprlen ;
hcl - > c - > tv . wcount = hcl - > c - > fnblk . info [ hcl - > c - > fnblk . depth ] . tmprcnt ; */
pop_fnblk ( hcl ) ;
2021-02-01 13:20:46 +00:00
if ( cf - > operand )
{
/* (defun x() ; this x refers to a variable in the outer scope.
* | t1 t2 x |
* ( set x 10 ) ; this x refers to the local variable .
* )
*
2021-02-01 13:26:48 +00:00
* the block has been exited ( blk . depth - - ) before finding ' x ' in the outer scope .
2021-02-01 13:20:46 +00:00
*/
hcl_cnode_t * defun_name = cf - > operand ;
hcl_oow_t index ;
2021-11-23 14:42:20 +00:00
hcl_var_info_t vi ;
2021-02-01 13:20:46 +00:00
2021-11-23 02:37:58 +00:00
if ( find_variable_backward ( hcl , HCL_CNODE_GET_TOK ( defun_name ) , & vi ) < = - 1 )
2021-02-01 13:20:46 +00:00
{
SWITCH_TOP_CFRAME ( hcl , COP_EMIT_SET , defun_name ) ;
2021-02-01 13:26:48 +00:00
cf = GET_TOP_CFRAME ( hcl ) ;
2021-11-23 14:42:20 +00:00
cf - > u . set . vi . type = VAR_NAMED ;
2021-02-01 13:20:46 +00:00
}
else
{
HCL_ASSERT ( hcl , index < = HCL_SMOOI_MAX ) ;
SWITCH_TOP_CFRAME ( hcl , COP_EMIT_SET , defun_name ) ;
2021-02-01 13:26:48 +00:00
cf = GET_TOP_CFRAME ( hcl ) ;
2021-11-23 14:42:20 +00:00
cf - > u . set . vi = vi ;
2021-02-01 13:20:46 +00:00
}
2021-11-23 15:52:01 +00:00
cf - > u . set . mode = VAR_ACCESS_STORE ;
2021-02-01 13:20:46 +00:00
}
else
{
POP_CFRAME ( hcl ) ;
}
return 0 ;
}
/* ========================================================================= */
2021-01-15 09:12:28 +00:00
static HCL_INLINE int emit_pop_stacktop ( hcl_t * hcl )
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
int n ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_EMIT_POP_STACKTOP ) ;
2021-01-29 08:13:18 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-01-15 09:12:28 +00:00
2021-01-29 08:13:18 +00:00
n = emit_byte_instruction ( hcl , HCL_CODE_POP_STACKTOP , HCL_CNODE_GET_LOC ( cf - > operand ) ) ;
2021-01-15 09:12:28 +00:00
POP_CFRAME ( hcl ) ;
return n ;
}
static HCL_INLINE int emit_return ( hcl_t * hcl )
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
int n ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_EMIT_RETURN ) ;
2021-01-27 08:47:08 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-01-15 09:12:28 +00:00
2021-01-27 08:47:08 +00:00
n = emit_byte_instruction ( hcl , ( cf - > u . _return . from_home ? HCL_CODE_RETURN_STACKTOP : HCL_CODE_RETURN_FROM_BLOCK ) , HCL_CNODE_GET_LOC ( cf - > operand ) ) ;
2021-01-15 09:12:28 +00:00
POP_CFRAME ( hcl ) ;
return n ;
}
static HCL_INLINE int emit_set ( hcl_t * hcl )
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_EMIT_SET ) ;
2021-11-23 15:52:01 +00:00
HCL_ASSERT ( hcl , cf - > u . set . mode = = VAR_ACCESS_POP | | cf - > u . set . mode = = VAR_ACCESS_STORE ) ;
2021-01-15 09:12:28 +00:00
2021-11-23 14:42:20 +00:00
if ( cf - > u . set . vi . type = = VAR_NAMED )
2021-01-15 09:12:28 +00:00
{
hcl_oow_t index ;
2021-01-21 14:59:01 +00:00
hcl_oop_t cons , sym ;
2021-01-15 09:12:28 +00:00
2021-01-19 14:07:42 +00:00
HCL_ASSERT ( hcl , HCL_CNODE_IS_SYMBOL ( cf - > operand ) ) ;
2021-01-15 09:12:28 +00:00
2021-01-21 14:59:01 +00:00
sym = hcl_makesymbol ( hcl , HCL_CNODE_GET_TOKPTR ( cf - > operand ) , HCL_CNODE_GET_TOKLEN ( cf - > operand ) ) ;
if ( HCL_UNLIKELY ( ! sym ) ) return - 1 ;
cons = ( hcl_oop_t ) hcl_getatsysdic ( hcl , sym ) ;
2021-01-15 09:12:28 +00:00
if ( ! cons )
{
2021-01-21 14:59:01 +00:00
cons = ( hcl_oop_t ) hcl_putatsysdic ( hcl , sym , hcl - > _nil ) ;
2021-01-28 08:17:50 +00:00
if ( HCL_UNLIKELY ( ! cons ) ) return - 1 ;
2021-01-15 09:12:28 +00:00
}
2021-11-23 15:52:01 +00:00
if ( add_literal ( hcl , cons , & index ) < = - 1 ) return - 1 ;
if ( emit_single_param_instruction ( hcl , ( cf - > u . set . mode = = VAR_ACCESS_POP ? HCL_CODE_POP_INTO_OBJECT_0 : HCL_CODE_STORE_INTO_OBJECT_0 ) , index , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
}
else
{
2021-01-28 08:17:50 +00:00
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
2021-11-23 15:52:01 +00:00
if ( emit_variable_access ( hcl , cf - > u . set . mode , & cf - > u . set . vi , HCL_CNODE_GET_LOC ( cf - > operand ) ) < = - 1 ) return - 1 ;
2021-01-15 09:12:28 +00:00
}
POP_CFRAME ( hcl ) ;
return 0 ;
}
2021-02-28 17:00:28 +00:00
static HCL_INLINE int emit_throw ( hcl_t * hcl )
{
hcl_cframe_t * cf ;
int n ;
cf = GET_TOP_CFRAME ( hcl ) ;
HCL_ASSERT ( hcl , cf - > opcode = = COP_EMIT_THROW ) ;
HCL_ASSERT ( hcl , cf - > operand ! = HCL_NULL ) ;
n = emit_byte_instruction ( hcl , HCL_CODE_THROW , HCL_CNODE_GET_LOC ( cf - > operand ) ) ;
POP_CFRAME ( hcl ) ;
return n ;
}
2021-01-15 09:12:28 +00:00
/* ========================================================================= */
2021-04-24 13:50:51 +00:00
int hcl_compile ( hcl_t * hcl , hcl_cnode_t * obj , int flags )
2021-01-15 09:12:28 +00:00
{
hcl_oow_t saved_bc_len , saved_lit_len ;
hcl_bitmask_t log_default_type_mask ;
2021-04-23 07:17:40 +00:00
hcl_fnblk_info_t top_fnblk_saved ;
2021-01-15 09:12:28 +00:00
HCL_ASSERT ( hcl , GET_TOP_CFRAME_INDEX ( hcl ) < 0 ) ;
2021-04-24 13:50:51 +00:00
if ( flags & HCL_COMPILE_CLEAR_CODE )
{
hcl - > code . bc . len = 0 ;
hcl - > code . lit . len = 0 ;
}
2021-01-15 09:12:28 +00:00
saved_bc_len = hcl - > code . bc . len ;
saved_lit_len = hcl - > code . lit . len ;
log_default_type_mask = hcl - > log . default_type_mask ;
hcl - > log . default_type_mask | = HCL_LOG_COMPILER ;
/*
* In the non - INTERACTIVE mode , the literal frame base doesn ' t matter .
* Only the initial function object contains the literal frame .
* No other function objects are created . All lambda defintions are
* translated to base context objects instead .
*
* In the INTERACTIVE mode , the literal frame base plays a key role .
2021-01-26 10:10:18 +00:00
* hcl_compile ( ) is called for the top - level expression and the literal
2021-01-15 09:12:28 +00:00
* frame base can be 0. The means it is ok for a top - level code to
* reference part of the literal frame reserved for a lambda function .
*
* ( set b 1 )
* ( defun set - a ( x ) ( set a x ) )
* ( set a 2 )
* ( set - a 4 )
* ( printf " %d \n " a )
*
* the global literal frame looks like this :
* @ 0 ( b )
* @ 1 ( a )
* @ 2 ( set - a )
* @ 3 ( printf . # < PRIM > )
* @ 4 " %d \n "
*
* @ 1 to @ 2 will be copied to a function object when defun is executed .
* The literal frame of the created function object for set - a looks
* like this
* @ 0 ( a )
* @ 1 ( set - a )
*/
2021-04-23 07:17:40 +00:00
/* TODO: in case i implement all global variables as block arguments at the top level...what should i do? */
HCL_ASSERT ( hcl , hcl - > c - > cblk . depth = = - 1 ) ;
if ( hcl - > c - > fnblk . depth < = - 1 )
{
HCL_ASSERT ( hcl , hcl - > c - > fnblk . depth = = - 1 ) ;
HCL_ASSERT ( hcl , hcl - > c - > tv . s . len = = 0 ) ;
HCL_ASSERT ( hcl , hcl - > c - > tv . wcount = = 0 ) ;
2021-06-07 01:11:17 +00:00
/* keep a virtual function block for the top-level compilation.
* pass HCL_TYPE_MAX ( hcl_oow_t ) as make_inst_pos because there is
* no actual MAKE_BLOCK / MAKE_FUNCTION instruction which otherwise
* would be patched in pop_fnblk ( ) . */
2021-06-27 17:47:51 +00:00
if ( push_fnblk ( hcl , HCL_NULL , 0 , 0 , 0 , hcl - > c - > tv . wcount , hcl - > c - > tv . wcount , hcl - > c - > tv . s . len , HCL_TYPE_MAX ( hcl_oow_t ) , 0 ) < = - 1 ) return - 1 ; /* must not goto oops */
2021-04-23 07:17:40 +00:00
}
top_fnblk_saved = hcl - > c - > fnblk . info [ 0 ] ;
HCL_ASSERT ( hcl , hcl - > c - > fnblk . depth = = 0 ) ; /* ensure the virtual function block is added */
2021-01-15 09:12:28 +00:00
PUSH_CFRAME ( hcl , COP_COMPILE_OBJECT , obj ) ;
while ( GET_TOP_CFRAME_INDEX ( hcl ) > = 0 )
{
2021-01-29 09:41:39 +00:00
hcl_cframe_t * cf ;
2021-01-15 09:12:28 +00:00
cf = GET_TOP_CFRAME ( hcl ) ;
/* TODO: tabulate this switch-based dispatch */
switch ( cf - > opcode )
{
case COP_COMPILE_OBJECT :
if ( compile_object ( hcl ) < = - 1 ) goto oops ;
break ;
2021-05-15 05:31:36 +00:00
case COP_COMPILE_OBJECT_R :
if ( compile_object_r ( hcl ) < = - 1 ) goto oops ;
break ;
2021-02-18 15:48:44 +00:00
case COP_COMPILE_ARGUMENT_LIST :
2021-01-15 09:12:28 +00:00
case COP_COMPILE_OBJECT_LIST :
case COP_COMPILE_OBJECT_LIST_TAIL :
case COP_COMPILE_IF_OBJECT_LIST :
case COP_COMPILE_IF_OBJECT_LIST_TAIL :
2021-02-18 15:48:44 +00:00
case COP_COMPILE_TRY_OBJECT_LIST :
case COP_COMPILE_TRY_OBJECT_LIST_TAIL :
2021-01-15 09:12:28 +00:00
if ( compile_object_list ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_COMPILE_ARRAY_LIST :
if ( compile_array_list ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_COMPILE_BYTEARRAY_LIST :
if ( compile_bytearray_list ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_COMPILE_DIC_LIST :
if ( compile_dic_list ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_COMPILE_QLIST :
2021-01-24 15:45:28 +00:00
if ( compile_qlist ( hcl ) < = - 1 ) goto oops ;
2021-01-15 09:12:28 +00:00
break ;
2021-02-22 09:20:45 +00:00
case COP_COMPILE_ELIF :
if ( compile_elif ( hcl ) < = - 1 ) goto oops ;
2021-02-01 13:20:46 +00:00
break ;
2021-02-22 09:20:45 +00:00
case COP_COMPILE_ELSE :
if ( compile_else ( hcl ) < = - 1 ) goto oops ;
2021-02-01 13:20:46 +00:00
break ;
2021-02-22 09:20:45 +00:00
case COP_COMPILE_CATCH :
if ( compile_catch ( hcl ) < = - 1 ) goto oops ;
2021-02-18 15:48:44 +00:00
break ;
2021-06-25 15:19:11 +00:00
case COP_COMPILE_AND_P1 :
if ( compile_and_p1 ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_COMPILE_AND_P2 :
if ( compile_and_p2 ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_COMPILE_BREAK_P1 :
if ( compile_break_p1 ( hcl ) < = - 1 ) goto oops ;
2021-02-01 13:20:46 +00:00
break ;
2021-06-25 15:19:11 +00:00
case COP_COMPILE_CLASS_P1 :
if ( compile_class_p1 ( hcl ) < = - 1 ) goto oops ;
2021-02-01 13:20:46 +00:00
break ;
2021-06-25 15:19:11 +00:00
case COP_COMPILE_CLASS_P2 :
if ( compile_class_p2 ( hcl ) < = - 1 ) goto oops ;
break ;
2021-12-12 16:09:31 +00:00
case COP_COMPILE_CLASS_P3 :
if ( compile_class_p3 ( hcl ) < = - 1 ) goto oops ;
break ;
2021-06-25 15:19:11 +00:00
case COP_COMPILE_OR_P1 :
if ( compile_or_p1 ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_COMPILE_OR_P2 :
if ( compile_or_p2 ( hcl ) < = - 1 ) goto oops ;
break ;
2021-01-15 09:12:28 +00:00
case COP_EMIT_CALL :
if ( emit_call ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_EMIT_MAKE_ARRAY :
if ( emit_make_array ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_EMIT_MAKE_BYTEARRAY :
if ( emit_make_bytearray ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_EMIT_MAKE_DIC :
if ( emit_make_dic ( hcl ) < = - 1 ) goto oops ;
break ;
2021-01-24 15:45:28 +00:00
case COP_EMIT_MAKE_CONS :
if ( emit_make_cons ( hcl ) < = - 1 ) goto oops ;
2021-01-15 09:12:28 +00:00
break ;
case COP_EMIT_POP_INTO_ARRAY :
if ( emit_pop_into_array ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_EMIT_POP_INTO_BYTEARRAY :
if ( emit_pop_into_bytearray ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_EMIT_POP_INTO_DIC :
if ( emit_pop_into_dic ( hcl ) < = - 1 ) goto oops ;
break ;
2021-01-24 15:45:28 +00:00
case COP_EMIT_POP_INTO_CONS :
if ( emit_pop_into_cons ( hcl , HCL_CODE_POP_INTO_CONS ) < = - 1 ) goto oops ;
break ;
case COP_EMIT_POP_INTO_CONS_END :
if ( emit_pop_into_cons ( hcl , HCL_CODE_POP_INTO_CONS_END ) < = - 1 ) goto oops ;
break ;
case COP_EMIT_POP_INTO_CONS_CDR :
if ( emit_pop_into_cons ( hcl , HCL_CODE_POP_INTO_CONS_CDR ) < = - 1 ) goto oops ;
break ;
2021-01-15 09:12:28 +00:00
case COP_EMIT_LAMBDA :
if ( emit_lambda ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_EMIT_POP_STACKTOP :
if ( emit_pop_stacktop ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_EMIT_RETURN :
if ( emit_return ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_EMIT_SET :
if ( emit_set ( hcl ) < = - 1 ) goto oops ;
break ;
2021-02-28 17:00:28 +00:00
case COP_EMIT_THROW :
if ( emit_throw ( hcl ) < = - 1 ) goto oops ;
break ;
2021-01-15 09:12:28 +00:00
case COP_POST_IF_COND :
if ( post_if_cond ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_POST_IF_BODY :
if ( post_if_body ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_POST_UNTIL_BODY :
case COP_POST_WHILE_BODY :
if ( post_while_body ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_POST_UNTIL_COND :
case COP_POST_WHILE_COND :
if ( post_while_cond ( hcl ) < = - 1 ) goto oops ;
break ;
2021-02-22 09:20:45 +00:00
case COP_POST_TRY :
if ( post_try ( hcl ) < = - 1 ) goto oops ;
break ;
case COP_POST_CATCH :
if ( post_catch ( hcl ) < = - 1 ) goto oops ;
break ;
2021-02-01 13:20:46 +00:00
case COP_POST_LAMBDA :
if ( post_lambda ( hcl ) < = - 1 ) goto oops ;
2021-01-15 09:12:28 +00:00
break ;
default :
HCL_DEBUG1 ( hcl , " Internal error - invalid compiler opcode %d \n " , cf - > opcode ) ;
hcl_seterrbfmt ( hcl , HCL_EINTERN , " invalid compiler opcode %d " , cf - > opcode ) ;
goto oops ;
}
}
/* emit the pop instruction to clear the final result */
if ( emit_byte_instruction ( hcl , HCL_CODE_POP_STACKTOP , HCL_NULL ) < = - 1 ) goto oops ;
HCL_ASSERT ( hcl , GET_TOP_CFRAME_INDEX ( hcl ) < 0 ) ;
2021-04-23 07:17:40 +00:00
HCL_ASSERT ( hcl , hcl - > c - > tv . s . len > = hcl - > c - > fnblk . info [ 0 ] . tmprlen ) ;
HCL_ASSERT ( hcl , hcl - > c - > tv . wcount > = hcl - > c - > fnblk . info [ 0 ] . tmprcnt ) ;
2021-04-09 08:22:40 +00:00
HCL_ASSERT ( hcl , hcl - > c - > cblk . depth = = - 1 ) ; /* no control blocks expected at this point */
2021-04-23 07:17:40 +00:00
HCL_ASSERT ( hcl , hcl - > c - > fnblk . depth = = 0 ) ; /* ensure the virtual function block be the only one left */
hcl - > code . ngtmprs = hcl - > c - > fnblk . info [ 0 ] . tmprcnt ; /* populate the number of global temporary variables */
2021-04-24 13:50:51 +00:00
if ( flags & HCL_COMPILE_CLEAR_FNBLK )
{
pop_fnblk ( hcl ) ;
HCL_ASSERT ( hcl , hcl - > c - > fnblk . depth = = - 1 ) ;
}
2021-01-15 09:12:28 +00:00
2021-06-27 17:47:51 +00:00
hcl - > log . default_type_mask = log_default_type_mask ;
2021-01-15 09:12:28 +00:00
return 0 ;
oops :
POP_ALL_CFRAMES ( hcl ) ;
hcl - > log . default_type_mask = log_default_type_mask ;
/* rollback any bytecodes or literals emitted so far */
hcl - > code . bc . len = saved_bc_len ;
hcl - > code . lit . len = saved_lit_len ;
2021-02-01 13:20:46 +00:00
hcl - > c - > tv . s . len = 0 ;
hcl - > c - > tv . wcount = 0 ;
2021-04-09 08:22:40 +00:00
2021-06-27 17:47:51 +00:00
while ( hcl - > c - > fnblk . depth > 0 ) pop_fnblk ( hcl ) ;
if ( flags & HCL_COMPILE_CLEAR_FNBLK )
2021-04-23 07:17:40 +00:00
{
2021-06-27 17:47:51 +00:00
pop_fnblk ( hcl ) ;
HCL_ASSERT ( hcl , hcl - > c - > fnblk . depth = = - 1 ) ;
}
else
{
/* restore the top level function block as it's first captured in this functio */
clear_fnblk_inners ( hcl ) ;
HCL_ASSERT ( hcl , hcl - > c - > fnblk . depth = = 0 ) ;
2021-04-23 07:17:40 +00:00
hcl - > c - > fnblk . info [ 0 ] = top_fnblk_saved ;
}
2021-01-15 09:12:28 +00:00
return - 1 ;
}