artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mlibc: Cleanup.

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2018-05-29 18:15:22 +02:00
parent 559699969c
commit 2cda87257a
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
26 changed files with 345 additions and 425 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
build-aux/build-cc.sh
View file

@ -50,8 +50,4 @@ build-aux/mes-snarf.scm src/posix.c
build-aux/mes-snarf.scm src/reader.c
build-aux/mes-snarf.scm src/vector.c
NOLINK=1 sh build-aux/cc.sh lib/libc-mini-gcc
NOLINK=1 sh build-aux/cc.sh lib/libc-gcc
NOLINK=1 sh build-aux/cc.sh lib/libc+tcc-gcc
sh build-aux/cc.sh src/mes

17
include/mlibc.h → include/libmes.h
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* Mes --- Maxwell Equations of Software
* Copyright © 2016,2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
*
* This file is part of Mes.
*
@ -18,12 +18,21 @@
* along with Mes. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef __MES_MLIBC_H
#define __MES_MLIBC_H
#ifndef __MES_LIBMES_H
#define __MES_LIBMES_H
char const* itoa (int);
char const* itoab (int x, int base);
int _atoi (char const**, int base);
int atoi (char const *s);
int eputc (int c);
int eputs (char const* s);
int fdgetc (int fd);
int fdputc (int c, int fd);
int fdputs (char const* s, int fd);
int fdungetc (int c, int fd);
int isdigit (int c);
int isspace (int c);
int isxdigit (int c);
#endif //__MES_MLIBC_H
#endif //__MES_LIBMES_H

62
include/stdio.h
View file

@ -43,24 +43,6 @@ int g_stdout;
#undef __MES_STDIO_H
#include_next <stdio.h>
int fdputs (char const* s, int fd);
#undef puts
#define fputs fdputs
#ifdef putc
#undef putc
#endif
int eputc (int c);
int eputs (char const* s);
int fdputc (int c, int fd);
int getchar ();
#define fputc fdputc
#define ungetc fdungetc
int fdungetc (int c, int fd);
#else // ! (__GNUC__ && POSIX)
#ifndef EOF
@ -81,15 +63,6 @@ int fdungetc (int c, int fd);
#define SEEK_CUR 1
#define SEEK_END 2
#if __GNUC__
#undef fputs
#undef fdputs
int fdputs (char const* s, int fd);
#endif // __MES_GNUC__
//#define fputs fdputs
//#define fputc fdputc
typedef int FILE;
#ifndef __MES_SIZE_T
@ -98,39 +71,34 @@ typedef int FILE;
typedef unsigned long size_t;
#endif
int getc (FILE *stream);
int fputc (int c, FILE* stream);
int fdputs (char const* s, int fd);
int fputs (char const* s, FILE *stream);
int putc (int c, FILE* stream);
//int putc (int c, int fd);
FILE *fdopen (int fd, char const *mode);
FILE *fopen (char const *file_name, char const *mode);
int eputc (int c);
int eputs (char const* s);
int fclose (FILE *stream);
FILE *fdopen (int fd, char const *mode);
int fdputc (int c, int fd);
int fflush (FILE *stream);
int ferror (FILE *stream);
FILE *fopen (char const *file_name, char const *mode);
int fpurge (FILE *stream);
//void __fpurge (FILE *stream);
int fflush (FILE *stream);
int fgetc (FILE* stream);
int fprintf (FILE *stream, char const *format, ...);
size_t fread (void *ptr, size_t size, size_t nmemb, FILE *stream);
size_t __freadahead (FILE *fp);
//size_t freadahead (FILE *fp);
int fpurge (FILE *stream);
int fputc (int c, FILE *stream);
int fputs (char const* s, FILE *stream);
int fseek (FILE *stream, long offset, int whence);
long ftell (FILE *stream);
size_t fwrite (void const *ptr, size_t size, size_t nmemb, FILE *stream);
int getc (FILE *stream);
int getchar ();
int printf (char const* format, ...);
int putc (int c, FILE* stream);
int putchar (int c);
int puts (char const* s);
int remove (char const *file_name);
int sscanf (char const *str, const char *format, ...);
int snprintf(char *str, size_t size, char const *format, ...);
int sprintf (char *str, char const* format, ...);
int ungetc (int c, int fd);
int sscanf (char const *str, const char *format, ...);
int ungetc (int c, FILE* stream);
long ftell (FILE *stream);
size_t fread (void *ptr, size_t size, size_t count, FILE *stream);
size_t freadahead (FILE *fp);
size_t fwrite (void const *ptr, size_t size, size_t count, FILE *stream);
#endif // ! (__GNUC__ && POSIX)

6
lib/crt1.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* Mes --- Maxwell Equations of Software
* Copyright © 2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
*
* This file is part of Mes.
*
@ -19,9 +19,9 @@
*/
char **g_environment = 0;
int main (int,char*[]);
int main (int argc, char *argv[]);
#if __GNUC__ && !POSIX
#if __GNUC__
void
_start ()

9
lib/libc+tcc-gcc.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* Mes --- Maxwell Equations of Software
* Copyright © 2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
*
* This file is part of Mes.
*
@ -33,8 +33,7 @@
#include <linux+tcc-gcc.c>
#include <libc+tcc.c>
#include <getopt.c>
#if !POSIX
#include <m4.c>
int errno;
@ -150,7 +149,3 @@ __fixsfdi (double a1)
eputs ("__fixsfdi stub\n");
return 0;
}
#include <m4.c>
#endif // !POSIX

48
lib/libc-gcc.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* Mes --- Maxwell Equations of Software
* Copyright © 2016,2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
*
* This file is part of Mes.
*
@ -18,10 +18,10 @@
* along with Mes. If not, see <http://www.gnu.org/licenses/>.
*/
#include <mlibc.h>
#include <libmes.h>
#include <stdio.h>
#include <mlibc.h>
#include <libmes.h>
#include <stdarg.h>
#include <stdlib.h>
#include <unistd.h>
@ -32,45 +32,5 @@
#include <linux-mini-gcc.c>
#include <libc-mini.c>
#include <linux-gcc.c>
#include <libmes.c>
#include <libc.c>
#if POSIX
int
putchar (int c)
{
write (STDOUT, (char*)&c, 1);
return 0;
}
int ungetc_char = -1;
char ungetc_buf[2];
int
getchar ()
{
char c;
int i;
if (ungetc_char == -1)
{
int r = read (g_stdin, &c, 1);
if (r < 1) return -1;
i = c;
}
else
i = ungetc_buf[ungetc_char--];
if (i < 0) i += 256;
return i;
}
int
fdungetc (int c, int fd)
{
assert (ungetc_char < 2);
ungetc_buf[++ungetc_char] = c;
return c;
}
#endif // POSIX

5
lib/libc-mes.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* Mes --- Maxwell Equations of Software
* Copyright © 2016,2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
*
* This file is part of Mes.
*
@ -18,7 +18,7 @@
* along with Mes. If not, see <http://www.gnu.org/licenses/>.
*/
#include <mlibc.h>
#include <libmes.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
@ -28,4 +28,5 @@ void _env ();
#include <linux-mini-mes.c>
#include <libc-mini.c>
#include <linux-mes.c>
#include <libmes.c>
#include <libc.c>

209
lib/libc.c
View file

@ -23,148 +23,6 @@
#include <stdarg.h>
#include <stdlib.h>
#if POSIX
#define _GNU_SOURCE
#include <assert.h>
#include <fcntl.h>
#include <string.h>
#include <unistd.h>
#endif // POSIX
int
isdigit (int c)
{
return (c>='0') && (c<='9');
}
int
isxdigit (int c)
{
return isdigit (c) || (c>='a') && (c<='f');
}
int
isspace (int c)
{
return (c == '\t' || c == '\n' || c == '\v' || c == '\f' || c == '\r' || c == ' ');
}
int
isnumber (int c, int base)
{
if (base == 2)
return (c>='0') && (c<='1');
if (base == 8)
return (c>='0') && (c<='7');
if (base == 10)
return isdigit (c);
if (base == 16)
return isxdigit (c);
}
int
abtoi (char const **p, int base)
{
char const *s = *p;
int i = 0;
int sign = 1;
if (!base) base = 10;
if (*s && *s == '-')
{
sign = -1;
s++;
}
while (isnumber (*s, base))
{
i *= base;
int m = *s > '9' ? 'a' - 10 : '0';
i += *s - m;
s++;
}
*p = s;
return i * sign;
}
int
atoi (char const *s)
{
char const *p = s;
return abtoi (&p, 0);
}
char const*
itoa (int x)
{
static char itoa_buf[12];
char *p = itoa_buf + 11;
*p-- = 0;
int sign = 0;
unsigned u = x;
if (x < 0)
{
sign = 1;
u = -x;
}
do
{
*p-- = '0' + (u % 10);
u = u / 10;
} while (u);
if (sign && *(p + 1) != '0')
*p-- = '-';
return p+1;
}
char const*
itoab (int x, int base)
{
static char itoa_buf[12];
char *p = itoa_buf + 11;
*p-- = 0;
int sign = 0;
unsigned u = x;
if (x < 0)
{
sign = 1;
u = -x;
}
do
{
int i = u % base;
*p-- = i > 9 ? 'a' + i - 10 : '0' + i;
x = u / base;
} while (u);
if (sign && *(p + 1) != '0')
*p-- = '-';
return p+1;
}
int
fdputc (int c, int fd)
{
write (fd, (char*)&c, 1);
return 0;
}
int
fdputs (char const* s, int fd)
{
int i = strlen (s);
write (fd, s, i);
return 0;
}
#if !POSIX
///char **g_environment = 0; // FIXME: todo extern
int g_stdin = 0;
void _env ();
@ -196,26 +54,19 @@ putc (int c, FILE* stream)
FILE*
fopen (char const* file_name, char const* mode)
{
FILE* f;
int fd;
if ('w' == mode[0])
/* 577 is O_WRONLY|O_CREAT|O_TRUNC, 384 is 600 in octal */
f = open (file_name, 577 , 384);
fd = open (file_name, 577 , 384);
else
/* Everything else is a read */
f = open (file_name, 0, 0);
fd = open (file_name, 0, 0);
/* Negative numbers are error codes */
if (0 > f)
if (fd > 0)
return 0;
return f;
}
int
putchar (int c)
{
write (STDOUT, (char*)&c, 1);
return 0;
return (FILE*)fd;
}
void
@ -224,48 +75,21 @@ assert_fail (char* s)
eputs ("assert fail: ");
eputs (s);
eputs ("\n");
//*((int*)0) = 0;
char *fail = s;
fail = 0;
*fail = 0;
}
int ungetc_char = -1;
char ungetc_buf[2];
int
getchar ()
getc (FILE *stream)
{
char c;
int i;
if (ungetc_char == -1)
{
int r = read (g_stdin, &c, 1);
if (r < 1) return -1;
i = c;
}
else
{
//FIXME
//i = ungetc_buf[ungetc_char--];
i = ungetc_buf[ungetc_char];
//ungetc_char--;
ungetc_char = ungetc_char - 1;
}
if (i < 0) i += 256;
return i;
return fdgetc ((int)stream);
}
int
fgetc (int fd)
fgetc (FILE *stream)
{
char c;
int i;
int r = read (fd, &c, 1);
if (r < 1) return -1;
i = c;
return i;
return fdgetc ((int)stream);
}
void
@ -273,18 +97,10 @@ free (void *ptr)
{
}
//#define assert(x) ((x) ? (void)0 : assert_fail (#x))
int
ungetc (int c, int fd)
ungetc (int c, FILE *stream)
{
//FIXME
//assert (ungetc_char < 2);
//assert (ungetc_char == -1 || ungetc_char < 2);
//FIXME
//ungetc_buf[++ungetc_char] = c;
ungetc_char++;
ungetc_buf[ungetc_char] = c;
return c;
return fdungetc (c, (int)stream);
}
int
@ -356,7 +172,6 @@ fwrite (void const *data, size_t size, size_t count, FILE *stream)
return 0;
int bytes = write ((int)stream, data, size * count);
if (bytes > 0)
//return bytes/size;
return count;
return bytes;
}
@ -479,5 +294,3 @@ wait (int *status_ptr)
{
return waitpid (-1, status_ptr, 0);
}
#endif //!POSIX

199
lib/libmes.c Normal file
View file

