summaryrefslogtreecommitdiffstats
path: root/mdk-stage1/slang/slposio.c
diff options
context:
space:
mode:
Diffstat (limited to 'mdk-stage1/slang/slposio.c')
-rw-r--r--mdk-stage1/slang/slposio.c568
1 files changed, 0 insertions, 568 deletions
diff --git a/mdk-stage1/slang/slposio.c b/mdk-stage1/slang/slposio.c
deleted file mode 100644
index ab1e9f689..000000000
--- a/mdk-stage1/slang/slposio.c
+++ /dev/null
@@ -1,568 +0,0 @@
-/* This module implements an interface to posix system calls */
-/* file stdio intrinsics for S-Lang */
-/* Copyright (c) 1992, 1999, 2001 John E. Davis
- * This file is part of the S-Lang library.
- *
- * You may distribute under the terms of either the GNU General Public
- * License or the Perl Artistic License.
- */
-
-#include "slinclud.h"
-
-#if defined(__unix__) || (defined (__os2__) && defined (__EMX__))
-# include <sys/types.h>
-#endif
-
-#ifdef HAVE_FCNTL_H
-# include <fcntl.h>
-#endif
-#ifdef HAVE_SYS_FCNTL_H
-# include <sys/fcntl.h>
-#endif
-
-#ifdef __unix__
-# include <sys/file.h>
-#endif
-
-#ifdef HAVE_IO_H
-# include <io.h>
-#endif
-
-#if defined(__BORLANDC__)
-# include <dir.h>
-#endif
-
-#if defined(__DECC) && defined(VMS)
-# include <unixio.h>
-# include <unixlib.h>
-#endif
-
-#ifdef VMS
-# include <stat.h>
-#else
-# include <sys/stat.h>
-#endif
-
-#include <errno.h>
-
-#include "slang.h"
-#include "_slang.h"
-
-struct _SLFile_FD_Type
-{
- char *name;
- unsigned int num_refs; /* reference counting */
- int fd;
- SLang_MMT_Type *stdio_mmt; /* fdopen'd stdio object */
-
- /* methods */
- int (*close)(int);
- int (*read) (int, char *, unsigned int *);
- int (*write)(int, char *, unsigned int *);
-};
-
-static int close_method (int fd)
-{
- return close (fd);
-}
-
-static int write_method (int fd, char *buf, unsigned int *nump)
-{
- int num;
-
- if (-1 == (num = write (fd, buf, *nump)))
- {
- *nump = 0;
- return -1;
- }
-
- *nump = (unsigned int) num;
- return 0;
-}
-
-static int read_method (int fd, char *buf, unsigned int *nump)
-{
- int num;
-
- num = read (fd, buf, *nump);
- if (num == -1)
- {
- *nump = 0;
- return -1;
- }
- *nump = (unsigned int) num;
- return 0;
-}
-
-static int check_fd (int fd)
-{
- if (fd == -1)
- {
-#ifdef EBADF
- _SLerrno_errno = EBADF;
-#endif
- return -1;
- }
-
- return 0;
-}
-
-static int posix_close (SLFile_FD_Type *f)
-{
- if (-1 == check_fd (f->fd))
- return -1;
-
- if ((f->close != NULL)
- && (-1 == f->close (f->fd)))
- {
- _SLerrno_errno = errno;
- return -1;
- }
-
- if (f->stdio_mmt != NULL)
- {
- SLang_free_mmt (f->stdio_mmt);
- f->stdio_mmt = NULL;
- }
-
- f->fd = -1;
- return 0;
-}
-
-/* Usage: Uint write (f, buf); */
-static void posix_write (SLFile_FD_Type *f, SLang_BString_Type *bstr)
-{
- unsigned int len;
- char *p;
-
- if ((-1 == check_fd (f->fd))
- || (NULL == (p = (char *)SLbstring_get_pointer (bstr, &len))))
- {
- SLang_push_integer (-1);
- return;
- }
-
- if (-1 == f->write (f->fd, p, &len))
- {
- _SLerrno_errno = errno;
- SLang_push_integer (-1);
- return;
- }
-
- (void) SLang_push_uinteger (len);
-}
-
-/* Usage: nn = read (f, &buf, n); */
-static void posix_read (SLFile_FD_Type *f, SLang_Ref_Type *ref, unsigned int *nbytes)
-{
- unsigned int len;
- char *b;
- SLang_BString_Type *bstr;
-
- b = NULL;
-
- len = *nbytes;
- if ((-1 == check_fd (f->fd))
- || (NULL == (b = SLmalloc (len + 1))))
- goto return_error;
-
- if (-1 == f->read (f->fd, b, &len))
- {
- _SLerrno_errno = errno;
- goto return_error;
- }
-
- if (len != *nbytes)
- {
- char *b1 = SLrealloc (b, len + 1);
- if (b1 == NULL)
- goto return_error;
- b = b1;
- }
-
- bstr = SLbstring_create_malloced ((unsigned char *) b, len, 0);
- if (bstr != NULL)
- {
- if ((-1 != SLang_assign_to_ref (ref, SLANG_BSTRING_TYPE, (VOID_STAR)&bstr))
- && (-1 != SLang_push_uinteger (len)))
- return;
-
- SLbstring_free (bstr);
- b = NULL;
- /* drop */
- }
-
- return_error:
- if (b != NULL) SLfree ((char *)b);
- (void) SLang_assign_to_ref (ref, SLANG_NULL_TYPE, NULL);
- (void) SLang_push_integer (-1);
-}
-
-SLFile_FD_Type *SLfile_create_fd (char *name, int fd)
-{
- SLFile_FD_Type *f;
-
- if (NULL == (f = (SLFile_FD_Type *) SLmalloc (sizeof (SLFile_FD_Type))))
- return NULL;
-
- memset ((char *) f, 0, sizeof (SLFile_FD_Type));
- if (NULL == (f->name = SLang_create_slstring (name)))
- {
- SLfree ((char *)f);
- return NULL;
- }
-
- f->fd = fd;
- f->num_refs = 1;
-
- f->close = close_method;
- f->read = read_method;
- f->write = write_method;
-
- return f;
-}
-
-SLFile_FD_Type *SLfile_dup_fd (SLFile_FD_Type *f0)
-{
- SLFile_FD_Type *f;
- int fd0, fd;
-
- if (f0 == NULL)
- return NULL;
- fd0 = f0->fd;
- if (-1 == check_fd (fd0))
- return NULL;
-
- while (-1 == (fd = dup (fd0)))
- {
-#ifdef EINTR
- if (errno == EINTR)
- continue;
-#endif
- _SLerrno_errno = errno;
- return NULL;
- }
-
- if (NULL == (f = SLfile_create_fd (f0->name, fd)))
- {
- f0->close (fd);
- return NULL;
- }
-
- return f;
-}
-
-int SLfile_get_fd (SLFile_FD_Type *f, int *fd)
-{
- if (f == NULL)
- return -1;
-
- *fd = f->fd;
- if (-1 == check_fd (*fd))
- return -1;
-
- return 0;
-}
-
-void SLfile_free_fd (SLFile_FD_Type *f)
-{
- if (f == NULL)
- return;
-
- if (f->num_refs > 1)
- {
- f->num_refs -= 1;
- return;
- }
-
- if (f->fd != -1)
- {
- if (f->close != NULL)
- (void) f->close (f->fd);
-
- f->fd = -1;
- }
-
- if (f->stdio_mmt != NULL)
- SLang_free_mmt (f->stdio_mmt);
-
- SLfree ((char *) f);
-}
-
-static int pop_string_int (char **s, int *i)
-{
- *s = NULL;
- if ((-1 == SLang_pop_integer (i))
- || (-1 == SLang_pop_slstring (s)))
- return -1;
-
- return 0;
-}
-
-static int pop_string_int_int (char **s, int *a, int *b)
-{
- *s = NULL;
- if ((-1 == SLang_pop_integer (b))
- || (-1 == pop_string_int (s, a)))
- return -1;
-
- return 0;
-}
-
-static void posix_open (void)
-{
- char *file;
- int mode, flags;
- SLFile_FD_Type *f;
-
- switch (SLang_Num_Function_Args)
- {
- case 3:
- if (-1 == pop_string_int_int (&file, &flags, &mode))
- {
- SLang_push_null ();
- return;
- }
- break;
-
- case 2:
- default:
- if (-1 == pop_string_int (&file, &flags))
- return;
- mode = 0777;
- break;
- }
-
- f = SLfile_create_fd (file, -1);
- if (f == NULL)
- {
- SLang_free_slstring (file);
- SLang_push_null ();
- return;
- }
- SLang_free_slstring (file);
-
- if (-1 == (f->fd = open (f->name, flags, mode)))
- {
- _SLerrno_errno = errno;
- SLfile_free_fd (f);
- SLang_push_null ();
- return;
- }
-
- if (-1 == SLfile_push_fd (f))
- SLang_push_null ();
- SLfile_free_fd (f);
-}
-
-static void posix_fileno (void)
-{
- FILE *fp;
- SLang_MMT_Type *mmt;
- int fd;
- SLFile_FD_Type *f;
- char *name;
-
- if (-1 == SLang_pop_fileptr (&mmt, &fp))
- {
- SLang_push_null ();
- return;
- }
- name = SLang_get_name_from_fileptr (mmt);
- fd = fileno (fp);
-
- f = SLfile_create_fd (name, fd);
- if (f != NULL)
- f->close = NULL; /* prevent fd from being closed
- * when it goes out of scope
- */
- SLang_free_mmt (mmt);
-
- if (-1 == SLfile_push_fd (f))
- SLang_push_null ();
- SLfile_free_fd (f);
-}
-
-static void posix_fdopen (SLFile_FD_Type *f, char *mode)
-{
- if (f->stdio_mmt == NULL)
- {
- if (-1 == _SLstdio_fdopen (f->name, f->fd, mode))
- return;
-
- if (NULL == (f->stdio_mmt = SLang_pop_mmt (SLANG_FILE_PTR_TYPE)))
- return;
- }
-
- (void) SLang_push_mmt (f->stdio_mmt);
-}
-
-static long posix_lseek (SLFile_FD_Type *f, long ofs, int whence)
-{
- long status;
-
- if (-1 == (status = lseek (f->fd, ofs, whence)))
- _SLerrno_errno = errno;
-
- return status;
-}
-
-static int posix_isatty (void)
-{
- int ret;
- SLFile_FD_Type *f;
-
- if (SLang_peek_at_stack () == SLANG_FILE_PTR_TYPE)
- {
- SLang_MMT_Type *mmt;
- FILE *fp;
-
- if (-1 == SLang_pop_fileptr (&mmt, &fp))
- return 0; /* invalid descriptor */
-
- ret = isatty (fileno (fp));
- SLang_free_mmt (mmt);
- return ret;
- }
-
- if (-1 == SLfile_pop_fd (&f))
- return 0;
-
- ret = isatty (f->fd);
- SLfile_free_fd (f);
-
- return ret;
-}
-
-static void posix_dup (SLFile_FD_Type *f)
-{
- if ((NULL == (f = SLfile_dup_fd (f)))
- || (-1 == SLfile_push_fd (f)))
- SLang_push_null ();
-
- SLfile_free_fd (f);
-}
-
-#define I SLANG_INT_TYPE
-#define V SLANG_VOID_TYPE
-#define F SLANG_FILE_FD_TYPE
-#define B SLANG_BSTRING_TYPE
-#define R SLANG_REF_TYPE
-#define U SLANG_UINT_TYPE
-#define S SLANG_STRING_TYPE
-#define L SLANG_LONG_TYPE
-static SLang_Intrin_Fun_Type Fd_Name_Table [] =
-{
- MAKE_INTRINSIC_0("fileno", posix_fileno, V),
- MAKE_INTRINSIC_0("isatty", posix_isatty, I),
- MAKE_INTRINSIC_0("open", posix_open, V),
- MAKE_INTRINSIC_3("read", posix_read, V, F, R, U),
- MAKE_INTRINSIC_3("lseek", posix_lseek, L, F, L, I),
- MAKE_INTRINSIC_2("fdopen", posix_fdopen, V, F, S),
- MAKE_INTRINSIC_2("write", posix_write, V, F, B),
- MAKE_INTRINSIC_1("dup_fd", posix_dup, V, F),
- MAKE_INTRINSIC_1("close", posix_close, I, F),
- SLANG_END_INTRIN_FUN_TABLE
-};
-#undef I
-#undef V
-#undef F
-#undef B
-#undef R
-#undef S
-#undef L
-#undef U
-
-static SLang_IConstant_Type PosixIO_Consts [] =
-{
-#ifdef O_RDONLY
- MAKE_ICONSTANT("O_RDONLY", O_RDONLY),
-#endif
-#ifdef O_WRONLY
- MAKE_ICONSTANT("O_WRONLY", O_WRONLY),
-#endif
-#ifdef O_RDWR
- MAKE_ICONSTANT("O_RDWR", O_RDWR),
-#endif
-#ifdef O_APPEND
- MAKE_ICONSTANT("O_APPEND", O_APPEND),
-#endif
-#ifdef O_CREAT
- MAKE_ICONSTANT("O_CREAT", O_CREAT),
-#endif
-#ifdef O_EXCL
- MAKE_ICONSTANT("O_EXCL", O_EXCL),
-#endif
-#ifdef O_NOCTTY
- MAKE_ICONSTANT("O_NOCTTY", O_NOCTTY),
-#endif
-#ifdef O_NONBLOCK
- MAKE_ICONSTANT("O_NONBLOCK", O_NONBLOCK),
-#endif
-#ifdef O_TRUNC
- MAKE_ICONSTANT("O_TRUNC", O_TRUNC),
-#endif
-#ifndef O_BINARY
-# define O_BINARY 0
-#endif
- MAKE_ICONSTANT("O_BINARY", O_BINARY),
-#ifndef O_TEXT
-# define O_TEXT 0
-#endif
- MAKE_ICONSTANT("O_TEXT", O_TEXT),
-
- SLANG_END_ICONST_TABLE
-};
-
-int SLfile_push_fd (SLFile_FD_Type *f)
-{
- if (f == NULL)
- return SLang_push_null ();
-
- f->num_refs += 1;
-
- if (0 == SLclass_push_ptr_obj (SLANG_FILE_FD_TYPE, (VOID_STAR) f))
- return 0;
-
- f->num_refs -= 1;
-
- return -1;
-}
-
-int SLfile_pop_fd (SLFile_FD_Type **f)
-{
- return SLclass_pop_ptr_obj (SLANG_FILE_FD_TYPE, (VOID_STAR *) f);
-}
-
-static void destroy_fd_type (unsigned char type, VOID_STAR ptr)
-{
- (void) type;
- SLfile_free_fd (*(SLFile_FD_Type **) ptr);
-}
-
-static int fd_push (unsigned char type, VOID_STAR v)
-{
- (void) type;
- return SLfile_push_fd (*(SLFile_FD_Type **)v);
-}
-
-int SLang_init_posix_io (void)
-{
- SLang_Class_Type *cl;
-
- if (NULL == (cl = SLclass_allocate_class ("FD_Type")))
- return -1;
- cl->cl_destroy = destroy_fd_type;
- (void) SLclass_set_push_function (cl, fd_push);
-
- if (-1 == SLclass_register_class (cl, SLANG_FILE_FD_TYPE, sizeof (SLFile_FD_Type), SLANG_CLASS_TYPE_PTR))
- return -1;
-
- if ((-1 == SLadd_intrin_fun_table(Fd_Name_Table, "__POSIXIO__"))
- || (-1 == SLadd_iconstant_table (PosixIO_Consts, NULL))
- || (-1 == _SLerrno_init ()))
- return -1;
-
- return 0;
-}
-
generated by cgit v1.2.1 (git 2.21.0) at 2025-11-03 22:35:21 +0000