Verified Commit 4b663a9e authored by Camil Staps's avatar Camil Staps 🚀

Implement a number of additional file I/O instructions

parent dccd2929
......@@ -976,15 +976,15 @@ static struct specialized_jsr specialized_jsr_labels[]={
SPECIALIZED(endF, S_IO)
SPECIALIZED(endSF, S_IO | S_UNSUPPORTED)
SPECIALIZED(errorF, S_IO)
SPECIALIZED(flushF, S_IO | S_UNSUPPORTED)
SPECIALIZED(flushF, S_IO)
SPECIALIZED(openF, S_IO)
SPECIALIZED(openSF, S_IO | S_UNSUPPORTED)
SPECIALIZED(positionF, S_IO | S_UNSUPPORTED)
SPECIALIZED(positionF, S_IO)
SPECIALIZED(positionSF, S_IO | S_UNSUPPORTED)
SPECIALIZED(readFC, S_IO)
SPECIALIZED(readFI, S_IO | S_UNSUPPORTED)
SPECIALIZED(readFR, S_IO | S_UNSUPPORTED)
SPECIALIZED(readFS, S_IO | S_UNSUPPORTED)
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)
......@@ -993,16 +993,16 @@ static struct specialized_jsr specialized_jsr_labels[]={
SPECIALIZED(readSFR, S_IO | S_UNSUPPORTED)
SPECIALIZED(readSFS, S_IO | S_UNSUPPORTED)
SPECIALIZED(reopenF, S_IO | S_UNSUPPORTED)
SPECIALIZED(seekF, S_IO | S_UNSUPPORTED)
SPECIALIZED(seekF, S_IO)
SPECIALIZED(seekSF, S_IO | S_UNSUPPORTED)
SPECIALIZED(shareF, S_IO | S_UNSUPPORTED)
SPECIALIZED(stderrF, S_IO | S_UNSUPPORTED)
SPECIALIZED(stderrF, S_IO)
SPECIALIZED(stdioF, S_IO)
SPECIALIZED(writeFC, S_IO)
SPECIALIZED(writeFI, S_IO | S_UNSUPPORTED)
SPECIALIZED(writeFR, S_IO | S_UNSUPPORTED)
SPECIALIZED(writeFI, S_IO)
SPECIALIZED(writeFR, S_IO)
SPECIALIZED(writeFS, S_IO)
SPECIALIZED(writeFString, S_IO | S_UNSUPPORTED)
SPECIALIZED(writeFString, S_IO)
};
static int get_specialized_jsr_label_n(char label_name[]) {
......
......@@ -11,10 +11,14 @@
#define F_WRITE_DATA 4
#define F_APPEND_DATA 5
static char *file_modes[]={"r","w",NULL/*a*/,"rb",NULL/*wb*/,NULL/*ab*/};
#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;
......
......@@ -12,9 +12,19 @@ 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
......@@ -140,6 +140,21 @@ instr_errorF t = foldl (flip append) t
, "}"
]
instr_flushF :: !Target -> Target
instr_flushF t = foldl (flip append) t
[ "{"
, "CHECK_FILE_IO;"
, "pc++;"
, "struct file *f=(struct file*)bsp[1];"
, "if (f==&clean_stdinout)"
, "\t*--bsp=fflush(stdout) ? 0 : 1;"
, "else if (f==&clean_stderr)"
, "\t*--bsp=fflush(stdin) ? 0 : 1;"
, "else"
, "\t*--bsp=fflush(f->file_handle) ? 0 : 1;"
, "}"
]
instr_openF :: !Target -> Target
instr_openF t = foldl (flip append) t
[ "{"
......@@ -157,6 +172,7 @@ instr_openF t = foldl (flip append) t
, "if (mode==NULL)"
, "\tIO_error(\"openF: unimplemented mode\");"
, "f->file_handle=fopen(file_name,mode);"
, "f->file_mode=bsp[0];"
, "bsp-=2;"
, "bsp[1]=0;"
, "if (f->file_handle==NULL) {"
......@@ -170,6 +186,19 @@ instr_openF t = foldl (flip append) t
, "}"
]
instr_positionF :: !Target -> Target
instr_positionF t = foldl (flip append) t
[ "{"
, "CHECK_FILE_IO;"
, "pc++;"
, "struct file *f=(struct file*)bsp[1];"
, "if (f==&clean_stdinout || f==&clean_stderr)"
, "\tIO_error(\"FPosition: not allowed for StdIO and StdErr\");"
, "else"
, "\t*--bsp=ftell(f->file_handle);"
, "}"
]
instr_readFC :: !Target -> Target
instr_readFC t = foldl (flip append) t
[ "{"
......@@ -189,6 +218,83 @@ instr_readFC t = foldl (flip append) t
, "}"
]
instr_readFI :: !Target -> Target
instr_readFI t = foldl (flip append) t
[ "{"
, "CHECK_FILE_IO;"
, "pc++;"
, "struct file *f=(struct file*)bsp[1];"
, "bsp-=2;"
, "if (f==&clean_stdinout) {"
, "\tbsp[0]=fscanf(stdin,BC_WORD_S_FMT,&bsp[1])==1;"
, "} else if (f==&clean_stderr) {"
, "\tIO_error(\"FReadI: can't read from StdErr\");"
, "} else if (F_IS_TEXT_MODE(f->file_mode)) {"
, "\tbsp[0]=fscanf(f->file_handle,BC_WORD_S_FMT,&bsp[1])==1;"
, "} else {"
, "\tint i;"
, "\tbsp[0]=1;"
, "\tbsp[1]=0;"
, "\tfor (int n=0; n<4; n++) {"
, "\t\tif ((i=fgetc(f->file_handle))==EOF) break;"
, "\t\t((char*)&bsp[1])[n]=i;"
, "\t}"
, "#if WORD_WIDTH == 64"
, "\tbsp[1]=*(int*)&bsp[1];"
, "#endif"
, "}"
, "}"
]
instr_readFR :: !Target -> Target
instr_readFR t = foldl (flip append) t
[ "{"
, "CHECK_FILE_IO;"
, "pc++;"
, "struct file *f=(struct file*)bsp[1];"
, "bsp-=2;"
, "if (f==&clean_stdinout) {"
, "\tbsp[0]=fscanf(stdin,\"%lg\",(BC_REAL*)&bsp[1])==1;"
, "} else if (f==&clean_stderr) {"
, "\tIO_error(\"FReadI: can't read from StdErr\");"
, "} else if (F_IS_TEXT_MODE(f->file_mode)) {"
, "\tbsp[0]=fscanf(f->file_handle,\"%lg\",(BC_REAL*)&bsp[1])==1;"
, "} else {"
, "\tint i;"
, "\tbsp[0]=1;"
, "\t*(BC_REAL*)&bsp[1]=0.0;"
, "\tfor (int n=0; n<8; n++) {"
, "\t\tif ((i=fgetc(f->file_handle))==EOF) break;"
, "\t\t((char*)&bsp[1])[n]=i;"
, "\t}"
, "}"
, "}"
]
instr_readFS :: !Target -> Target
instr_readFS t = foldl (flip append) t
[ "{"
, "CHECK_FILE_IO;"
, "BC_WORD len=bsp[2];"
, "NEED_HEAP(len);"
, "bsp[2]=bsp[1];"
, "bsp[1]=bsp[0];"
, "bsp++;"
, "struct file *f=(struct file*)bsp[1];"
, "pc++;"
, "*++asp=(BC_WORD)hp;"
, "hp[0]=(BC_WORD)&__STRING__+2;"
, "if (f==&clean_stdinout) {"
, "\thp[1]=fread((char*)&hp[2],1,len,stdin);"
, "} else if (f==&clean_stderr) {"
, "\tIO_error(\"FReadS: can't read from StdErr\");"
, "} else {"
, "\thp[1]=fread((char*)&hp[2],1,len,f->file_handle);"
, "}"
, "hp+=2+((hp[1]+7)>>3);"
, "}"
]
instr_readLineF :: !Target -> Target
instr_readLineF t = foldl (flip append) t
[ "{"
......@@ -228,6 +334,35 @@ instr_readLineF t = foldl (flip append) t
, "}"
]
instr_seekF :: !Target -> Target
instr_seekF t = foldl (flip append) t
[ "{"
, "CHECK_FILE_IO;"
, "pc++;"
, "unsigned int seek_mode=bsp[3];"
, "int position=bsp[2];"
, "if (seek_mode>2)"
, "\tIO_error(\"FSeek: invalid mode\");"
, "struct file *f=(struct file*)bsp[1];"
, "bsp[3]=bsp[1];"
, "bsp[2]=bsp[0];"
, "bsp++;"
, "if (f==&clean_stdinout || f==&clean_stderr)"
, "\tIO_error(\"FSeek: can't seek on StdIO and StdErr\");"
, "else"
, "\tbsp[0]=fseek(f->file_handle,position,seek_mode) ? 0 : 1;"
, "}"
]
instr_stderrF :: !Target -> Target
instr_stderrF t = foldl (flip append) t
[ "CHECK_FILE_IO;"
, "pc+=1;"
, "bsp[-1]=(BC_WORD)&clean_stderr;"
, "bsp[-2]=-1;"
, "bsp-=2;"
]
instr_stdioF :: !Target -> Target
instr_stdioF t = foldl (flip append) t
[ "CHECK_FILE_IO;"
......@@ -256,6 +391,56 @@ instr_writeFC t = foldl (flip append) t
, "}"
]
instr_writeFI :: !Target -> Target
instr_writeFI t = foldl (flip append) t
[ "{"
, "CHECK_FILE_IO;"
, "pc++;"
, "BC_WORD_S i=*bsp++;"
, "struct file *f=(struct file*)bsp[1];"
, "if (f==&clean_stdinout)"
, "\tPRINTF(BC_WORD_S_FMT,i);"
, "else if (f==&clean_stderr)"
, "\tEPRINTF(BC_WORD_S_FMT,i);"
, "else if (F_IS_TEXT_MODE(f->file_mode))"
, "\tfprintf(f->file_handle,BC_WORD_S_FMT,i);"
, "else {"
, "\tputc(((char*)&i)[0],f->file_handle);"
, "\tputc(((char*)&i)[1],f->file_handle);"
, "\tputc(((char*)&i)[2],f->file_handle);"
, "\tputc(((char*)&i)[3],f->file_handle);"
, "}"
, "}"
]
instr_writeFR :: !Target -> Target
instr_writeFR t = foldl (flip append) t
[ "{"
, "CHECK_FILE_IO;"
, "pc++;"
, "BC_REAL r=0.0 + *(BC_REAL*)bsp;"
, "bsp++;"
, "struct file *f=(struct file*)bsp[1];"
, "if (f==&clean_stdinout)"
, "\tPRINTF(\"%.15g\",r);"
, "else if (f==&clean_stderr)"
, "\tEPRINTF(\"%.15g\",r);"
, "else if (F_IS_TEXT_MODE(f->file_mode))"
, "\tfprintf(f->file_handle,\"%.15g\",r);"
, "else {"
, "\tBC_WORD i=bsp[-1];"
, "\tputc(((char*)&i)[0],f->file_handle);"
, "\tputc(((char*)&i)[1],f->file_handle);"
, "\tputc(((char*)&i)[2],f->file_handle);"
, "\tputc(((char*)&i)[3],f->file_handle);"
, "\tputc(((char*)&i)[4],f->file_handle);"
, "\tputc(((char*)&i)[5],f->file_handle);"
, "\tputc(((char*)&i)[6],f->file_handle);"
, "\tputc(((char*)&i)[7],f->file_handle);"
, "}"
, "}"
]
instr_writeFS :: !Target -> Target
instr_writeFS t = foldl (flip append) t
[ "{"
......@@ -271,6 +456,29 @@ instr_writeFS t = foldl (flip append) t
, "else if (f==&clean_stderr)"
, "\tfor (;len;len--) EPUTCHAR(*s++);"
, "else"
, "\tIO_error(\"writeFS fallthrough\");" // TODO
, "\tfwrite(s,1,len,f->file_handle);"
, "}"
]
instr_writeFString :: !Target -> Target
instr_writeFString t = foldl (flip append) t
[ "{"
, "CHECK_FILE_IO;"
, "struct file *f=(struct file*)bsp[3];"
, "BC_WORD *n=(BC_WORD*)asp[0];"
, "BC_WORD start=bsp[0];"
, "BC_WORD len=bsp[1];"
, "if (start+len>n[1])"
, "\tIO_error(\"Error in fwritesubstring parameters.\");"
, "bsp+=2;"
, "pc++;"
, "asp--;"
, "char *s=(char*)&n[2]+start;"
, "if (f==&clean_stdinout)"
, "\tfor (;len;len--) PUTCHAR(*s++);"
, "else if (f==&clean_stderr)"
, "\tfor (;len;len--) EPUTCHAR(*s++);"
, "else"
, "\tfwrite(s,1,len,f->file_handle);" // TODO
, "}"
]
......@@ -3767,12 +3767,22 @@ all_instructions opts t = bootstrap $ collect_instructions opts $ map (\i -> i t
, 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 "ccall" $
......@@ -3795,13 +3805,8 @@ all_instructions opts t = bootstrap $ collect_instructions opts $ map (\i -> i t
alias "set_finalizers" $
alias "endSF" $
alias "flushF" $
alias "openSF" $
alias "positionF" $
alias "positionSF" $
alias "readFI" $
alias "readFR" $
alias "readFS" $
alias "readFString" $
alias "readLineSF" $
alias "readSFC" $
......@@ -3809,13 +3814,8 @@ all_instructions opts t = bootstrap $ collect_instructions opts $ map (\i -> i t
alias "readSFR" $
alias "readSFS" $
alias "reopenF" $
alias "seekF" $
alias "seekSF" $
alias "shareF" $
alias "stderrF" $
alias "writeFI" $
alias "writeFR" $
alias "writeFString" $
alias "A_data_IIIla" $
alias "A_data_IIl" $
......
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