@ -0,0 +1,199 @@
/* -*-comment-start: "//";comment-end:""-*-
* Mes --- Maxwell Equations of Software
* Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
*
* This file is part of Mes.
*
* Mes is free software; you can redistribute it and/or modify it
* under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 3 of the License, or (at
* your option) any later version.
*
* Mes is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with Mes. If not, see <http://www.gnu.org/licenses/>.
*/
#include <libmes.h>
int
isdigit (int c)
{
return c >= '0' && c <= '9';
}
int
isxdigit (int c)
{
return isdigit (c) || c >= 'a' && c <= 'f';
}
int
isspace (int c)
{
return (c == '\t' || c == '\n' || c == '\v' || c == '\f' || c == '\r' || c == ' ');
}
int
isnumber (int c, int base)
{
if (base == 2)
return (c >= '0') && (c <= '1');
if (base == 8)
return (c >= '0') && (c <= '7');
if (base == 10)
return isdigit (c);
if (base == 16)
return isxdigit (c);
}
int
abtoi (char const **p, int base)
{
char const *s = *p;
int i = 0;
int sign = 1;
if (!base) base = 10;
if (*s && *s == '-')
{
sign = -1;
s++;
}
while (isnumber (*s, base))
{
i *= base;
int m = *s > '9' ? 'a' - 10 : '0';
i += *s - m;
s++;
}
*p = s;
return i * sign;
}
int
atoi (char const *s)
{
char const *p = s;
return abtoi (&p, 0);
}
char const*
itoa (int x)
{
static char itoa_buf[12];
char *p = itoa_buf + 11;
*p-- = 0;
int sign = 0;
unsigned u = x;
if (x < 0)
{
sign = 1;
u = -x;
}
do
{
*p-- = '0' + (u % 10);
u = u / 10;
} while (u);
if (sign && *(p + 1) != '0')
*p-- = '-';
return p+1;
}
char const*
itoab (int x, int base)
{
static char itoa_buf[12];
char *p = itoa_buf + 11;
*p-- = 0;
int sign = 0;
unsigned u = x;
if (x < 0)
{
sign = 1;
u = -x;
}
do
{
int i = u % base;
*p-- = i > 9 ? 'a' + i - 10 : '0' + i;
x = u / base;
} while (u);
if (sign && *(p + 1) != '0')
*p-- = '-';
return p+1;
}
int _ungetc_pos = -1;
char _ungetc_buf[10];
int
fdgetc (int fd)
{
char c;
int i;
if (_ungetc_pos == -1)
{
int r = read (fd, &c, 1);
if (r < 1)
return -1;
i = c;
}
else
{
i = _ungetc_buf[_ungetc_pos];
_ungetc_pos -= 1;
}
if (i < 0)
i += 256;
return i;
}
int
fdputc (int c, int fd)
{
write (fd, (char*)&c, 1);
return 0;
}
int
putchar (int c)
{
write (STDOUT, (char*)&c, 1);
return 0;
}
int
fdputs (char const* s, int fd)
{
int i = strlen (s);
write (fd, s, i);
return 0;
}
int
fdungetc (int c, int fd)
{
_ungetc_pos++;
_ungetc_buf[_ungetc_pos] = c;
return c;
}
int
getchar ()
{
return fdgetc (g_stdin);
}

6
lib/linux-gcc.c
View file

@ -19,13 +19,11 @@
*/
#include <stdio.h>
#include <mlibc.h>
#include <libmes.h>
#include <stdlib.h>
#include <unistd.h>
#include <sys/wait.h>
#if !POSIX
int
fork ()
{
@ -253,5 +251,3 @@ fsync (int fd)
return r;
#endif
}
#endif //!POSIX

4
lib/linux-mini-gcc.c
View file

@ -18,8 +18,6 @@
* along with Mes. If not, see <http://www.gnu.org/licenses/>.
*/
#if !POSIX
void
exit (int code)
{
@ -79,5 +77,3 @@ write (int fd, char const* s, int n)
#endif
return r;
}
#endif //!POSIX

27
lib/m4.c
View file

