Commit a1199062 authored by Camil Staps's avatar Camil Staps 🍃

Fix #81 (currying of constructors) in the C version: add .a-like entries for _add_arg1 and above

parent 076b761f
Pipeline #25782 failed with stages
in 1 minute and 16 seconds
......@@ -106,6 +106,8 @@ const char *instruction_type (BC_WORD i) {
case Cbuildhr30: return "l";
case Cbuildhr31: return "l";
case Cbuildhr40: return "l";
case Cbuild_node_rtn: return "n";
case Cbuild_node2_rtn: return "";
case Cbuild_r: return "nnlnn";
case Cbuild_ra0: return "nnl";
case Cbuild_ra1: return "nnln";
......
......@@ -78,6 +78,8 @@ enum {
INSTRUCTION(buildhr30)
INSTRUCTION(buildhr31)
INSTRUCTION(buildhr40)
INSTRUCTION(build_node_rtn)
INSTRUCTION(build_node2_rtn)
INSTRUCTION(build_r)
INSTRUCTION(build_ra0)
INSTRUCTION(build_ra1)
......
......@@ -913,6 +913,17 @@ struct word *add_add_arg_labels(void) {
for(i=0; i<N_ADD_ARG_LABELS; ++i)
if (Fadd_arg_label_used[i]) {
if (i>0) {
/* Three instructions above add_arg is the code used for fast
* applies of constructors. build_node returns; notB is not used. */
if (i==1) {
add_instruction(Cbuild_node2_rtn);
add_instruction(CnotB);
} else {
add_instruction_w(Cbuild_node_rtn,i-1);
}
add_instruction(CnotB);
}
char label_name[11];
sprintf(label_name,"_add_arg%d",i);
struct label *label = enter_label(label_name);
......
......@@ -498,6 +498,7 @@ eval_to_hnf_return_failure:
pc = (BC_WORD*)program->symbol_table[program->start_symbol_id].offset;
}
BC_WORD fast_ap_descriptor=0;
#ifdef COMPUTED_GOTOS
goto **(void**)pc;
# include "interpret_instructions.h"
......
......@@ -27,4 +27,4 @@ typedef int64_t CleanInt;
#define BCGEN_INSTRUCTION_TABLE_SIZE 512
#define ABC_MAGIC_NUMBER 0x2a434241
#define ABC_VERSION 8
#define ABC_VERSION 9
......@@ -23,7 +23,7 @@ lit_char :: !Char -> Expr TChar
lit_short :: !Int -> Expr TShort
lit_int :: !Int -> Expr TInt
instance to_word TWord, TChar, TInt, TShort, (TPtr t), TReal
instance to_word TWord, TPtrOffset, TChar, TInt, TShort, (TPtr t), TReal
instance to_bool TWord
instance to_char TWord
instance to_int TWord
......@@ -51,7 +51,7 @@ instance ^ (Expr TReal)
(&.) infixl 6 :: !(Expr TWord) !(Expr TWord) -> Expr TWord
(|.) infixl 6 :: !(Expr TWord) !(Expr TWord) -> Expr TWord
(<<.) infix 7 :: !(Expr TWord) !(Expr TWord) -> Expr TWord
(<<.) infix 7 :: !(Expr a) !(Expr a) -> Expr a
(>>.) infix 7 :: !(Expr a) !(Expr a) -> Expr a
xorI :: !(Expr TWord) !(Expr TWord) -> Expr TWord
~. :: !(Expr TWord) -> Expr TWord
......@@ -150,6 +150,7 @@ small_integer :: !(Expr TInt) -> Expr TWord
static_character :: !(Expr TChar) -> Expr TWord
static_boolean :: !(Expr TWord) -> Expr TWord
caf_list :: Expr (TPtr TWord)
fast_ap_descriptor :: Expr TWord
push_c :: !(Expr (TPtr TWord)) !Target -> Target
pop_pc_from_c :: !Target -> Target
......
......@@ -197,12 +197,13 @@ lit_short i = toString i
lit_int :: !Int -> Expr TInt
lit_int i = toString i
instance to_word TWord where to_word e = e
instance to_word TChar where to_word e = "(BC_WORD)("+-+e+-+")"
instance to_word TInt where to_word e = "(BC_WORD)("+-+e+-+")"
instance to_word TShort where to_word e = "(BC_WORD)("+-+e+-+")"
instance to_word (TPtr t) where to_word e = "(BC_WORD)("+-+e+-+")"
instance to_word TReal where to_word e = "*(BC_WORD*)&("+-+e+-+")"
instance to_word TWord where to_word e = e
instance to_word TPtrOffset where to_word e = "(BC_WORD)("+-+e+-+")"
instance to_word TChar where to_word e = "(BC_WORD)("+-+e+-+")"
instance to_word TInt where to_word e = "(BC_WORD)("+-+e+-+")"
instance to_word TShort where to_word e = "(BC_WORD)("+-+e+-+")"
instance to_word (TPtr t) where to_word e = "(BC_WORD)("+-+e+-+")"
instance to_word TReal where to_word e = "*(BC_WORD*)&("+-+e+-+")"
instance to_bool TWord
where
......@@ -264,7 +265,7 @@ instance ^ (Expr TReal) where ^ a b = "pow("+-+a+-+","+-+b+-+")"
(|.) infixl 6 :: !(Expr TWord) !(Expr TWord) -> Expr TWord
(|.) a b = "("+-+a+-+"|"+-+b+-+")"
(<<.) infix 7 :: !(Expr TWord) !(Expr TWord) -> Expr TWord
(<<.) infix 7 :: !(Expr a) !(Expr a) -> Expr a
(<<.) a b = "("+-+a+-+"<<"+-+b+-+")"
(>>.) infix 7 :: !(Expr a) !(Expr a) -> Expr a
......@@ -495,6 +496,9 @@ static_boolean b = "(BC_WORD)&static_booleans[("+-+b+-+") ? 2 : 0]"
caf_list :: Expr (TPtr TWord)
caf_list = "(BC_WORD*)caf_list"
fast_ap_descriptor :: Expr TWord
fast_ap_descriptor = "fast_ap_descriptor";
push_c :: !(Expr (TPtr TWord)) !Target -> Target
push_c v t = append ("\t*++csp=(BC_WORD)"+-+v+-+";") t
......
......@@ -3530,6 +3530,7 @@ all_instructions opts t = bootstrap $ collect_instructions opts $ map (\i -> i t
new_local TWord (n @ 0) \d ->
if_then_else (to_short_ptr d @ 0 ==. lit_short (8*ns)) (
new_local TShort (to_short_ptr d @ -1) \arity ->
fast_ap_descriptor .= d - to_word (arity <<. if_i64_or_i32_expr (lit_short 4) (lit_short 3)) :.
Pc .= to_word_ptr (to_word_ptr (d + (lit_word (ns*2-1) * if_i64_or_i32_expr (lit_word 8) (lit_word 4)) - lit_word 2) @ 0) :.
rewind_ptr Pc 3 :.
if_then_else (arity <=. lit_short 1) (
......@@ -3560,7 +3561,27 @@ all_instructions opts t = bootstrap $ collect_instructions opts $ map (\i -> i t
Pc .= to_word_ptr (to_word_ptr (d + if_i64_or_i32_expr (lit_word 6) (lit_word 2)) @ 0)
))
] ++
[ instr "add_arg0" Nothing $
[ instr "build_node2_rtn" Nothing $
ensure_hp 3 :.
pop_pc_from_c :.
Hp @ 0 .= fast_ap_descriptor + if_i64_or_i32_expr (lit_word 32) (lit_word 16) :.
Hp @ 1 .= A @ 0 :.
Hp @ 2 .= A @ -1 :.
A @ -1 .= to_word Hp :.
shrink_a 1
, instr "build_node_rtn" Nothing $
new_local TPtrOffset (to_ptr_offset (Pc @ 1)) \n_args_m_2 ->
ensure_hp (n_args_m_2 + lit_hword 3) :.
Hp @ 0 .= fast_ap_descriptor + to_word ((n_args_m_2 + lit_hword 2) <<. if_i64_or_i32_expr (lit_hword 4) (lit_hword 3)) :.
Hp @ 1 .= A @ 0 :.
Hp @ 2 .= to_word (Hp @? 3) :.
pop_pc_from_c :.
Hp @ 3 .= A @ -1 :.
unrolled_loop [1..32] (\i -> n_args_m_2 <. lit_hword i) (\i -> Hp @ (i+3) .= A @ (-1-i)) :.
shrink_a (n_args_m_2 + lit_hword 1) :.
A @ 0 .= to_word Hp :.
advance_ptr Hp (n_args_m_2 + lit_hword 3)
, instr "add_arg0" Nothing $
ensure_hp 2 :.
new_local (TPtr TWord) (to_word_ptr (A @ 0)) \n ->
pop_pc_from_c :.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment