st/lama_byterun
1
0
Fork 0
mirror of https://github.com/ProgramSnail/Lama.git synced 2025-12-05 22:38:44 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

fexists added

Browse source
This commit is contained in:
Dmitry Boulytchev 2021-11-19 01:38:22 +03:00
parent eb098a6fac
commit 9ff649e563
5 changed files with 28 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

BIN
lama-spec.pdf
View file

Binary file not shown.

1
runtime/Std.i
View file

@ -26,6 +26,7 @@ F,fopen;
F,fclose; F,fclose;
F,fread; F,fread;
F,fwrite; F,fwrite;
F,fexists;
F,failure; F,failure;
F,read; F,read;
F,write; F,write;

36
runtime/runtime.c
View file

@ -62,7 +62,7 @@ void __post_gc_subst () {}
# define TO_DATA(x) ((data*)((char*)(x)-sizeof(int))) # define TO_DATA(x) ((data*)((char*)(x)-sizeof(int)))
# define TO_SEXP(x) ((sexp*)((char*)(x)-2*sizeof(int))) # define TO_SEXP(x) ((sexp*)((char*)(x)-2*sizeof(int)))
#ifdef DEBUG_PRINT // GET_SEXP_TAG is necessary for printing from space # ifdef DEBUG_PRINT // GET_SEXP_TAG is necessary for printing from space
# define GET_SEXP_TAG(x) (LEN(x)) # define GET_SEXP_TAG(x) (LEN(x))
#endif #endif
@ -71,7 +71,7 @@ void __post_gc_subst () {}
# define BOX(x) ((((int) (x)) << 1) | 0x0001) # define BOX(x) ((((int) (x)) << 1) | 0x0001)
/* GC extra roots */ /* GC extra roots */
#define MAX_EXTRA_ROOTS_NUMBER 32 # define MAX_EXTRA_ROOTS_NUMBER 32
typedef struct { typedef struct {
int current_free; int current_free;
void ** roots[MAX_EXTRA_ROOTS_NUMBER]; void ** roots[MAX_EXTRA_ROOTS_NUMBER];
@ -84,44 +84,44 @@ void clear_extra_roots (void) {
} }
void push_extra_root (void ** p) { void push_extra_root (void ** p) {
#ifdef DEBUG_PRINT # ifdef DEBUG_PRINT
indent++; print_indent (); indent++; print_indent ();
printf ("push_extra_root %p %p\n", p, &p); fflush (stdout); printf ("push_extra_root %p %p\n", p, &p); fflush (stdout);
#endif # endif
if (extra_roots.current_free >= MAX_EXTRA_ROOTS_NUMBER) { if (extra_roots.current_free >= MAX_EXTRA_ROOTS_NUMBER) {
perror ("ERROR: push_extra_roots: extra_roots_pool overflow"); perror ("ERROR: push_extra_roots: extra_roots_pool overflow");
exit (1); exit (1);
} }
extra_roots.roots[extra_roots.current_free] = p; extra_roots.roots[extra_roots.current_free] = p;
extra_roots.current_free++; extra_roots.current_free++;
#ifdef DEBUG_PRINT # ifdef DEBUG_PRINT
indent--; indent--;
#endif # endif
} }
void pop_extra_root (void ** p) { void pop_extra_root (void ** p) {
#ifdef DEBUG_PRINT # ifdef DEBUG_PRINT
indent++; print_indent (); indent++; print_indent ();
printf ("pop_extra_root %p %p\n", p, &p); fflush (stdout); printf ("pop_extra_root %p %p\n", p, &p); fflush (stdout);
#endif # endif
if (extra_roots.current_free == 0) { if (extra_roots.current_free == 0) {
perror ("ERROR: pop_extra_root: extra_roots are empty"); perror ("ERROR: pop_extra_root: extra_roots are empty");
exit (1); exit (1);
} }
extra_roots.current_free--; extra_roots.current_free--;
if (extra_roots.roots[extra_roots.current_free] != p) { if (extra_roots.roots[extra_roots.current_free] != p) {
#ifdef DEBUG_PRINT # ifdef DEBUG_PRINT
print_indent (); print_indent ();
printf ("%i %p %p", extra_roots.current_free, printf ("%i %p %p", extra_roots.current_free,
extra_roots.roots[extra_roots.current_free], p); extra_roots.roots[extra_roots.current_free], p);
fflush (stdout); fflush (stdout);
#endif # endif
perror ("ERROR: pop_extra_root: stack invariant violation"); perror ("ERROR: pop_extra_root: stack invariant violation");
exit (1); exit (1);
} }
#ifdef DEBUG_PRINT # ifdef DEBUG_PRINT
indent--; indent--;
#endif # endif
} }
/* end */ /* end */
@ -1427,6 +1427,18 @@ extern void Lfwrite (char *fname, char *contents) {
failure ("fwrite (\"%s\"): %s\n", fname, strerror (errno)); failure ("fwrite (\"%s\"): %s\n", fname, strerror (errno));
} }
extern void* Lfexists (char *fname) {
FILE *f;
ASSERT_STRING("fexists", fname);
f = fopen (fname, "r");
if (f) return BOX(1);
return BOX(0);
}
extern void* Lfst (void *v) { extern void* Lfst (void *v) {
return Belem (v, BOX(0)); return Belem (v, BOX(0));
} }

2
spec/08.standard_library.tex
View file

@ -87,6 +87,8 @@ is automatically open and closed within the call.}
\descr{\lstinline|fun fwrite (fname, contents)|}{Writes a file. The arguments are file name and the contents to write as strings. The file \descr{\lstinline|fun fwrite (fname, contents)|}{Writes a file. The arguments are file name and the contents to write as strings. The file
is automatically created and closed within the call.} is automatically created and closed within the call.}
\descr{\lstinline|fun fexists (fname)|}{Checks if a file exists. The argument is the file name.}
\descr{\lstinline|fun fprintf (file, fmt, ...)|}{Same as "\lstinline|printf|", but outputs to a given file. The file argument should be that acquired \descr{\lstinline|fun fprintf (file, fmt, ...)|}{Same as "\lstinline|printf|", but outputs to a given file. The file argument should be that acquired
by \lstinline|fopen| function.} by \lstinline|fopen| function.}

2
src/version.ml
View file

@ -1 +1 @@
let version = "Version 1.10, 594fa7bf8, Sat Oct 30 19:24:25 2021 +0300" let version = "Version 1.10, eb098a6fa, Sun Oct 31 15:34:34 2021 +0300"