@ -65,13 +65,6 @@ fileno (FILE *stream)
return (int)stream;
}
// void
// __fpurge (FILE *stream)
// {
// eputs ("__fpurge stub\n");
// return 0;
// }
int
fpurge (FILE *stream)
{
@ -79,13 +72,6 @@ fpurge (FILE *stream)
return 0;
}
// size_t
// __freadahead (FILE *fp)
// {
// eputs ("__freadahead stub\n");
// return 0;
// }
size_t
freadahead (FILE *fp)
{
@ -93,12 +79,6 @@ freadahead (FILE *fp)
return 0;
}
int
getc (FILE *stream)
{
return fgetc ((int)stream);
}
int
index (char const *s, int c)
{
@ -222,3 +202,10 @@ tolower (int x)
eputs ("tolower stub\n");
return 0;
}
int
toupper (int x)
{
eputs ("toupper stub\n");
return 0;
}

2
scaffold/cons-mes.c
View file

@ -26,7 +26,7 @@
#include <assert.h>
#include <stdlib.h>
#include <string.h>
#include <mlibc.h>
#include <libmes.h>
char arena[2000];

2
scaffold/malloc.c
View file

@ -22,7 +22,7 @@
#error "POSIX not supported"
#endif
#include <mlibc.h>
#include <libmes.h>
int
main (int argc, char *argv[])

2
scaffold/mini-mes.c
View file

@ -28,7 +28,7 @@
#include <assert.h>
#include <stdlib.h>
#include <string.h>
#include <mlibc.h>
#include <libmes.h>
int ARENA_SIZE = 200000; // 32b: 2MiB, 64b: 4 MiB
int MAX_ARENA_SIZE = 300000000;

2
scaffold/tests/52-itoa.c
View file

@ -19,7 +19,7 @@
*/
#include "30-test.i"
#include <mlibc.h>
#include <libmes.h>
#include <stdlib.h>
#include <string.h>

2
scaffold/tests/61-array.c
View file

@ -18,7 +18,7 @@
* along with Mes. If not, see <http://www.gnu.org/licenses/>.
*/
#include <mlibc.h>
#include <libmes.h>
#include <stdio.h>
#include <stdlib.h>

2
scaffold/tests/79-int-array.c
View file

@ -20,7 +20,7 @@
#include "30-test.i"
#include <mlibc.h>
#include <libmes.h>
#include <stdio.h>
#include <string.h>

2
scaffold/tests/7c-dynarray.c
View file

@ -20,7 +20,7 @@
#include "30-test.i"
#include <mlibc.h>
#include <libmes.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>

2
scaffold/tests/7f-struct-pointer-arithmetic.c
View file

@ -20,7 +20,7 @@
#include "30-test.i"
#include <mlibc.h>
#include <libmes.h>
#include <stdio.h>
struct foo;

2
scaffold/tests/7j-strtoull.c
View file

@ -19,7 +19,7 @@
*/
#include "30-test.i"
#include <mlibc.h>
#include <libmes.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

2
scaffold/tests/7n-struct-struct-array.c
View file

@ -20,7 +20,7 @@
#include "30-test.i"
#include <mlibc.h>
#include <libmes.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>

2
scaffold/tiny-mes.c
View file

@ -23,7 +23,7 @@
#endif
#include <stdio.h>
#include <mlibc.h>
#include <libmes.h>
char arena[300];

128
src/lib.c
View file

