slstdio.c

一个C格式的脚本处理函数库源代码,可让你的C程序具有执行C格式的脚本文件

	return -1;
     }

   return 0;
}

/* Usage: n = fread (&str, data-type, nelems, fp); */
static void stdio_fread (SLang_Ref_Type *ref, int *data_typep, unsigned int *num_elemns, SL_File_Table_Type *t)
{
   char *s;
   FILE *fp;
   int ret;
   unsigned int num_read, num_to_read;
   unsigned int nbytes;
   SLang_Class_Type *cl;
   unsigned int sizeof_type;
   int data_type;

   ret = -1;
   s = NULL;
   /* cl = NULL; */

   if (NULL == (fp = check_fp (t, SL_READ)))
     goto the_return;

   /* FIXME: priority = low : I should add some mechanism to support
    * other types.
    */
   data_type = *data_typep;

   cl = _SLclass_get_class ((unsigned char) data_type);

   if (cl->cl_fread == NULL)
     {
	SLang_verror (SL_NOT_IMPLEMENTED,
		      "fread does not support %s objects",
		      cl->cl_name);
	goto the_return;
     }

   sizeof_type = cl->cl_sizeof_type;

   num_to_read = *num_elemns;
   nbytes = (unsigned int) num_to_read * sizeof_type;

   s = SLmalloc (nbytes + 1);
   if (s == NULL)
     goto the_return;

   ret = cl->cl_fread (data_type, fp, (VOID_STAR)s, num_to_read, &num_read);

   if ((num_read == 0)
       && (num_read != num_to_read))
     ret = -1;

   if ((ret == -1) && ferror (fp))
     _SLerrno_errno = errno;

   if ((ret == 0)
       && (num_read != num_to_read))
     {
	char *new_s;

	nbytes = num_read * sizeof_type;
	new_s = SLrealloc (s, nbytes + 1);
	if (new_s == NULL)
	  ret = -1;
	else
	  s = new_s;
     }

   if (ret == 0)
     {
	if (num_read == 1)
	  {
	     ret = SLang_assign_to_ref (ref, data_type, (VOID_STAR)s);
	     SLfree (s);
	  }
	else if ((data_type == SLANG_CHAR_TYPE)
		 || (data_type == SLANG_UCHAR_TYPE))
	  {
	     SLang_BString_Type *bs;

	     bs = SLbstring_create_malloced ((unsigned char *)s, num_read, 1);
	     ret = SLang_assign_to_ref (ref, SLANG_BSTRING_TYPE, (VOID_STAR)&bs);
	     SLbstring_free (bs);
	  }
	else
	  {
	     SLang_Array_Type *at;
	     int inum_read = (int) num_read;
	     at = SLang_create_array (data_type, 0, (VOID_STAR)s, &inum_read, 1);
	     ret = SLang_assign_to_ref (ref, SLANG_ARRAY_TYPE, (VOID_STAR)&at);
	     SLang_free_array (at);
	  }
	s = NULL;
     }

   the_return:

   if (s != NULL)
     SLfree (s);
   
   if (ret == -1)
     SLang_push_integer (ret);
   else
     SLang_push_uinteger (num_read);
}

