static void encode_csv_row_intrin (void)
{
SLang_Array_Type *at;
CSV_Type *csv;
SLang_MMT_Type *mmt;
int flags;
int has_flags;
char *str;
if (SLang_Num_Function_Args == 3)
{
if (-1 == SLang_pop_int (&flags))
return;
has_flags = 1;
}
else has_flags = 0;
if (-1 == SLang_pop_array_of_type (&at, SLANG_STRING_TYPE))
return;
if (NULL == (csv = pop_csv_type (&mmt)))
{
SLang_free_array (at);
return;
}
if (0 == has_flags)
flags = csv->flags;
str = csv_encode (csv, (char **)at->data, at->num_elements, flags);
SLang_free_mmt (mmt);
SLang_free_array (at);
(void) SLang_push_malloced_string (str);
}
static int readline_intrinsic_internal (Slsh_Readline_Type *sri, char *prompt, int noecho)
{
char *line;
if (sri == NULL)
sri = Intrinsic_Rline_Info;
#if USE_SLANG_READLINE
if ((sri == NULL) && Use_Readline)
{
Intrinsic_Rline_Info = open_slsh_readline (NULL, SL_RLINE_BLINK_MATCH);
if (Intrinsic_Rline_Info == NULL)
return -1;
(void) SLang_add_cleanup_function (close_intrinsic_readline);
sri = Intrinsic_Rline_Info;
}
#endif
enable_keyboard_interrupt ();
line = read_input_line (sri, prompt, noecho);
if (noecho == 0)
(void) save_input_line (sri, line);
(void) SLang_push_malloced_string (line);
return 0;
}
static void chksum_close (Chksum_Object_Type *obj)
{
unsigned char *digest;
unsigned int digest_len;
SLChksum_Type *c;
if (NULL == (c = obj->c))
{
(void) SLang_push_null ();
return;
}
digest_len = c->digest_len;
if (NULL == (digest = (unsigned char *)SLmalloc(2*digest_len+1)))
return;
if (-1 == c->close (c, digest))
{
SLfree ((char *)digest);
return;
}
obj->c = NULL;
hexify_string (digest, digest_len);
(void) SLang_push_malloced_string ((char *)digest);
}
static void rline_get_line_intrinsic (void)
{
char *s;
if ((Active_Rline_Info == NULL)
|| (NULL == (s = SLrline_get_line (Active_Rline_Info))))
{
(void) SLang_push_string ("");
return;
}
(void) SLang_push_malloced_string (s);
}
static void path_extname (char *path)
{
#ifdef VMS
char *p;
#endif
path = SLpath_extname (path);
#ifndef VMS
SLang_push_string (path);
#else
p = strchr (path, ';');
if (p == NULL)
(void)SLang_push_string (p);
else
(void)SLang_push_malloced_string (SLmake_nstring (path, (unsigned int)(p - path)));
#endif
}
static void path_sans_extname (char *path)
{
(void) SLang_push_malloced_string (SLpath_pathname_sans_extname (path));
}
static void path_dirname (char *path)
{
(void) SLang_push_malloced_string (SLpath_dirname (path));
}
static void path_concat (char *a, char *b)
{
SLang_push_malloced_string (SLpath_dircat (a,b));
}
static int get_doc_string (char *file, char *topic)
{
FILE *fp;
char line[1024];
unsigned int topic_len, str_len;
char *str;
char ch;
if (NULL == (fp = fopen (file, "r")))
return -1;
topic_len = strlen (topic);
ch = *topic;
while (1)
{
if (NULL == fgets (line, sizeof(line), fp))
{
fclose (fp);
return -1;
}
if ((ch == *line)
&& (0 == strncmp (line, topic, topic_len))
&& ((line[topic_len] == '\n') || (line [topic_len] == 0)
|| (line[topic_len] == ' ') || (line[topic_len] == '\t')))
break;
}
if (NULL == (str = SLmake_string (line)))
{
fclose (fp);
return -1;
}
str_len = strlen (str);
while (NULL != fgets (line, sizeof (line), fp))
{
unsigned int len;
char *new_str;
ch = *line;
if (ch == '#') continue;
if (ch == '-') break;
len = strlen (line);
if (NULL == (new_str = SLrealloc (str, str_len + len + 1)))
{
SLfree (str);
str = NULL;
break;
}
str = new_str;
strcpy (str + str_len, line);
str_len += len;
}
fclose (fp);
(void) SLang_push_malloced_string (str);
return 0;
}
void _pSLpack_pad_format (char *format)
{
unsigned int len, max_len;
Format_Type ft;
char *buf, *b;
check_native_byte_order ();
/* Just check the syntax */
if (-1 == compute_size_for_format (format, &max_len))
return;
/* This should be sufficient to handle any needed xyy padding characters.
* I cannot see how this will be overrun
*/
max_len = 4 * (strlen (format) + 1);
if (NULL == (buf = SLmalloc (max_len + 1)))
return;
b = buf;
len = 0;
while (1 == parse_a_format (&format, &ft))
{
struct { char a; short b; } s_h;
struct { char a; int b; } s_i;
struct { char a; long b; } s_l;
struct { char a; float b; } s_f;
struct { char a; double b; } s_d;
unsigned int pad;
if (ft.repeat == 0)
continue;
if (ft.data_type == 0)
{ /* pad */
sprintf (b, "x%u", ft.repeat);
b += strlen (b);
len += ft.repeat;
continue;
}
switch (ft.data_type)
{
default:
case SLANG_STRING_TYPE:
case SLANG_BSTRING_TYPE:
case SLANG_CHAR_TYPE:
case SLANG_UCHAR_TYPE:
pad = 0;
break;
case SLANG_SHORT_TYPE:
case SLANG_USHORT_TYPE:
pad = ((unsigned int) ((char *)&s_h.b - (char *)&s_h.a));
break;
case SLANG_INT_TYPE:
case SLANG_UINT_TYPE:
pad = ((unsigned int) ((char *)&s_i.b - (char *)&s_i.a));
break;
case SLANG_LONG_TYPE:
case SLANG_ULONG_TYPE:
pad = ((unsigned int) ((char *)&s_l.b - (char *)&s_l.a));
break;
case SLANG_FLOAT_TYPE:
pad = ((unsigned int) ((char *)&s_f.b - (char *)&s_f.a));
break;
case SLANG_DOUBLE_TYPE:
pad = ((unsigned int) ((char *)&s_d.b - (char *)&s_d.a));
break;
}
/* Pad to a length that is an integer multiple of pad. */
if (pad)
pad = pad * ((len + pad - 1)/pad) - len;
if (pad)
{
sprintf (b, "x%u", pad);
b += strlen (b);
len += pad;
}
*b++ = ft.format_type;
if (ft.repeat > 1)
{
sprintf (b, "%u", ft.repeat);
b += strlen (b);
}
len += ft.repeat * ft.sizeof_type;
}
*b = 0;
(void) SLang_push_malloced_string (buf);
}
void _pSLunpack (char *format, SLang_BString_Type *bs)
{
Format_Type ft;
unsigned char *b;
unsigned int len;
unsigned int num_bytes;
check_native_byte_order ();
if (-1 == compute_size_for_format (format, &num_bytes))
return;
b = SLbstring_get_pointer (bs, &len);
if (b == NULL)
return;
if (len < num_bytes)
{
_pSLang_verror (SL_INVALID_PARM,
"unpack format %s is too large for input string",
format);
return;
}
while (1 == parse_a_format (&format, &ft))
{
char *str, *s;
if (ft.repeat == 0)
continue;
if (ft.data_type == 0)
{ /* skip padding */
b += ft.repeat;
continue;
}
if (ft.is_scalar)
{
SLang_Array_Type *at;
SLindex_Type dims;
if (ft.repeat == 1)
{
SLang_Class_Type *cl;
cl = _pSLclass_get_class (ft.data_type);
memcpy ((char *)cl->cl_transfer_buf, (char *)b, ft.sizeof_type);
if (ft.byteorder != NATIVE_ORDER)
byteswap (ft.byteorder, (unsigned char *)cl->cl_transfer_buf, ft.sizeof_type, 1);
if (-1 == (cl->cl_apush (ft.data_type, cl->cl_transfer_buf)))
return;
b += ft.sizeof_type;
continue;
}
dims = (SLindex_Type) ft.repeat;
at = SLang_create_array (ft.data_type, 0, NULL, &dims, 1);
if (at == NULL)
return;
num_bytes = ft.repeat * ft.sizeof_type;
memcpy ((char *)at->data, (char *)b, num_bytes);
if (ft.byteorder != NATIVE_ORDER)
byteswap (ft.byteorder, (unsigned char *)at->data, ft.sizeof_type, ft.repeat);
if (-1 == SLang_push_array (at, 1))
return;
b += num_bytes;
continue;
}
/* string type: s, S, or Z */
if (ft.format_type == 's')
len = ft.repeat;
else
len = get_unpadded_strlen ((char *)b, ft.pad, ft.repeat);
str = SLmalloc (len + 1);
if (str == NULL)
return;
memcpy ((char *) str, (char *)b, len);
str [len] = 0;
/* Avoid a bstring if possible */
s = SLmemchr (str, 0, len);
if (s == NULL)
{
if (-1 == SLang_push_malloced_string (str))
return;
}
else
{
SLang_BString_Type *new_bs;
new_bs = SLbstring_create_malloced ((unsigned char *)str, len, 1);
if (new_bs == NULL)
return;
if (-1 == SLang_push_bstring (new_bs))
{
SLfree (str);
return;
}
SLbstring_free (new_bs);
}
b += ft.repeat;
}
}