@ -24,94 +24,94 @@ SCM fdisplay_ (SCM, int, int);
SCM
display_helper (SCM x, int cont, char* sep, int fd, int write_p)
{
fputs (sep, fd);
fdputs (sep, fd);
if (g_depth == 0)
return cell_unspecified;
g_depth = g_depth - 1;
switch (TYPE (x))
{
case TCHAR:
{
if (!write_p)
fputc (VALUE (x), fd);
fdputc (VALUE (x), fd);
else
{
fputs ("#\\", fd);
fdputs ("#\\", fd);
switch (VALUE (x))
{
case '\0': fputs ("nul", fd); break;
case '\a': fputs ("alarm", fd); break;
case '\b': fputs ("backspace", fd); break;
case '\t': fputs ("tab", fd); break;
case '\n': fputs ("newline", fd); break;
case '\v': fputs ("vtab", fd); break;
case '\f': fputs ("page", fd); break;
case '\0': fdputs ("nul", fd); break;
case '\a': fdputs ("alarm", fd); break;
case '\b': fdputs ("backspace", fd); break;
case '\t': fdputs ("tab", fd); break;
case '\n': fdputs ("newline", fd); break;
case '\v': fdputs ("vtab", fd); break;
case '\f': fdputs ("page", fd); break;
//Nyacc bug
// case '\r': fputs ("return", fd); break;
case 13: fputs ("return", fd); break;
case ' ': fputs ("space", fd); break;
default: fputc (VALUE (x), fd);
// case '\r': fdputs ("return", fd); break;
case 13: fdputs ("return", fd); break;
case ' ': fdputs ("space", fd); break;
default: fdputc (VALUE (x), fd);
}
}
break;
}
case TCLOSURE:
{
fputs ("#<closure ", fd);
fdputs ("#<closure ", fd);
display_helper (CDR (x), cont, "", fd, 0);
fputs (">", fd);
fdputs (">", fd);
break;
}
case TFUNCTION:
{
fputs ("#<procedure ", fd);
fdputs ("#<procedure ", fd);
char const *p = "?";
if (FUNCTION (x).name != 0)
p = FUNCTION (x).name;
fputs (p, fd);
fputs ("[", fd);
fputs (itoa (CDR (x)), fd);
fputs (",", fd);
fputs (itoa (x), fd);
fputs ("]>", fd);
fdputs (p, fd);
fdputs ("[", fd);
fdputs (itoa (CDR (x)), fd);
fdputs (",", fd);
fdputs (itoa (x), fd);
fdputs ("]>", fd);
break;
}
case TMACRO:
{
fputs ("#<macro ", fd);
fdputs ("#<macro ", fd);
display_helper (CDR (x), cont, "", fd, 0);
fputs (">", fd);
fdputs (">", fd);
break;
}
case TVARIABLE:
{
fputs ("#<variable ", fd);
fdputs ("#<variable ", fd);
display_helper (CAR (VARIABLE (x)), cont, "", fd, 0);
fputs (">", fd);
fdputs (">", fd);
break;
}
case TNUMBER:
{
fputs (itoa (VALUE (x)), fd);
fdputs (itoa (VALUE (x)), fd);
break;
}
case TPAIR:
{
if (!cont)
fputs ("(", fd);
fdputs ("(", fd);
if (CAR (x) == cell_circular
&& CADR (x) != cell_closure)
{
fputs ("(*circ* . ", fd);
fdputs ("(*circ* . ", fd);
int i = 0;
x = CDR (x);
while (x != cell_nil && i++ < 10)
{
fdisplay_ (CAAR (x), fd, write_p); fputs (" ", fd);
fdisplay_ (CAAR (x), fd, write_p); fdputs (" ", fd);
x = CDR (x);
}
fputs (" ...)", fd);
fdputs (" ...)", fd);
}
else
{
@ -122,12 +122,12 @@ display_helper (SCM x, int cont, char* sep, int fd, int write_p)
else if (CDR (x) && CDR (x) != cell_nil)
{
if (TYPE (CDR (x)) != TPAIR)
fputs (" . ", fd);
fdputs (" . ", fd);
fdisplay_ (CDR (x), fd, write_p);
}
}
if (!cont)
fputs (")", fd);
fdputs (")", fd);
break;
}
case TKEYWORD:
@ -138,68 +138,68 @@ display_helper (SCM x, int cont, char* sep, int fd, int write_p)
{
if (TYPE (x) == TPORT)
{
fputs ("#<port ", fd);
fputs (itoa (PORT (x)), fd);
fputs (" " ,fd);
fdputs ("#<port ", fd);
fdputs (itoa (PORT (x)), fd);
fdputs (" " ,fd);
}
if (TYPE (x) == TKEYWORD)
fputs ("#:", fd);
fdputs ("#:", fd);
if ((write_p && TYPE (x) == TSTRING) || TYPE (x) == TPORT)
fputc ('"', fd);
fdputc ('"', fd);
SCM t = CAR (x);
while (t && t != cell_nil)
{
switch (write_p ? VALUE (CAR (t)) : -1)
{
case '\0': fputs ("\\0", fd); break;
case '\a': fputs ("\\a", fd); break;
case '\b': fputs ("\\b", fd); break;
case '\t': fputs ("\\t", fd); break;
case '\v': fputs ("\\v", fd); break;
case '\n': fputs ("\\n", fd); break;
case '\f': fputs ("\\f", fd); break;
case '\0': fdputs ("\\0", fd); break;
case '\a': fdputs ("\\a", fd); break;
case '\b': fdputs ("\\b", fd); break;
case '\t': fdputs ("\\t", fd); break;
case '\v': fdputs ("\\v", fd); break;
case '\n': fdputs ("\\n", fd); break;
case '\f': fdputs ("\\f", fd); break;
#if 1 //__MESC__
//Nyacc bug
case 13: fputs ("\\r", fd); break;
case 27: fputs ("\\e", fd); break;
case 13: fdputs ("\\r", fd); break;
case 27: fdputs ("\\e", fd); break;
#else
//case '\r': fputs ("\\r", fd); break;
//case '\r': fdputs ("\\r", fd); break;
//Nyacc crash
//case '\e': fputs ("\\e", fd); break;
//case '\e': fdputs ("\\e", fd); break;
#endif
case '\\': fputs ("\\\\", fd); break;
case '"': fputs ("\\\"", fd); break;
case '\\': fdputs ("\\\\", fd); break;
case '"': fdputs ("\\\"", fd); break;
default:
fputc (VALUE (CAR (t)), fd);
fdputc (VALUE (CAR (t)), fd);
}
t = CDR (t);
}
if ((write_p && TYPE (x) == TSTRING) || TYPE (x) == TPORT)
fputc ('"', fd);
fdputc ('"', fd);
if (TYPE (x) == TPORT)
fputs (">", fd);
fdputs (">", fd);
break;
}
case TVECTOR:
{
fputs ("#(", fd);
fdputs ("#(", fd);
SCM t = CAR (x);
for (int i = 0; i < LENGTH (x); i++)
{
if (i)
fputc (' ', fd);
fdputc (' ', fd);
fdisplay_ (VECTOR (x) + i, fd, write_p);
}
fputc (')', fd);
fdputc (')', fd);
break;
}
default:
{
fputs ("<", fd);
fputs (itoa (TYPE (x)), fd);
fputs (":", fd);
fputs (itoa (x), fd);
fputs (">", fd);
fdputs ("<", fd);
fdputs (itoa (TYPE (x)), fd);
fdputs (":", fd);
fdputs (itoa (x), fd);
fdputs (">", fd);
break;
}
}

20
src/mes.c
View file

@ -22,7 +22,7 @@
#include <assert.h>
#include <stdlib.h>
#include <string.h>
#include <mlibc.h>
#include <libmes.h>
//#define MES_MINI 1
#if _POSIX_SOURCE
@ -2196,18 +2196,18 @@ a = acons (lookup_symbol_ (scm_display_error_.string), cell_display_error_, a);
if (g_debug > 3)
{
fputs ("functions: ", STDERR);
fputs (itoa (g_function), STDERR);
fputs ("\n", STDERR);
fdputs ("functions: ", STDERR);
fdputs (itoa (g_function), STDERR);
fdputs ("\n", STDERR);
for (int i = 0; i < g_function; i++)
{
fputs ("[", STDERR);
fputs (itoa (i), STDERR);
fputs ("]: ", STDERR);
fputs (g_functions[i].name, STDERR);
fputs ("\n", STDERR);
fdputs ("[", STDERR);
fdputs (itoa (i), STDERR);
fdputs ("]: ", STDERR);
fdputs (g_functions[i].name, STDERR);
fdputs ("\n", STDERR);
}
fputs ("\n", STDERR);
fdputs ("\n", STDERR);
}
return a;

4
src/posix.c
View file

@ -44,7 +44,7 @@ int
readchar ()
{
if (g_stdin >= 0)
return getchar ();
return fdgetc (g_stdin);
SCM port = current_input_port ();
SCM string = STRING (port);
if (string == cell_nil)
@ -58,7 +58,7 @@ int
unreadchar (int c)
{
if (g_stdin >= 0)
return ungetc (c, g_stdin);
return fdungetc (c, g_stdin);
SCM port = current_input_port ();
STRING (port) = cons (MAKE_CHAR (c), STRING (port));
return c;