/* Usage: n = fwrite (str, fp); */
static void stdio_fwrite (SL_File_Table_Type *t)
{
   FILE *fp;
   unsigned char *s;
   unsigned int num_to_write, num_write;
   int ret;
   SLang_BString_Type *b;
   SLang_Array_Type *at;
   SLang_Class_Type *cl;

   ret = -1;
   b = NULL;
   at = NULL;

   switch (SLang_peek_at_stack ())
     {
      case SLANG_BSTRING_TYPE:
      case SLANG_STRING_TYPE:
	if (-1 == SLang_pop_bstring (&b))
	  goto the_return;

	if (NULL == (s = SLbstring_get_pointer (b, &num_to_write)))
	  goto the_return;

	cl = _SLclass_get_class (SLANG_UCHAR_TYPE);
	break;

      default:
	if (-1 == SLang_pop_array (&at, 1))
	  goto the_return;

	cl = at->cl;
	num_to_write = at->num_elements;
	s = (unsigned char *) at->data;
     }

   if (NULL == (fp = check_fp (t, SL_WRITE)))
     goto the_return;

   if (cl->cl_fwrite == NULL)
     {
	SLang_verror (SL_NOT_IMPLEMENTED,
		      "fwrite does not support %s objects", cl->cl_name);
	goto the_return;
     }

   ret = cl->cl_fwrite (cl->cl_data_type, fp, s, num_to_write, &num_write);

   if ((ret == -1) && ferror (fp))
     _SLerrno_errno = errno;

   /* drop */
   the_return:
   if (b != NULL)
     SLbstring_free (b);
   if (at != NULL)
     SLang_free_array (at);

   if (ret == -1)
     SLang_push_integer (ret);
   else
     SLang_push_uinteger (num_write);
}

static int stdio_fseek (SL_File_Table_Type *t, int *ofs, int *whence)
{
   FILE *fp;

   if (NULL == (fp = check_fp (t, 0xFFFF)))
     return -1;

   if (-1  == fseek (fp, (long) *ofs, *whence))
     {
	_SLerrno_errno = errno;
	return -1;
     }

   return 0;
}

static int stdio_ftell (SL_File_Table_Type *t)
{
   FILE *fp;
   long ofs;

   if (NULL == (fp = check_fp (t, 0xFFFF)))
     return -1;

   if (-1L == (ofs = ftell (fp)))
     {
	_SLerrno_errno = errno;
	return -1;
     }

   return (int) ofs;
}

static int stdio_feof (SL_File_Table_Type *t)
{
   FILE *fp;

   if (NULL == (fp = check_fp (t, 0xFFFF)))
     return -1;

   return feof (fp);
}

static int stdio_ferror (SL_File_Table_Type *t)
{
   FILE *fp;

   if (NULL == (fp = check_fp (t, 0xFFFF)))
     return -1;

   return ferror (fp);
}

static void stdio_clearerr (SL_File_Table_Type *t)
{
   FILE *fp;

   if (NULL != (fp = check_fp (t, 0xFFFF)))
     clearerr (fp);
}

/* () = fprintf (fp, "FORMAT", arg...); */
static int stdio_fprintf (void)
{
   char *s;
   FILE *fp;
   SLang_MMT_Type *mmt;
   int status;

   if (-1 == _SLstrops_do_sprintf_n (SLang_Num_Function_Args - 2))
     return -1;
   
   if (-1 == SLang_pop_slstring (&s))
     return -1;
   
   if (NULL == (mmt = pop_fp (SL_WRITE, &fp)))
     {
	SLang_free_slstring (s);
	return -1;
     }
   
   if (EOF == fputs(s, fp))
     status = -1;
   else
     status = (int) strlen (s);

   SLang_free_mmt (mmt);
   SLang_free_slstring (s);
   return status;
}

