/***************************************************************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 beginning at the position and attempts to determine (a) the position of the line number in the buffer (returned in ), (b) the line number at this position (returned in ), (c) the position of the BASIC command in the buffer (returned in ), (d) the position of this BASIC command in the command table (returned in ), and (e) the position of the beginning of the rest of the line (returned in ). Although must be returned as a positive integer, the other searches may fail, in which case FALSE will be returned in their positions. 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 */