Verified Commit fecc8baf authored by Camil Staps's avatar Camil Staps 🚀

Fix predefined FILE constructor, add {build,fill}F_b

parent ea4c0e25
......@@ -1223,7 +1223,6 @@ void code_buildC_b(int b_offset) {
}
void code_buildF_b(int b_offset) {
unsupported_instruction_warning(CbuildF_b);
add_instruction_w(CbuildF_b,b_offset);
}
......@@ -2250,7 +2249,6 @@ void code_fillC_b(int b_offset,int a_offset) {
}
void code_fillF_b(int b_offset,int a_offset) {
unsupported_instruction_warning(CfillF_b);
add_instruction_w_w(CfillF_b,-a_offset,b_offset);
}
......@@ -2763,7 +2761,6 @@ void code_pushD_a(int a_offset) {
}
void code_pushF_a(int a_offset) {
unsupported_instruction_warning(CpushF_a);
add_instruction_w(CpushF_a,-a_offset);
}
......
......@@ -322,6 +322,8 @@ void wprint_node(WINDOW *win, BC_WORD *node, int with_arguments) {
wprintw(win, "CHAR '%c'", node[1]);
else if ((node[0]&-4)==(BC_WORD)&REAL)
wprintw(win, "REAL %f", *(BC_REAL*)&node[1]);
else if ((node[0]&-4)==(BC_WORD)&d_FILE)
wprintw(win, "FILE "BC_WORD_S_FMT" 0x"BC_WORD_FMT_HEX, node[1], node[2]);
else if ((node[0]&-4)==(BC_WORD)&__interpreter_cycle_in_spine[1])
wprintw(win, "_cycle_in_spine");
else if ((node[0]&-4)==(BC_WORD)&__interpreter_indirection[5]) {
......@@ -540,6 +542,8 @@ void debugger_show_node_as_tree_(WINDOW *win, BC_WORD *node, int indent, uint64_
wprintw(win, " CHAR '%c'", node[1]);
else if (node[0] == (BC_WORD) &REAL+2)
wprintw(win, " REAL %f", *(BC_REAL*)&node[1]);
else if (node[0] == (BC_WORD) &d_FILE+2)
wprintw(win, " FILE "BC_WORD_S_FMT" 0x"BC_WORD_FMT_HEX, node[1], node[2]);
else if (node[0] == (BC_WORD) &__STRING__+2)
wprintw(win, " __STRING__");
else if (node[0] == (BC_WORD) &__ARRAY__+2)
......
......@@ -45,7 +45,7 @@ void** ARRAY;
static BC_WORD m____system[] = {7, (BC_WORD) _7chars2int('_','s','y','s','t','e','m')};
void* d___Nil[] = {2+&d___Nil[1], 0, 0, &m____system, (void*) 4, _4chars2int('_','N','i','l')};
static void* d_FILE[] = {&m____system, &d_FILE[4], (void*) (258<<16), _2chars2int('i','i'), (void*) 4, _4chars2int('F','I','L','E')};
void* d_FILE[] = {&m____system, (void*) 258, (void*) 2, _2chars2int('i','i'), (void*) 4, _4chars2int('F','I','L','E')};
# ifndef LINK_CLEAN_RUNTIME
void* __ARRAY__[] = {0, 0, &m____system, (void*) 7, _7chars2int('_','A','R','R','A','Y','_')};
......@@ -59,7 +59,7 @@ void* dINT[] = {0, 0, &m____system, (void*) 3, _3chars2int('I','N',
static BC_WORD m____system[] = { 7, (BC_WORD) _4chars2int ('_','s','y','s'), (BC_WORD) _3chars2int ('t','e','m') };
void* d___Nil[] = { 2+&d___Nil[1], 0, 0, &m____system, (void*) 4, _4chars2int ('_','N','i','l') };
static void* d_FILE[] = { &m____system, &d_FILE[4], (void*) (258<<16), _2chars2int ('i','i'), (void*) 4, _4chars2int ('F','I','L','E') };
void* d_FILE[] = { &m____system, (void*) 258, (void*) 2, _2chars2int ('i','i'), (void*) 4, _4chars2int ('F','I','L','E') };
# ifndef LINK_CLEAN_RUNTIME
void* __ARRAY__[] = { 0, 0, &m____system, (void*) 7, _4chars2int ('_','A','R','R'), _3chars2int ('A','Y','_') };
......@@ -71,8 +71,6 @@ void* dINT[] = { 0, 0, &m____system, (void*) 3, _3chars2int ('I','N
# endif
#endif /* Word-width dependency */
#define dFILE (d_FILE[2])
#ifndef LINK_CLEAN_RUNTIME
BC_WORD small_integers[66];
BC_WORD static_characters[512];
......
......@@ -67,6 +67,7 @@ extern void* dINT[];
extern void* BOOL[];
extern void* CHAR[];
extern void* REAL[];
extern void* d_FILE[];
extern BC_WORD small_integers[66];
extern BC_WORD static_characters[512];
......
......@@ -142,6 +142,7 @@ INT_ptr :: Expr TWord
REAL_ptr :: Expr TWord
ARRAY__ptr :: Expr TWord
STRING__ptr :: Expr TWord
FILE_ptr :: Expr TWord
jmp_ap_ptr :: !Int -> Expr (TPtr TWord)
cycle_ptr :: Expr TWord
indirection_ptr :: Expr TWord
......
......@@ -473,6 +473,9 @@ STRING__ptr = "(BC_WORD)&__STRING__"
jmp_ap_ptr :: !Int -> Expr (TPtr TWord)
jmp_ap_ptr i = "(BC_WORD)&Fjmp_ap["+-+toString i+-+"]"
FILE_ptr :: Expr TWord
FILE_ptr = "(BC_WORD)&d_FILE[1]"
cycle_ptr :: Expr TWord
cycle_ptr = "(BC_WORD)&__interpreter_cycle_in_spine[1]"
......
......@@ -204,6 +204,15 @@ all_instructions opts t = bootstrap $ collect_instructions opts $ map (\i -> i t
, instr "buildC_b" (Just 1) $
A @ 1 .= static_character (to_char (B @ (Pc @ 1))) :.
grow_a 1
, instr "buildF_b" (Just 1) $
ensure_hp 3 :.
new_local TInt (to_int (Pc @ 1)) \bo ->
Hp @ 0 .= FILE_ptr + lit_word 2 :.
Hp @ 1 .= B @ bo :.
Hp @ 2 .= B @ (bo + lit_int 1) :.
A @ 1 .= to_word Hp :.
grow_a 1 :.
advance_ptr Hp 3
, instr "buildI" (Just 1) $
new_local TInt (to_int (Pc @ 1)) \i ->
if_then_else (lit_int 0 <=. i &&. i <=. lit_int 32)
......@@ -1692,6 +1701,12 @@ all_instructions opts t = bootstrap $ collect_instructions opts $ map (\i -> i t
new_local (TPtr TWord) (to_word_ptr (A @ to_int (Pc @ 1))) \n ->
n @ 0 .= CHAR_ptr + lit_word 2 :.
n @ 1 .= B @ to_int (Pc @ 2)
, instr "fillF_b" (Just 2) $
new_local (TPtr TWord) (to_word_ptr (A @ to_int (Pc @ 1))) \n ->
new_local TInt (to_int (Pc @ 2)) \bo ->
n @ 0 .= FILE_ptr + lit_word 2 :.
n @ 1 .= B @ bo :.
n @ 2 .= B @ (bo + lit_int 1)
, instr "fillI" (Just 2) $
new_local (TPtr TWord) (to_word_ptr (A @ to_int (Pc @ 2))) \n ->
n @ 0 .= INT_ptr + lit_word 2 :.
......
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