static int stdio_printf (void)
{
   char *s;
   int status;

   if (-1 == _SLstrops_do_sprintf_n (SLang_Num_Function_Args - 1))
     return -1;

   if (-1 == SLang_pop_slstring (&s))
     return -1;
   
   if (EOF == fputs(s, stdout))
     status = -1;
   else
     status = (int) strlen (s);

   SLang_free_slstring (s);
   return status;
}

   
#define F SLANG_FILE_PTR_TYPE
#define R SLANG_REF_TYPE
#define I SLANG_INT_TYPE
#define V SLANG_VOID_TYPE
#define S SLANG_STRING_TYPE
#define B SLANG_BSTRING_TYPE
#define U SLANG_UINT_TYPE
#define D SLANG_DATATYPE_TYPE
static SLang_Intrin_Fun_Type Stdio_Name_Table[] =
{
   MAKE_INTRINSIC_0("fgetslines", stdio_fgetslines, V),
   MAKE_INTRINSIC_SS("fopen", stdio_fopen, V),
   MAKE_INTRINSIC_1("feof", stdio_feof, I, F),
   MAKE_INTRINSIC_1("ferror", stdio_ferror, I, F),
   MAKE_INTRINSIC_1("fclose", stdio_fclose, I, F),
   MAKE_INTRINSIC_2("fgets", stdio_fgets, I, R, F),
   MAKE_INTRINSIC_1("fflush", stdio_fflush, I, F),
   MAKE_INTRINSIC_2("fputs", stdio_fputs, I, S, F),
   MAKE_INTRINSIC_0("fprintf", stdio_fprintf, I),
   MAKE_INTRINSIC_0("printf", stdio_printf, I),
   MAKE_INTRINSIC_3("fseek", stdio_fseek, I, F, I, I),
   MAKE_INTRINSIC_1("ftell", stdio_ftell, I, F),
   MAKE_INTRINSIC_1("clearerr", stdio_clearerr, V, F),
   MAKE_INTRINSIC_4("fread", stdio_fread, V, R, D, U, F),
   MAKE_INTRINSIC_1("fwrite", stdio_fwrite, V, F),
#ifdef HAVE_POPEN
   MAKE_INTRINSIC_SS("popen", stdio_popen, V),
   MAKE_INTRINSIC_1("pclose", stdio_fclose, I, F),
#endif
   SLANG_END_INTRIN_FUN_TABLE
};
#undef F
#undef I
#undef R
#undef V
#undef S
#undef B
#undef U
#undef D

#ifndef SEEK_SET
# define SEEK_SET 0
#endif
#ifndef SEEK_CUR
# define SEEK_CUR 1
#endif
#ifndef SEEK_END
# define SEEK_END 2
#endif

static SLang_IConstant_Type Stdio_Consts [] =
{
   MAKE_ICONSTANT("SEEK_SET", SEEK_SET),
   MAKE_ICONSTANT("SEEK_END", SEEK_END),
   MAKE_ICONSTANT("SEEK_CUR", SEEK_CUR),
   SLANG_END_ICONST_TABLE
};

static void destroy_file_type (unsigned char type, VOID_STAR ptr)
{
   (void) type;
   (void) close_file_type ((SL_File_Table_Type *) ptr);
}


struct _SLang_Foreach_Context_Type
{
   SLang_MMT_Type *mmt;
   FILE *fp;
#define CTX_USE_LINE		1
#define CTX_USE_CHAR		2
#define CTX_USE_LINE_WS		3
   unsigned char type;
};


static SLang_Foreach_Context_Type *
cl_foreach_open (unsigned char type, unsigned int num)
{
   SLang_Foreach_Context_Type *c;
   SLang_MMT_Type *mmt;
   FILE *fp;

   if (NULL == (mmt = pop_fp (SL_READ, &fp)))
     return NULL;

   /* type = CTX_USE_LINE; */

   switch (num)
     {
	char *s;

      case 0:
	type = CTX_USE_LINE;
	break;
	
      case 1:
	if (-1 == SLang_pop_slstring (&s))
	  {
	     SLang_free_mmt (mmt);
	     return NULL;
	  }
	if (0 == strcmp (s, "char"))
	  type = CTX_USE_CHAR;
	else if (0 == strcmp (s, "line"))
	  type = CTX_USE_LINE;
	else if (0 == strcmp (s, "wsline"))
	  type = CTX_USE_LINE_WS;
	else
	  {
	     SLang_verror (SL_NOT_IMPLEMENTED,
			   "using '%s' not supported by File_Type",
			   s);
	     SLang_free_slstring (s);
	     SLang_free_mmt (mmt);
	     return NULL;
	  }
	SLang_free_slstring (s);
	break;

      default:
	SLdo_pop_n (num);
	SLang_verror (SL_NOT_IMPLEMENTED, 
		      "Usage: foreach (File_Type) using ([line|char])");
	SLang_free_mmt (mmt);
	return NULL;
     }

   if (NULL == (c = (SLang_Foreach_Context_Type *) SLmalloc (sizeof (SLang_Foreach_Context_Type))))
     {
	SLang_free_mmt (mmt);
	return NULL;
     }
   memset ((char *) c, 0, sizeof (SLang_Foreach_Context_Type));

   c->type = type;
   c->mmt = mmt;
   c->fp = fp;

   return c;
}

