...
 
Commits (13)
......@@ -29,8 +29,9 @@ from StdMaybe import :: Maybe
* expressions. You may also use {{`defaultDeserializationSettings`}}.
*/
:: DeserializationSettings =
{ heap_size :: !Int //* Heap size for the interpreter, in bytes (default: 2M)
, stack_size :: !Int //* Stack size for the interpreter, in bytes (default: 1M in total; 500k for A and 500k for BC stack)
{ heap_size :: !Int //* Heap size for the interpreter, in bytes (default: 2M)
, stack_size :: !Int //* Stack size for the interpreter, in bytes (default: 1M in total; 500k for A and 500k for BC stack)
, file_io :: !Bool //* Whether file I/O is allowed (default: False)
}
defaultDeserializationSettings :: DeserializationSettings
......@@ -94,6 +95,8 @@ deserialize :: !DeserializationSettings !SerializedGraph !String !*World -> *(!M
//* The ABC instruction `halt` was encountered.
| DV_IllegalInstruction
//* A forbidden (ccall, etc.) or unknown ABC instruction was encountered.
| DV_FileIOAttempted
//* File I/O was attempted while the interpreter was started with file_io=False.
| DV_HostHeapFull
//* The heap of the host application has not enough space to copy the result.
......
......@@ -20,6 +20,7 @@ defaultDeserializationSettings :: DeserializationSettings
defaultDeserializationSettings =
{ heap_size = 2 << 20
, stack_size = (512 << 10) * 2
, file_io = False
}
:: *SerializedGraph =
......@@ -104,7 +105,7 @@ deserialize` strict dsets {graph,descinfo,modules,bytecode} thisexe w
pgm
heap dsets.heap_size stack dsets.stack_size
asp bsp csp heap
strict
strict dsets.file_io
# graph = replace_desc_numbers_by_descs 0 graph int_syms 0 0
# graph_node = string_to_interpreter graph ie_settings
#! (ie,_) = make_finalizer ie_settings
......@@ -188,7 +189,7 @@ get_start_rule_as_expression dsets filename prog w
pgm
heap dsets.heap_size stack dsets.stack_size
asp bsp csp heap
False
False dsets.file_io
# start_node = build_start_node ie_settings
#! (ie,_) = make_finalizer ie_settings
# ie = {ie_finalizer=ie, ie_snode_ptr=0, ie_snodes=create_array_ 1}
......@@ -198,9 +199,9 @@ get_start_rule_as_expression dsets filename prog w
// it to the finalizer_list anyway. This is just to ensure that the first
// call to interpret gets the right argument.
build_interpretation_environment :: !Pointer !Pointer !Int !Pointer !Int !Pointer !Pointer !Pointer !Pointer !Bool -> Pointer
build_interpretation_environment pgm heap hsize stack ssize asp bsp csp hp strict = code {
ccall build_interpretation_environment "ppIpIppppI:p"
build_interpretation_environment :: !Pointer !Pointer !Int !Pointer !Int !Pointer !Pointer !Pointer !Pointer !Bool !Bool -> Pointer
build_interpretation_environment pgm heap hsize stack ssize asp bsp csp hp strict file_io = code {
ccall build_interpretation_environment "ppIpIppppII:p"
}
build_start_node :: !Pointer -> Pointer
......
......@@ -141,7 +141,7 @@ const char *instruction_type (BC_WORD i) {
case Cbuild_u31: return "l";
case Cbuild_ua1: return "nl";
case CcatAC: return "";
case Cccall: return "";
case Cccall: return "ss";
case Ccentry: return "";
case CcmpAC: return "";
case CcosR: return "";
......@@ -690,6 +690,38 @@ const char *instruction_type (BC_WORD i) {
case Ceval_upd32: return "";
case Cfill_a01_pop_rtn: return "";
case CcloseF: return "";
case CendF: return "";
case CendSF: return "";
case CerrorF: return "";
case CflushF: return "";
case CopenF: return "";
case CopenSF: return "";
case CpositionF: return "";
case CpositionSF: return "";
case CreadFC: return "";
case CreadFI: return "";
case CreadFR: return "";
case CreadFS: return "";
case CreadFString: return "";
case CreadLineF: return "";
case CreadLineSF: return "";
case CreadSFC: return "";
case CreadSFI: return "";
case CreadSFR: return "";
case CreadSFS: return "";
case CreopenF: return "";
case CseekF: return "";
case CseekSF: return "";
case CshareF: return "";
case CstderrF: return "";
case CstdioF: return "";
case CwriteFC: return "";
case CwriteFI: return "";
case CwriteFR: return "";
case CwriteFS: return "";
case CwriteFString: return "";
case CaddIi: return "i";
case CandIi: return "i";
case CandIio: return "ni";
......
......@@ -678,6 +678,38 @@ enum {
INSTRUCTION(swap_a3)
INSTRUCTION(swap_a)
INSTRUCTION(closeF)
INSTRUCTION(endF)
INSTRUCTION(endSF)
INSTRUCTION(errorF)
INSTRUCTION(flushF)
INSTRUCTION(openF)
INSTRUCTION(openSF)
INSTRUCTION(positionF)
INSTRUCTION(positionSF)
INSTRUCTION(readFC)
INSTRUCTION(readFI)
INSTRUCTION(readFR)
INSTRUCTION(readFS)
INSTRUCTION(readFString)
INSTRUCTION(readLineF)
INSTRUCTION(readLineSF)
INSTRUCTION(readSFC)
INSTRUCTION(readSFI)
INSTRUCTION(readSFR)
INSTRUCTION(readSFS)
INSTRUCTION(reopenF)
INSTRUCTION(seekF)
INSTRUCTION(seekSF)
INSTRUCTION(shareF)
INSTRUCTION(stderrF)
INSTRUCTION(stdioF)
INSTRUCTION(writeFC)
INSTRUCTION(writeFI)
INSTRUCTION(writeFR)
INSTRUCTION(writeFS)
INSTRUCTION(writeFString)
INSTRUCTION(addIi)
INSTRUCTION(andIi)
INSTRUCTION(andIio)
......
......@@ -891,6 +891,15 @@ void add_instruction_internal_label(int16_t i,struct label *label) {
store_code_internal_label_value(label,0);
}
void add_instruction_internal_label_internal_label(int16_t i,struct label *label1,struct label *label2) {
if (list_code || i>max_implemented_instruction_n)
printf("%d\t%s %d %d\n",pgrm.code_size,instruction_name (i),label1->label_offset,label2->label_offset);
store_code_elem(BYTEWIDTH_INSTRUCTION, i);
store_code_internal_label_value(label1,0);
store_code_internal_label_value(label2,0);
}
void add_instruction_w_internal_label_label(int16_t i,int32_t n1,struct label *label,char *label_name) {
if (list_code || i>max_implemented_instruction_n)
printf("%d\t%s %d %d %s\n",pgrm.code_size,instruction_name (i),n1,label->label_offset,label_name);
......@@ -941,57 +950,89 @@ struct word *add_add_arg_labels(void) {
return pgrm.code;
}
static char *specialized_jsr_labels[] = {
/* 0*/ "eqAC",
/* 1*/ "cmpAC",
/* 2*/ "catAC",
/* 3*/ "sliceAC",
/* 4*/ "updateAC",
/* 5*/ "ItoAC",
/* 6*/ "BtoAC",
/* 7*/ "RtoAC",
/* 8*/ "print__string__",
/* 9*/ "openF",
/*10*/ "stdioF",
/*11*/ "closeF",
/*12*/ "readLineF",
/*13*/ "endF",
/*14*/ "writeFI",
/*15*/ "writeFS",
/*16*/ "writeFC",
/*17*/ "openSF"
struct specialized_jsr {
const char *label;
int instruction;
int flags;
int warned_flags;
};
#define SPECIALIZED(instr,flags) {#instr, C ## instr, flags, 0},
#define S_UNSUPPORTED 1
#define S_IO 2
static struct specialized_jsr specialized_jsr_labels[]={
SPECIALIZED(eqAC,0)
SPECIALIZED(cmpAC,0)
SPECIALIZED(catAC,0)
SPECIALIZED(sliceAC,0)
SPECIALIZED(updateAC,0)
SPECIALIZED(ItoAC,0)
SPECIALIZED(BtoAC,0)
SPECIALIZED(RtoAC,0)
{"print__string__",Cprint_string,0},
SPECIALIZED(closeF, S_IO)
SPECIALIZED(endF, S_IO)
SPECIALIZED(endSF, S_IO | S_UNSUPPORTED)
SPECIALIZED(errorF, S_IO)
SPECIALIZED(flushF, S_IO)
SPECIALIZED(openF, S_IO)
SPECIALIZED(openSF, S_IO | S_UNSUPPORTED)
SPECIALIZED(positionF, S_IO)
SPECIALIZED(positionSF, S_IO | S_UNSUPPORTED)
SPECIALIZED(readFC, S_IO)
SPECIALIZED(readFI, S_IO)
SPECIALIZED(readFR, S_IO)
SPECIALIZED(readFS, S_IO)
SPECIALIZED(readFString, S_IO | S_UNSUPPORTED)
SPECIALIZED(readLineF, S_IO)
SPECIALIZED(readLineSF, S_IO | S_UNSUPPORTED)
SPECIALIZED(readSFC, S_IO | S_UNSUPPORTED)
SPECIALIZED(readSFI, S_IO | S_UNSUPPORTED)
SPECIALIZED(readSFR, S_IO | S_UNSUPPORTED)
SPECIALIZED(readSFS, S_IO | S_UNSUPPORTED)
SPECIALIZED(reopenF, S_IO | S_UNSUPPORTED)
SPECIALIZED(seekF, S_IO)
SPECIALIZED(seekSF, S_IO | S_UNSUPPORTED)
SPECIALIZED(shareF, S_IO | S_UNSUPPORTED)
SPECIALIZED(stderrF, S_IO)
SPECIALIZED(stdioF, S_IO)
SPECIALIZED(writeFC, S_IO)
SPECIALIZED(writeFI, S_IO)
SPECIALIZED(writeFR, S_IO)
SPECIALIZED(writeFS, S_IO)
SPECIALIZED(writeFString, S_IO)
};
static int get_specialized_jsr_label_n(char label_name[]) {
int i,n;
n = sizeof(specialized_jsr_labels) / sizeof (char*);
n=sizeof(specialized_jsr_labels)/sizeof(struct specialized_jsr);
for(i=0; i<n; ++i)
if (!strcmp (label_name,specialized_jsr_labels[i]))
if (!strcmp(label_name,specialized_jsr_labels[i].label))
return i;
return -1;
}
void add_specialized_jsr_instruction(unsigned int n) {
switch (n) {
case 0: add_instruction(CeqAC); return;
case 1: add_instruction(CcmpAC); return;
case 2: add_instruction(CcatAC); return;
case 3: add_instruction(CsliceAC); return;
case 4: add_instruction(CupdateAC); return;
case 5: add_instruction(CItoAC); return;
case 6: add_instruction(CBtoAC); return;
case 7: add_instruction(CRtoAC); return;
case 8: add_instruction(Cprint_string); return;
default:
if (n < sizeof(specialized_jsr_labels)/sizeof(char*)) {
fprintf(stderr,"Warning: jsr %s is not supported by the interpreter\n",specialized_jsr_labels[n]);
} else {
fprintf(stderr,"internal error in add_specialized_jsr_instruction: %d\n",n);
exit(1);
}
if (n>=sizeof(specialized_jsr_labels)/sizeof(struct specialized_jsr)) {
fprintf(stderr,"internal error in add_specialized_jsr_instruction: %d\n",n);
exit(1);
}
struct specialized_jsr *entry=&specialized_jsr_labels[n];
if (entry->flags & S_UNSUPPORTED)
unsupported_instruction_warning(entry->instruction);
else if (entry->flags & S_IO) {
if (!(entry->warned_flags & S_IO)) {
fprintf(stderr,"Warning: jsr %s requires file IO\n",entry->label);
entry->warned_flags|=S_IO;
}
}
add_instruction(entry->instruction);
}
void add_label(char *label_name) {
......@@ -1196,7 +1237,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);
}
......@@ -2223,7 +2263,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);
}
......@@ -2736,7 +2775,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);
}
......@@ -3670,9 +3708,31 @@ void code_buildo2(char code_name[],int a_offset1,int a_offset2) {
add_instruction_w_w_label(Cbuildo2,-a_offset1,-a_offset2,code_name);
}
void code_ccall (char *c_function_name,char *s,int length) {
unsupported_instruction_warning(Cccall);
add_instruction(Cccall);
void code_ccall (char *c_function_name,char *type,int type_length) {
fprintf(stderr,"Warning: external C function %s cannot be packaged into the bytecode\n",c_function_name);
struct label *function_label;
function_label=new_internal_label();
function_label->label_offset=(pgrm.data_size<<2)+1;
store_string(c_function_name,strlen(c_function_name),0);
struct label *type_label;
type_label=new_internal_label();
type_label->label_offset=(pgrm.data_size<<2)+1;
for (int i=0; i<type_length; i++) {
switch (type[i]) {
case '-': type[i]=':'; break;
case ':': break;
case 'p': type[i]='I'; break;
case 'I': break;
default:
//fprintf(stderr,"Warning: '%c' type in ccall for %s not supported by interpreter\n",type[i],c_function_name);
break;
}
}
store_string(type,type_length,0);
add_instruction_internal_label_internal_label(Cccall,function_label,type_label);
}
void code_centry (char *c_function_name,char *clean_function_label,char *s,int length) {
......
......@@ -16,11 +16,12 @@ enum section_type {
ST_Start
};
#define _2chars2int(a,b) ((uint64_t) (a+(b<<8)))
#define _3chars2int(a,b,c) ((uint64_t) (a+(b<<8)+(c<<16)))
#define _4chars2int(a,b,c,d) ((uint64_t) (a+(b<<8)+(c<<16)+(d<<24)))
#define _7chars2int(a,b,c,d,e,f,g) ((uint64_t) (a+(b<<8)+(c<<16)+(d<<24)+((uint64_t)e<<32)+((uint64_t)f<<40)+((uint64_t)g<<48)))
#define _8chars2int(a,b,c,d,e,f,g,h) ((uint64_t) (a+(b<<8)+(c<<16)+(d<<24)+((uint64_t)e<<32)+((uint64_t)f<<40)+((uint64_t)g<<48)+((uint64_t)h<<56)))
uint64_t prelinker_preamble[664] = {
uint64_t prelinker_preamble[669] = {
/* 0 */ 0, 0, 0, 7, _7chars2int('_','A','R','R','A','Y','_'),
/* 5 */ 0, 0, 0, 8, _8chars2int('_','S','T','R','I','N','G','_'),
/* 10 */ 0, 0, 0, 4, _4chars2int('B','O','O','L'),
......@@ -66,6 +67,8 @@ uint64_t prelinker_preamble[664] = {
/* 660 static booleans */
10*8+2,0, 10*8+2,1,
/* 664 */
258, 2, _2chars2int('i','i'), 4, _4chars2int('F','I','L','E'),
/* 669 */
};
void prepare_preamble(void) {
......
#pragma once
extern uint64_t prelinker_preamble[664];
extern uint64_t prelinker_preamble[669];
......@@ -352,7 +352,7 @@ unsigned int print_instruction(int to_stderr, struct program *pgm, uint32_t i) {
WPRINTF(w, " %d", abs((int)pgm->code[i] / IF_INT_64_OR_32(8,4)));
break;
case 'r': /* Real constant */
WPRINTF(w, " %.15g", (*(BC_REAL*)&pgm->code[i]) + 0.0);
WPRINTF(w, BC_REAL_FMT, (*(BC_REAL*)&pgm->code[i]) + 0.0);
break;
case 'a': /* Arity */
WPRINTF(w, " %d", abs((int16_t) ((BC_WORD_S)pgm->code[i] >> IF_INT_64_OR_32(48,16))));
......
......@@ -18,6 +18,7 @@
# define BC_WORD_FMT_HEX "%"SCNx64
# define BC_WORD_S_FMT "%"SCNd64
# define BC_REAL double
# define BC_REAL_SCAN_FMT "%lg"
#else
# define BC_WORD uint32_t
# define BC_WORD_S int32_t
......@@ -25,7 +26,9 @@
# define BC_WORD_FMT_HEX "%x"
# define BC_WORD_S_FMT "%d"
# define BC_REAL float
# define BC_REAL_SCAN_FMT "%g"
#endif
#define BC_REAL_FMT "%.15g"
#define BC_BOOL uint8_t
......
......@@ -52,7 +52,7 @@ struct interpretation_environment *build_interpretation_environment(
struct program *program,
BC_WORD *heap, BC_WORD heap_size, BC_WORD *stack, BC_WORD stack_size,
BC_WORD *asp, BC_WORD *bsp, BC_WORD *csp, BC_WORD *hp,
int hyperstrict) {
int hyperstrict, int allow_file_io) {
struct interpretation_environment *ie = safe_malloc(sizeof(struct interpretation_environment));
ie->host = safe_malloc(sizeof(struct host_status));
ie->program = program;
......@@ -68,7 +68,8 @@ struct interpretation_environment *build_interpretation_environment(
ie->caf_list[0] = 0;
ie->caf_list[1] = &ie->caf_list[1];
ie->options.in_first_semispace=1;
ie->options.hyperstrict=hyperstrict != 0;
ie->options.hyperstrict=hyperstrict!=0;
ie->options.allow_file_io=allow_file_io!=0;
#if DEBUG_CLEAN_LINKS > 0
EPRINTF("Building interpretation_environment %p\n",ie);
#endif
......
......@@ -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)
......
#ifdef MACH_O64
# define NEWLINE_CHAR '\r'
#else
# define NEWLINE_CHAR '\n'
#endif
#define F_READ_TEXT 0
#define F_WRITE_TEXT 1
#define F_APPEND_TEXT 2
#define F_READ_DATA 3
#define F_WRITE_DATA 4
#define F_APPEND_DATA 5
#define F_IS_TEXT_MODE(m) (0<=m && m<=2)
#define F_IS_DATA_MODE(m) (3<=m && m<=5)
static char *file_modes[]={"r","w","a","rb","wb","ab"};
struct file {
FILE *file_handle;
int file_mode;
};
static struct file clean_stdinout;
static struct file clean_stderr;
#define IO_error(s) do { EPRINTF("IO error: %s\n",s); exit(1); } while (0)
static int stdio_open=0;
static int last_readLineF_failed=0;
static long clean_get_line(char *dest,long max_length) {
for (long length=1; length<=max_length; length++) {
char c=getchar();
*dest++=c;
if (c==NEWLINE_CHAR)
return length;
}
return -1;
}
......@@ -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];
......@@ -229,6 +227,8 @@ BC_WORD Fjmp_ap[32] =
, Cjmp_ap32
};
#include "files.h"
void* __interpreter_cycle_in_spine[2] = {
(void*) 0,
(void*) Chalt
......@@ -340,9 +340,11 @@ int ensure_interpreter_init(void) {
#ifdef COMPUTED_GOTOS
/* Fetch label addresses */
if (instruction_labels[0]==NULL) {
interpret(NULL,
# ifdef LINK_CLEAN_RUNTIME
0,
interpret(NULL, 0,
# else
struct interpretation_options options;
interpret(NULL, options,
# endif
NULL, 0, NULL, 0, NULL, NULL, NULL, NULL, NULL);
......@@ -379,6 +381,7 @@ int interpret(
int create_restore_point,
#else
struct program *program,
struct interpretation_options options,
#endif
BC_WORD *stack, size_t stack_size,
BC_WORD *heap, size_t heap_size,
......@@ -410,8 +413,6 @@ int interpret(
int instr_arg; /* for jsr_eval_host_node_n */
#else
void *caf_list[2] = {0, &caf_list[1]};
struct interpretation_options options;
options.in_first_semispace=1;
#endif
BC_WORD *pc;
......@@ -561,9 +562,9 @@ eval_to_hnf_return_failure:
#ifndef LINK_CLEAN_RUNTIME
# if defined(DEBUG_CURSES) || defined(COMPUTED_GOTOS)
const char usage[] = "Usage: %s [-h SIZE] [-s SIZE] FILE\n";
const char usage[] = "Usage: %s [-io] [-h SIZE] [-s SIZE] FILE\n";
# else
const char usage[] = "Usage: %s [-l] [-R] [-h SIZE] [-s SIZE] FILE\n";
const char usage[] = "Usage: %s [-l] [-R] [-io] [-h SIZE] [-s SIZE] FILE\n";
# endif
int main(int argc, char **argv) {
......@@ -575,6 +576,10 @@ int main(int argc, char **argv) {
size_t stack_size = (512 << 10) * 2;
size_t heap_size = 2 << 20;
struct interpretation_options options;
options.in_first_semispace=1;
options.allow_file_io=0;
BC_WORD *stack;
BC_WORD *heap;
......@@ -603,6 +608,8 @@ int main(int argc, char **argv) {
EPRINTF(usage, argv[0]);
EXIT(NULL,-1);
}
} else if (!strcmp(argv[i],"-io")) {
options.allow_file_io=1;
} else if (input) {
EPRINTF(usage, argv[0]);
EXIT(NULL,-1);
......@@ -651,6 +658,7 @@ int main(int argc, char **argv) {
#endif
interpret(state.program,
options,
stack, stack_size,
heap, heap_size,
asp, bsp, csp,
......
......@@ -4,6 +4,7 @@
struct interpretation_options {
int in_first_semispace:1;
int allow_file_io:1;
#ifdef LINK_CLEAN_RUNTIME
int hyperstrict:1;
#endif
......@@ -49,6 +50,7 @@ extern void *e__ABC_PInterpreter__dDV__HeapFull;
extern void *e__ABC_PInterpreter__dDV__StackOverflow;
extern void *e__ABC_PInterpreter__dDV__Halt;
extern void *e__ABC_PInterpreter__dDV__IllegalInstruction;
extern void *e__ABC_PInterpreter__dDV__FileIOAttempted;
extern void *e__ABC_PInterpreter__dDV__SegmentationFault;
extern void *e__ABC_PInterpreter__dDV__HostHeapFull;
extern void *e__ABC_PInterpreter__kDV__Ok;
......@@ -67,6 +69,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];
......@@ -111,6 +114,7 @@ int interpret(
int create_restore_point,
#else
struct program *program,
struct interpretation_options options,
#endif
BC_WORD *stack, size_t stack_size,
BC_WORD *heap, size_t heap_size,
......
......@@ -27,4 +27,4 @@ typedef int64_t CleanInt;
#define BCGEN_INSTRUCTION_TABLE_SIZE 512
#define ABC_MAGIC_NUMBER 0x2a434241
#define ABC_VERSION 12
#define ABC_VERSION 13
......@@ -52,11 +52,12 @@ char *strsep(char **stringp, const char *delim);
extern char print_buffer[];
# ifdef STDERR_TO_FILE
void stderr_print(int);
# define EPRINTF(...) stderr_print(snprintf(print_buffer, PRINT_BUFFER_SIZE-1, __VA_ARGS__))
# define EPRINTF(...) stderr_print(snprintf(print_buffer, PRINT_BUFFER_SIZE-1, __VA_ARGS__))
# else
extern void ew_print_text(char*,int);
# define EPRINTF(...) ew_print_text(print_buffer, snprintf(print_buffer, PRINT_BUFFER_SIZE-1, __VA_ARGS__))
# define EPRINTF(...) ew_print_text(print_buffer, snprintf(print_buffer, PRINT_BUFFER_SIZE-1, __VA_ARGS__))
# endif
# define EPUTCHAR(c) EPRINTF("%c",c)
extern void w_print_text(char*,int);
extern void w_print_char(char);
# define PRINTF(...) w_print_text(print_buffer, snprintf(print_buffer, PRINT_BUFFER_SIZE-1, __VA_ARGS__))
......@@ -66,9 +67,11 @@ extern void w_print_char(char);
# include "debug_curses.h"
# define EPRINTF debugger_printf
# define PRINTF debugger_printf
# define EPUTCHAR debugger_putchar
# define PUTCHAR debugger_putchar
#else
# define EPRINTF(...) fprintf(stderr,__VA_ARGS__)
# define PRINTF printf
# define EPUTCHAR(c) fputc(c,stderr)
# define PUTCHAR putchar
#endif
......@@ -6,6 +6,7 @@ brainfuck
cafs
chars
compress
copyfile
curry
e
fills
......
module copyfile
/*
Commandline version of a file copying program.
Run the program using the "Basic Values Only" option.
*/
import StdEnv, StdFile
Start::*World -> *File
Start world = fwrites "\nGoodbye.\n" stdinout`
where
(stdinout`,_) = accFiles (CommandLoop stdinout) world`
(stdinout ,world`) = stdio world
CommandLoop::*File *Files -> (*File,*Files)
CommandLoop stdio files = CommandLoop` stdio` files`
where
(files`,stdio`) = Copy files stdio
CommandLoop`::*File *Files -> (*File,*Files)
CommandLoop` stdio files
| answer<>'y' && answer<>'Y' = (stdio2,files)
= CommandLoop` stdio` files`
where
(files`,stdio`) = Copy files stdio2
answer = FirstChar answ
(answ ,stdio2) = freadline stdio1
stdio1 = fwrites "\nCopy another file (y/n)? " stdio
Copy::*Files *File -> (*Files,*File)
Copy files io
| source == dest = (files, fwrites "\nCopying succeeded.\n" io4)
= CopyFile (StripNewline source) (StripNewline dest) files io4
where
(dest,io4) = freadline io3
io3 = fwrites "\nDestination file: " io2
(source,io2) = freadline io1
io1 = fwrites "\nSource file: " io
CopyFile::String String *Files *File -> (*Files,*File)
CopyFile source dest files io
| not sopen = (files1,alert1)
| not dopen = (files2,alert2)
| io_error = (files4,alert3)
| not dclose = (files4,alert4)
| not sclose = (files4,alert5)
= (files4,alert6)
where
(sclose,files4) = fclose sfile` files3
(dclose,files3) = fclose dfile` files2
(io_error,sfile`,dfile`) = CopyFiles sfile dfile
(dopen,dfile,files2) = fopen dest FWriteText files1
(sopen,sfile,files1) = fopen source FReadData files
alert1 = fwrites "\nCopying failed.\nSource file could not be opened.\n" io
alert2 = fwrites "Copying failed.\nDestination file could not be opened.\n" io
alert3 = fwrites "Copying failed.\nFile I/O error.\n" io
alert4 = fwrites "Copying failed.\nDestination file could not be closed.\n" io
alert5 = fwrites "Copying failed.\nSource file could not be closed.\n" io
alert6 = fwrites "\nCopying succeeded.\n" io
CopyFiles::*File *File -> (Bool, *File, *File)
CopyFiles source dest
| srcend || wrterror = (wrterror,source1,dest1)
= CopyFiles source2 (fwritec byte dest1)
where
(_,byte,source2) = freadc source1
(srcend,source1) = fend source
(wrterror,dest1) = ferror dest
StripNewline::String -> String
StripNewline "" = ""
StripNewline str = str % (0, size str - 2)
FirstChar::String -> Char
FirstChar "" = ' '
FirstChar str = str.[0]
Version: 1.5
Global
ProjectRoot: .
Target: StdEnv
Exec: {Project}/copyfile
ByteCode: {Project}/copyfile.bc
CodeGen
CheckStacks: False
CheckIndexes: True
OptimiseABC: True
GenerateByteCode: True
Application
HeapSize: 409600
StackSize: 102400
ExtraMemory: 81920
IntialHeapSize: 204800
HeapSizeMultiplier: 4096
ShowExecutionTime: False
ShowGC: False
ShowStackSize: False
MarkingCollector: False
DisableRTSFlags: False
StandardRuntimeEnv: True
Profile
Memory: False
MemoryMinimumHeapSize: 0
Time: False
Stack: False
Dynamics: False
GenericFusion: False
DescExL: False
Output
Output: ShowConstructors
Font: Courier
FontSize: 9
WriteStdErr: False
Link
LinkMethod: Static
GenerateRelocations: False
GenerateSymbolTable: False
GenerateLinkMap: False
LinkResources: False
ResourceSource:
GenerateDLL: False
ExportedNames:
StripByteCode: True
KeepByteCodeSymbols: True
PrelinkByteCode: False
Paths
Path: {Project}
Precompile:
Postlink:
MainModule
Name: copyfile
Dir: {Project}
Compiler
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes: StrictExportTypes
ListAttributes: True
Warnings: True
Verbose: True
ReadableABC: False
ReuseUniqueNodes: True
Fusion: False
definition module specialized
import target
instr_halt :: !Target -> Target
instr_divLU :: !Target -> Target
instr_mulUUL :: !Target -> Target
instr_RtoAC :: !Target -> Target
instr_closeF :: !Target -> Target
instr_endF :: !Target -> Target
instr_errorF :: !Target -> Target
instr_flushF :: !Target -> Target
instr_openF :: !Target -> Target
instr_positionF :: !Target -> Target
instr_readFC :: !Target -> Target
instr_readFI :: !Target -> Target
instr_readFR :: !Target -> Target
instr_readFS :: !Target -> Target
instr_readLineF :: !Target -> Target
instr_seekF :: !Target -> Target
instr_stderrF :: !Target -> Target
instr_stdioF :: !Target -> Target
instr_writeFC :: !Target -> Target
instr_writeFI :: !Target -> Target
instr_writeFR :: !Target -> Target
instr_writeFS :: !Target -> Target
instr_writeFString :: !Target -> Target
This diff is collapsed.
......@@ -7,15 +7,13 @@ import interpretergen
:: Target
:: Expr t
append :: !String !Target -> Target
start :: Target
bootstrap :: ![String] -> [String]
collect_instructions :: !Options ![Target] -> [String]
instr_unimplemented :: !Target -> Target
instr_halt :: !Target -> Target
instr_divLU :: !Target -> Target
instr_mulUUL :: !Target -> Target
instr_RtoAC :: !Target -> Target
lit_word :: !Int -> Expr TWord
lit_hword :: !Int -> Expr TPtrOffset
......@@ -142,6 +140,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
......
......@@ -19,6 +19,9 @@ import interpretergen
.o 1 0
}
append :: !String !Target -> Target
append e t = {t & output=[e:t.output]}
start :: Target
start = {instrs=[], output=[], var_counter=0}
......@@ -40,6 +43,22 @@ where
, "#endif"
, "#define NEED_HEAP(words) {if ((heap_free-=words)<0){ heap_free+=words; GARBAGE_COLLECT;}}"
, "#ifdef LINK_CLEAN_RUNTIME"
, "# define CHECK_FILE_IO do { \\"
, "\t\tif (!ie->options.allow_file_io) {\\"
, "\t\t\tinterpret_error=&e__ABC_PInterpreter__dDV__FileIOAttempted; \\"
, "\t\t\tEXIT(ie,-1); \\"
, "\t\t} \\"
, "\t} while (0)"
, "#else"
, "# define CHECK_FILE_IO do { \\"
, "\t\tif (!options.allow_file_io) {\\"
, "\t\t\tEPRINTF(\"File I/O attempted (%s) at %d\\n\", instruction_name(*pc), (int) (pc-program->code)); \\"
, "\t\t\tEXIT(ie,-1); \\"
, "\t\t} \\"
, "\t} while (0)"
, "#endif"
]
post :: [String]
......@@ -67,7 +86,6 @@ where
head = ["INSTRUCTION_BLOCK("+++i+++"):" \\ i <- t.instrs]
out = reverse t.output
append e t :== {t & output=[e:t.output]}
mark t :== append "MARK" t
concat_up_to_mark t=:{output} :==
let (ls,[_:rest]) = span ((<>) "MARK") output in
......@@ -101,85 +119,6 @@ instr_unimplemented t = foldl (flip append) t
, "#endif"
]
instr_halt :: !Target -> Target
instr_halt t = foldl (flip append) t
[ "#ifdef DEBUG_CURSES"
, "\tdebugger_graceful_end();"
, "#endif"
, "#ifdef LINK_CLEAN_RUNTIME"
, "\t{"
, "\t\tEPRINTF(\"Stack trace:\\n\");"
, "\t\tBC_WORD *start_csp = &stack[stack_size >> 1];"
, "\t\tchar _tmp[256];"
, "\t\tfor (; csp>start_csp; csp--) {"
, "\t\t\tprint_label(_tmp, 256, 1, (BC_WORD*)*csp, program, ie->heap, ie->heap_size);"
, "\t\t\tEPRINTF(\"%s\\n\",_tmp);"
, "\t\t}"
, "\t}"
, "\tinterpret_error=&e__ABC_PInterpreter__dDV__Halt;"
, "\tEXIT(ie,1);"
, "\tgoto eval_to_hnf_return_failure;"
, "#else"
, "\treturn 0;"
, "#endif"
]
instr_divLU :: !Target -> Target
instr_divLU t = foldl (flip append) t
[ "{"
, "#if defined(WINDOWS) && WORD_WIDTH==64"
, "\tEPRINTF(\"divLU is not supported on 64-bit Windows\\n\");"
, "#else"
, "# if WORD_WIDTH==64"
, "\t__int128_t num=((__int128_t)bsp[0] << 64) + bsp[1];"
, "# else"
, "\tint64_t num=((int64_t)bsp[0] << 32) + bsp[1];"
, "# endif"
, "\tbsp[1]=num%bsp[2];"
, "\tbsp[2]=num/bsp[2];"
, "\tbsp+=1;"
, "\tpc+=1;"
, "\tEND_INSTRUCTION_BLOCK;"
, "#endif"
, "}"
]
instr_mulUUL :: !Target -> Target
instr_mulUUL t = foldl (flip append) t
[ "{"
, "#if defined(WINDOWS) && WORD_WIDTH==64"
, "\tEPRINTF(\"mulUUL is not supported on 64-bit Windows\\n\");"
, "#else"
, "# if WORD_WIDTH==64"
, "\t__uint128_t res=(__uint128_t)((__uint128_t)bsp[0] * (__uint128_t)bsp[1]);"
, "# else"
, "\tuint64_t res=(uint64_t)bsp[0] * (uint64_t)bsp[1];"
, "# endif"
, "\tbsp[0]=res>>WORD_WIDTH;"
, "\tbsp[1]=(BC_WORD)res;"
, "\tpc+=1;"
, "\tEND_INSTRUCTION_BLOCK;"
, "#endif"
, "}"
]
instr_RtoAC :: !Target -> Target
instr_RtoAC t = foldl (flip append) t
[ "{"
, "char r[22];"
, "int n=sprintf(r,\"%.15g\",*((BC_REAL*)bsp)+0.0);"
, "NEED_HEAP(2+((n+IF_INT_64_OR_32(7,3))>>IF_INT_64_OR_32(3,2)));"
, "hp[0]=(BC_WORD)&__STRING__+2;"
, "hp[1]=n;"
, "memcpy(&hp[2],r,n);"
, "pc+=1;"
, "bsp+=1;"
, "asp[1]=(BC_WORD)hp;"
, "asp+=1;"
, "hp+=2+((n+IF_INT_64_OR_32(7,3))>>IF_INT_64_OR_32(3,2));"
, "}"
]
lit_word :: !Int -> Expr TWord
lit_word i = toString i
......@@ -473,6 +412,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]"
......
definition module specialized
import target
instr_halt :: !Target -> Target
instr_divLU :: !Target -> Target
instr_mulUUL :: !Target -> Target
instr_RtoAC :: !Target -> Target
instr_closeF :: !Target -> Target
instr_endF :: !Target -> Target
instr_errorF :: !Target -> Target
instr_flushF :: !Target -> Target
instr_openF :: !Target -> Target
instr_positionF :: !Target -> Target
instr_readFC :: !Target -> Target
instr_readFI :: !Target -> Target
instr_readFR :: !Target -> Target
instr_readFS :: !Target -> Target
instr_readLineF :: !Target -> Target
instr_seekF :: !Target -> Target
instr_stderrF :: !Target -> Target
instr_stdioF :: !Target -> Target
instr_writeFC :: !Target -> Target
instr_writeFI :: !Target -> Target
instr_writeFR :: !Target -> Target
instr_writeFS :: !Target -> Target
instr_writeFString :: !Target -> Target
implementation module specialized
import target
import wasm
instr_halt :: !Target -> Target
instr_halt t = (
append (Ecall "clean_halt" [expr_to_ex Pc, expr_to_ex Hp_free, Eget (Global "g-hp-size")]) :.
append (Ereturn (Econst I32 0))
) t
instr_divLU :: !Target -> Target
instr_divLU t = instr_unimplemented t // TODO
instr_mulUUL :: !Target -> Target
instr_mulUUL t = instr_unimplemented t // TODO
instr_RtoAC :: !Target -> Target
instr_RtoAC t = (
new_local TReal (to_real (B @ 0)) \r ->
new_local TPtrOffset (ex_to_expr (Ecall "clean_RtoAC_words_needed" [expr_to_ex r])) \lw ->
ensure_hp lw :.
A @ 1 .= to_word Hp :.
Hp .= (ex_to_expr (Ecall "clean_RtoAC" [expr_to_ex Hp,expr_to_ex r]) ::: TPtr TWord) :.
advance_ptr Pc 1 :.
advance_ptr A 1 :.
advance_ptr B 1
) t
instr_closeF :: !Target -> Target
instr_closeF t = instr_unimplemented t
instr_endF :: !Target -> Target
instr_endF t = instr_unimplemented t
instr_errorF :: !Target -> Target
instr_errorF t = instr_unimplemented t
instr_flushF :: !Target -> Target
instr_flushF t = instr_unimplemented t
instr_openF :: !Target -> Target
instr_openF t = instr_unimplemented t
instr_positionF :: !Target -> Target
instr_positionF t = instr_unimplemented t
instr_readFC :: !Target -> Target
instr_readFC t = instr_unimplemented t
instr_readFI :: !Target -> Target
instr_readFI t = instr_unimplemented t
instr_readFR :: !Target -> Target
instr_readFR t = instr_unimplemented t
instr_readFS :: !Target -> Target
instr_readFS t = instr_unimplemented t
instr_readLineF :: !Target -> Target
instr_readLineF t = instr_unimplemented t
instr_seekF :: !Target -> Target
instr_seekF t = instr_unimplemented t
instr_stderrF :: !Target -> Target
instr_stderrF t = instr_unimplemented t
instr_stdioF :: !Target -> Target
instr_stdioF t = instr_unimplemented t
instr_writeFC :: !Target -> Target
instr_writeFC t = instr_unimplemented t
instr_writeFI :: !Target -> Target
instr_writeFI t = instr_unimplemented t
instr_writeFR :: !Target -> Target
instr_writeFR t = instr_unimplemented t
instr_writeFS :: !Target -> Target
instr_writeFS t = instr_unimplemented t
instr_writeFString :: !Target -> Target
instr_writeFString t = instr_unimplemented t
......@@ -3,24 +3,32 @@ definition module target
import StdEnv
import StdMaybe
import interpretergen
from wasm import :: Type
from wasm import :: Type, :: Ex
class wasm_type a :: !a -> Type
instance wasm_type TWord, TPtrOffset, TBool, TChar, TShort, TInt, TReal, (TPtr t)
:: Target
:: TempVars
:: Target =
{ stmts :: ![Ex]
, instrs :: ![String]
, temp_vars :: !TempVars
}
append e t :== {t & stmts=[e:t.stmts]}
:: Expr t
cast_expr :: !(Expr t) -> Expr u
expr_to_ex :: !(Expr t) -> Ex
ex_to_expr :: !Ex -> Expr t
start :: Target
bootstrap :: ![String] -> [String]
collect_instructions :: !Options ![Target] -> [String]
instr_unimplemented :: !Target -> Target
instr_halt :: !Target -> Target
instr_divLU :: !Target -> Target
instr_mulUUL :: !Target -> Target
instr_RtoAC :: !Target -> Target
lit_word :: !Int -> Expr TWord
lit_hword :: !Int -> Expr TPtrOffset
......@@ -138,6 +146,7 @@ A :: Expr (TPtr TWord)
B :: Expr (TPtr TWord)
Pc :: Expr (TPtr TWord)
Hp :: Expr (TPtr TWord)
Hp_free :: Expr TPtrOffset
BOOL_ptr :: Expr TWord
CHAR_ptr :: Expr TWord
......@@ -145,6 +154,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
......
......@@ -51,12 +51,6 @@ where
, tv_f64 :: !Int
}
:: Target =
{ stmts :: ![Ex]
, instrs :: ![String]
, temp_vars :: !TempVars
}
start :: Target
start =
{ instrs = []
......@@ -64,8 +58,6 @@ start =
, temp_vars = {tv_i32=0,tv_i64=0,tv_f64=0}
}
append e t :== {t & stmts=[e:t.stmts]}
new_temp_var :: !Type !Target -> (!Variable, !Target)
new_temp_var tp t
# tp = case tp of
......@@ -88,8 +80,17 @@ f64_temp_vars =: {#{#'v','d',i} \\ i <- ['0'..'0']}
:: Expr t :== Ex
cast_expr :: !Ex -> Ex
cast_expr e = e
cast_expr :: !(Expr t) -> Expr u
cast_expr e = cast e
where
cast :: !Ex -> Ex
cast e = e
expr_to_ex :: !(Expr t) -> Ex
expr_to_ex e = e
ex_to_expr :: !Ex -> Expr t
ex_to_expr e = e
bootstrap :: ![String] -> [String]
bootstrap instrs = instrs
......@@ -298,30 +299,6 @@ where
fix_type :: !t !(Expr t) -> Expr t
fix_type _ e = e
instr_halt :: !Target -> Target
instr_halt t = (
append (Ecall "clean_halt" [cast_expr Pc, Hp_free, Eget (Global "g-hp-size")]) :.
append (Ereturn (Econst I32 0))
) t
instr_divLU :: !Target -> Target
instr_divLU t = instr_unimplemented t // TODO
instr_mulUUL :: !Target -> Target
instr_mulUUL t = instr_unimplemented t // TODO
instr_RtoAC :: !Target -> Target
instr_RtoAC t = (
new_local TReal (to_real (B @ 0)) \r ->
new_local TPtrOffset (Ecall "clean_RtoAC_words_needed" [r]) \lw ->
ensure_hp lw :.
A @ 1 .= to_word Hp :.
Hp .= (Ecall "clean_RtoAC" [Hp,r] ::: TPtr TWord) :.
advance_ptr Pc 1 :.
advance_ptr A 1 :.
advance_ptr B 1
) t
lit_word :: !Int -> Expr TWord
lit_word w = Econst I64 w
......@@ -707,6 +684,9 @@ ARRAY__ptr = Econst I64 (0*8)
STRING__ptr :: Expr TWord
STRING__ptr = Econst I64 (5*8)
FILE_ptr :: Expr TWord
FILE_ptr = Econst I64 (664*8)
jmp_ap_ptr :: !Int -> Expr (TPtr TWord)
jmp_ap_ptr i = Econst I32 ((98+i)*8)
......
......@@ -3,7 +3,8 @@ implementation module interpretergen
import StdEnv
import StdMaybe
import ArgEnv
import target
import target, specialized
Start w
# args = getCommandLine
......@@ -204,6 +205,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 +1702,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 :.
......@@ -3747,11 +3763,30 @@ all_instructions opts t = bootstrap $ collect_instructions opts $ map (\i -> i t
d .= (d + if_i64_or_i32_expr (lit_word 7) (lit_word 3)) &. if_i64_or_i32_expr (lit_word -8) (lit_word -4) :.
d += (B @ 0 <<. if_i64_or_i32_expr (lit_word 3) (lit_word 2)) :.
B @ 0 .= to_word_ptr d @ 0
, instr "closeF" Nothing instr_closeF
, instr "endF" Nothing instr_endF
, instr "errorF" Nothing instr_errorF
, instr "flushF" Nothing instr_flushF
, instr "openF" Nothing instr_openF
, instr "positionF" Nothing instr_positionF
, instr "readFC" Nothing instr_readFC
, instr "readFI" Nothing instr_readFI
, instr "readFR" Nothing instr_readFR
, instr "readFS" Nothing instr_readFS
, instr "readLineF" Nothing instr_readLineF
, instr "seekF" Nothing instr_seekF
, instr "stderrF" Nothing instr_stderrF
, instr "stdioF" Nothing instr_stdioF
, instr "writeFC" Nothing instr_writeFC
, instr "writeFI" Nothing instr_writeFI
, instr "writeFR" Nothing instr_writeFR
, instr "writeFS" Nothing instr_writeFS
, instr "writeFString" Nothing instr_writeFString
, alias "add_arg" $
alias "buildF_b" $
alias "ccall" $
alias "centry" $
alias "fillF_b" $
alias "fill3_r" $
alias "fill3_r01a" $
alias "fill3_r01b" $
......@@ -3768,6 +3803,20 @@ all_instructions opts t = bootstrap $ collect_instructions opts $ map (\i -> i t
alias "pushL" $
alias "pushLc" $
alias "set_finalizers" $
alias "endSF" $
alias "openSF" $
alias "positionSF" $
alias "readFString" $
alias "readLineSF" $
alias "readSFC" $
alias "readSFI" $
alias "readSFR" $
alias "readSFS" $
alias "reopenF" $
alias "seekSF" $
alias "shareF" $
alias "A_data_IIIla" $
alias "A_data_IIl" $
alias "A_data_IlI" $
......