aboutsummaryrefslogtreecommitdiffstats
path: root/bwb_int.c
diff options
context:
space:
mode:
Diffstat (limited to 'bwb_int.c')
-rw-r--r--bwb_int.c4086
1 files changed, 4086 insertions, 0 deletions
diff --git a/bwb_int.c b/bwb_int.c
new file mode 100644
index 0000000..31ec041
--- /dev/null
+++ b/bwb_int.c
@@ -0,0 +1,4086 @@
+/***************************************************************f
+
+ bwb_int.c Line Interpretation Routines
+ for Bywater BASIC Interpreter
+
+ Copyright (c) 1993, Ted A. Campbell
+ Bywater Software
+
+ email: tcamp@delphi.com
+
+ Copyright and Permissions Information:
+
+ All U.S. and international rights are claimed by the author,
+ Ted A. Campbell.
+
+ This software is released under the terms of the GNU General
+ Public License (GPL), which is distributed with this software
+ in the file "COPYING". The GPL specifies the terms under
+ which users may copy and use the software in this distribution.
+
+ A separate license is available for commercial distribution,
+ for information on which you should contact the author.
+
+***************************************************************/
+
+/*---------------------------------------------------------------*/
+/* NOTE: Modifications marked "JBV" were made by Jon B. Volkoff, */
+/* 11/1995 (eidetics@cerf.net). */
+/* */
+/* Those additionally marked with "DD" were at the suggestion of */
+/* Dale DePriest (daled@cadence.com). */
+/* */
+/* Version 3.00 by Howard Wulf, AF5NE */
+/* */
+/* Version 3.10 by Howard Wulf, AF5NE */
+/* */
+/* Version 3.20 by Howard Wulf, AF5NE */
+/* */
+/*---------------------------------------------------------------*/
+
+
+
+#include "bwbasic.h"
+
+static int buff_read_keyword (char *buffer, int *position, char *keyword);
+static int bwb_chartype (int C);
+static int char_is_varfirst (char C);
+static char char_is_varhead (char C);
+static int char_is_varnext (char C);
+static int char_is_vartail (char C);
+static int GetKeyword (LineType * l, char *Keyword);
+static void internal_DEF8SUB (LineType * l);
+static int is_cmd (char *name);
+static int is_let (char *buffer);
+static int line_read_keyword (LineType * line, char *keyword);
+
+extern void
+buff_skip_spaces (char *buffer, int *position)
+{
+ /*
+ skip spaces in 'buffer'.
+ 'position' is always updated.
+ */
+ int p;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+
+ p = *position;
+
+ while (buffer[p] == ' ')
+ {
+ p++;
+ }
+
+ *position = p;
+}
+
+extern void
+line_skip_spaces (LineType * line)
+{
+
+ assert (line != NULL);
+ buff_skip_spaces (line->buffer, &(line->position)); /* keep this */
+}
+
+extern void
+buff_skip_eol (char *buffer, int *position)
+{
+ /*
+ skip to the NUL (NulChar) in 'buffer'.
+ always updates 'position'.
+ */
+ int p;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+
+ p = *position;
+
+ while (buffer[p])
+ {
+ p++;
+ }
+
+ *position = p;
+}
+
+extern void
+line_skip_eol (LineType * line)
+{
+
+ assert (line != NULL);
+ buff_skip_eol (line->buffer, &(line->position));
+}
+
+extern int
+buff_is_eol (char *buffer, int *position)
+{
+ /*
+ determines whether 'position' is effectively at the NUL (NulChar) in 'buffer'.
+ if successful then 'position' is updated and returns TRUE
+ otherwise returns FALSE.
+ */
+ int p;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+
+ p = *position;
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (buffer[p] == NulChar)
+ {
+ *position = p;
+ return TRUE;
+ }
+ return FALSE;
+}
+
+extern int
+line_is_eol (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_is_eol (line->buffer, &(line->position));
+}
+
+extern int
+buff_peek_char (char *buffer, int *position, char find)
+{
+ /*
+ determine whether the next non-space character in 'buffer' is 'find'.
+ if successful then returns TRUE
+ otherwise returns FALSE.
+ 'position' is unchanged.
+ */
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+
+ if (find != NulChar && find != ' ')
+ {
+ int p;
+ p = *position;
+
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (buffer[p] == find)
+ {
+ return TRUE;
+ }
+ }
+ return FALSE;
+}
+
+#if FALSE /* keep this ... */
+extern int
+line_peek_char (LineType * line, char find)
+{
+
+ assert (line != NULL);
+ return buff_peek_char (line->buffer, &(line->position), find);
+}
+#endif
+
+extern int
+buff_peek_EqualChar (char *buffer, int *position)
+{
+ /*
+ determine whether the next non-space character in 'buffer' is 'find'.
+ if successful then returns TRUE
+ otherwise returns FALSE.
+ 'position' is unchanged.
+ */
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ return buff_peek_char (buffer, position, '=');
+}
+
+extern int
+line_peek_EqualChar (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_peek_EqualChar (line->buffer, &(line->position));
+}
+
+extern int
+buff_peek_QuoteChar (char *buffer, int *position)
+{
+ /*
+ determine whether the next non-space character in 'buffer' is 'find'.
+ if successful then returns TRUE
+ otherwise returns FALSE.
+ 'position' is unchanged.
+ */
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ return buff_peek_char (buffer, position,
+ My->CurrentVersion->OptionQuoteChar);
+}
+
+extern int
+line_peek_QuoteChar (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_peek_QuoteChar (line->buffer, &(line->position));
+}
+
+extern int
+buff_peek_LparenChar (char *buffer, int *position)
+{
+ /*
+ determine whether the next non-space character in 'buffer' is 'find'.
+ if successful then returns TRUE
+ otherwise returns FALSE.
+ 'position' is unchanged.
+ */
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ return buff_peek_char (buffer, position,
+ My->CurrentVersion->OptionLparenChar);
+}
+
+extern int
+line_peek_LparenChar (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_peek_LparenChar (line->buffer, &(line->position));
+}
+
+extern int
+buff_skip_char (char *buffer, int *position, char find)
+{
+ /*
+ skip the next non-space character in 'buffer' if it is 'find'.
+ 'find' is NOT an alphabetic (A-Z,a-z) character.
+ if successful then 'position' is updated past 'find' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ */
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+
+ if (find)
+ {
+ int p;
+
+ p = *position;
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (buffer[p] == find)
+ {
+ p++;
+ *position = p;
+ return TRUE;
+ }
+ }
+ return FALSE;
+}
+
+extern int
+line_skip_char (LineType * line, char find)
+{
+
+ assert (line != NULL);
+ return buff_skip_char (line->buffer, &(line->position), find);
+}
+
+extern int
+buff_skip_FilenumChar (char *buffer, int *position)
+{
+ /*
+ skip the next non-space character in 'buffer' if it is 'find'.
+ if successful then 'position' is updated past 'find' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ */
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ return buff_skip_char (buffer, position,
+ My->CurrentVersion->OptionFilenumChar);
+}
+
+extern int
+line_skip_FilenumChar (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_skip_FilenumChar (line->buffer, &(line->position));
+}
+
+extern int
+buff_skip_AtChar (char *buffer, int *position)
+{
+ /*
+ skip the next non-space character in 'buffer' if it is 'find'.
+ if successful then 'position' is updated past 'find' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ */
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ return buff_skip_char (buffer, position,
+ My->CurrentVersion->OptionAtChar);
+}
+
+extern int
+line_skip_AtChar (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_skip_AtChar (line->buffer, &(line->position));
+}
+
+extern int
+buff_skip_LparenChar (char *buffer, int *position)
+{
+ /*
+ skip the next non-space character in 'buffer' if it is 'find'.
+ if successful then 'position' is updated past 'find' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ */
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ return buff_skip_char (buffer, position,
+ My->CurrentVersion->OptionLparenChar);
+}
+
+extern int
+line_skip_LparenChar (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_skip_LparenChar (line->buffer, &(line->position));
+}
+
+extern int
+buff_skip_RparenChar (char *buffer, int *position)
+{
+ /*
+ skip the next non-space character in 'buffer' if it is 'find'.
+ if successful then 'position' is updated past 'find' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ */
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ return buff_skip_char (buffer, position,
+ My->CurrentVersion->OptionRparenChar);
+}
+
+extern int
+line_skip_RparenChar (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_skip_RparenChar (line->buffer, &(line->position));
+}
+
+extern int
+buff_skip_CommaChar (char *buffer, int *position)
+{
+ /*
+ skip the next non-space character in 'buffer' if it is 'find'.
+ if successful then 'position' is updated past 'find' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ */
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ return buff_skip_char (buffer, position, ',');
+}
+
+extern int
+line_skip_CommaChar (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_skip_CommaChar (line->buffer, &(line->position));
+}
+
+extern int
+buff_skip_SemicolonChar (char *buffer, int *position)
+{
+ /*
+ skip the next non-space character in 'buffer' if it is 'find'.
+ if successful then 'position' is updated past 'find' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ */
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ return buff_skip_char (buffer, position, ';');
+}
+
+extern int
+line_skip_SemicolonChar (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_skip_SemicolonChar (line->buffer, &(line->position));
+}
+
+extern int
+buff_skip_EqualChar (char *buffer, int *position)
+{
+ /*
+ skip the next non-space character in 'buffer' if it is 'find'.
+ if successful then 'position' is updated past 'find' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ */
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ return buff_skip_char (buffer, position, '=');
+}
+
+extern int
+line_skip_EqualChar (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_skip_EqualChar (line->buffer, &(line->position));
+}
+
+extern int
+buff_skip_StarChar (char *buffer, int *position)
+{
+ /*
+ skip the next non-space character in 'buffer' if it is 'find'.
+ if successful then 'position' is updated past 'find' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ */
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ return buff_skip_char (buffer, position, '*');
+}
+
+extern int
+line_skip_StarChar (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_skip_StarChar (line->buffer, &(line->position));
+}
+
+extern int
+buff_skip_PlusChar (char *buffer, int *position)
+{
+ /*
+ skip the next non-space character in 'buffer' if it is 'find'.
+ if successful then 'position' is updated past 'find' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ */
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ return buff_skip_char (buffer, position, '+');
+}
+
+extern int
+line_skip_PlusChar (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_skip_PlusChar (line->buffer, &(line->position));
+}
+
+extern int
+buff_skip_MinusChar (char *buffer, int *position)
+{
+ /*
+ skip the next non-space character in 'buffer' if it is 'find'.
+ if successful then 'position' is updated past 'find' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ */
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ return buff_skip_char (buffer, position, '-');
+}
+
+extern int
+line_skip_MinusChar (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_skip_MinusChar (line->buffer, &(line->position));
+}
+
+extern char
+buff_skip_seperator (char *buffer, int *position)
+{
+ /*
+ skip the next non-space character in 'buffer' if it is a seperator (comma, semicolon, or colon).
+ if successful then 'position' is updated past the character and returns the character skipped
+ otherwise 'position' is unchanged and returns NulChar.
+ */
+ int p;
+ char C;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+
+ p = *position;
+
+
+ buff_skip_spaces (buffer, &p); /* keep this */
+ C = buffer[p];
+ switch (C)
+ {
+ case ',': /* COMMA */
+ case ';': /* SEMICOLON */
+ case ':': /* COLON */
+ p++;
+ buff_skip_spaces (buffer, &p); /* keep this */
+ *position = p;
+ return C;
+ }
+ return NulChar;
+}
+
+
+extern char
+line_skip_seperator (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_skip_seperator (line->buffer, &(line->position));
+}
+
+static int
+char_is_varfirst (char C)
+{
+ /*
+ determine whether the character is allowed to be the first character of a BASIC variable name.
+ if successful then returns TRUE
+ otherwise returns FALSE.
+ */
+
+ if (C == NulChar || C == ' ')
+ {
+ return FALSE; /* never allowed */
+ }
+ if (bwb_isalpha (C))
+ {
+ return TRUE; /* always allowed */
+ }
+ /* dialect specific */
+ switch (C)
+ {
+ case '@':
+ case '#':
+ case '$':
+ if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
+ {
+ /* alphabet extenders */
+ return TRUE;
+ }
+ break;
+ }
+ /* NOT FOUND */
+ return FALSE;
+}
+
+static int
+char_is_varnext (char C)
+{
+ /*
+ determine whether the character is allowed to be the second character of a BASIC variable name.
+ if successful then returns TRUE
+ otherwise returns FALSE.
+ */
+
+ if (C == NulChar || C == ' ')
+ {
+ return FALSE; /* never allowed */
+ }
+ if (bwb_isalnum (C))
+ {
+ return TRUE; /* always allowed */
+ }
+ /* dialect specific */
+ switch (C)
+ {
+ case '.':
+ case '_':
+ if (My->CurrentVersion->OptionFlags & (OPTION_BUGS_ON)) /* varname: period and underscore are allowed */
+ {
+ return TRUE;
+ }
+ break;
+ case '@':
+ case '#':
+ case '$':
+ if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73)) /* alphabet extenders */
+ {
+ return TRUE;
+ }
+ break;
+ }
+ /* NOT FOUND */
+ return FALSE;
+}
+
+extern char
+TypeCode_to_Char (char TypeCode)
+{
+ /*
+ Convert the internal TypeCode value into the dialect-specifc tail character.
+ if successful then returns the dialect-specifc tail character
+ otherwise returns NulChar.
+ */
+ switch (TypeCode)
+ {
+ case ByteTypeCode:
+ return My->CurrentVersion->OptionByteChar;
+ case IntegerTypeCode:
+ return My->CurrentVersion->OptionIntegerChar;
+ case LongTypeCode:
+ return My->CurrentVersion->OptionLongChar;
+ case CurrencyTypeCode:
+ return My->CurrentVersion->OptionCurrencyChar;
+ case SingleTypeCode:
+ return My->CurrentVersion->OptionSingleChar;
+ case DoubleTypeCode:
+ return My->CurrentVersion->OptionDoubleChar;
+ case StringTypeCode:
+ return My->CurrentVersion->OptionStringChar;
+ }
+ /* NOT FOUND */
+ return NulChar;
+}
+
+extern char
+Char_to_TypeCode (char C)
+{
+ /*
+ Convert the dialect-specifc tail character into the internal TypeCode value.
+ if successful then returns the internal TypeCode value
+ otherwise returns NulChar.
+ */
+
+ if (C == NulChar || C == ' ')
+ {
+ return NulChar; /* never allowed */
+ }
+ /* dialect specific */
+ if (C == My->CurrentVersion->OptionByteChar)
+ {
+ return ByteTypeCode;
+ }
+ if (C == My->CurrentVersion->OptionIntegerChar)
+ {
+ return IntegerTypeCode;
+ }
+ if (C == My->CurrentVersion->OptionLongChar)
+ {
+ return LongTypeCode;
+ }
+ if (C == My->CurrentVersion->OptionCurrencyChar)
+ {
+ return CurrencyTypeCode;
+ }
+ if (C == My->CurrentVersion->OptionSingleChar)
+ {
+ return SingleTypeCode;
+ }
+ if (C == My->CurrentVersion->OptionDoubleChar)
+ {
+ return DoubleTypeCode;
+ }
+ if (C == My->CurrentVersion->OptionStringChar)
+ {
+ return StringTypeCode;
+ }
+ /* NOT FOUND */
+ return NulChar;
+}
+
+extern char
+var_nametype (char *name)
+{
+ /*
+ determine the internal TypeCode associated with the vaariable name.
+ if successful then returns the internal TypeCode value
+ otherwise returns NulChar.
+ */
+
+ assert (name != NULL);
+
+ if (name == NULL)
+ {
+ WARN_INTERNAL_ERROR;
+ return NulChar;
+ }
+ /* look only at the last charactr of the variable name */
+ if (*name)
+ {
+ while (*name)
+ {
+ name++;
+ }
+ name--;
+ }
+ return Char_to_TypeCode (*name);
+}
+
+static char
+char_is_varhead (char C)
+{
+ /*
+ determine whether the character is allowed at the head of a variable name.
+ if successful then returns TRUE
+ otherwise retuns FALSE.
+ */
+
+ if (C == NulChar || C == ' ')
+ {
+ return NulChar;
+ } /* never allowed */
+ if (char_is_varfirst (C))
+ {
+ return C;
+ }
+ if (char_is_varnext (C))
+ {
+ return C;
+ }
+ return NulChar;
+}
+
+static int
+char_is_vartail (char C)
+{
+ /*
+ determine whether the character is allowed at the tail of a variable name.
+ if successful then returns TRUE
+ otherwise retuns FALSE.
+ */
+
+ if (C == NulChar || C == ' ')
+ {
+ return FALSE; /* never allowed */
+ }
+ if (char_is_varnext (C))
+ {
+ return TRUE;
+ }
+ if (Char_to_TypeCode (C))
+ {
+ return TRUE;
+ }
+ return FALSE;
+}
+
+#if FALSE /* kepp this ... */
+extern int
+buff_peek_word (char *buffer, int *position, char *find)
+{
+ /*
+ determine whether the next non-space word in 'buffer' is 'find';
+ the word 'find' is not allowed to be a sub-string of a bigger word.
+ if successful then returns TRUE
+ otherwise returns FALSE.
+ 'position' is unchanged.
+ */
+ int p;
+ int n;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ assert (find != NULL);
+
+ p = *position;
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (buff_is_eol (buffer, &p))
+ {
+ return FALSE;
+ }
+ n = bwb_strlen (find);
+ if (bwb_strnicmp (&(buffer[p]), find, n) == 0)
+ {
+ if (p > 0)
+ {
+ if (char_is_varhead (buffer[p - 1]))
+ {
+ /* _TO */
+ return FALSE;
+ }
+ }
+ if (char_is_vartail (buffer[p + n]))
+ {
+ /* TO_ */
+ return FALSE;
+ }
+ return TRUE;
+ }
+ return FALSE;
+}
+#endif
+
+#if FALSE /* keep this ... */
+extern int
+line_peek_word (LineType * line, char *find)
+{
+
+ assert (line != NULL);
+ assert (find != NULL);
+ return buff_peek_word (line->buffer, &(line->position), find);
+}
+#endif
+
+extern int
+buff_skip_word (char *buffer, int *position, char *find)
+{
+ /*
+ skip the next non-space word in 'buffer' if it is 'find';
+ the word 'find' is not a sub-string of a bigger word.
+ if successful then 'position' is updated past 'find' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ */
+ int p;
+ int n;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ assert (find != NULL);
+
+ p = *position;
+
+
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (buff_is_eol (buffer, &p))
+ {
+ return FALSE;
+ }
+ n = bwb_strlen (find);
+ if (bwb_strnicmp (&(buffer[p]), find, n) == 0)
+ {
+ if (p > 0)
+ {
+ if (char_is_varhead (buffer[p - 1]))
+ {
+ /* _TO */
+ return FALSE;
+ }
+ }
+ if (char_is_vartail (buffer[p + n]))
+ {
+ /* TO_ */
+ return FALSE;
+ }
+ p += n;
+ *position = p;
+ return TRUE;
+ }
+ return FALSE;
+}
+
+extern int
+line_skip_word (LineType * line, char *find)
+{
+
+ assert (line != NULL);
+ assert (find != NULL);
+ return buff_skip_word (line->buffer, &(line->position), find);
+}
+
+extern int
+buff_read_varname (char *buffer, int *position, char *varname)
+{
+ /*
+ read the next non-space word in 'buffer' that conforms to a BASIC variable name into 'varname'.
+ if successful then 'position' is updated past 'varname' and returns TRUE
+ otherwise 'position' is unchanged ('varname' is truncated) and returns FALSE.
+ 'varname' shall be declared "char varname[NameLengthMax + 1]".
+ */
+ int p;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ assert (varname != NULL);
+
+ p = *position;
+
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (char_is_varfirst (buffer[p]))
+ {
+ int i;
+ i = 0;
+
+ if (i > NameLengthMax)
+ {
+ i = NameLengthMax;
+ }
+ varname[i] = buffer[p];
+ p++;
+ i++;
+ while (char_is_varnext (buffer[p]))
+ {
+ if (i > NameLengthMax)
+ {
+ i = NameLengthMax;
+ }
+ varname[i] = buffer[p];
+ p++;
+ i++;
+ }
+ if (Char_to_TypeCode (buffer[p]))
+ {
+ if (i > NameLengthMax)
+ {
+ i = NameLengthMax;
+ }
+ varname[i] = buffer[p];
+ p++;
+ i++;
+ }
+ varname[i] = NulChar;
+ *position = p;
+ return TRUE;
+ }
+ varname[0] = NulChar;
+ return FALSE;
+}
+
+extern int
+line_read_varname (LineType * line, char *varname)
+{
+
+ assert (line != NULL);
+ assert (varname != NULL);
+ return buff_read_varname (line->buffer, &(line->position), varname);
+}
+
+extern int
+buff_read_label (char *buffer, int *position, char *label)
+{
+ /*
+ read the next non-space word in 'buffer' that conforms to a BASIC label name into 'label'.
+ if successful then 'position' is updated past 'label' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ 'label' shall be declared "char label[NameLengthMax + 1]".
+ */
+ int p;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ assert (label != NULL);
+
+ p = *position;
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (char_is_varfirst (buffer[p]))
+ {
+ int i;
+ i = 0;
+
+ if (i > NameLengthMax)
+ {
+ i = NameLengthMax;
+ }
+ label[i] = buffer[p];
+ p++;
+ i++;
+ while (char_is_varnext (buffer[p]))
+ {
+ if (i > NameLengthMax)
+ {
+ i = NameLengthMax;
+ }
+ label[i] = buffer[p];
+ p++;
+ i++;
+ }
+ label[i] = NulChar;
+ *position = p;
+ return TRUE;
+ }
+ return FALSE;
+}
+
+extern int
+line_read_label (LineType * line, char *label)
+{
+
+ assert (line != NULL);
+ assert (label != NULL);
+ return buff_read_label (line->buffer, &(line->position), label);
+}
+
+static int
+buff_read_keyword (char *buffer, int *position, char *keyword)
+{
+ /*
+ read the next non-space word in 'buffer' that conforms to a BASIC keyword into 'keyword'.
+ if successful then 'position' is updated past 'keyword' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ 'label' shall be declared "char keyword[NameLengthMax + 1]".
+ */
+ int p;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ assert (keyword != NULL);
+
+ p = *position;
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (char_is_varfirst (buffer[p]))
+ {
+ int i;
+ i = 0;
+
+ if (i > NameLengthMax)
+ {
+ i = NameLengthMax;
+ }
+ keyword[i] = buffer[p];
+ p++;
+ i++;
+ while (char_is_varnext (buffer[p]))
+ {
+ if (i > NameLengthMax)
+ {
+ i = NameLengthMax;
+ }
+ keyword[i] = buffer[p];
+ p++;
+ i++;
+ }
+ if (Char_to_TypeCode (buffer[p]) == StringTypeCode)
+ {
+ if (i > NameLengthMax)
+ {
+ i = NameLengthMax;
+ }
+ keyword[i] = buffer[p];
+ p++;
+ i++;
+ }
+ keyword[i] = NulChar;
+ *position = p;
+ return TRUE;
+ }
+ keyword[0] = NulChar;
+ return FALSE;
+}
+
+static int
+line_read_keyword (LineType * line, char *keyword)
+{
+
+ assert (line != NULL);
+ assert (keyword != NULL);
+ return buff_read_keyword (line->buffer, &(line->position), keyword);
+}
+
+extern VariableType *
+buff_read_scalar (char *buffer, int *position)
+{
+ /*
+ read the next non-space word in 'buffer' that conforms to a BASIC variable name,
+ including both scalar variables and subscripted array variables.
+ if successful then 'position' is updated
+ past 'varname' for scalar variables
+ (past right parenthesis for subscripted array variables).
+ and returns a pointer to the variable.
+ otherwise 'position' is unchanged and returns NULL.
+ */
+ int p;
+ VariableType *v;
+ char varname[NameLengthMax + 1];
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+
+
+ p = *position;
+
+ /* Read a variable name */
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (buff_read_varname (buffer, &p, varname) == FALSE)
+ {
+ WARN_VARIABLE_NOT_DECLARED;
+ return NULL;
+ }
+ if (buff_peek_LparenChar (buffer, &p))
+ {
+ /* MUST be a an array */
+ int n;
+ int n_params; /* number of parameters */
+ int pp[MAX_DIMS];
+
+ /* get parameters because the variable is dimensioned */
+ if (buff_read_array_dimensions (buffer, &p, &n_params, pp) == FALSE)
+ {
+ WARN_SUBSCRIPT_OUT_OF_RANGE;
+ return NULL;
+ }
+ /* get the array variable */
+ if ((v = var_find (varname, n_params, TRUE)) == NULL)
+ {
+ WARN_VARIABLE_NOT_DECLARED;
+ return NULL;
+ }
+ for (n = 0; n < v->dimensions; n++)
+ {
+ v->VINDEX[n] = pp[n];
+ }
+ }
+ else
+ {
+ /* simple scalar variable */
+
+ if ((v = var_find (varname, 0, TRUE)) == NULL)
+ {
+ WARN_VARIABLE_NOT_DECLARED;
+ return NULL;
+ }
+ }
+ *position = p;
+ return v;
+}
+
+extern VariableType *
+line_read_scalar (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_read_scalar (line->buffer, &(line->position));
+}
+
+extern VariableType *
+buff_read_matrix (char *buffer, int *position)
+{
+ /*
+ read the next non-space word in 'buffer' that conforms to a BASIC matrix name,
+ including both simple matrix variables and redimensioned matrix variables.
+ if successful then 'position' is updated
+ past 'varname' for matrix variables
+ (past right parenthesis for redimensioned matrix variables).
+ and returns a pointer to the variable.
+ otherwise 'position' is unchanged and returns NULL.
+ */
+ int p;
+ VariableType *v;
+ char varname[NameLengthMax + 1];
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+
+
+ p = *position;
+
+ /* Read a variable name */
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (buff_read_varname (buffer, &p, varname) == FALSE)
+ {
+ WARN_SYNTAX_ERROR;
+ return NULL;
+ }
+ v = mat_find (varname);
+ if (v == NULL)
+ {
+ WARN_VARIABLE_NOT_DECLARED;
+ return NULL;
+ }
+ if (buff_peek_LparenChar (buffer, &p))
+ {
+ /* get requested matrix size, which is <= original matrix size */
+ size_t array_units;
+ int n;
+ int dimensions;
+ int LBOUND[MAX_DIMS];
+ int UBOUND[MAX_DIMS];
+
+ if (buff_read_array_redim (buffer, &p, &dimensions, LBOUND, UBOUND) ==
+ FALSE)
+ {
+ WARN_SYNTAX_ERROR;
+ return NULL;
+ }
+ /* update array dimensions */
+ array_units = 1;
+ for (n = 0; n < dimensions; n++)
+ {
+ if (UBOUND[n] < LBOUND[n])
+ {
+ WARN_SUBSCRIPT_OUT_OF_RANGE;
+ return FALSE;
+ }
+ array_units *= UBOUND[n] - LBOUND[n] + 1;
+ }
+ if (array_units > v->array_units)
+ {
+ WARN_SUBSCRIPT_OUT_OF_RANGE;
+ return FALSE;
+ }
+ v->dimensions = dimensions;
+ for (n = 0; n < dimensions; n++)
+ {
+ v->LBOUND[n] = LBOUND[n];
+ v->UBOUND[n] = UBOUND[n];
+ }
+ }
+ *position = p;
+ return v;
+}
+
+extern VariableType *
+line_read_matrix (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_read_matrix (line->buffer, &(line->position));
+}
+
+extern int
+buff_read_line_number (char *buffer, int *position, int *linenum)
+{
+ /*
+ read the next non-space word in 'buffer' that conforms to a BASIC line number.
+ if successful then 'position' is updated past 'linenum' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ */
+ int p;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ assert (linenum != NULL);
+
+ p = *position;
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (bwb_isdigit (buffer[p]))
+ {
+ int i;
+ int n;
+ char label[NameLengthMax + 1];
+
+ i = 0;
+ while (bwb_isdigit (buffer[p]))
+ {
+ if (i > NameLengthMax)
+ {
+ i = NameLengthMax;
+ }
+ label[i] = buffer[p];
+ p++;
+ i++;
+ }
+ label[i] = NulChar;
+ n = atoi (label);
+ *linenum = n;
+ *position = p;
+ return TRUE;
+ }
+ return FALSE;
+}
+
+extern int
+line_read_line_number (LineType * line, int *linenum)
+{
+
+ assert (line != NULL);
+ assert (linenum != NULL);
+ return buff_read_line_number (line->buffer, &(line->position), linenum);
+}
+
+extern int
+buff_read_line_sequence (char *buffer, int *position, int *head, int *tail)
+{
+ /*
+ read the next non-space words in 'buffer' that conforms to a BASIC line number sequnence.
+ if successful then 'position' is updated past the line number sequence and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ */
+ /*
+ ### head == tail
+ ### - head to BMAX
+ ### - ### head to tail
+ - ### BMIN to tail
+ */
+ int p; /* position */
+ int h; /* head */
+ int t; /* tail */
+ char c; /* line range seperator for BREAK, DELETE and LIST */
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ assert (head != NULL);
+ assert (tail != NULL);
+
+ p = *position;
+ buff_skip_spaces (buffer, &p); /* keep this */
+ c = '-';
+ if (My->CurrentVersion->OptionVersionValue & (D70 | H80))
+ {
+ c = ',';
+ }
+
+ if (buff_skip_char (buffer, &p, c) /* line sequence seperator */ )
+ {
+ /* - ... */
+ if (buff_read_line_number (buffer, &p, &t))
+ {
+ /* - ### */
+ *head = MINLIN;
+ *tail = t;
+ *position = p;
+ return TRUE;
+ }
+ }
+ else
+ if (buff_read_line_number (buffer, &p, &h) /* line sequence seperator */ )
+ {
+ /* ### ... */
+ if (buff_skip_char (buffer, &p, c))
+ {
+ /* ### - ... */
+ if (buff_read_line_number (buffer, &p, &t))
+ {
+ /* ### - ### */
+ *head = h;
+ *tail = t;
+ *position = p;
+ return TRUE;
+ }
+ else
+ {
+ /* ### - */
+ *head = h;
+ *tail = MAXLIN;
+ *position = p;
+ return TRUE;
+ }
+ }
+ else
+ {
+ /* ### */
+ *head = h;
+ *tail = h;
+ *position = p;
+ return TRUE;
+ }
+ }
+ return FALSE;
+}
+
+extern int
+line_read_line_sequence (LineType * line, int *head, int *tail)
+{
+
+ assert (line != NULL);
+ assert (head != NULL);
+ assert (tail != NULL);
+ return buff_read_line_sequence (line->buffer, &(line->position), head,
+ tail);
+}
+
+extern int
+buff_read_integer_expression (char *buffer, int *position, int *Value)
+{
+ /*
+ read the next non-space words in 'buffer' that conforms to a BASIC integer expression into 'Value'.
+ if successful then 'position' is updated past 'Value' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ 'Value' shall be declared "int Value".
+ */
+ DoubleType X;
+ int p;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ assert (Value != NULL);
+
+ p = *position;
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (buff_read_numeric_expression (buffer, &p, &X))
+ {
+ /* we want the rounded value */
+ X = bwb_rint (X);
+ if (INT_MIN <= X && X <= INT_MAX)
+ {
+ /* OK */
+ *Value = (int) bwb_rint (X);
+ *position = p;
+ return TRUE;
+ }
+ }
+ /* ERROR */
+ return FALSE;
+}
+
+extern int
+line_read_integer_expression (LineType * line, int *Value)
+{
+
+ assert (line != NULL);
+ assert (Value != NULL);
+ return buff_read_integer_expression (line->buffer, &(line->position),
+ Value);
+}
+
+
+extern int
+buff_read_numeric_expression (char *buffer, int *position, DoubleType * Value)
+{
+ /*
+ read the next non-space words in 'buffer' that conforms to a BASIC numeric expression into 'Value'.
+ if successful then 'position' is updated past 'Value' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ 'Value' shall be declared "DoubleType Value".
+ */
+ int p;
+ VariantType x;
+ VariantType *X;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ assert (Value != NULL);
+
+ X = &x;
+ p = *position;
+ CLEAR_VARIANT (X);
+
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (buff_read_expression (buffer, &p, X) == FALSE) /* buff_read_numeric_expression */
+ {
+ return FALSE;
+ }
+ if (X->VariantTypeCode != StringTypeCode)
+ {
+ /* OK */
+ *Value = X->Number;
+ *position = p;
+ return TRUE;
+ }
+ RELEASE_VARIANT (X);
+ return FALSE;
+}
+
+extern int
+line_read_numeric_expression (LineType * line, DoubleType * Value)
+{
+
+ assert (line != NULL);
+ assert (Value != NULL);
+ return buff_read_numeric_expression (line->buffer, &(line->position),
+ Value);
+}
+
+extern int
+buff_read_string_expression (char *buffer, int *position, char **Value)
+{
+ /*
+ read the next non-space words in 'buffer' that conforms to a BASIC string expression into 'Value'.
+ if successful then 'position' is updated past 'Value' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ 'Value' shall be declared "char * Value = NULL".
+ */
+ int p;
+ VariantType x;
+ VariantType *X;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ assert (Value != NULL);
+
+ X = &x;
+ p = *position;
+ CLEAR_VARIANT (X);
+
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (buff_read_expression (buffer, &p, X) == FALSE) /* buff_read_string_expression */
+ {
+ return FALSE;
+ }
+ if (X->VariantTypeCode == StringTypeCode)
+ {
+ /* OK */
+ X->Buffer[X->Length] = NulChar;
+ *Value = X->Buffer;
+ *position = p;
+ return TRUE;
+ /* the caller is responsible to free() the returned pointer */
+ }
+ return FALSE;
+}
+
+extern int
+line_read_string_expression (LineType * line, char **Value)
+{
+
+ assert (line != NULL);
+ assert (Value != NULL);
+ return buff_read_string_expression (line->buffer, &(line->position), Value);
+}
+
+extern int
+buff_read_index_item (char *buffer, int *position, int Index, int *Value)
+{
+ /*
+ read the next non-space words in 'buffer' that conforms to a BASIC integer expression list into 'Value',
+ selecting the item matching 'Index'. The first 'Index' value is one;
+ if successful then 'position' is updated past 'Value' and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ 'Value' shall be declared "int Value".
+ */
+ int p;
+ int i;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ assert (Value != NULL);
+
+ p = *position;
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (buff_is_eol (buffer, &p))
+ {
+ return FALSE;
+ }
+ if (Index < 1)
+ {
+ return FALSE;
+ }
+ /* Index >= 1 */
+ i = 0;
+ do
+ {
+ int v;
+
+ if (buff_read_integer_expression (buffer, &p, &v))
+ {
+ i++;
+ if (i == Index)
+ {
+ *Value = v;
+ *position = p;
+ return TRUE;
+ }
+ }
+ else
+ {
+ return FALSE;
+ }
+ }
+ while (buff_skip_seperator (buffer, &p));
+ return FALSE;
+}
+
+extern int
+line_read_index_item (LineType * line, int Index, int *Value)
+{
+
+ assert (line != NULL);
+ assert (Value != NULL);
+ return buff_read_index_item (line->buffer, &(line->position), Index, Value);
+}
+
+
+extern int
+buff_read_letter_sequence (char *buffer, int *position, char *head,
+ char *tail)
+{
+ /*
+ read the next non-space alphabetic character in 'buffer' into 'start';
+ if seperated by a hyphen ('-') then read the next non-space alphabetic character into 'end'.
+ if successful then 'position' is updated past 'start' (or 'end') and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ */
+ int p;
+ char h;
+ char t;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ assert (head != NULL);
+ assert (tail != NULL);
+
+ p = *position;
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (bwb_isalpha (buffer[p]) == FALSE)
+ {
+ /* character at this position must be a letter */
+ return FALSE;
+ }
+ h = buffer[p];
+ p++;
+
+ /* check for hyphen, indicating sequence of more than one letter */
+ if (buff_skip_MinusChar (buffer, &p))
+ {
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (bwb_isalpha (buffer[p]) == FALSE)
+ {
+ /* character at this position must be a letter */
+ return FALSE;
+ }
+ t = buffer[p];
+ p++;
+ }
+ else
+ {
+ t = h;
+ }
+ *head = h;
+ *tail = t;
+ *position = p;
+ return TRUE;
+}
+
+extern int
+line_read_letter_sequence (LineType * line, char *head, char *tail)
+{
+
+ assert (line != NULL);
+ assert (head != NULL);
+ assert (tail != NULL);
+ return buff_read_letter_sequence (line->buffer, &(line->position), head,
+ tail);
+}
+
+extern int
+buff_read_array_dimensions (char *buffer, int *position, int *n_params,
+ int params[ /* MAX_DIMS */ ])
+{
+ /*
+ read the next non-space words in 'buffer' that conform to BASIC array index values;
+ if successful then 'position' is updated past the right parenthesis and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ */
+ int p;
+ int n;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ assert (n_params != NULL);
+ assert (params != NULL);
+
+ p = *position;
+ n = 0;
+
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (buff_skip_LparenChar (buffer, &p))
+ {
+ /* matrix */
+ do
+ {
+ int Value;
+
+ if (n >= MAX_DIMS)
+ {
+ /* ERROR */
+ return FALSE;
+ }
+ /* OK */
+ if (buff_read_integer_expression (buffer, &p, &Value) == FALSE)
+ {
+ /* ERROR */
+ return FALSE;
+ }
+ /* OK */
+ params[n] = Value;
+ n++;
+ }
+ while (buff_skip_seperator (buffer, &p));
+
+ if (buff_skip_RparenChar (buffer, &p) == FALSE)
+ {
+ /* ERROR */
+ return FALSE;
+ }
+ }
+ else
+ {
+ /* scalar */
+ n = 0;
+ }
+ *n_params = n;
+ *position = p;
+ return TRUE;
+}
+
+#if FALSE /* keep this ... */
+extern int
+line_read_array_dimensions (LineType * line, int *n_params,
+ int params[ /* MAX_DIMS */ ])
+{
+
+ assert (line != NULL);
+ assert (n_params != NULL);
+ assert (params != NULL);
+ return buff_read_array_dimensions (line->buffer, &(line->position),
+ n_params, params);
+}
+#endif
+
+extern int
+buff_read_array_redim (char *buffer, int *position, int *dimensions,
+ int LBOUND[ /* MAX_DIMS */ ],
+ int UBOUND[ /* MAX_DIMS */ ])
+{
+ /*
+ read the next non-space words in 'buffer' that conform to BASIC array index values;
+ if successful then 'position' is updated past the right parenthesis and returns TRUE
+ otherwise 'position' is unchanged and returns FALSE.
+ */
+ int p;
+ int n;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ assert (dimensions != NULL);
+ assert (LBOUND != NULL);
+ assert (UBOUND != NULL);
+
+ p = *position;
+ n = 0;
+
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (buff_skip_LparenChar (buffer, &p))
+ {
+ /* matrix */
+ do
+ {
+ int Value;
+
+ if (n >= MAX_DIMS)
+ {
+ /* ERROR */
+ return FALSE;
+ }
+ /* OK */
+ if (buff_read_integer_expression (buffer, &p, &Value) == FALSE)
+ {
+ /* ERROR */
+ return FALSE;
+ }
+ /* OK */
+ if (buff_skip_word (buffer, &p, "TO") == TRUE)
+ {
+ LBOUND[n] = Value; /* explicit lower bound */
+ if (buff_read_integer_expression (buffer, &p, &Value) == FALSE)
+ {
+ /* ERROR */
+ return FALSE;
+ }
+ /* OK */
+ UBOUND[n] = Value; /* explicit upper bound */
+ }
+ else
+ {
+ LBOUND[n] = My->CurrentVersion->OptionBaseInteger; /* implicit lower bound */
+ UBOUND[n] = Value; /* explicit upper bound */
+ }
+ n++;
+ }
+ while (buff_skip_seperator (buffer, &p));
+
+ if (buff_skip_RparenChar (buffer, &p) == FALSE)
+ {
+ /* ERROR */
+ return FALSE;
+ }
+ }
+ else
+ {
+ /* scalar */
+ n = 0;
+ }
+ *dimensions = n;
+ *position = p;
+ return TRUE;
+}
+
+extern int
+line_read_array_redim (LineType * line, int *dimensions,
+ int LBOUND[ /* MAX_DIMS */ ],
+ int UBOUND[ /* MAX_DIMS */ ])
+{
+
+ assert (line != NULL);
+ assert (dimensions != NULL);
+ assert (LBOUND != NULL);
+ assert (UBOUND != NULL);
+ return buff_read_array_redim (line->buffer, &(line->position), dimensions,
+ LBOUND, UBOUND);
+}
+
+extern int
+buff_peek_array_dimensions (char *buffer, int *position, int *n_params)
+{
+ /*
+ peek the next non-space words in 'buffer' that conform to BASIC array index values;
+ if successful then 'n_params' is updated and returns TRUE
+ otherwise 'n_params' is unchanged and returns FALSE.
+ 'position' is always unchanged.
+ */
+ int p;
+ int ParenLevel;
+ int NumDimensions;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+ assert (n_params != NULL);
+
+ ParenLevel = 0;
+ NumDimensions = 1;
+ p = *position;
+ buff_skip_spaces (buffer, &p); /* keep this */
+ while (buffer[p])
+ {
+ /* check the current character */
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (buff_skip_LparenChar (buffer, &p))
+ {
+ ParenLevel++;
+ }
+ else if (buff_skip_RparenChar (buffer, &p))
+ {
+ ParenLevel--;
+ if (ParenLevel < 0)
+ {
+ return FALSE;
+ }
+ if (ParenLevel == 0)
+ {
+ *n_params = NumDimensions;
+ return TRUE;
+ }
+ }
+ else if (buff_skip_seperator (buffer, &p))
+ {
+ if (ParenLevel == 1)
+ {
+ NumDimensions++;
+ }
+ }
+ else if (buffer[p] == My->CurrentVersion->OptionQuoteChar)
+ {
+ /* embedded string constant */
+ p++;
+ while ((buffer[p] != My->CurrentVersion->OptionQuoteChar)
+ && (buffer[p] != NulChar))
+ {
+ p++;
+ }
+ if (buffer[p] == My->CurrentVersion->OptionQuoteChar)
+ {
+ p++;
+ }
+ }
+ else
+ {
+ /* normal character */
+ p++;
+ }
+ }
+ return FALSE;
+}
+
+#if FALSE /* keep this ... */
+extern int
+line_peek_array_dimensions (LineType * line, int *n_params)
+{
+
+ assert (line != NULL);
+ assert (n_params != NULL);
+ return buff_peek_array_dimensions (line->buffer, &(line->position),
+ n_params);
+}
+#endif
+
+extern char
+buff_read_type_declaration (char *buffer, int *position)
+{
+ /*
+ skip the next non-space words in 'buffer' if it is a BASIC type declaration.
+ if successful then 'position' is updated past the BASIC type declaration and returns the TypeCode
+ otherwise 'position' is unchanged and returns NulChar.
+ */
+ int p;
+ char TypeCode;
+
+ assert (buffer != NULL);
+ assert (position != NULL);
+
+
+ p = *position;
+ TypeCode = NulChar;
+
+
+ buff_skip_spaces (buffer, &p); /* keep this */
+ if (buff_is_eol (buffer, &p))
+ {
+ return TypeCode;
+ }
+
+ if (buff_skip_word (buffer, &p, "AS") == TRUE)
+ {
+ /* AS ... */
+
+ if (buff_skip_word (buffer, &p, "BYTE"))
+ {
+ /* AS BYTE */
+ TypeCode = ByteTypeCode;
+ }
+ else if (buff_skip_word (buffer, &p, "INTEGER"))
+ {
+ /* AS INTEGER */
+ TypeCode = IntegerTypeCode;
+ }
+ else if (buff_skip_word (buffer, &p, "LONG"))
+ {
+ /* AS LONG */
+ TypeCode = LongTypeCode;
+ }
+ else if (buff_skip_word (buffer, &p, "CURRENCY"))
+ {
+ /* AS CURRENCY */
+ TypeCode = CurrencyTypeCode;
+ }
+ else if (buff_skip_word (buffer, &p, "SINGLE"))
+ {
+ /* AS SINGLE */
+ TypeCode = SingleTypeCode;
+ }
+ else if (buff_skip_word (buffer, &p, "DOUBLE"))
+ {
+ /* AS DOUBLE */
+ TypeCode = DoubleTypeCode;
+ }
+ else if (buff_skip_word (buffer, &p, "STRING"))
+ {
+ /* AS STRING */
+ TypeCode = StringTypeCode;
+ }
+ else
+ {
+ /* invalid type */
+ }
+ }
+ if (TypeCode)
+ {
+ /* success */
+ *position = p;
+ }
+ return TypeCode;
+}
+
+extern char
+line_read_type_declaration (LineType * line)
+{
+
+ assert (line != NULL);
+ return buff_read_type_declaration (line->buffer, &(line->position));
+}
+
+
+
+/***************************************************************
+
+ FUNCTION: line_start()
+
+ DESCRIPTION: This function reads a line buffer in
+ <buffer> beginning at the position
+ <pos> and attempts to determine (a)
+ the position of the line number in the
+ buffer (returned in <lnpos>), (b) the
+ line number at this position (returned
+ in <lnum>), (c) the position of the
+ BASIC command in the buffer (returned
+ in <cmdpos>), (d) the position of this
+ BASIC command in the command table
+ (returned in <cmdnum>), and (e) the
+ position of the beginning of the rest
+ of the line (returned in <Startpos>).
+ Although <Startpos> must be returned
+ as a positive integer, the other
+ searches may fail, in which case FALSE
+ will be returned in their positions.
+ <pos> is not incremented.
+
+***************************************************************/
+static void
+internal_DEF8SUB (LineType * l)
+{
+ /*
+ **
+ ** User is executing a function as though it were a command, such as 100 COS X.
+ ** This applies to both intrinsic functions and user defined functions and subroutines.
+ ** No special parsing is required, just insert "CALL" before the name and
+ ** add parentheses around the parameters:
+ ** 100 fna 1,2,3 -->> 100 CALL fna(1,2,3)
+ **
+ */
+ const char *A = "CALL ";
+ int a;
+ int n;
+ char *buffer;
+
+ assert (l != NULL);
+
+ a = bwb_strlen (A);
+ n = bwb_strlen (l->buffer) + a /* "CALL " */ + 1 /* '(' */ + 1 /* ')' */ ;
+ buffer = calloc (n + 1 /* NulChar */ , sizeof (char));
+ if (buffer == NULL)
+ {
+ WARN_OUT_OF_MEMORY;
+ return;
+ }
+ bwb_strcpy (buffer, A);
+ /* buffer == "CALL " */
+ l->position = 0;
+ if (line_read_varname (l, &(buffer[a])) == FALSE)
+ {
+ WARN_SYNTAX_ERROR;
+ return;
+ }
+ /* buffer == "CALL name" */
+ line_skip_spaces (l);
+ if (line_is_eol (l))
+ {
+ /* buffer == "CALL name" */
+ }
+ else
+ {
+ /* buffer == "CALL name" */
+ bwb_strcat (buffer, "(");
+ /* buffer == "CALL name(" */
+ bwb_strcat (buffer, &(l->buffer[l->position]));
+ /* buffer == "CALL name(...parameters..." */
+ bwb_strcat (buffer, ")");
+ /* buffer == "CALL name(...parameters...)" */
+ }
+ /*
+ printf("%s\n", buffer );
+ */
+ free (l->buffer);
+ l->buffer = buffer;
+ l->position = a;
+ l->Startpos = a;
+ l->cmdnum = C_CALL;
+}
+extern void
+line_start (LineType * l)
+{
+ char tbuf[NameLengthMax + 1];
+
+ assert (l != NULL);
+
+
+ /* set initial values */
+ l->cmdnum = 0; /* NOT FOUND */
+ l->Startpos = 0;
+ l->position = 0;
+
+ line_skip_spaces (l); /* keep this */
+
+ /* handle special cases */
+ if (line_is_eol (l))
+ {
+ /* the NUL (0) char must be handled first */
+ l->cmdnum = C_REM;
+ return;
+ }
+ if (line_skip_char (l, My->CurrentVersion->OptionCommentChar))
+ {
+ line_skip_eol (l);
+ l->Startpos = l->position;
+ l->cmdnum = C_REM;
+ return;
+ }
+ if (line_skip_char (l, My->CurrentVersion->OptionPrintChar))
+ {
+ line_skip_spaces (l); /* keep this */
+ l->Startpos = l->position;
+ l->cmdnum = C_PRINT;
+ return;
+ }
+ if (line_skip_char (l, My->CurrentVersion->OptionInputChar))
+ {
+ line_skip_spaces (l); /* keep this */
+ l->Startpos = l->position;
+ l->cmdnum = C_INPUT;
+ return;
+ }
+ if (line_skip_char (l, My->CurrentVersion->OptionImageChar))
+ {
+ line_skip_spaces (l); /* keep this */
+ l->Startpos = l->position;
+ l->cmdnum = C_IMAGE;
+ return;
+ }
+ if (bwb_strnicmp (&l->buffer[l->position], "REM", 3) == 0)
+ {
+ line_skip_eol (l);
+ l->Startpos = l->position;
+ l->cmdnum = C_REM;
+ return;
+ }
+ /* not a SPECIAL */
+
+ /* get the first keyword */
+ if (line_read_keyword (l, tbuf) == FALSE)
+ {
+ /* ERROR */
+ return;
+ }
+ line_skip_spaces (l); /* keep this */
+
+
+ /*
+ **
+ ** check for COMMAND
+ **
+ */
+ l->cmdnum = is_cmd (tbuf);
+ if (l->cmdnum)
+ {
+ /*
+ **
+ ** NOTE: This is NOT a full parser, this exists only to
+ ** handle STRUCTURED commands. It is true that we also handle
+ ** some other easy cases, but remember that this only exists
+ ** to support STRUCTURED commands. Whether any other commands
+ ** get processed here is simply because it was easy to do so.
+ **
+ */
+
+ int cmdnum;
+ char *xbuf;
+ int xlen;
+
+ cmdnum = 0;
+ xbuf = My->ConsoleInput;
+ xlen = MAX_LINE_LENGTH;
+ bwb_strcpy (xbuf, tbuf);
+
+ do
+ {
+ cmdnum = 0;
+ l->Startpos = l->position;
+ if (line_read_keyword (l, tbuf))
+ {
+ int n;
+ n = bwb_strlen (xbuf) + 1 /* SpaceChar */ + bwb_strlen (tbuf);
+ if (n < xlen)
+ {
+ /* not too long */
+ bwb_strcat (xbuf, " ");
+ bwb_strcat (xbuf, tbuf);
+ cmdnum = is_cmd (xbuf);
+ if (cmdnum)
+ {
+ /* longer command is valid */
+ line_skip_spaces (l); /* keep this */
+ l->Startpos = l->position;
+ l->cmdnum = cmdnum;
+ }
+ }
+ }
+ }
+ while (cmdnum);
+ /*
+ **
+ ** process special cases here
+ **
+ */
+ l->position = l->Startpos;
+ switch (l->cmdnum)
+ {
+ case C_CLOAD:
+ {
+ if (line_skip_StarChar (l))
+ {
+ /*
+ **
+ ** CLOAD*
+ **
+ */
+ line_skip_spaces (l); /* keep this */
+ l->Startpos = l->position;
+ l->cmdnum = C_CLOAD8;
+ }
+ }
+ break;
+ case C_CSAVE:
+ {
+ if (line_skip_StarChar (l))
+ {
+ /*
+ **
+ ** CSAVE*
+ **
+ */
+ line_skip_spaces (l); /* keep this */
+ l->Startpos = l->position;
+ l->cmdnum = C_CSAVE8;
+ }
+ }
+ break;
+ case C_DEF:
+ if (bwb_strchr (l->buffer, '=') == NULL)
+ {
+ /*
+ **
+ ** multi-line DEF ... FNEND
+ **
+ */
+ l->cmdnum = C_FUNCTION;
+ }
+ /*
+ **
+ ** we look up declared USER functions as we load
+ **
+ */
+ UserFunction_add (l);
+ break;
+ case C_FEND:
+ /*
+ **
+ ** this makes bwb_scan() simpler
+ **
+ */
+ l->cmdnum = C_END_FUNCTION;
+ break;
+ case C_FNEND:
+ /*
+ **
+ ** this makes bwb_scan() simpler
+ **
+ */
+ l->cmdnum = C_END_FUNCTION;
+ break;
+ case C_FUNCTION:
+ /*
+ **
+ ** we look up declared USER functions as we load
+ **
+ */
+ UserFunction_add (l);
+ break;
+ case C_IF:
+ /*
+ **
+ ** CLASSIC vs STRUCTURED
+ **
+ */
+ if (IsLastKeyword (l, " THEN"))
+ {
+ /*
+ **
+ ** STRUCTURED
+ **
+ */
+ l->cmdnum = C_IF8THEN;
+ }
+ break;
+ case C_OPEN:
+ /*
+ **
+ ** CLASSIC vs STRUCTURED
+ **
+ */
+ if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73 | D71))
+ {
+ /*
+ **
+ ** STRUCTURED
+ **
+ */
+ /* OPEN filenum, filename$, INPUT | OUTPUT */
+ }
+ else if (GetKeyword (l, " AS "))
+ {
+ /*
+ **
+ ** STRUCTURED
+ **
+ */
+ /* OPEN ... AS ... */
+ }
+ else
+ {
+ /*
+ **
+ ** CLASSIC
+ **
+ */
+ /*
+ l->cmdnum = C_DEF8SUB;
+ l->Startpos = 0;
+ */
+ internal_DEF8SUB (l);
+ }
+ break;
+ case C_SUB:
+ /*
+ **
+ ** we look up declared USER functions as we load
+ **
+ */
+ UserFunction_add (l);
+ break;
+ case C_SUBEND:
+ case C_SUB_END:
+ /*
+ **
+ ** this makes bwb_scan() simpler
+ **
+ */
+ l->cmdnum = C_END_SUB;
+ break;
+ case C_SUBEXIT:
+ case C_SUB_EXIT:
+ /*
+ **
+ ** this makes bwb_scan() simpler
+ **
+ */
+ l->cmdnum = C_EXIT_SUB;
+ break;
+ case C_DEF8LBL:
+ /*
+ **
+ ** we look up declared USER functions as we load
+ **
+ */
+ UserFunction_add (l);
+ break;
+ }
+ return;
+ }
+ /* not a COMMAND */
+
+ /*
+ **
+ ** check for implied LET
+ **
+ */
+ if (is_let (l->buffer))
+ {
+ /*
+ **
+ ** this is an implied LET, such as:
+ ** 100 A = 123
+ **
+ */
+ l->Startpos = 0;
+ l->cmdnum = C_LET;
+ return;
+ }
+ /* not an implied LET */
+
+ /*
+ **
+ ** check for FUNCTION called as a SUBROUTINE
+ **
+ */
+ if (UserFunction_name (tbuf) || IntrinsicFunction_name (tbuf))
+ {
+ /*
+ **
+ ** check for a bogus assignment to a FUNCTION called as a SUBROUTINE, such as:
+ ** 100 COS = X
+ **
+ */
+ if (line_peek_EqualChar (l))
+ {
+ /* SYNTAX ERROR */
+ l->cmdnum = 0;
+ return;
+ }
+ /*
+ **
+ ** FUNCTION called as a SUBROUTINE, such as:
+ ** 100 OUT X, Y
+ **
+ */
+ /*
+ l->Startpos = 0;
+ l->cmdnum = C_DEF8SUB;
+ */
+ internal_DEF8SUB (l);
+ return;
+ }
+ /* not a FUNCTION */
+
+ /*
+ **
+ ** check for LABEL
+ **
+ */
+ if (My->CurrentVersion->OptionFlags & OPTION_LABELS_ON) /* labels are enabled */
+ if (My->CurrentVersion->OptionStatementChar) /* a Statement seperator exists */
+ if (line_skip_char (l, My->CurrentVersion->OptionStatementChar)) /* this is a label */
+ if (line_is_eol (l)) /* we finish the line */
+ {
+ /*
+ **
+ ** LABEL, such as:
+ ** 100 MyLabel:
+ **
+ */
+ l->Startpos = l->position;
+ l->cmdnum = C_DEF8LBL;
+ return;
+ }
+ /* not a LABEL */
+
+
+ /* SYNTAX ERROR */
+ l->cmdnum = 0;
+ return;
+}
+
+
+/***************************************************************
+
+ FUNCTION: is_cmd()
+
+ DESCRIPTION: This function determines whether the
+ string in 'buffer' is a BASIC command
+ statement, returning 'id' or 0.
+
+
+***************************************************************/
+
+static int
+is_cmd (char *name)
+{
+ int i;
+
+ assert (name != NULL);
+
+
+#if THE_PRICE_IS_RIGHT
+ /* start with the closest command, without going over */
+ i = VarTypeIndex (name[0]);
+ if (i < 0)
+ {
+ /* non-alpha, all commands start with an alpha character */
+ /* NOT FOUND */
+ return 0;
+ }
+ i = My->CommandStart[i]; /* first command starting with this letter */
+ if (i < 0)
+ {
+ /* no command starts with that letter */
+ /* NOT FOUND */
+ return 0;
+ }
+#else /* THE_PRICE_IS_RIGHT */
+ i = 0;
+#endif /* THE_PRICE_IS_RIGHT */
+ for (; i < NUM_COMMANDS; i++)
+ {
+ if (My->CurrentVersion->OptionVersionValue & IntrinsicCommandTable[i].
+ OptionVersionBitmask)
+ {
+ int result;
+ result = bwb_stricmp (IntrinsicCommandTable[i].name, name);
+ if (result == 0)
+ {
+ /* FOUND */
+ return IntrinsicCommandTable[i].CommandID;
+ }
+ if (result > 0 /* found > searched */ )
+ {
+ /* NOT FOUND */
+ return 0;
+ }
+ /* result < 0 : found < searched */
+ }
+ }
+ /* NOT FOUND */
+ return 0;
+}
+
+static int
+is_let (char *buffer)
+{
+ /*
+ **
+ ** returns TRUE if 'buffer' contains an implied LET statement,
+ ** which is detected by an unquoted '='
+ **
+ */
+ int n;
+
+ assert (buffer != NULL);
+
+ /* Go through the expression and search for an unquoted assignment operator. */
+
+ for (n = 0; buffer[n]; n++)
+ {
+ if (buffer[n] == '=')
+ {
+ return TRUE;
+ }
+ if (buffer[n] == My->CurrentVersion->OptionQuoteChar)
+ {
+ /* string constant */
+ n++;
+ while (buffer[n] != My->CurrentVersion->OptionQuoteChar)
+ {
+ n++;
+ if (buffer[n] == NulChar)
+ {
+ WARN_SYNTAX_ERROR;
+ return FALSE;
+ }
+ }
+ n++;
+ }
+ }
+
+ /* No command name was found */
+
+ return FALSE;
+
+}
+
+
+extern int
+bwb_freeline (LineType * l)
+{
+ /*
+ **
+ ** free memory associated with a program line
+ **
+ */
+
+
+ if (l != NULL)
+ {
+ /* free arguments if there are any */
+ if (l->buffer != NULL)
+ {
+ free (l->buffer);
+ l->buffer = NULL;
+ }
+ free (l);
+ /* l = NULL; */
+ My->IsScanRequired = TRUE; /* program needs to be scanned again */
+ }
+ return TRUE;
+}
+
+static int
+GetKeyword (LineType * l, char *Keyword)
+{
+ /*
+ *
+ * Returns TRUE if Keyword is found unquoted
+ *
+ */
+ char *S;
+ char *C;
+ int n;
+
+ assert (l != NULL);
+ assert (Keyword != NULL);
+
+ S = l->buffer;
+ S += l->position;
+ C = S;
+ n = bwb_strlen (Keyword);
+
+
+ while (*C)
+ {
+ if (bwb_strnicmp (C, Keyword, n) == 0)
+ {
+ /* FOUND */
+ return TRUE;
+ }
+ else if (*C == My->CurrentVersion->OptionQuoteChar)
+ {
+ /* skip string constant */
+ C++;
+ while (*C != NulChar && *C != My->CurrentVersion->OptionQuoteChar)
+ {
+ C++;
+ }
+ if (*C == My->CurrentVersion->OptionQuoteChar)
+ {
+ C++;
+ }
+ }
+ else
+ {
+ /* skip normal character */
+ C++;
+ }
+ }
+ /* NOT FOUND */
+ return FALSE;
+}
+
+extern int
+IsLastKeyword (LineType * l, char *Keyword)
+{
+ /* find the end of the line */
+ /* backup thru spaces */
+ int n;
+ char *S;
+ char *C;
+
+ assert (l != NULL);
+ assert (Keyword != NULL);
+
+
+ S = l->buffer;
+ S += l->position;
+ C = S;
+ n = bwb_strlen (Keyword);
+ S += n;
+ /*
+ ** IF x THEN 0
+ ** IF x THEN
+ */
+ while (*C)
+ {
+ /* skip string constants */
+ if (*C == My->CurrentVersion->OptionQuoteChar)
+ {
+ /* skip leading quote */
+ C++;
+ while (*C != NulChar && *C != My->CurrentVersion->OptionQuoteChar)
+ {
+ C++;
+ }
+ /* skip trailing quote */
+ if (*C == My->CurrentVersion->OptionQuoteChar)
+ {
+ C++;
+ }
+ }
+ else
+ {
+ C++;
+ }
+ }
+ if (C > S)
+ {
+ C--;
+ while (C > S && *C == ' ')
+ {
+ C--;
+ }
+ C++;
+ if (C > S)
+ {
+ C -= n;
+ if (bwb_strnicmp (C, Keyword, n) == 0)
+ {
+ /* FOUND */
+ return TRUE;
+ }
+ }
+ }
+ /* NOT FOUND */
+ return FALSE;
+}
+
+/* bitmask values returned by bwb_chartype() */
+#define CHAR_IS_CNTRL 0x01
+#define CHAR_IS_SPACE 0x02
+#define CHAR_IS_PRINT 0x04
+#define CHAR_IS_PUNCT 0x08
+#define CHAR_IS_DIGIT 0x10
+#define CHAR_IS_XDIGIT 0x20
+#define CHAR_IS_UPPER 0x40
+#define CHAR_IS_LOWER 0x80
+
+#define CHAR_IS_ALPHA (CHAR_IS_UPPER | CHAR_IS_LOWER)
+#define CHAR_IS_ALNUM (CHAR_IS_ALPHA | CHAR_IS_DIGIT)
+#define CHAR_IS_GRAPH (CHAR_IS_ALNUM | CHAR_IS_PUNCT)
+
+
+static int
+bwb_chartype (int C)
+{
+ /* returns the the character type bitmask */
+
+ switch (C)
+ {
+ case EOF:
+ return 0; /* Special Case */
+ case '\t':
+ case '\n':
+ case '\v':
+ case '\f':
+ case '\r':
+ return CHAR_IS_CNTRL | CHAR_IS_SPACE;
+ case ' ':
+ return CHAR_IS_PRINT | CHAR_IS_SPACE;
+ case '!':
+ case '"':
+ case '#':
+ case '$':
+ case '%':
+ case '&':
+ case '\'':
+ case '(':
+ case ')':
+ case '*':
+ case '+':
+ case ',':
+ case '-':
+ case '.':
+ case '/':
+ return CHAR_IS_PRINT | CHAR_IS_PUNCT;
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ return CHAR_IS_PRINT | CHAR_IS_DIGIT | CHAR_IS_XDIGIT;
+ case ':':
+ case ';':
+ case '<':
+ case '=':
+ case '>':
+ case '?':
+ case '@':
+ return CHAR_IS_PRINT | CHAR_IS_PUNCT;
+ case 'A':
+ case 'B':
+ case 'C':
+ case 'D':
+ case 'E':
+ case 'F':
+ return CHAR_IS_PRINT | CHAR_IS_UPPER | CHAR_IS_XDIGIT;
+ case 'G':
+ case 'H':
+ case 'I':
+ case 'J':
+ case 'K':
+ case 'L':
+ case 'M':
+ case 'N':
+ case 'O':
+ case 'P':
+ case 'Q':
+ case 'R':
+ case 'S':
+ case 'T':
+ case 'U':
+ case 'V':
+ case 'W':
+ case 'X':
+ case 'Y':
+ case 'Z':
+ return CHAR_IS_PRINT | CHAR_IS_UPPER;
+ case '[':
+ case '\\':
+ case ']':
+ case '^':
+ case '_':
+ case '`':
+ return CHAR_IS_PRINT | CHAR_IS_PUNCT;
+ case 'a':
+ case 'b':
+ case 'c':
+ case 'd':
+ case 'e':
+ case 'f':
+ return CHAR_IS_PRINT | CHAR_IS_LOWER | CHAR_IS_XDIGIT;
+ case 'g':
+ case 'h':
+ case 'i':
+ case 'j':
+ case 'k':
+ case 'l':
+ case 'm':
+ case 'n':
+ case 'o':
+ case 'p':
+ case 'q':
+ case 'r':
+ case 's':
+ case 't':
+ case 'u':
+ case 'v':
+ case 'w':
+ case 'x':
+ case 'y':
+ case 'z':
+ return CHAR_IS_PRINT | CHAR_IS_LOWER;
+ case '{':
+ case '|':
+ case '}':
+ case '~':
+ return CHAR_IS_PRINT | CHAR_IS_PUNCT;
+ }
+ return CHAR_IS_CNTRL;
+}
+
+extern int
+bwb_isalnum (int C)
+{
+ /*
+ 4.3.1.1 The isalnum function
+
+ Synopsis
+
+ #include <ctype.h>
+ int isalnum(int c);
+
+ Description
+
+ The isalnum function tests for any character for which isalpha or
+ isdigit is true.
+ */
+
+ if (bwb_chartype (C) & CHAR_IS_ALNUM)
+ {
+ return TRUE;
+ }
+ return FALSE;
+}
+
+int
+bwb_isalpha (int C)
+{
+ /*
+ 4.3.1.2 The isalpha function
+
+ Synopsis
+
+ #include <ctype.h>
+ int isalpha(int c);
+
+ Description
+
+ The isalpha function tests for any character for which isupper or
+ islower is true, or any of an implementation-defined set of characters
+ for which none of iscntrl , isdigit , ispunct , or isspace is true.
+ In the C locale, isalpha returns true only for the characters for
+ which isupper or islower is true.
+ */
+
+ if (bwb_chartype (C) & CHAR_IS_ALPHA)
+ {
+ return TRUE;
+ }
+ return FALSE;
+}
+
+#if FALSE /* keep this ... */
+extern int
+bwb_iscntrl (int C)
+{
+ /*
+ 4.3.1.3 The iscntrl function
+
+ Synopsis
+
+ #include <ctype.h>
+ int iscntrl(int c);
+
+ Description
+
+ The iscntrl function tests for any control character.
+ */
+
+ if (bwb_chartype (C) & CHAR_IS_CNTRL)
+ {
+ return TRUE;
+ }
+ return FALSE;
+}
+#endif
+
+extern int
+bwb_isdigit (int C)
+{
+ /*
+ 4.3.1.4 The isdigit function
+
+ Synopsis
+
+ #include <ctype.h>
+ int isdigit(int c);
+
+ Description
+
+ The isdigit function tests for any decimal-digit character (as
+ defined in $2.2.1).
+ */
+
+ if (bwb_chartype (C) & CHAR_IS_DIGIT)
+ {
+ return TRUE;
+ }
+ return FALSE;
+}
+
+extern int
+bwb_isgraph (int C)
+{
+ /*
+ 4.3.1.5 The isgraph function
+
+ Synopsis
+
+ #include <ctype.h>
+ int isgraph(int c);
+
+ Description
+
+ The isgraph function tests for any printing character except space (' ').
+ */
+
+ if (bwb_chartype (C) & CHAR_IS_GRAPH)
+ {
+ return TRUE;
+ }
+ return FALSE;
+}
+
+#if FALSE /* keep this ... */
+extern int
+bwb_islower (int C)
+{
+ /*
+ 4.3.1.6 The islower function
+
+ Synopsis
+
+ #include <ctype.h>
+ int islower(int c);
+
+ Description
+
+ The islower function tests for any lower-case letter or any of an
+ implementation-defined set of characters for which none of iscntrl ,
+ isdigit , ispunct , or isspace is true. In the C locale, islower
+ returns true only for the characters defined as lower-case letters (as
+ defined in $2.2.1).
+ */
+
+ if (bwb_chartype (C) & CHAR_IS_LOWER)
+ {
+ return TRUE;
+ }
+ return FALSE;
+}
+#endif
+
+extern int
+bwb_isprint (int C)
+{
+ /*
+ 4.3.1.7 The isprint function
+
+ Synopsis
+
+ #include <ctype.h>
+ int isprint(int c);
+
+ Description
+
+ The isprint function tests for any printing character including
+ space (' ').
+ */
+
+ if (bwb_chartype (C) & CHAR_IS_PRINT)
+ {
+ return TRUE;
+ }
+ return FALSE;
+}
+
+extern int
+bwb_ispunct (int C)
+{
+ /*
+ 4.3.1.8 The ispunct function
+
+ Synopsis
+
+ #include <ctype.h>
+ int ispunct(int c);
+
+ Description
+
+ The ispunct function tests for any printing character except space
+ (' ') or a character for which isalnum is true.
+ */
+
+ if (bwb_chartype (C) & CHAR_IS_PUNCT)
+ {
+ return TRUE;
+ }
+ return FALSE;
+}
+
+#if FALSE /* keep this ... */
+extern int
+bwb_isspace (int C)
+{
+ /*
+ 4.3.1.9 The isspace function
+
+ Synopsis
+
+ #include <ctype.h>
+ int isspace(int c);
+
+ Description
+
+ The isspace function tests for the standard white-space characters
+ or for any of an implementation-defined set of characters for which
+ isalnum is false. The standard white-space characters are the
+ following: space (' '), form feed ('\f'), new-line ('\n'), carriage
+ return ('\r'), horizontal tab ('\t'), and vertical tab ('\v'). In the
+ C locale, isspace returns true only for the standard white-space
+ characters.
+ */
+
+ if (bwb_chartype (C) & CHAR_IS_SPACE)
+ {
+ return TRUE;
+ }
+ return FALSE;
+}
+#endif
+
+#if FALSE /* keep this ... */
+extern int
+bwb_isupper (int C)
+{
+ /*
+ 4.3.1.10 The isupper function
+
+ Synopsis
+
+ #include <ctype.h>
+ int isupper(int c);
+
+ Description
+
+ The isupper function tests for any upper-case letter or any of an
+ implementation-defined set of characters for which none of iscntrl ,
+ isdigit , ispunct , or isspace is true. In the C locale, isupper
+ returns true only for the characters defined as upper-case letters (as
+ defined in $2.2.1).
+ */
+
+ if (bwb_chartype (C) & CHAR_IS_UPPER)
+ {
+ return TRUE;
+ }
+ return FALSE;
+}
+#endif
+
+extern int
+bwb_isxdigit (int C)
+{
+ /*
+ 4.3.1.11 The isxdigit function
+
+ Synopsis
+
+ #include <ctype.h>
+ int isxdigit(int c);
+
+ Description
+
+ The isxdigit function tests for any hexadecimal-digit character (as
+ defined in $3.1.3.2).
+ */
+
+ if (bwb_chartype (C) & CHAR_IS_XDIGIT)
+ {
+ return TRUE;
+ }
+ return FALSE;
+}
+
+extern int
+bwb_tolower (int C)
+{
+ /*
+ 4.3.2.1 The tolower function
+
+ Synopsis
+
+ #include <ctype.h>
+ int tolower(int c);
+
+ Description
+
+ The tolower function converts an upper-case letter to the
+ corresponding lower-case letter.
+
+ Returns
+
+ If the argument is an upper-case letter, the tolower function
+ returns the corresponding lower-case letter if there is one; otherwise
+ the argument is returned unchanged. In the C locale, tolower maps
+ only the characters for which isupper is true to the corresponding
+ characters for which islower is true.
+ */
+
+ switch (C)
+ {
+ case 'A':
+ return 'a';
+ case 'B':
+ return 'b';
+ case 'C':
+ return 'c';
+ case 'D':
+ return 'd';
+ case 'E':
+ return 'e';
+ case 'F':
+ return 'f';
+ case 'G':
+ return 'g';
+ case 'H':
+ return 'h';
+ case 'I':
+ return 'i';
+ case 'J':
+ return 'j';
+ case 'K':
+ return 'k';
+ case 'L':
+ return 'l';
+ case 'M':
+ return 'm';
+ case 'N':
+ return 'n';
+ case 'O':
+ return 'o';
+ case 'P':
+ return 'p';
+ case 'Q':
+ return 'q';
+ case 'R':
+ return 'r';
+ case 'S':
+ return 's';
+ case 'T':
+ return 't';
+ case 'U':
+ return 'u';
+ case 'V':
+ return 'v';
+ case 'W':
+ return 'w';
+ case 'X':
+ return 'x';
+ case 'Y':
+ return 'y';
+ case 'Z':
+ return 'z';
+ }
+ return C;
+}
+
+extern int
+bwb_toupper (int C)
+{
+ /*
+ 4.3.2.2 The toupper function
+
+ Synopsis
+
+ #include <ctype.h>
+ int toupper(int c);
+
+ Description
+
+ The toupper function converts a lower-case letter to the corresponding upper-case letter.
+
+ Returns
+
+ If the argument is a lower-case letter, the toupper function
+ returns the corresponding upper-case letter if there is one; otherwise
+ the argument is returned unchanged. In the C locale, toupper maps
+ only the characters for which islower is true to the corresponding
+ characters for which isupper is true.
+ */
+
+ switch (C)
+ {
+ case 'a':
+ return 'A';
+ case 'b':
+ return 'B';
+ case 'c':
+ return 'C';
+ case 'd':
+ return 'D';
+ case 'e':
+ return 'E';
+ case 'f':
+ return 'F';
+ case 'g':
+ return 'G';
+ case 'h':
+ return 'H';
+ case 'i':
+ return 'I';
+ case 'j':
+ return 'J';
+ case 'k':
+ return 'K';
+ case 'l':
+ return 'L';
+ case 'm':
+ return 'M';
+ case 'n':
+ return 'N';
+ case 'o':
+ return 'O';
+ case 'p':
+ return 'P';
+ case 'q':
+ return 'Q';
+ case 'r':
+ return 'R';
+ case 's':
+ return 'S';
+ case 't':
+ return 'T';
+ case 'u':
+ return 'U';
+ case 'v':
+ return 'V';
+ case 'w':
+ return 'W';
+ case 'x':
+ return 'X';
+ case 'y':
+ return 'Y';
+ case 'z':
+ return 'Z';
+ }
+ return C;
+}
+
+
+extern void *
+bwb_memcpy (void *s1, const void *s2, size_t n)
+{
+ /*
+ 4.11.2.1 The memcpy function
+
+ Synopsis
+
+ #include <string.h>
+ void *memcpy(void *s1, const void *s2, size_t n);
+
+ Description
+
+ The memcpy function copies n characters from the object pointed to
+ by s2 into the object pointed to by s1 . If copying takes place
+ between objects that overlap, the behavior is undefined.
+
+ Returns
+
+ The memcpy function returns the value of s1 .
+ */
+
+
+ if (n > 0)
+ {
+ char *Target;
+ char *Source;
+ int p;
+ assert (s1 != NULL);
+ assert (s2 != NULL);
+
+
+ Target = (char *) s1;
+ Source = (char *) s2;
+ p = 0;
+ while (p < n)
+ {
+ Target[p] = Source[p];
+ p++;
+ }
+ }
+ return s1;
+}
+
+#if FALSE /* keep this ... */
+extern void *
+bwb_memmove (void *s1, const void *s2, size_t n)
+{
+ /*
+ 4.11.2.2 The memmove function
+
+ Synopsis
+
+ #include <string.h>
+ void *memmove(void *s1, const void *s2, size_t n);
+
+ Description
+
+ The memmove function copies n characters from the object pointed to
+ by s2 into the object pointed to by s1 . Copying takes place as if
+ the n characters from the object pointed to by s2 are first copied
+ into a temporary array of n characters that does not overlap the
+ objects pointed to by s1 and s2 , and then the n characters from the
+ temporary array are copied into the object pointed to by s1 .
+
+ Returns
+
+ The memmove function returns the value of s1 .
+ */
+
+
+ if (n > 0)
+ {
+ char *Target;
+ char *Source;
+ char *Temp;
+ assert (s1 != NULL);
+ assert (s2 != NULL);
+
+ Target = (char *) s1;
+ Source = (char *) s2;
+ Temp = (char *) malloc (n);
+ if (Temp != NULL)
+ {
+ int p;
+
+ p = 0;
+ while (p < n)
+ {
+ Temp[p] = Source[p];
+ p++;
+ }
+ p = 0;
+ while (p < n)
+ {
+ Target[p] = Temp[p];
+ p++;
+ }
+ free (Temp);
+ Temp = NULL;
+ }
+ }
+ return s1;
+}
+#endif
+
+extern char *
+bwb_strcpy (char *s1, const char *s2)
+{
+ /*
+ 4.11.2.3 The strcpy function
+
+ Synopsis
+
+ #include <string.h>
+ char *strcpy(char *s1, const char *s2);
+
+ Description
+
+ The strcpy function copies the string pointed to by s2 (including
+ the terminating null character) into the array pointed to by s1 . If
+ copying takes place between objects that overlap, the behavior is
+ undefined.
+
+ Returns
+
+ The strcpy function returns the value of s1 .
+ */
+ char C;
+ int p;
+
+ assert (s1 != NULL);
+ assert (s2 != NULL);
+
+ p = 0;
+ do
+ {
+ C = s2[p];
+ s1[p] = C;
+ p++;
+ }
+ while (C);
+ return s1;
+}
+
+
+extern char *
+bwb_strncpy (char *s1, const char *s2, size_t n)
+{
+ /*
+ 4.11.2.4 The strncpy function
+
+ Synopsis
+
+ #include <string.h>
+ char *strncpy(char *s1, const char *s2, size_t n);
+
+ Description
+
+ The strncpy function copies not more than n characters (characters
+ that follow a null character are not copied) from the array pointed to
+ by s2 to the array pointed to by s1 ./120/ If copying takes place
+ between objects that overlap, the behavior is undefined.
+
+ If the array pointed to by s2 is a string that is shorter than n
+ characters, null characters are appended to the copy in the array
+ pointed to by s1 , until n characters in all have been written.
+
+ Returns
+
+ The strncpy function returns the value of s1 .
+ */
+
+
+ if (n > 0)
+ {
+ char C;
+ int p;
+ assert (s1 != NULL);
+ assert (s2 != NULL);
+
+ p = 0;
+ do
+ {
+ C = s2[p];
+ s1[p] = C;
+ p++;
+ }
+ while (C != NulChar && p < n);
+ while (p < n)
+ {
+ s1[p] = NulChar;
+ p++;
+ }
+ }
+ return s1;
+}
+
+
+extern char *
+bwb_strcat (char *s1, const char *s2)
+{
+ /*
+ 4.11.3.1 The strcat function
+
+ Synopsis
+
+ #include <string.h>
+ char *strcat(char *s1, const char *s2);
+
+ Description
+
+ The strcat function appends a copy of the string pointed to by s2
+ (including the terminating null character) to the end of the string
+ pointed to by s1 . The initial character of s2 overwrites the null
+ character at the end of s1 . If copying takes place between objects
+ that overlap, the behavior is undefined.
+
+ Returns
+
+ The strcat function returns the value of s1 .
+ */
+ char *Temp;
+
+ assert (s1 != NULL);
+ assert (s2 != NULL);
+
+ Temp = bwb_strchr (s1, NulChar);
+ bwb_strcpy (Temp, s2);
+ return s1;
+}
+
+#if FALSE /* keep this ... */
+extern char *
+bwb_strncat (char *s1, const char *s2, size_t n)
+{
+ /*
+ 4.11.3.2 The strncat function
+
+ Synopsis
+
+ #include <string.h>
+ char *strncat(char *s1, const char *s2, size_t n);
+
+ Description
+
+ The strncat function appends not more than n characters (a null
+ character and characters that follow it are not appended) from the
+ array pointed to by s2 to the end of the string pointed to by s1 .
+ The initial character of s2 overwrites the null character at the end
+ of s1 . A terminating null character is always appended to the
+ result./121/ If copying takes place between objects that overlap, the
+ behavior is undefined.
+
+ Returns
+
+ The strncat function returns the value of s1 .
+ */
+ char *Temp;
+
+ assert (s1 != NULL);
+ assert (s2 != NULL);
+
+ Temp = bwb_strchr (s1, NulChar);
+ bwb_strncpy (Temp, s2, n);
+ return s1;
+}
+#endif
+
+extern int
+bwb_memcmp (const void *s1, const void *s2, size_t n)
+{
+ /*
+ 4.11.4.1 The memcmp function
+
+ Synopsis
+
+ #include <string.h>
+ int memcmp(const void *s1, const void *s2, size_t n);
+
+ Description
+
+ The memcmp function compares the first n characters of the object
+ pointed to by s1 to the first n characters of the object pointed to by
+ s2 ./122/
+
+ Returns
+
+ The memcmp function returns an integer greater than, equal to, or
+ less than zero, according as the object pointed to by s1 is greater
+ than, equal to, or less than the object pointed to by s2 .
+ */
+
+
+ if (n > 0)
+ {
+ int p;
+ char *L;
+ char *R;
+ assert (s1 != NULL);
+ assert (s2 != NULL);
+
+ p = 0;
+ L = (char *) s1;
+ R = (char *) s2;
+ while (p < n)
+ {
+ if (L[p] > R[p])
+ {
+ return 1;
+ }
+ if (L[p] < R[p])
+ {
+ return -1;
+ }
+ /* L[ p ] == R[ p ] */
+ p++;
+ }
+ }
+ return 0;
+}
+
+
+extern int
+bwb_strcmp (const char *s1, const char *s2)
+{
+ /*
+ 4.11.4.2 The strcmp function
+
+ Synopsis
+
+ #include <string.h>
+ int strcmp(const char *s1, const char *s2);
+
+ Description
+
+ The strcmp function compares the string pointed to by s1 to the
+ string pointed to by s2 .
+
+ Returns
+
+ The strcmp function returns an integer greater than, equal to, or
+ less than zero, according as the string pointed to by s1 is greater
+ than, equal to, or less than the string pointed to by s2 .
+ */
+ char C;
+ int p;
+
+ assert (s1 != NULL);
+ assert (s2 != NULL);
+
+ p = 0;
+ do
+ {
+ if (s1[p] > s2[p])
+ {
+ return 1;
+ }
+ if (s1[p] < s2[p])
+ {
+ return -1;
+ }
+ /* s1[ p ] == s2[ p ] */
+ C = s1[p];
+ p++;
+ }
+ while (C);
+ return 0;
+}
+
+#if FALSE /* keep this ... */
+extern int
+bwb_strncmp (const char *s1, const char *s2, size_t n)
+{
+ /*
+ 4.11.4.4 The strncmp function
+
+ Synopsis
+
+ #include <string.h>
+ int strncmp(const char *s1, const char *s2, size_t n);
+
+ Description
+
+ The strncmp function compares not more than n characters
+ (characters that follow a null character are not compared) from the
+ array pointed to by s1 to the array pointed to by s2 .
+
+ Returns
+
+ The strncmp function returns an integer greater than, equal to, or
+ less than zero, according as the possibly null-terminated array
+ pointed to by s1 is greater than, equal to, or less than the possibly
+ null-terminated array pointed to by s2 .
+ */
+
+
+ if (n > 0)
+ {
+ char C;
+ int p;
+ assert (s1 != NULL);
+ assert (s2 != NULL);
+
+ p = 0;
+ do
+ {
+ if (s1[p] > s2[p])
+ {
+ return 1;
+ }
+ if (s1[p] < s2[p])
+ {
+ return -1;
+ }
+ /* s1[ p ] == s2[ p ] */
+ C = s1[p];
+ p++;
+ }
+ while (C != NulChar && p < n);
+ }
+ return 0;
+}
+#endif
+
+#if FALSE /* keep this ... */
+extern void *
+bwb_memchr (const void *s, int c, size_t n)
+{
+ /*
+ 4.11.5.1 The memchr function
+
+ Synopsis
+
+ #include <string.h>
+ void *memchr(const void *s, int c, size_t n);
+
+ Description
+
+ The memchr function locates the first occurrence of c (converted to
+ an unsigned char ) in the initial n characters (each interpreted as
+ unsigned char ) of the object pointed to by s .
+
+ Returns
+
+ The memchr function returns a pointer to the located character, or
+ a null pointer if the character does not occur in the object.
+ */
+
+
+ if (n > 0)
+ {
+ int p;
+ unsigned char *Check;
+ unsigned char Find;
+ assert (s != NULL);
+
+ p = 0;
+ Check = (unsigned char *) s;
+ Find = (unsigned char) c;
+ do
+ {
+ if (Check[p] == Find)
+ {
+ return (void *) &(Check[p]);
+ }
+ p++;
+ }
+ while (p < n);
+ }
+ return NULL;
+}
+#endif
+
+extern char *
+bwb_strchr (const char *s, int c)
+{
+ /*
+ 4.11.5.2 The strchr function
+
+ Synopsis
+
+ #include <string.h>
+ char *strchr(const char *s, int c);
+
+ Description
+
+ The strchr function locates the first occurrence of c (converted to
+ a char ) in the string pointed to by s . The terminating null
+ character is considered to be part of the string.
+
+ Returns
+
+ The strchr function returns a pointer to the located character, or
+ a null pointer if the character does not occur in the string.
+ */
+ int p;
+ char Find;
+ char C;
+
+ assert (s != NULL);
+
+ p = 0;
+ Find = (char) c;
+ do
+ {
+ C = s[p];
+ if (C == Find)
+ {
+ return (char *) &(s[p]);
+ }
+ p++;
+ }
+ while (C);
+ return NULL;
+}
+
+
+extern char *
+bwb_strrchr (const char *s, int c)
+{
+ /*
+ 4.11.5.5 The strrchr function
+
+ Synopsis
+
+ #include <string.h>
+ char *strrchr(const char *s, int c);
+
+ Description
+
+ The strrchr function locates the last occurrence of c (converted to
+ a char ) in the string pointed to by s . The terminating null
+ character is considered to be part of the string.
+
+ Returns
+
+ The strrchr function returns a pointer to the character, or a null
+ pointer if c does not occur in the string.
+ */
+ int p;
+ char Find;
+ char *Found;
+ char C;
+
+ assert (s != NULL);
+
+ p = 0;
+ Find = (char) c;
+ Found = NULL;
+ do
+ {
+ C = s[p];
+ if (C == Find)
+ {
+ Found = (char *) &(s[p]);
+ }
+ p++;
+ }
+ while (C);
+ return Found;
+}
+
+
+extern void *
+bwb_memset (void *s, int c, size_t n)
+{
+ /*
+ 4.11.6.1 The memset function
+
+ Synopsis
+
+ #include <string.h>
+ void *memset(void *s, int c, size_t n);
+
+ Description
+
+ The memset function copies the value of c (converted to an unsigned
+ char ) into each of the first n characters of the object pointed to by
+ s .
+
+ Returns
+
+ The memset function returns the value of s .
+ */
+
+
+ if (n > 0)
+ {
+ int p;
+ unsigned char *Target;
+ unsigned char Value;
+ assert (s != NULL);
+
+ p = 0;
+ Target = (unsigned char *) s;
+ Value = (unsigned char) c;
+ do
+ {
+ Target[p] = Value;
+ p++;
+ }
+ while (p < n);
+ }
+ return s;
+}
+
+extern size_t
+bwb_strlen (const char *s)
+{
+ /*
+ 4.11.6.3 The strlen function
+
+ Synopsis
+
+ #include <string.h>
+ size_t strlen(const char *s);
+
+ Description
+
+ The strlen function computes the length of the string pointed to by s .
+
+ Returns
+
+ The strlen function returns the number of characters that precede
+ the terminating null character.
+ */
+ size_t p;
+
+ assert (s != NULL);
+
+ p = 0;
+ while (s[p])
+ {
+ p++;
+ }
+ return p;
+}
+
+extern char *
+bwb_strdup (char *s)
+{
+ size_t n;
+ char *r;
+ assert (s != NULL);
+
+ /* r = NULL; */
+ n = bwb_strlen (s);
+ r = calloc (n + 1 /* NulChar */ , sizeof (char));
+ if (r != NULL)
+ {
+ bwb_strcpy (r, s);
+ }
+ return r;
+}
+
+extern char *
+bwb_strdup2 (char *s, char *t)
+{
+ size_t n;
+ char *r;
+ assert (s != NULL);
+ assert (t != NULL);
+
+ /* r = NULL; */
+ n = bwb_strlen (s) + bwb_strlen (t);
+ r = calloc (n + 1 /* NulChar */ , sizeof (char));
+ if (r != NULL)
+ {
+ bwb_strcpy (r, s);
+ bwb_strcat (r, t);
+ }
+ return r;
+}
+
+#if HAVE_UNIX_GCC
+
+/* these are intrinsic C functions in my environment using -ansi */
+
+#else /* ! HAVE_UNIX_GCC */
+
+extern unsigned int
+sleep (unsigned int X)
+{
+ /* do nothing */
+ return X;
+}
+
+#endif /* ! HAVE_UNIX_GCC */
+
+
+extern double
+bwb_rint (double x)
+{
+ /* BASIC dialects have different rounding rules */
+ double Result;
+
+
+ if (x < 0)
+ {
+ return -bwb_rint (-x);
+ }
+ /* x >= 0 */
+ switch (My->OptionRoundType)
+ {
+ case C_OPTION_ROUND_BANK:
+ /* normal financial rounding */
+ Result = floor (x + 0.5);
+ if (x - floor (x) == 0.5)
+ {
+ /* midway */
+ double Half;
+ Half = Result / 2.0;
+ if (Half != floor (Half))
+ {
+ /* odd -> even */
+ Result--;
+ }
+ }
+ break;
+ case C_OPTION_ROUND_MATH:
+ /* normal mathematical rounding */
+ Result = floor (x + 0.5);
+ break;
+ case C_OPTION_ROUND_TRUNCATE:
+ /* simple truncation */
+ Result = floor (x);
+ break;
+ }
+ return Result;
+}
+
+extern int
+bwb_stricmp (const char *s1, const char *s2)
+{
+ const unsigned char *p1;
+ const unsigned char *p2;
+
+ assert (s1 != NULL);
+ assert (s2 != NULL);
+
+ p1 = (const unsigned char *) s1;
+ p2 = (const unsigned char *) s2;
+ while (*p1)
+ {
+ char c1;
+ char c2;
+ c1 = bwb_toupper (*p1);
+ c2 = bwb_toupper (*p2);
+ if (c1 < c2)
+ {
+ return -1;
+ }
+ if (c1 > c2)
+ {
+ return 1;
+ }
+ p1++;
+ p2++;
+ }
+ if (*p2 == NulChar)
+ {
+ return 0;
+ }
+ return -1;
+}
+
+extern int
+bwb_strnicmp (const char *s1, const char *s2, size_t n)
+{
+ const unsigned char *p1;
+ const unsigned char *p2;
+ size_t x = 0;
+
+ assert (s1 != NULL);
+ assert (s2 != NULL);
+
+ p1 = (const unsigned char *) s1;
+ p2 = (const unsigned char *) s2;
+ while (x < n)
+ {
+ char c1;
+ char c2;
+ c1 = bwb_toupper (p1[x]);
+ c2 = bwb_toupper (p2[x]);
+ if (c1 < c2)
+ {
+ return -1;
+ }
+ if (c1 > c2)
+ {
+ return 1;
+ }
+ if (c1 == NulChar)
+ {
+ return 0;
+ }
+ x++;
+ }
+ return 0;
+}
+
+
+/* EOF */
Un proyecto texto-plano.xyz