static void cl_foreach_close (unsigned char type, SLang_Foreach_Context_Type *c)
{
   (void) type;
   if (c == NULL) return;
   SLang_free_mmt (c->mmt);
   SLfree ((char *) c);
}

static int cl_foreach (unsigned char type, SLang_Foreach_Context_Type *c)
{
   int status;
   int ch;
   unsigned int len;
   char *s;

   (void) type;

   if (c == NULL)
     return -1;
   
   switch (c->type)
     {
      case CTX_USE_CHAR:
	if (EOF == (ch = getc (c->fp)))
	  return 0;
	if (-1 == SLang_push_uchar ((unsigned char) ch))
	  return -1;
	return 1;

      case CTX_USE_LINE:
      case CTX_USE_LINE_WS:
	status = read_one_line (c->fp, &s, &len, (c->type==CTX_USE_LINE_WS));
	if (status <= 0)
	  return status;
	if (0 == _SLang_push_slstring (s))
	  return 1;
	return -1;
     }
   
   return -1;
}

static int Stdio_Initialized;
static SLang_MMT_Type *Stdio_Mmts[3];

int SLang_init_stdio (void)
{
   unsigned int i;
   SL_File_Table_Type *s;
   SLang_Class_Type *cl;
   char *names[3];

   if (Stdio_Initialized)
     return 0;

   SL_File_Table = (SL_File_Table_Type *)SLcalloc(sizeof (SL_File_Table_Type), SL_MAX_FILES);
   if (SL_File_Table == NULL)
     return -1;

   if (NULL == (cl = SLclass_allocate_class ("File_Type")))
     return -1;
   cl->cl_destroy = destroy_file_type;
   cl->cl_foreach_open = cl_foreach_open;
   cl->cl_foreach_close = cl_foreach_close;
   cl->cl_foreach = cl_foreach;


   if (-1 == SLclass_register_class (cl, SLANG_FILE_PTR_TYPE, sizeof (SL_File_Table_Type), SLANG_CLASS_TYPE_MMT))
     return -1;

   if ((-1 == SLadd_intrin_fun_table(Stdio_Name_Table, "__STDIO__"))
       || (-1 == SLadd_iconstant_table (Stdio_Consts, NULL))
       || (-1 == _SLerrno_init ()))
     return -1;

   names[0] = "stdin";
   names[1] = "stdout";
   names[2] = "stderr";

   s = SL_File_Table;
   s->fp = stdin;  s->flags = SL_READ;

   s++;
   s->fp = stdout;  s->flags = SL_WRITE;

   s++;
   s->fp = stderr;  s->flags = SL_WRITE|SL_READ;

   s = SL_File_Table;
   for (i = 0; i < 3; i++)
     {
	if (NULL == (s->file = SLang_create_slstring (names[i])))
	  return -1;

	if (NULL == (Stdio_Mmts[i] = SLang_create_mmt (SLANG_FILE_PTR_TYPE, (VOID_STAR) s)))
	  return -1;
	SLang_inc_mmt (Stdio_Mmts[i]);

	if (-1 == SLadd_intrinsic_variable (s->file, (VOID_STAR)&Stdio_Mmts[i], SLANG_FILE_PTR_TYPE, 1))
	  return -1;
	s++;
     }

   Stdio_Initialized = 1;
   return 0;
}