Commit 41e0f2a9 authored by Camil Staps's avatar Camil Staps 🚀

Merge branch 'file-io' into 'master'

File I/O

See merge request !112
parents 8df29455 c7cf9ddc
Pipeline #29161 passed with stages
in 12 minutes and 36 seconds
......@@ -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)