diff options
Diffstat (limited to 'bwb_cmd.c')
| -rw-r--r-- | bwb_cmd.c | 10217 |
1 files changed, 10217 insertions, 0 deletions
diff --git a/bwb_cmd.c b/bwb_cmd.c new file mode 100644 index 0000000..d627d34 --- /dev/null +++ b/bwb_cmd.c @@ -0,0 +1,10217 @@ +/*************************************************************** + + bwb_cmd.c Miscellaneous Commands + 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 void bwb_copy_file (char *Source, char *Target); +static LineType *bwb_delete (LineType * l); +static void bwb_display_file (char *Source); +static LineType *bwb_load (LineType * Line, char *Prompt, int IsNew); +static void bwb_new (void); +static LineType *bwb_run_filename_or_linenumber (LineType * L); +static LineType *bwb_save (LineType * Line, char *Prompt); +static LineType *bwb_system (LineType * l); +static LineType *bwb_xlist (LineType * l, FILE * file); +static LineType *bwx_run (LineType * Line, char *ProgramName); +static void CommandOptionVersion (int n, char *OutputLine); +static void CommandUniqueID (int i, char *UniqueID); +static void CommandVector (int i, char *Vector); +static VariableType *find_variable_by_type (char *name, int dimensions, + char VariableTypeCode); +static void FixUp (char *Name); +static LineType *H14_RENAME (LineType * l); +static int line_read_matrix_redim (LineType * l, VariableType * v); +static void ProcessEscapeChars (const char *Input, char *Output); +static int xl_line (FILE * file, LineType * l); + + +/* + fprintf( file, "------------------------------------------------------------\n"); + 123456789012345678901234567890123456789012345678901234567890 + fprintf( file, " SYNTAX: %s\n", IntrinsicCommandTable[n].Syntax); + sprintf( tbuf, "DESCRIPTION: %s\n", IntrinsicCommandTable[n].Description); + fprintf( file, " " ); + fprintf( file, " [%c] %s\n", X, bwb_vertable[i].Name); + 1234567890123 +*/ +#define LEFT_LENGTH 13 +#define RIGHT_LENGTH 47 +#define TOTAL_LENGTH ( LEFT_LENGTH + RIGHT_LENGTH ) + +/* +-------------------------------------------------------------------------------------------- + EDIT, RENUM, RENUMBER +-------------------------------------------------------------------------------------------- +*/ + +static LineType * +bwx_run (LineType * Line, char *ProgramName) +{ + size_t n; + char *tbuf; + + assert (Line != NULL); + assert( My != NULL ); + + if (is_empty_string (ProgramName)) + { + WARN_BAD_FILE_NAME; + return (Line); + } + if (is_empty_string (My->ProgramFilename)) + { + WARN_BAD_FILE_NAME; + return (Line); + } + n = bwb_strlen (ProgramName) + 1 + bwb_strlen (My->ProgramFilename); + if ((tbuf = (char *) calloc (n + 1 /* NulChar */ , sizeof (char))) == NULL) + { + WARN_OUT_OF_MEMORY; + return (Line); + } + bwb_strcpy (tbuf, ProgramName); + bwb_strcat (tbuf, " "); + bwb_strcat (tbuf, My->ProgramFilename); + system (tbuf); + free (tbuf); + tbuf = NULL; + + /* open edited file for read */ + bwb_NEW (Line); /* Relocated by JBV (bug found by DD) */ + if (bwb_fload (NULL) == FALSE) + { + WARN_BAD_FILE_NAME; + return (Line); + } + return (Line); +} + + + +/*************************************************************** + + FUNCTION: bwb_edit() + + DESCRIPTION: This function implements the BASIC EDIT + program by shelling out to a default editor + specified by the variable BWB.EDITOR$. + + SYNTAX: EDIT + +***************************************************************/ + +LineType * +bwb_EDIT (LineType * Line) +{ + /* + SYNTAX: EDIT + */ + + assert (Line != NULL); + assert( My != NULL ); + + return bwx_run (Line, My->OptionEditString); +} + +/*************************************************************** + + FUNCTION: bwb_renum() + + DESCRIPTION: This function implements the BASIC RENUM + command by shelling out to a default + renumbering program called "renum". + Added by JBV 10/95 + + SYNTAX: RENUM + +***************************************************************/ + +LineType * +bwb_RENUM (LineType * Line) +{ + /* + SYNTAX: RENUM + */ + + assert (Line != NULL); + assert( My != NULL ); + + return bwx_run (Line, My->OptionRenumString); +} + +LineType * +bwb_RENUMBER (LineType * Line) +{ + /* + SYNTAX: RENUMBER + */ + + assert (Line != NULL); + assert( My != NULL ); + + return bwx_run (Line, My->OptionRenumString); +} + +/* +-------------------------------------------------------------------------------------------- + REM +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_REM (LineType * L) +{ + /* + SYNTAX: REM comment + */ + /* + This line holds BASIC comments. + */ + + assert (L != NULL); + + line_skip_eol (L); + return L; +} + +/* +-------------------------------------------------------------------------------------------- + IMAGE +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_IMAGE (LineType * L) +{ + /* + SYNTAX: IMAGE print-using-format + */ + + assert (L != NULL); + + line_skip_eol (L); + return L; +} + +/* +-------------------------------------------------------------------------------------------- + LET +-------------------------------------------------------------------------------------------- +*/ + + +LineType * +bwb_LET (LineType * L) +{ + /* + SYNTAX: LET variable [,...] = expression + */ + VariableType *v; + VariantType x; + VariantType *X; + + assert (L != NULL); + X = &x; + CLEAR_VARIANT (X); + /* read the list of variables */ + do + { + if ((v = line_read_scalar (L)) == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + goto EXIT; + } + } + while (line_skip_seperator (L)); + + /* skip the equal sign */ + if (line_skip_EqualChar (L)) + { + /* OK */ + } + else if (line_skip_word (L, "EQ")) + { + /* OK */ + } + else if (line_skip_word (L, ".EQ.")) + { + /* OK */ + } + else + { + WARN_SYNTAX_ERROR; + goto EXIT; + } + + /* evaluate the expression */ + if (line_read_expression (L, X)) /* bwb_LET */ + { + /* save the value */ + if (line_is_eol (L) == FALSE) + { + WARN_SYNTAX_ERROR; + goto EXIT; + } + L->position = L->Startpos; + + /* for each variable, assign the value */ + do + { + /* read a variable */ + if ((v = line_read_scalar (L)) == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + goto EXIT; + } + assert (v != NULL); + assert (X != NULL); + if (var_set (v, X) == FALSE) + { + WARN_TYPE_MISMATCH; + goto EXIT; + } + } + while (line_skip_seperator (L)); + + /* we are now at the equals sign */ + line_skip_eol (L); + } + else + { + WARN_SYNTAX_ERROR; + } +EXIT: + RELEASE_VARIANT (X); + return L; +} + + +LineType * +bwb_CONST (LineType * L) +{ + /* + SYNTAX: CONST variable [,...] = expression + */ + VariableType *v; + VariantType x; + VariantType *X; + + assert (L != NULL); + + X = &x; + CLEAR_VARIANT (X); + /* read the list of variables */ + do + { + if ((v = line_read_scalar (L)) == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + goto EXIT; + } + } + while (line_skip_seperator (L)); + /* we are now at the equals sign */ + + /* skip the equal sign */ + if (line_skip_EqualChar (L)) + { + /* OK */ + } + else if (line_skip_word (L, "EQ")) + { + /* OK */ + } + else if (line_skip_word (L, ".EQ.")) + { + /* OK */ + } + else + { + WARN_SYNTAX_ERROR; + goto EXIT; + } + + /* evaluate the expression */ + if (line_read_expression (L, X)) /* bwb_LET */ + { + /* save the value */ + if (line_is_eol (L) == FALSE) + { + WARN_SYNTAX_ERROR; + goto EXIT; + } + + /* for each variable, assign the value */ + L->position = L->Startpos; + do + { + /* read a variable */ + if ((v = line_read_scalar (L)) == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + goto EXIT; + } + assert (v != NULL); + assert (X != NULL); + if (var_set (v, X) == FALSE) + { + WARN_TYPE_MISMATCH; + goto EXIT; + } + } + while (line_skip_seperator (L)); + /* we are now at the equals sign */ + + /* for each variable, mark as constant */ + L->position = L->Startpos; + do + { + /* read a variable */ + if ((v = line_read_scalar (L)) == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + goto EXIT; + } + assert (v != NULL); + v->VariableFlags |= VARIABLE_CONSTANT; + } + while (line_skip_seperator (L)); + /* we are now at the equals sign */ + + line_skip_eol (L); + } + else + { + WARN_SYNTAX_ERROR; + } +EXIT: + RELEASE_VARIANT (X); + return L; +} + +LineType * +bwb_DEC (LineType * L) +{ + /* + SYNTAX: DEC variable [,...] + */ + VariableType *v; + VariantType x; + VariantType *X; + + assert (L != NULL); + + X = &x; + CLEAR_VARIANT (X); + /* read the list of variables */ + do + { + if ((v = line_read_scalar (L)) == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + goto EXIT; + } + if (v->VariableTypeCode == StringTypeCode) + { + WARN_TYPE_MISMATCH; + goto EXIT; + } + } + while (line_skip_seperator (L)); + /* we are now at the end of the line */ + + if (line_is_eol (L) == FALSE) + { + WARN_SYNTAX_ERROR; + goto EXIT; + } + L->position = L->Startpos; + + /* for each variable, assign the value */ + do + { + /* read a variable */ + if ((v = line_read_scalar (L)) == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + goto EXIT; + } + assert (v != NULL); + assert (X != NULL); + if (var_get (v, X) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + goto EXIT; + } + X->Number--; + if (var_set (v, X) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + goto EXIT; + } + } + while (line_skip_seperator (L)); + /* we are now at the end of the line */ +EXIT: + RELEASE_VARIANT (X); + return L; +} + +LineType * +bwb_INC (LineType * L) +{ + /* + SYNTAX: INC variable [,...] + */ + VariableType *v; + VariantType x; + VariantType *X; + + assert (L != NULL); + + X = &x; + CLEAR_VARIANT (X); + /* read the list of variables */ + do + { + if ((v = line_read_scalar (L)) == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + goto EXIT; + } + if (v->VariableTypeCode == StringTypeCode) + { + WARN_TYPE_MISMATCH; + goto EXIT; + } + } + while (line_skip_seperator (L)); + /* we are now at the end of the line */ + + if (line_is_eol (L) == FALSE) + { + WARN_SYNTAX_ERROR; + goto EXIT; + } + L->position = L->Startpos; + + /* for each variable, assign the value */ + do + { + /* read a variable */ + if ((v = line_read_scalar (L)) == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + goto EXIT; + } + assert (v != NULL); + assert (X != NULL); + if (var_get (v, X) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + goto EXIT; + } + X->Number++; + if (var_set (v, X) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + goto EXIT; + } + } + while (line_skip_seperator (L)); + /* we are now at the end of the line */ +EXIT: + RELEASE_VARIANT (X); + return L; +} + + + +/* +-------------------------------------------------------------------------------------------- + GO +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_GO (LineType * L) +{ + + assert (L != NULL); + WARN_SYNTAX_ERROR; + return L; +} + +LineType * +bwb_THEN (LineType * L) +{ + + assert (L != NULL); + WARN_SYNTAX_ERROR; + return L; +} + +LineType * +bwb_TO (LineType * L) +{ + + assert (L != NULL); + WARN_SYNTAX_ERROR; + return L; +} + +LineType * +bwb_STEP (LineType * L) +{ + + assert (L != NULL); + WARN_SYNTAX_ERROR; + return L; +} + +LineType * +bwb_OF (LineType * L) +{ + + assert (L != NULL); + WARN_SYNTAX_ERROR; + return L; +} + +LineType * +bwb_AS (LineType * L) +{ + + assert (L != NULL); + WARN_SYNTAX_ERROR; + return L; +} + + +/* +-------------------------------------------------------------------------------------------- + AUTO +-------------------------------------------------------------------------------------------- +*/ + + +LineType * +bwb_BUILD (LineType * L) +{ + /* + SYNTAX: BUILD + SYNTAX: BUILD start + SYNTAX: BUILD start, increment + */ + + assert (L != NULL); + return bwb_AUTO (L); +} + +LineType * +bwb_AUTO (LineType * L) +{ + /* + SYNTAX: AUTO + SYNTAX: AUTO start + SYNTAX: AUTO start , increment + */ + + assert (L != NULL); + assert( My != NULL ); + + My->AutomaticLineNumber = 0; + My->AutomaticLineIncrement = 0; + + if (line_is_eol (L)) + { + /* AUTO */ + My->AutomaticLineNumber = 10; + My->AutomaticLineIncrement = 10; + return L; + } + if (line_read_line_number (L, &My->AutomaticLineNumber)) + { + /* AUTO ### ... */ + if (My->AutomaticLineNumber < MINLIN || My->AutomaticLineNumber > MAXLIN) + { + WARN_UNDEFINED_LINE; + return L; + } + if (line_is_eol (L)) + { + /* AUTO start */ + My->AutomaticLineIncrement = 10; + return L; + } + else if (line_skip_seperator (L)) + { + /* AUTO ### , ... */ + if (line_read_line_number (L, &My->AutomaticLineIncrement)) + { + /* AUTO start , increment */ + if (My->AutomaticLineIncrement < MINLIN + || My->AutomaticLineIncrement > MAXLIN) + { + WARN_UNDEFINED_LINE; + return L; + } + return L; + } + } + } + My->AutomaticLineNumber = 0; + My->AutomaticLineIncrement = 0; + WARN_SYNTAX_ERROR; + return L; +} + +/* +-------------------------------------------------------------------------------------------- + BREAK +-------------------------------------------------------------------------------------------- +*/ + + +LineType * +bwb_BREAK (LineType * l) +{ + /* + SYNTAX: BREAK + SYNTAX: BREAK line [,...] + SYNTAX: BREAK line - line + */ + + assert (l != NULL); + assert( My != NULL ); + assert( My->StartMarker != NULL ); + assert( My->EndMarker != NULL ); + + if (line_is_eol (l)) + { + /* BREAK */ + /* remove all line breaks */ + LineType *x; + for (x = My->StartMarker->next; x != My->EndMarker; x = x->next) + { + x->LineFlags &= ~LINE_BREAK; + } + return (l); + } + else + { + do + { + int head; + int tail; + + if (line_read_line_sequence (l, &head, &tail)) + { + /* BREAK 's' - 'e' */ + LineType *x; + if (head < MINLIN || head > MAXLIN) + { + WARN_UNDEFINED_LINE; + return (l); + } + if (tail < MINLIN || tail > MAXLIN) + { + WARN_UNDEFINED_LINE; + return (l); + } + if (head > tail) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* valid range */ + /* now go through and list appropriate lines */ + for (x = My->StartMarker->next; x != My->EndMarker; x = x->next) + { + if (head <= x->number && x->number <= tail) + { + if (x->LineFlags & LINE_NUMBERED) + { + x->LineFlags |= LINE_BREAK; + } + } + } + } + else + { + WARN_SYNTAX_ERROR; + return (l); + } + } + while (line_skip_seperator (l)); + } + return (l); +} + + +/* +-------------------------------------------------------------------------------------------- + DSP +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_DSP (LineType * l) +{ + /* + SYNTAX: DSP + SYNTAX: DSP variablename [,...] + */ + VariableType *v; + + assert (l != NULL); + assert( My != NULL ); + + + if (line_is_eol (l)) + { + /* DSP */ + /* remove all variable displays */ + for (v = My->VariableHead; v != NULL; v = v->next) + { + v->VariableFlags &= ~VARIABLE_DISPLAY; /* bwb_DSP() */ + } + return (l); + } + /* DSP variablename [,...] */ + do + { + char varname[NameLengthMax + 1]; + + if (line_read_varname (l, varname)) + { + /* mark the variable */ + for (v = My->VariableHead; v != NULL; v = v->next) + { + if (bwb_stricmp (v->name, varname) == 0) + { + v->VariableFlags |= VARIABLE_DISPLAY; /* bwb_DSP() */ + } + } + } + } + while (line_skip_seperator (l)); + return (l); +} + + +/* +-------------------------------------------------------------------------------------------- + GOTO +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_GO_TO (LineType * l) +{ + + assert (l != NULL); + return bwb_GOTO (l); +} + +LineType * +bwb_GOTO (LineType * l) +{ + /* + SYNTAX: GOTO line ' standard GOTO + SYNTAX: GOTO expression ' calculated GOTO + SYNTAX: GOTO expression OF line,... ' indexed GOTO, same as ON expression GOTO line,... + SYNTAX: GOTO line [,...] ON expression ' indexed GOTO, same as ON expression GOTO line,... + */ + int Value; + int LineNumber; + LineType *x; + + assert (l != NULL); + assert( My != NULL ); + assert( My->CurrentVersion != NULL ); + + Value = 0; + LineNumber = 0; + if (l->LineFlags & (LINE_USER)) + { + WARN_ILLEGAL_DIRECT; + return (l); + } + + if (line_is_eol (l)) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_integer_expression (l, &Value) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + + if (line_is_eol (l)) + { + /* GOTO linenumber */ + /* 'Value' is the line number */ + LineNumber = Value; + } + else if (line_skip_word (l, "OF")) + { + /* GOTO expression OF line, ... */ + /* 'Value' is an index into a list of line numbers */ + if (line_read_index_item (l, Value, &LineNumber)) + { + /* found 'LineNumber' */ + } + else if (My->CurrentVersion->OptionFlags & (OPTION_BUGS_ON) ) /* GOTO X OF ... */ + { + /* silently fall-thru to the following line */ + line_skip_eol (l); + return (l); + } + else + { + /* ERROR */ + WARN_UNDEFINED_LINE; + return (l); + } + } + else if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73)) + { + /* GOTO line [,...] ON expression */ + while (line_skip_seperator (l)) + { + if (line_read_integer_expression (l, &Value) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + } + if (line_skip_word (l, "ON") == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_integer_expression (l, &Value) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* 'Value' is an index into a list of line numbers */ + l->position = l->Startpos; + if (line_read_index_item (l, Value, &LineNumber)) + { + /* found 'LineNumber' */ + } + else + { + /* silently fall-thru to the following line */ + line_skip_eol (l); + return (l); + } + line_skip_eol (l); + } + else + { + WARN_SYNTAX_ERROR; + return (l); + } + + if (LineNumber < MINLIN || LineNumber > MAXLIN) + { + WARN_UNDEFINED_LINE; + return (l); + } + /* valid range */ + x = NULL; +#if THE_PRICE_IS_RIGHT + if (l->OtherLine != NULL) + { + /* look in the cache */ + if (l->OtherLine->number == LineNumber) + { + x = l->OtherLine; /* found in cache */ + } + } +#endif /* THE_PRICE_IS_RIGHT */ + if (x == NULL) + { + x = find_line_number (LineNumber); /* not found in the cache */ + } + if (x != NULL) + { + /* FOUND */ + line_skip_eol (l); + x->position = 0; +#if THE_PRICE_IS_RIGHT + l->OtherLine = x; /* save in cache */ +#endif /* THE_PRICE_IS_RIGHT */ + return x; + } + /* NOT FOUND */ + WARN_UNDEFINED_LINE; + return (l); +} + + +/* +-------------------------------------------------------------------------------------------- + GOSUB +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_GO_SUB (LineType * l) +{ + + assert (l != NULL); + return bwb_GOSUB (l); +} + +LineType * +bwb_GOSUB (LineType * l) +{ + /* + SYNTAX: GOSUB line ' standard GOSUB + SYNTAX: GOSUB expression ' calculated GOSUB + SYNTAX: GOSUB expression OF line,... ' indexed GOSUB, same as ON expression GOSUB line,... + SYNTAX: GOSUB line [,...] ON expression ' indexed GOSUB, same as ON expression GOSUB line,... + */ + int Value; + int LineNumber; + LineType *x; + + assert (l != NULL); + assert( My != NULL ); + assert( My->CurrentVersion != NULL ); + + Value = 0; + LineNumber = 0; + x = NULL; + if (l->LineFlags & (LINE_USER)) + { + WARN_ILLEGAL_DIRECT; + return (l); + } + + if (line_is_eol (l)) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_integer_expression (l, &Value) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + + if (line_is_eol (l)) + { + /* GOSUB linenumber */ + /* 'Value' is the line number */ + LineNumber = Value; + } + else if (line_skip_word (l, "OF")) + { + /* GOSUB linenumber [,...] OF expression */ + /* 'Value' is an index into a list of line numbers */ + if (line_read_index_item (l, Value, &LineNumber)) + { + /* found 'LineNumber' */ + } + else if (My->CurrentVersion->OptionFlags & (OPTION_BUGS_ON) ) /* GOSUB X OF ... */ + { + /* silently fall-thru to the following line */ + line_skip_eol (l); + return (l); + } + else + { + /* ERROR */ + WARN_UNDEFINED_LINE; + return (l); + } + } + else if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73)) + { + /* GOSUB line [,...] ON expression */ + while (line_skip_seperator (l)) + { + if (line_read_integer_expression (l, &Value) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + } + if (line_skip_word (l, "ON") == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_integer_expression (l, &Value) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* 'Value' is an index into a list of line numbers */ + l->position = l->Startpos; + if (line_read_index_item (l, Value, &LineNumber)) + { + /* found 'LineNumber' */ + } + else + { + /* silently fall-thru to the following line */ + line_skip_eol (l); + return (l); + } + line_skip_eol (l); + } + else + { + WARN_SYNTAX_ERROR; + return (l); + } + + if (LineNumber < MINLIN || LineNumber > MAXLIN) + { + WARN_UNDEFINED_LINE; + return (l); + } + /* valid range */ + x = NULL; +#if THE_PRICE_IS_RIGHT + if (l->OtherLine != NULL) + { + /* look in the cache */ + if (l->OtherLine->number == LineNumber) + { + x = l->OtherLine; /* found in cache */ + } + } +#endif /* THE_PRICE_IS_RIGHT */ + if (x == NULL) + { + x = find_line_number (LineNumber); /* not found in the cache */ + } + if (x != NULL) + { + /* FOUND */ + line_skip_eol (l); + /* save current stack level */ + My->StackHead->line = l; + /* increment exec stack */ + if (bwb_incexec ()) + { + /* set the new position to x and return x */ + x->position = 0; + My->StackHead->line = x; + My->StackHead->ExecCode = EXEC_GOSUB; +#if THE_PRICE_IS_RIGHT + l->OtherLine = x; /* save in cache */ +#endif /* THE_PRICE_IS_RIGHT */ + return x; + } + else + { + /* ERROR */ + WARN_OUT_OF_MEMORY; + return My->EndMarker; + } + } + /* NOT FOUND */ + WARN_UNDEFINED_LINE; + return (l); +} + + + +/* +-------------------------------------------------------------------------------------------- + RETURN +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_RETURN (LineType * l) +{ + /* + SYNTAX: RETURN + */ + + assert (l != NULL); + assert (My != NULL); + assert (My->CurrentVersion != NULL); + assert (My->StackHead != NULL); + + if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73)) + { + /* RETURN [comment] */ + line_skip_eol (l); + } + + if (My->CurrentVersion->OptionVersionValue & (C77)) + { + /* CBASIC-II: RETURN exits the first FUNCTION or GOSUB */ + + while (My->StackHead->ExecCode != EXEC_GOSUB + && My->StackHead->ExecCode != EXEC_FUNCTION) + { + bwb_decexec (); + if (My->StackHead == NULL) + { + WARN_RETURN_WITHOUT_GOSUB; + return (l); + } + if (My->StackHead->ExecCode == EXEC_NORM) /* End of the line? */ + { + WARN_RETURN_WITHOUT_GOSUB; + return (l); + } + } + } + else + { + /* RETURN exits the first GOSUB */ + + while (My->StackHead->ExecCode != EXEC_GOSUB) + { + bwb_decexec (); + if (My->StackHead == NULL) + { + WARN_RETURN_WITHOUT_GOSUB; + return (l); + } + if (My->StackHead->ExecCode == EXEC_NORM) /* End of the line? */ + { + WARN_RETURN_WITHOUT_GOSUB; + return (l); + } + } + } + + + /* decrement the EXEC stack counter */ + + bwb_decexec (); + assert (My->StackHead != NULL); + return My->StackHead->line; +} + +/* +-------------------------------------------------------------------------------------------- + POP +-------------------------------------------------------------------------------------------- +*/ + + +LineType * +bwb_POP (LineType * l) +{ + /* + SYNTAX: POP + */ + StackType *StackItem; + + assert (l != NULL); + assert (My != NULL); + assert (My->CurrentVersion != NULL); + assert (My->StackHead != NULL); + + StackItem = My->StackHead; + while (StackItem->ExecCode != EXEC_GOSUB) + { + StackItem = StackItem->next; + if (StackItem == NULL) + { + WARN_RETURN_WITHOUT_GOSUB; + return (l); + } + if (StackItem->ExecCode == EXEC_NORM) + { + /* End of the line */ + WARN_RETURN_WITHOUT_GOSUB; + return (l); + } + } + /* hide the GOSUB */ + StackItem->ExecCode = EXEC_POPPED; + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + ON +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_ON (LineType * l) +{ + /* + SYNTAX: ON expression GOTO line,... ' expression evaluates to an index + SYNTAX: ON expression GOSUB line,... ' expression evaluates to an index + */ + int Value; + int command; + int LineNumber; + LineType *x; + + assert (l != NULL); + assert (My != NULL); + assert (My->CurrentVersion != NULL); + + Value = 0; + command = 0; + LineNumber = 0; + x = NULL; + if (l->LineFlags & (LINE_USER)) + { + WARN_ILLEGAL_DIRECT; + return (l); + } + + if (line_is_eol (l)) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_integer_expression (l, &Value) == FALSE) + { + WARN_UNDEFINED_LINE; + return (l); + } + if (line_skip_word (l, "GO")) + { + if (line_skip_word (l, "TO")) + { + command = C_GOTO; + } + else if (line_skip_word (l, "SUB")) + { + command = C_GOSUB; + } + else + { + WARN_SYNTAX_ERROR; + return (l); + } + } + else if (line_skip_word (l, "GOTO")) + { + command = C_GOTO; + } + else if (line_skip_word (l, "GOSUB")) + { + command = C_GOSUB; + } + else + { + WARN_SYNTAX_ERROR; + return (l); + } + + /* 'Value' is an index into a list of line numbers */ + if (line_read_index_item (l, Value, &LineNumber)) + { + /* found 'LineNumber' */ + } + else if (My->CurrentVersion->OptionFlags & (OPTION_BUGS_ON) ) /* ON X GOTO|GOSUB ... */ + { + /* silently fall-thru to the following line */ + line_skip_eol (l); + return (l); + } + else + { + /* ERROR */ + WARN_UNDEFINED_LINE; + return (l); + } + + if (LineNumber < MINLIN || LineNumber > MAXLIN) + { + WARN_UNDEFINED_LINE; + return (l); + } + /* valid range */ + x = NULL; +#if THE_PRICE_IS_RIGHT + if (l->OtherLine != NULL) + { + /* look in the cache */ + if (l->OtherLine->number == LineNumber) + { + x = l->OtherLine; /* found in cache */ + } + } +#endif /* THE_PRICE_IS_RIGHT */ + if (x == NULL) + { + x = find_line_number (LineNumber); /* not found in the cache */ + } + if (x != NULL) + { + /* FOUND */ + if (command == C_GOTO) + { + /* ON ... GOTO ... */ + line_skip_eol (l); + x->position = 0; +#if THE_PRICE_IS_RIGHT + l->OtherLine = x; /* save in cache */ +#endif /* THE_PRICE_IS_RIGHT */ + return x; + } + else if (command == C_GOSUB) + { + /* ON ... GOSUB ... */ + line_skip_eol (l); + /* save current stack level */ + My->StackHead->line = l; + /* increment exec stack */ + if (bwb_incexec ()) + { + /* set the new position to x and return x */ + x->position = 0; + My->StackHead->line = x; + My->StackHead->ExecCode = EXEC_GOSUB; +#if THE_PRICE_IS_RIGHT + l->OtherLine = x; /* save in cache */ +#endif /* THE_PRICE_IS_RIGHT */ + return x; + } + else + { + /* ERROR */ + WARN_OUT_OF_MEMORY; + return My->EndMarker; + } + } + else + { + /* ERROR */ + WARN_SYNTAX_ERROR; + return (l); + } + } + /* NOT FOUND */ + WARN_UNDEFINED_LINE; + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + PAUSE +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_PAUSE (LineType * l) +{ + /* + SYNTAX: PAUSE + */ + char *pstring; + char *tbuf; + int tlen; + + assert (l != NULL); + assert (My != NULL); + assert (My->CurrentVersion != NULL); + assert (My->ConsoleOutput != NULL); + assert (My->ConsoleInput != NULL); + + pstring = My->ConsoleOutput; + tbuf = My->ConsoleInput; + tlen = MAX_LINE_LENGTH; + if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73)) + { + /* PAUSE [comment] */ + line_skip_eol (l); + } + sprintf (pstring, "PAUSE AT %d\n", l->number); + bwx_input (pstring, FALSE, tbuf, tlen); + return (l); +} + + +/* +-------------------------------------------------------------------------------------------- + STOP +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_STOP (LineType * l) +{ + /* + SYNTAX: STOP + */ + + assert (l != NULL); + assert (My != NULL); + assert (My->CurrentVersion != NULL); + + if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73)) + { + /* STOP [comment] */ + line_skip_eol (l); + } + My->ContinueLine = l->next; + bwx_STOP (TRUE); + return bwb_END (l); +} + + +/* +-------------------------------------------------------------------------------------------- + END +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_END (LineType * l) +{ + /* + SYNTAX: END + */ + + assert (l != NULL); + assert (My != NULL); + assert (My->CurrentVersion != NULL); + + if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73)) + { + /* END [comment] */ + line_skip_eol (l); + } + My->ContinueLine = l->next; + bwx_STOP (FALSE); + return My->EndMarker; +} + +/* +-------------------------------------------------------------------------------------------- + RUN +-------------------------------------------------------------------------------------------- +*/ + +static LineType * +bwb_run_filename_or_linenumber (LineType * L) +{ + LineType *current = NULL; + VariantType x; + VariantType *X; + + assert (L != NULL); + assert (My != NULL); + assert (My->StartMarker != NULL); + + X = &x; + CLEAR_VARIANT (X); + if (line_read_expression (L, X) == FALSE) /* bwb_run_filename_or_linenumber */ + { + WARN_SYNTAX_ERROR; + return L; + } + if (X->VariantTypeCode == StringTypeCode) + { + /* RUN "filename" */ + /* RUN A$ */ + if (is_empty_string (X->Buffer)) + { + WARN_BAD_FILE_NAME; + return L; + } + /* open the file and execute it */ + bwb_new (); /* clear memory */ + if (My->ProgramFilename != NULL) + { + free (My->ProgramFilename); + My->ProgramFilename = NULL; + } + My->ProgramFilename = bwb_strdup (X->Buffer); + if (bwb_fload (NULL) == FALSE) + { + WARN_BAD_FILE_NAME; + return L; + } + /* + ** + ** FORCE SCAN + ** + */ + if (bwb_scan () == FALSE) + { + WARN_CANT_CONTINUE; + return L; + } + current = My->StartMarker->next; + } + else + { + /* RUN 100 */ + /* RUN N */ + /* execute the line */ + int LineNumber; + + + LineNumber = (int) bwb_rint (X->Number); + /* + ** + ** FORCE SCAN + ** + */ + if (bwb_scan () == FALSE) + { + WARN_CANT_CONTINUE; + goto EXIT; + } + current = find_line_number (LineNumber); /* RUN 100 */ + if (current == NULL) + { + WARN_CANT_CONTINUE; + return L; + } + } +EXIT: + RELEASE_VARIANT (X); + return current; +} + +LineType * +bwb_RUNNH (LineType * L) +{ + + assert (L != NULL); + return bwb_RUN (L); +} + +LineType * +bwb_RUN (LineType * L) +{ + /* + SYNTAX: RUN + SYNTAX: RUN filename$ + SYNTAX: RUN linenumber + */ + LineType *current; + + assert (L != NULL); + assert (My != NULL); + assert (My->EndMarker != NULL); + assert (My->DefaultVariableType != NULL); + + /* clear the STACK */ + bwb_clrexec (); + if (bwb_incexec ()) + { + /* OK */ + } + else + { + /* ERROR */ + WARN_OUT_OF_MEMORY; + return My->EndMarker; + } + + if (line_is_eol (L)) + { + /* RUN */ + + var_CLEAR (); + + /* if( TRUE ) */ + { + int n; + for (n = 0; n < 26; n++) + { + My->DefaultVariableType[n] = DoubleTypeCode; + } + } + /* + ** + ** FORCE SCAN + ** + */ + if (bwb_scan () == FALSE) + { + WARN_CANT_CONTINUE; + return My->EndMarker; + } + current = My->StartMarker->next; + } + else + { + /* RUN 100 : RUN filename$ */ + current = bwb_run_filename_or_linenumber (L); + if (current == NULL) + { + WARN_UNDEFINED_LINE; + return My->EndMarker; + } + } + current->position = 0; + + assert (My->StackHead != NULL); + My->StackHead->line = current; + My->StackHead->ExecCode = EXEC_NORM; + + /* RUN */ + WARN_CLEAR; /* bwb_RUN */ + My->ContinueLine = NULL; + SetOnError (0); + + /* if( TRUE ) */ + { + time_t t; + struct tm *lt; + + time (&t); + lt = localtime (&t); + My->StartTimeInteger = lt->tm_hour; + My->StartTimeInteger *= 60; + My->StartTimeInteger += lt->tm_min; + My->StartTimeInteger *= 60; + My->StartTimeInteger += lt->tm_sec; + /* number of seconds since midnight */ + } + + return current; +} + +/* +-------------------------------------------------------------------------------------------- + CONT +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_CONTINUE (LineType * l) +{ + /* + SYNTAX: CONTINUE + */ + + assert (l != NULL); + return bwb_CONT (l); +} + +LineType * +bwb_CONT (LineType * l) +{ + /* + SYNTAX: CONT + */ + LineType *current; + + assert (l != NULL); + assert (My != NULL); + assert (My->EndMarker != NULL); + assert (My->StartMarker != NULL); + + current = NULL; + /* see if there is an element */ + if (line_is_eol (l)) + { + /* CONT */ + current = My->ContinueLine; + } + else + { + /* CONT 100 */ + int LineNumber; + + LineNumber = 0; + if (line_read_line_number (l, &LineNumber)) + { + current = find_line_number (LineNumber); /* CONT 100 */ + } + } + + + if (current == NULL || current == My->EndMarker) + { + /* same as RUN */ + current = My->StartMarker->next; + } + /* + ** + ** FORCE SCAN + ** + */ + if (bwb_scan () == FALSE) + { + WARN_CANT_CONTINUE; + return (l); + } + current->position = 0; + bwb_clrexec (); + if (bwb_incexec ()) + { + /* OK */ + My->StackHead->line = current; + My->StackHead->ExecCode = EXEC_NORM; + } + else + { + /* ERROR */ + WARN_OUT_OF_MEMORY; + return My->EndMarker; + } + + + /* CONT */ + My->ContinueLine = NULL; + return current; +} + + +/* +-------------------------------------------------------------------------------------------- + NEW +-------------------------------------------------------------------------------------------- +*/ + +void +bwb_xnew (LineType * l) +{ + LineType *current; + LineType *previous; + int wait; + + assert (l != NULL); + assert (My != NULL); + assert (My->EndMarker != NULL); + + previous = NULL; /* JBV */ + wait = TRUE; + for (current = l->next; current != My->EndMarker; current = current->next) + { + assert (current != NULL); + if (wait == FALSE) + { + free (previous); + previous = NULL; + } + wait = FALSE; + previous = current; + } + l->next = My->EndMarker; +} + +static void +bwb_new () +{ + assert (My != NULL); + assert (My->StartMarker != NULL); + assert (My->DefaultVariableType != NULL); + + + /* clear program in memory */ + bwb_xnew (My->StartMarker); + + /* clear all variables */ + var_CLEAR (); + /* if( TRUE ) */ + { + int n; + for (n = 0; n < 26; n++) + { + My->DefaultVariableType[n] = DoubleTypeCode; + } + } + + /* NEW */ + WARN_CLEAR; /* bwb_new */ + My->ContinueLine = NULL; + SetOnError (0); +} + +LineType * +bwb_NEW (LineType * l) +{ + /* + SYNTAX: NEW + */ + + assert (l != NULL); + assert (My != NULL); + assert (My->CurrentVersion != NULL); + + bwb_new (); + if (My->CurrentVersion->OptionVersionValue & (D64 | G65 | G67 | G74)) + { + if (line_is_eol (l)) + { + /* NEW */ + char *tbuf; + int tlen; + + tbuf = My->ConsoleInput; + tlen = MAX_LINE_LENGTH; + /* prompt for the program name */ + bwx_input ("NEW PROBLEM NAME:", FALSE, tbuf, tlen); + if (is_empty_string (tbuf)) + { + WARN_BAD_FILE_NAME; + return l; + } + if (My->ProgramFilename != NULL) + { + free (My->ProgramFilename); + My->ProgramFilename = NULL; + } + My->ProgramFilename = bwb_strdup (tbuf); + } + else + { + /* NEW filename$ */ + /* the parameter is the program name */ + + char *Value; + + Value = NULL; + if (line_read_string_expression (l, &Value) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (is_empty_string (Value)) + { + WARN_BAD_FILE_NAME; + return l; + } + if (My->ProgramFilename != NULL) + { + free (My->ProgramFilename); + My->ProgramFilename = NULL; + } + My->ProgramFilename = Value; + } + } + else + { + /* ignore any parameters */ + line_skip_eol (l); + } + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + SCRATCH +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_SCRATCH (LineType * l) +{ + /* + SYNTAX: SCRATCH -- same as NEW + SYNTAX: SCRATCH # filenumber -- close file and re-open for output + */ + + assert (l != NULL); + + if (line_is_eol (l)) + { + /* SCRATCH */ + bwb_new (); + return (l); + } + if (line_skip_FilenumChar (l)) + { + /* SCRATCH # X */ + int FileNumber; + + if (line_read_integer_expression (l, &FileNumber) == FALSE) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + if (FileNumber < 0) + { + /* SCRATCH # -1 is silently ignored */ + return (l); + } + if (FileNumber == 0) + { + /* SCRATCH # 0 is silently ignored */ + return (l); + } + My->CurrentFile = find_file_by_number (FileNumber); + if (My->CurrentFile == NULL) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + if (My->CurrentFile->DevMode != DEVMODE_CLOSED) + { + My->CurrentFile->DevMode = DEVMODE_CLOSED; + } + if (My->CurrentFile->cfp != NULL) + { + bwb_fclose (My->CurrentFile->cfp); + My->CurrentFile->cfp = NULL; + } + if (My->CurrentFile->buffer != NULL) + { + free (My->CurrentFile->buffer); + My->CurrentFile->buffer = NULL; + } + My->CurrentFile->width = 0; + My->CurrentFile->col = 1; + My->CurrentFile->row = 1; + My->CurrentFile->delimit = ','; + if (is_empty_string (My->CurrentFile->FileName)) + { + WARN_BAD_FILE_NAME; + return (l); + } + if (bwb_strcmp (My->CurrentFile->FileName, "*") != 0) + { + if ((My->CurrentFile->cfp = + fopen (My->CurrentFile->FileName, "w")) == NULL) + { + WARN_BAD_FILE_NAME; + return (l); + } + My->CurrentFile->DevMode = DEVMODE_OUTPUT; + } + /* OK */ + return (l); + } + WARN_SYNTAX_ERROR; + return (l); +} + +/* +============================================================================================ + SYSTEM and so on +============================================================================================ +*/ +static LineType * +bwb_system (LineType * l) +{ + /* + SYNTAX: SYSTEM + */ + assert (l != NULL); + assert (My != NULL); + assert (My->SYSOUT != NULL); + assert (My->SYSOUT->cfp != NULL); + + fprintf (My->SYSOUT->cfp, "\n"); + fflush (My->SYSOUT->cfp); + bwx_terminate (); + return (l); /* never reached */ +} + +/* +-------------------------------------------------------------------------------------------- + BYE +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_BYE (LineType * l) +{ + /* + SYNTAX: BYE + */ + + assert (l != NULL); + return bwb_system (l); +} + +/* +-------------------------------------------------------------------------------------------- + DOS +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_DOS (LineType * l) +{ + /* + SYNTAX: DOS + */ + + assert (l != NULL); + return bwb_system (l); +} + +/* +-------------------------------------------------------------------------------------------- + FLEX +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_FLEX (LineType * l) +{ + /* + SYNTAX: FLEX + */ + + assert (l != NULL); + return bwb_system (l); +} + +/* +-------------------------------------------------------------------------------------------- + GOODBYE +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_GOODBYE (LineType * l) +{ + /* + SYNTAX: GOODBYE + */ + + assert (l != NULL); + return bwb_system (l); +} + +/* +-------------------------------------------------------------------------------------------- + MON +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_MON (LineType * l) +{ + /* + SYNTAX: MON + */ + + assert (l != NULL); + return bwb_system (l); +} + +/* +-------------------------------------------------------------------------------------------- + QUIT +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_QUIT (LineType * l) +{ + /* + SYNTAX: QUIT + */ + + assert (l != NULL); + return bwb_system (l); +} + +/* +-------------------------------------------------------------------------------------------- + SYSTEM +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_SYSTEM (LineType * l) +{ + /* + SYNTAX: SYSTEM + */ + + assert (l != NULL); + return bwb_system (l); +} + + +/* +============================================================================================ + LOAD and so on +============================================================================================ +*/ + +static LineType * +bwb_load (LineType * Line, char *Prompt, int IsNew) +{ + /* + ** + ** load a BASIC program from a file + ** + */ + /* + SYNTAX: ... [filename$] + */ + + assert (Line != NULL); + assert (Prompt != NULL); + assert (My != NULL); + assert (My->CurrentVersion != NULL); + + if (IsNew) + { + /* TRUE == LOAD */ + bwb_new (); + } + else + { + /* FALSE == MERGE */ + if (My->ProgramFilename != NULL) + { + free (My->ProgramFilename); + My->ProgramFilename = NULL; + } + } + if (line_is_eol (Line)) + { + /* default is the last filename used by LOAD or SAVE */ + /* if( My->CurrentVersion->OptionVersionValue & (D64 | G65 | G67 | G74) ) */ + if (is_empty_string (My->ProgramFilename)) + { + /* prompt for the program name */ + char *tbuf; + int tlen; + + tbuf = My->ConsoleInput; + tlen = MAX_LINE_LENGTH; + bwx_input (Prompt, FALSE, tbuf, tlen); + if (is_empty_string (tbuf)) + { + WARN_BAD_FILE_NAME; + return (Line); + } + if (My->ProgramFilename != NULL) + { + free (My->ProgramFilename); + My->ProgramFilename = NULL; + } + My->ProgramFilename = bwb_strdup (tbuf); + } + fprintf (My->SYSOUT->cfp, "Loading %s\n", My->ProgramFilename); + ResetConsoleColumn (); + } + else + { + /* Get an argument for filename */ + char *Value; + + Value = NULL; + if (line_read_string_expression (Line, &Value) == FALSE) + { + WARN_SYNTAX_ERROR; + return (Line); + } + if (is_empty_string (Value)) + { + WARN_BAD_FILE_NAME; + return (Line); + } + if (My->ProgramFilename != NULL) + { + free (My->ProgramFilename); + My->ProgramFilename = NULL; + } + My->ProgramFilename = Value; + } + if (bwb_fload (NULL) == FALSE) + { + WARN_BAD_FILE_NAME; + return (Line); + } + if (IsNew) + { + /* TRUE == LOAD */ + } + else + { + /* FALSE == MERGE */ + if (My->ProgramFilename != NULL) + { + free (My->ProgramFilename); + My->ProgramFilename = NULL; + } + } + /* + ** + ** FORCE SCAN + ** + */ + if (bwb_scan () == FALSE) + { + WARN_CANT_CONTINUE; + } + return (Line); +} + +/* +-------------------------------------------------------------------------------------------- + CLOAD +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_CLOAD (LineType * Line) +{ + /* + SYNTAX: CLOAD [filename$] + */ + + assert (Line != NULL); + return bwb_load (Line, "CLOAD FILE NAME:", TRUE); +} + +/* +-------------------------------------------------------------------------------------------- + LOAD +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_LOAD (LineType * Line) +{ + /* + SYNTAX: LOAD [filename$] + */ + + assert (Line != NULL); + return bwb_load (Line, "LOAD FILE NAME:", TRUE); +} + +/* +-------------------------------------------------------------------------------------------- + MERGE +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_MERGE (LineType * l) +{ + /* + SYNTAX: MERGE [filename$] + */ + + assert (l != NULL); + return bwb_load (l, "MERGE FILE NAME:", FALSE); +} + +/* +-------------------------------------------------------------------------------------------- + OLD +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_OLD (LineType * Line) +{ + /* + SYNTAX: OLD [filename$] + */ + + assert (Line != NULL); + return bwb_load (Line, "OLD PROBLEM NAME:", TRUE); +} + +/* +-------------------------------------------------------------------------------------------- + TLOAD +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_TLOAD (LineType * Line) +{ + /* + SYNTAX: TLOAD [filename$] + */ + + assert (Line != NULL); + return bwb_load (Line, "TLOAD FILE NAME:", TRUE); +} + + +/* +-------------------------------------------------------------------------------------------- + RENAME +-------------------------------------------------------------------------------------------- +*/ +static LineType * +H14_RENAME (LineType * l) +{ + /* + SYNTAX: RENAME from$ TO to$ + */ + char *From; + char *To; + + assert (l != NULL); + + From = NULL; + To = NULL; + if (line_read_string_expression (l, &From) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (is_empty_string (From)) + { + WARN_BAD_FILE_NAME; + return (l); + } + if (line_skip_word (l, "TO") == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_string_expression (l, &To) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (is_empty_string (To)) + { + WARN_BAD_FILE_NAME; + return (l); + } + if (rename (From, To)) + { + WARN_BAD_FILE_NAME; + return (l); + } + return (l); +} + +LineType * +bwb_RENAME (LineType * l) +{ + /* + SYNTAX: RENAME filename$ + */ + + assert (l != NULL); + assert( My != NULL ); + assert( My->CurrentVersion != NULL ); + assert( My->ConsoleInput != NULL ); + + if (My->CurrentVersion->OptionVersionValue & (H14)) + { + /* RENAME == change an exisiting file's name */ + return H14_RENAME (l); + } + /* RENAME == change the BASIC program's name for a later SAVE */ + if (line_is_eol (l)) + { + /* RENAME */ + if (My->CurrentVersion->OptionVersionValue & (D64 | G65 | G67 | G74)) + { + /* prompt for the program name */ + char *tbuf; + int tlen; + + tbuf = My->ConsoleInput; + tlen = MAX_LINE_LENGTH; + bwx_input ("RENAME PROBLEM NAME:", FALSE, tbuf, tlen); + if (is_empty_string (tbuf)) + { + WARN_BAD_FILE_NAME; + return (l); + } + if (My->ProgramFilename != NULL) + { + free (My->ProgramFilename); + My->ProgramFilename = NULL; + } + My->ProgramFilename = bwb_strdup (tbuf); + } + else + { + WARN_SYNTAX_ERROR; + return (l); + } + } + else + { + /* RENAME value$ */ + char *Value; + + Value = NULL; + if (line_read_string_expression (l, &Value) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (is_empty_string (Value)) + { + WARN_BAD_FILE_NAME; + return (l); + } + if (My->ProgramFilename != NULL) + { + free (My->ProgramFilename); + My->ProgramFilename = NULL; + } + My->ProgramFilename = Value; + } + return (l); +} + + +/* +-------------------------------------------------------------------------------------------- + MAT +-------------------------------------------------------------------------------------------- +*/ + +extern void +Determinant (VariableType * v) +{ + /* http://easy-learn-c-language.blogspot.com/search/label/Numerical%20Methods */ + /* Numerical Methods: Determinant of nxn matrix using C */ + + DoubleType **matrix; + DoubleType ratio; + + int i; + int j; + int k; + int n; + + assert (v != NULL); + assert( My != NULL ); + + + My->LastDeterminant = 0; /* default */ + + n = v->UBOUND[0] - v->LBOUND[0] + 1; + + if ((matrix = (DoubleType **) calloc (n, sizeof (DoubleType *))) == NULL) + { + goto EXIT; + } + assert( matrix != NULL ); + for (i = 0; i < n; i++) + { + if ((matrix[i] = (DoubleType *) calloc (n, sizeof (DoubleType))) == NULL) + { + goto EXIT; + } + assert( matrix[i] != NULL ); + } + + for (i = 0; i < n; i++) + { + for (j = 0; j < n; j++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + v->VINDEX[0] = v->LBOUND[0] + i; + v->VINDEX[1] = v->LBOUND[1] + j; + if (var_get (v, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + goto EXIT; + } + if (variant.VariantTypeCode == StringTypeCode) + { + WARN_TYPE_MISMATCH; + goto EXIT; + } + matrix[i][j] = variant.Number; + } + } + + /* Conversion of matrix to upper triangular */ + + for (i = 0; i < n; i++) + { + for (j = 0; j < n; j++) + { + if (j > i) + { + if (matrix[i][i] == 0) + { + /* - Evaluation of an expression results in division + * by zero (nonfatal, the recommended recovery + * procedure is to supply machine infinity with the + * sign of the numerator and continue) + */ + if (WARN_DIVISION_BY_ZERO) + { + /* ERROR */ + goto EXIT; + } + /* CONTINUE */ + if (matrix[j][i] < 0) + { + ratio = MINDBL; + } + else + { + ratio = MAXDBL; + } + } + else + { + ratio = matrix[j][i] / matrix[i][i]; + } + for (k = 0; k < n; k++) + { + matrix[j][k] -= ratio * matrix[i][k]; + } + } + } + } + + + My->LastDeterminant = 1; /* storage for determinant */ + + for (i = 0; i < n; i++) + { + DoubleType Value; + + Value = matrix[i][i]; + My->LastDeterminant *= Value; + } + +EXIT: + if( matrix != NULL ) + { + for (i = 0; i < n; i++) + { + if( matrix[i] != NULL ) + { + free (matrix[i]); + /* matrix[i] = NULL; */ + } + } + free (matrix); + /* matrix = NULL; */ + } +} + +int +InvertMatrix (VariableType * vOut, VariableType * vIn) +{ + /* http://easy-learn-c-language.blogspot.com/search/label/Numerical%20Methods */ + /* Numerical Methods: Inverse of nxn matrix using C */ + + int Result; + DoubleType **matrix; + DoubleType ratio; + + int i; + int j; + int k; + int n; + + assert (vOut != NULL); + assert (vIn != NULL); + + Result = FALSE; + n = vIn->UBOUND[0] - vIn->LBOUND[0] + 1; + + if ((matrix = (DoubleType **) calloc (n, sizeof (DoubleType *))) == NULL) + { + goto EXIT; + } + assert( matrix != NULL ); + + for (i = 0; i < n; i++) + { + if ((matrix[i] = + (DoubleType *) calloc (n + n, sizeof (DoubleType))) == NULL) + { + goto EXIT; + } + assert( matrix[i] != NULL ); + } + + for (i = 0; i < n; i++) + { + for (j = 0; j < n; j++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + vIn->VINDEX[0] = vIn->LBOUND[0] + i; + vIn->VINDEX[1] = vIn->LBOUND[1] + j; + if (var_get (vIn, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + goto EXIT; + } + if (variant.VariantTypeCode == StringTypeCode) + { + WARN_TYPE_MISMATCH; + goto EXIT; + } + matrix[i][j] = variant.Number; + } + } + + for (i = 0; i < n; i++) + { + for (j = n; j < 2 * n; j++) + { + if (i == (j - n)) + { + matrix[i][j] = 1.0; + } + else + { + matrix[i][j] = 0.0; + } + } + } + + for (i = 0; i < n; i++) + { + for (j = 0; j < n; j++) + { + if (i != j) + { + if (matrix[i][i] == 0) + { + /* - Evaluation of an expression results in division + * by zero (nonfatal, the recommended recovery + * procedure is to supply machine infinity with the + * sign of the numerator and continue) + */ + if (WARN_DIVISION_BY_ZERO) + { + /* ERROR */ + goto EXIT; + } + /* CONTINUE */ + if (matrix[j][i] < 0) + { + ratio = MINDBL; + } + else + { + ratio = MAXDBL; + } + } + else + { + ratio = matrix[j][i] / matrix[i][i]; + } + for (k = 0; k < 2 * n; k++) + { + matrix[j][k] -= ratio * matrix[i][k]; + } + } + } + } + + for (i = 0; i < n; i++) + { + DoubleType a; + + a = matrix[i][i]; + if (a == 0) + { + /* - Evaluation of an expression results in division + * by zero (nonfatal, the recommended recovery + * procedure is to supply machine infinity with the + * sign of the numerator and continue) + */ + if (WARN_DIVISION_BY_ZERO) + { + /* ERROR */ + goto EXIT; + } + /* CONTINUE */ + for (j = 0; j < 2 * n; j++) + { + if (matrix[i][j] < 0) + { + matrix[i][j] = MINDBL; + } + else + { + matrix[i][j] = MAXDBL; + } + } + } + else + { + for (j = 0; j < 2 * n; j++) + { + matrix[i][j] /= a; + } + } + } + + for (i = 0; i < n; i++) + { + for (j = 0; j < n; j++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + vOut->VINDEX[0] = vOut->LBOUND[0] + i; + vOut->VINDEX[1] = vOut->LBOUND[0] + j; + variant.VariantTypeCode = vOut->VariableTypeCode; + variant.Number = matrix[i][j + n]; + if (var_set (vOut, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + goto EXIT; + } + } + } + /* + ** + ** Everything is OK + ** + */ + Result = TRUE; + + +EXIT: + if (matrix != NULL) + { + for (i = 0; i < n; i++) + { + if (matrix[i] != NULL) + { + free (matrix[i]); + /* matrix[i] = NULL; */ + } + } + free (matrix); + /* matrix = NULL; */ + } + return Result; +} + +static int +line_read_matrix_redim (LineType * l, VariableType * v) +{ + /* get OPTIONAL parameters if the variable is dimensioned */ + + assert (l != NULL); + assert (v != NULL); + + if (line_peek_LparenChar (l)) + { + /* get requested size, which is <= original array size */ + size_t array_units; + int n; + int dimensions; + int LBOUND[MAX_DIMS]; + int UBOUND[MAX_DIMS]; + + if (line_read_array_redim (l, &dimensions, LBOUND, UBOUND) == FALSE) + { + WARN_SYNTAX_ERROR; + return FALSE; + } + /* 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]; + } + } + return TRUE; +} + +LineType * +bwb_MAT (LineType * l) +{ + /* + SYNTAX: MAT A = CON + SYNTAX: MAT A = IDN + SYNTAX: MAT A = ZER + SYNTAX: MAT A = INV B + SYNTAX: MAT A = TRN B + SYNTAX: MAT A = (k) * B + SYNTAX: MAT A = B + SYNTAX: MAT A = B + C + SYNTAX: MAT A = B - C + SYNTAX: MAT A = B * C + */ + VariableType *v_A; + char varname_A[NameLengthMax + 1]; + + assert (l != NULL); + + /* just a placeholder for now. this will grow. */ + + if (line_read_varname (l, varname_A) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + v_A = mat_find (varname_A); + if (v_A == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + /* variable MUST be numeric */ + if (VAR_IS_STRING (v_A)) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_matrix_redim (l, v_A) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_skip_EqualChar (l) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* MAT A = ... */ + if (line_skip_word (l, "CON")) + { + /* MAT A = CON */ + /* MAT A = CON(I) */ + /* MAT A = CON(I,J) */ + /* MAT A = CON(I,J,K) */ + /* OK */ + int i; + int j; + int k; + + if (line_read_matrix_redim (l, v_A) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + + /* both arrays are of the same size */ + switch (v_A->dimensions) + { + case 1: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + variant.VariantTypeCode = v_A->VariableTypeCode; + variant.Number = 1; + v_A->VINDEX[0] = i; + if (var_set (v_A, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + break; + case 2: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + variant.VariantTypeCode = v_A->VariableTypeCode; + variant.Number = 1; + v_A->VINDEX[0] = i; + v_A->VINDEX[1] = j; + if (var_set (v_A, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + } + break; + case 3: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++) + { + for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + variant.VariantTypeCode = v_A->VariableTypeCode; + variant.Number = 1; + v_A->VINDEX[0] = i; + v_A->VINDEX[1] = j; + v_A->VINDEX[2] = k; + if (var_set (v_A, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + } + } + break; + default: + WARN_SYNTAX_ERROR; + return (l); + } + } + else if (line_skip_word (l, "IDN")) + { + /* MAT A = IDN */ + /* MAT A = IDN(I,J) */ + /* OK */ + int i; + int j; + + if (line_read_matrix_redim (l, v_A) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + + if (v_A->dimensions != 2) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + if (v_A->LBOUND[0] != v_A->LBOUND[1]) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + if (v_A->UBOUND[0] != v_A->UBOUND[1]) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + /* square matrix */ + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + variant.VariantTypeCode = v_A->VariableTypeCode; + if (i == j) + { + variant.Number = 1; + } + else + { + variant.Number = 0; + } + v_A->VINDEX[0] = i; + v_A->VINDEX[1] = j; + if (var_set (v_A, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + } + } + else if (line_skip_word (l, "ZER")) + { + /* MAT A = ZER */ + /* MAT A = ZER(I) */ + /* MAT A = ZER(I,J) */ + /* MAT A = ZER(I,J,K) */ + /* OK */ + int i; + int j; + int k; + + if (line_read_matrix_redim (l, v_A) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* both arrays are of the same size */ + switch (v_A->dimensions) + { + case 1: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + variant.VariantTypeCode = v_A->VariableTypeCode; + variant.Number = 0; + v_A->VINDEX[0] = i; + if (var_set (v_A, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + break; + case 2: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + variant.VariantTypeCode = v_A->VariableTypeCode; + variant.Number = 0; + v_A->VINDEX[0] = i; + v_A->VINDEX[1] = j; + if (var_set (v_A, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + } + break; + case 3: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++) + { + for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + variant.VariantTypeCode = v_A->VariableTypeCode; + variant.Number = 0; + v_A->VINDEX[0] = i; + v_A->VINDEX[1] = j; + v_A->VINDEX[2] = k; + if (var_set (v_A, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + } + } + break; + default: + WARN_SYNTAX_ERROR; + return (l); + } + } + else if (line_skip_word (l, "INV")) + { + /* MAT A = INV B */ + /* MAT A = INV( B ) */ + /* OK */ + VariableType *v_B; + char varname_B[NameLengthMax + 1]; + + if (v_A->dimensions != 2) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (v_A->LBOUND[0] != v_A->LBOUND[1] || v_A->UBOUND[0] != v_A->UBOUND[1]) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + if (line_skip_LparenChar (l)) + { + /* optional */ + } + if (line_read_varname (l, varname_B) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + + if ((v_B = mat_find (varname_B)) == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + /* variable MUST be numeric */ + if (VAR_IS_STRING (v_B)) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_matrix_redim (l, v_B) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_skip_RparenChar (l)) + { + /* optional */ + } + if (v_B->dimensions != 2) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (v_B->LBOUND[0] != v_B->LBOUND[1] || v_B->UBOUND[0] != v_B->UBOUND[1]) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + if (v_A->LBOUND[0] != v_B->LBOUND[0] || v_A->UBOUND[0] != v_B->UBOUND[0]) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + /* square matrix */ + Determinant (v_B); + if (My->LastDeterminant == 0) + { + WARN_ILLEGAL_FUNCTION_CALL; + return (l); + } + if (InvertMatrix (v_A, v_B) == FALSE) + { + WARN_ILLEGAL_FUNCTION_CALL; + return (l); + } + } + else if (line_skip_word (l, "TRN")) + { + /* MAT A = TRN B */ + /* MAT A = TRN( B ) */ + /* OK */ + int i; + int j; + VariableType *v_B; + char varname_B[NameLengthMax + 1]; + + if (v_A->dimensions != 2) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_skip_LparenChar (l)) + { + /* optional */ + } + if (line_read_varname (l, varname_B) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if ((v_B = mat_find (varname_B)) == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + /* variable MUST be numeric */ + if (VAR_IS_STRING (v_B)) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_matrix_redim (l, v_B) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_skip_RparenChar (l)) + { + /* optional */ + } + if (v_B->dimensions != 2) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* MxN */ + if (v_A->LBOUND[0] != v_B->LBOUND[1] || v_A->UBOUND[0] != v_B->UBOUND[1]) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (v_A->LBOUND[1] != v_B->LBOUND[0] || v_A->UBOUND[1] != v_B->UBOUND[0]) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* transpose matrix */ + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + v_B->VINDEX[1] = i; + v_B->VINDEX[0] = j; + if (var_get (v_B, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + v_A->VINDEX[0] = i; + v_A->VINDEX[1] = j; + if (var_set (v_A, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + } + } + else if (line_peek_LparenChar (l)) + { + /* MAT A = (k) * B */ + DoubleType Multiplier; + VariableType *v_B; + int i; + int j; + int k; + char *E; + int p; + char varname_B[NameLengthMax + 1]; + char *tbuf; + + tbuf = My->ConsoleInput; + bwb_strcpy (tbuf, &(l->buffer[l->position])); + E = bwb_strrchr (tbuf, '*'); + if (E == NULL) + { + WARN_SYNTAX_ERROR; + return (l); + } + *E = NulChar; + p = 0; + if (buff_read_numeric_expression (tbuf, &p, &Multiplier) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + l->position += p; + if (line_skip_StarChar (l) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_varname (l, varname_B) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + + if ((v_B = mat_find (varname_B)) == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + /* variable MUST be numeric */ + if (VAR_IS_STRING (v_B)) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_matrix_redim (l, v_B) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (v_A->dimensions != v_B->dimensions) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* both arrays are of the same size */ + switch (v_A->dimensions) + { + case 1: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + v_B->VINDEX[0] = i; + if (var_get (v_B, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + variant.Number *= Multiplier; + + v_A->VINDEX[0] = i; + if (var_set (v_A, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + break; + case 2: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + v_B->VINDEX[0] = i; + v_B->VINDEX[1] = j; + if (var_get (v_B, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + variant.Number *= Multiplier; + + v_A->VINDEX[0] = i; + v_A->VINDEX[1] = j; + if (var_set (v_A, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + } + break; + case 3: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++) + { + for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + v_B->VINDEX[0] = i; + v_B->VINDEX[1] = j; + v_B->VINDEX[2] = k; + if (var_get (v_B, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + variant.Number *= Multiplier; + + v_A->VINDEX[0] = i; + v_A->VINDEX[1] = j; + v_A->VINDEX[2] = k; + if (var_set (v_A, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + } + } + break; + default: + WARN_SYNTAX_ERROR; + return (l); + } + } + else + { + /* MAT A = B */ + /* MAT A = B + C */ + /* MAT A = B - C */ + /* MAT A = B * C */ + VariableType *v_B; + char varname_B[NameLengthMax + 1]; + + if (line_read_varname (l, varname_B) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + + if ((v_B = mat_find (varname_B)) == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + /* variable MUST be numeric */ + if (VAR_IS_STRING (v_B)) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_matrix_redim (l, v_B) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_is_eol (l)) + { + /* MAT A = B */ + /* OK */ + int i; + int j; + int k; + + if (v_A->dimensions != v_B->dimensions) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* both arrays are of the same size */ + switch (v_A->dimensions) + { + case 1: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + v_B->VINDEX[0] = i; + if (var_get (v_B, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + v_A->VINDEX[0] = i; + if (var_set (v_A, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + break; + case 2: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + v_B->VINDEX[0] = i; + v_B->VINDEX[1] = j; + if (var_get (v_B, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + v_A->VINDEX[0] = i; + v_A->VINDEX[1] = j; + if (var_set (v_A, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + } + break; + case 3: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++) + { + for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + v_B->VINDEX[0] = i; + v_B->VINDEX[1] = j; + v_B->VINDEX[2] = k; + if (var_get (v_B, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + v_A->VINDEX[0] = i; + v_A->VINDEX[1] = j; + v_A->VINDEX[2] = k; + if (var_set (v_A, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + } + } + break; + default: + WARN_SYNTAX_ERROR; + return (l); + } + } + else if (line_skip_PlusChar (l)) + { + /* MAT A = B + C */ + /* OK */ + int i; + int j; + int k; + VariableType *v_C; + char varname_C[NameLengthMax + 1]; + + if (v_A->dimensions != v_B->dimensions) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* both arrays are of the same size */ + + if (line_read_varname (l, varname_C) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + + if ((v_C = mat_find (varname_C)) == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + /* variable MUST be numeric */ + if (VAR_IS_STRING (v_C)) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_matrix_redim (l, v_C) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (v_B->dimensions != v_C->dimensions) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* both arrays are of the same size */ + switch (v_A->dimensions) + { + case 1: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + VariantType variant_L; + VariantType variant_R; + CLEAR_VARIANT (&variant_L); + CLEAR_VARIANT (&variant_R); + + v_B->VINDEX[0] = i; + if (var_get (v_B, &variant_L) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + v_C->VINDEX[0] = i; + if (var_get (v_C, &variant_R) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + variant_L.Number += variant_R.Number; + + v_A->VINDEX[0] = i; + if (var_set (v_A, &variant_L) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + break; + case 2: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++) + { + VariantType variant_L; + VariantType variant_R; + CLEAR_VARIANT (&variant_L); + CLEAR_VARIANT (&variant_R); + + v_B->VINDEX[0] = i; + v_B->VINDEX[1] = j; + if (var_get (v_B, &variant_L) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + v_C->VINDEX[0] = i; + v_C->VINDEX[1] = j; + if (var_get (v_C, &variant_R) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + variant_L.Number += variant_R.Number; + + v_A->VINDEX[0] = i; + v_A->VINDEX[1] = j; + if (var_set (v_A, &variant_L) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + } + break; + case 3: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++) + { + for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++) + { + VariantType variant_L; + VariantType variant_R; + CLEAR_VARIANT (&variant_L); + CLEAR_VARIANT (&variant_R); + + v_B->VINDEX[0] = i; + v_B->VINDEX[1] = j; + v_B->VINDEX[2] = k; + if (var_get (v_B, &variant_L) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + v_C->VINDEX[0] = i; + v_C->VINDEX[1] = j; + v_C->VINDEX[2] = k; + if (var_get (v_C, &variant_R) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + variant_L.Number += variant_R.Number; + + v_A->VINDEX[0] = i; + v_A->VINDEX[1] = j; + v_A->VINDEX[2] = k; + if (var_set (v_A, &variant_L) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + } + } + break; + default: + WARN_SYNTAX_ERROR; + return (l); + } + } + else if (line_skip_MinusChar (l)) + { + /* MAT A = B - C */ + /* OK */ + int i; + int j; + int k; + VariableType *v_C; + char varname_C[NameLengthMax + 1]; + + if (v_A->dimensions != v_B->dimensions) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* both arrays are of the same size */ + + if (line_read_varname (l, varname_C) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + + if ((v_C = mat_find (varname_C)) == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + /* variable MUST be numeric */ + if (VAR_IS_STRING (v_C)) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_matrix_redim (l, v_C) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (v_B->dimensions != v_C->dimensions) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* both arrays are of the same dimension */ + switch (v_A->dimensions) + { + case 1: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + VariantType variant_L; + VariantType variant_R; + CLEAR_VARIANT (&variant_L); + CLEAR_VARIANT (&variant_R); + + v_B->VINDEX[0] = i; + if (var_get (v_B, &variant_L) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + v_C->VINDEX[0] = i; + if (var_get (v_C, &variant_R) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + variant_L.Number -= variant_R.Number; + + v_A->VINDEX[0] = i; + if (var_set (v_A, &variant_L) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + break; + case 2: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++) + { + VariantType variant_L; + VariantType variant_R; + CLEAR_VARIANT (&variant_L); + CLEAR_VARIANT (&variant_R); + + v_B->VINDEX[0] = i; + v_B->VINDEX[1] = j; + if (var_get (v_B, &variant_L) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + v_C->VINDEX[0] = i; + v_C->VINDEX[1] = j; + if (var_get (v_C, &variant_R) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + variant_L.Number -= variant_R.Number; + + v_A->VINDEX[0] = i; + v_A->VINDEX[1] = j; + if (var_set (v_A, &variant_L) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + } + break; + case 3: + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++) + { + for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++) + { + VariantType variant_L; + VariantType variant_R; + CLEAR_VARIANT (&variant_L); + CLEAR_VARIANT (&variant_R); + + v_B->VINDEX[0] = i; + v_B->VINDEX[1] = j; + v_B->VINDEX[2] = k; + if (var_get (v_B, &variant_L) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + v_C->VINDEX[0] = i; + v_C->VINDEX[1] = j; + v_C->VINDEX[2] = k; + if (var_get (v_C, &variant_R) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + variant_L.Number -= variant_R.Number; + + v_A->VINDEX[0] = i; + v_A->VINDEX[1] = j; + v_A->VINDEX[2] = k; + if (var_set (v_A, &variant_L) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + } + } + break; + default: + WARN_SYNTAX_ERROR; + return (l); + } + } + else if (line_skip_StarChar (l)) + { + /* MAT A = B * C */ + int i; + int j; + int k; + VariableType *v_C; + char varname_C[NameLengthMax + 1]; + + + if (v_A->dimensions != 2) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + if (v_B->dimensions != 2) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + if (line_read_varname (l, varname_C) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if ((v_C = mat_find (varname_C)) == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + /* variable MUST be numeric */ + if (VAR_IS_STRING (v_C)) + { + WARN_TYPE_MISMATCH; + return (l); + } + if (line_read_matrix_redim (l, v_C) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (v_C->dimensions != 2) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + if (v_A->LBOUND[0] != v_B->LBOUND[0]) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + if (v_A->UBOUND[0] != v_B->UBOUND[0]) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + if (v_A->LBOUND[1] != v_C->LBOUND[1]) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + if (v_A->UBOUND[1] != v_C->UBOUND[1]) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + if (v_B->LBOUND[1] != v_C->LBOUND[0]) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + if (v_B->UBOUND[1] != v_C->UBOUND[0]) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++) + { + for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++) + { + VariantType variant_A; + CLEAR_VARIANT (&variant_A); + + variant_A.VariantTypeCode = v_A->VariableTypeCode; + variant_A.Number = 0; + + v_A->VINDEX[0] = i; + v_A->VINDEX[1] = j; + if (var_set (v_A, &variant_A) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + for (k = v_C->LBOUND[0]; k <= v_C->UBOUND[0]; k++) + { + VariantType variant_B; + VariantType variant_C; + CLEAR_VARIANT (&variant_B); + CLEAR_VARIANT (&variant_C); + + v_A->VINDEX[0] = i; + v_A->VINDEX[1] = j; + if (var_get (v_A, &variant_A) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + v_B->VINDEX[0] = i; + v_B->VINDEX[1] = k; + if (var_get (v_B, &variant_B) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + v_C->VINDEX[0] = k; + v_C->VINDEX[1] = j; + if (var_get (v_C, &variant_C) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + variant_A.Number += variant_B.Number * variant_C.Number; + + v_A->VINDEX[0] = i; + v_A->VINDEX[1] = j; + if (var_set (v_A, &variant_A) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + } + } + } + } + else + { + WARN_SYNTAX_ERROR; + return (l); + } + } + return (l); +} + + + +/* +-------------------------------------------------------------------------------------------- + STORE +-------------------------------------------------------------------------------------------- +*/ + + +LineType * +bwb_STORE (LineType * l) +{ + /* + SYNTAX: STORE NumericArrayName + */ + + assert (l != NULL); + return bwb_CSAVE8 (l); +} + + +/* +-------------------------------------------------------------------------------------------- + CSAVE* +-------------------------------------------------------------------------------------------- +*/ + +#define CSAVE_VERSION_1 0x20150218L + +LineType * +bwb_CSAVE8 (LineType * l) +{ + /* + SYNTAX: CSAVE* NumericArrayName + */ + VariableType *v = NULL; + FILE *f; + unsigned long n; + size_t t; + char varname[NameLengthMax + 1]; + + assert (l != NULL); + + if (line_read_varname (l, varname) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + + v = mat_find (varname); + if (v == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + /* variable MUST be numeric */ + if (VAR_IS_STRING (v)) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* variable MUST be an array */ + if (v->dimensions == 0) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_matrix_redim (l, v) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* variable storage is a mess, we bypass that tradition here. */ + t = v->array_units; + if (t <= 1) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* open file */ + f = fopen (v->name, "w"); + if (f == NULL) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* write version number */ + n = CSAVE_VERSION_1; + fwrite (&n, sizeof (long), 1, f); + /* write total number of elements */ + fwrite (&t, sizeof (long), 1, f); + /* write data */ + fwrite (v->Value.Number, sizeof (DoubleType), t, f); + /* OK */ + bwb_fclose (f); + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + RECALL +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_RECALL (LineType * l) +{ + /* + SYNTAX: RECALL NumericArrayName + */ + + assert (l != NULL); + return bwb_CLOAD8 (l); +} + +/* +-------------------------------------------------------------------------------------------- + CLOAD* +-------------------------------------------------------------------------------------------- +*/ + + +LineType * +bwb_CLOAD8 (LineType * l) +{ + /* + SYNTAX: CLOAD* NumericArrayName + */ + VariableType *v = NULL; + FILE *f; + unsigned long n; + size_t t; + char varname[NameLengthMax + 1]; + + assert (l != NULL); + + if (line_read_varname (l, varname) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + + v = mat_find (varname); + if (v == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + /* variable MUST be numeric */ + if (VAR_IS_STRING (v)) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* variable MUST be an array */ + if (v->dimensions == 0) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_matrix_redim (l, v) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* variable storage is a mess, we bypass that tradition here. */ + t = v->array_units; + if (t <= 1) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* open file */ + f = fopen (v->name, "r"); + if (f == NULL) + { + WARN_BAD_FILE_NAME; + return (l); + } + /* read version number */ + n = 0; + fread (&n, sizeof (long), 1, f); + if (n != CSAVE_VERSION_1) + { + bwb_fclose (f); + WARN_BAD_FILE_NAME; + return (l); + } + /* read total number of elements */ + n = 0; + fread (&n, sizeof (long), 1, f); + if (n != t) + { + bwb_fclose (f); + WARN_BAD_FILE_NAME; + return (l); + } + /* read data */ + fread (v->Value.Number, sizeof (DoubleType), t, f); + /* OK */ + bwb_fclose (f); + return (l); +} + + + + +/* +============================================================================================ + SAVE and so on +============================================================================================ +*/ + +static LineType * +bwb_save (LineType * Line, char *Prompt) +{ + /* + SYNTAX: SAVE [filename$] + */ + FILE *outfile; + + assert (Line != NULL); + assert (Prompt != NULL); + assert( My != NULL ); + assert( My->ConsoleInput != NULL ); + assert( My->SYSOUT != NULL ); + assert( My->SYSOUT->cfp != NULL ); + + + /* Get an argument for filename */ + if (line_is_eol (Line)) + { + /* default is the last filename used by LOAD or SAVE */ + if (is_empty_string (My->ProgramFilename) && Prompt != NULL) + { + /* prompt for the program name */ + char *tbuf; + int tlen; + + tbuf = My->ConsoleInput; + tlen = MAX_LINE_LENGTH; + bwx_input (Prompt, FALSE, tbuf, tlen); + if (is_empty_string (tbuf)) + { + WARN_BAD_FILE_NAME; + return (Line); + } + if (My->ProgramFilename != NULL) + { + free (My->ProgramFilename); + My->ProgramFilename = NULL; + } + My->ProgramFilename = bwb_strdup (tbuf); + } + assert( My->ProgramFilename != NULL ); + fprintf (My->SYSOUT->cfp, "Saving %s\n", My->ProgramFilename); + ResetConsoleColumn (); + } + else + { + char *Value; + + Value = NULL; + if (line_read_string_expression (Line, &Value) == FALSE) + { + WARN_SYNTAX_ERROR; + return (Line); + } + if (is_empty_string (Value)) + { + WARN_BAD_FILE_NAME; + return (Line); + } + if (My->ProgramFilename != NULL) + { + free (My->ProgramFilename); + } + My->ProgramFilename = Value; + } + assert( My->ProgramFilename != NULL ); + if ((outfile = fopen (My->ProgramFilename, "w")) == NULL) + { + WARN_BAD_FILE_NAME; + return (Line); + } + bwb_xlist (Line, outfile); + bwb_fclose (outfile); + return (Line); +} + +/* +-------------------------------------------------------------------------------------------- + CSAVE +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_CSAVE (LineType * Line) +{ + /* + SYNTAX: CSAVE [filename$] + */ + + assert (Line != NULL); + return bwb_save (Line, "CSAVE FILE NAME:"); +} + +/* +-------------------------------------------------------------------------------------------- + REPLACE +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_REPLACE (LineType * Line) +{ + /* + SYNTAX: REPLACE [filename$] + */ + + assert (Line != NULL); + return bwb_save (Line, "REPLACE FILE NAME:"); +} + +/* +-------------------------------------------------------------------------------------------- + SAVE +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_SAVE (LineType * l) +{ + /* + SYNTAX: SAVE [filename$] + */ + + assert (l != NULL); + return bwb_save (l, "SAVE FILE NAME:"); +} + +/* +-------------------------------------------------------------------------------------------- + TSAVE +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_TSAVE (LineType * Line) +{ + /* + SYNTAX: TSAVE [filename$] + */ + + assert (Line != NULL); + return bwb_save (Line, "TSAVE FILE NAME:"); +} + + +/* +============================================================================================ + LIST and so on +============================================================================================ +*/ +static int +xl_line (FILE * file, LineType * l) +{ + char LineExecuted; + char *C; /* start of comment text */ + char *buffer; /* 0...99999 */ + + assert (file != NULL); + assert (l != NULL); + assert( My != NULL ); + assert( My->NumLenBuffer != NULL ); + assert( My->CurrentVersion != NULL ); + assert( My->SYSOUT != NULL ); + assert( My->SYSOUT->cfp != NULL ); + assert( My->SYSPRN != NULL ); + assert( My->SYSPRN->cfp != NULL ); + + /* + ** The only difference between LIST, LLIST and SAVE is: + ** LIST and LLIST display an '*' + ** when a line has been executed + ** and OPTION COVERAGE ON is enabled. + */ + + buffer = My->NumLenBuffer; + LineExecuted = ' '; + if (My->CurrentVersion->OptionFlags & (OPTION_COVERAGE_ON)) + { + if (l->LineFlags & LINE_EXECUTED) + { + if (file == My->SYSOUT->cfp || file == My->SYSPRN->cfp) + { + /* LIST */ + /* LLIST */ + LineExecuted = '*'; + } + else + { + /* SAVE */ + /* EDIT implies SAVE */ + } + } + } + + C = l->buffer; + if (l->LineFlags & LINE_NUMBERED) + { + /* explicitly numbered */ + sprintf (buffer, "%*d", LineNumberDigits, l->number); + /* ##### xxx */ + } + else + { + /* implicitly numbered */ + if (My->LastLineNumber == l->number) + { + /* multi-statement line */ + if (l->cmdnum == C_REM + && IS_CHAR (l->buffer[0], My->CurrentVersion->OptionCommentChar)) + { + /* trailing comment */ + sprintf (buffer, "%*s%c", LineNumberDigits - 1, "", + My->CurrentVersion->OptionCommentChar); + C++; /* skip comment char */ + while (*C == ' ') + { + /* skip spaces */ + C++; + } + /* ____' xxx */ + } + else if (My->CurrentVersion->OptionStatementChar) + { + /* all other commands, add a colon */ + sprintf (buffer, "%*s%c", LineNumberDigits - 1, "", + My->CurrentVersion->OptionStatementChar); + /* ____: xxx */ + } + else + { + /* + The user is trying to list a multi-line statement + in a dialect that does NOT support multi-line statements. + This could occur when LOADing in one dialect and then SAVEing as another dialect, such as: + OPTION VERSION BASIC-80 + LOAD "TEST1.BAS" + 100 REM TEST + 110 PRINT:PRINT:PRINT + OPTION VERSION MARK-I + EDIT + 100 REM TEST + 110 PRINT + PRINT + PRINT + The only thing we can reasonably do is put spaces for the line number, + since the user will have to edit the results manually anyways. + */ + sprintf (buffer, "%*s", LineNumberDigits, ""); + /* _____ xxx */ + } + } + else + { + /* single-statement line */ + sprintf (buffer, "%*s", LineNumberDigits, ""); + /* _____ xxx */ + } + } + + fprintf (file, "%s", buffer); + fprintf (file, "%c", LineExecuted); + + /* if( TRUE ) */ + { + /* %INCLUDE */ + int i; + for (i = 0; i < l->IncludeLevel; i++) + { + fputc (' ', file); + } + } + if (My->OptionIndentInteger > 0) + { + int i; + + for (i = 0; i < l->Indention; i++) + { + int j; + for (j = 0; j < My->OptionIndentInteger; j++) + { + fputc (' ', file); + } + } + } + fprintf (file, "%s\n", C); + + My->LastLineNumber = l->number; + + return TRUE; +} + +static LineType * +bwb_xlist (LineType * l, FILE * file) +{ + + assert (l != NULL); + assert (file != NULL); + assert( My != NULL ); + assert( My->StartMarker != NULL ); + assert( My->EndMarker != NULL ); + + /* + ** + ** FORCE SCAN + ** + */ + if (bwb_scan () == FALSE) + { + /* + ** + ** we are used by bwb_SAVE and bwb_EDIT + ** + WARN_CANT_CONTINUE; + return (l); + */ + } + + if (line_is_eol (l)) + { + /* LIST */ + LineType *x; + /* now go through and list appropriate lines */ + My->LastLineNumber = -1; + for (x = My->StartMarker->next; x != My->EndMarker; x = x->next) + { + xl_line (file, x); + } + fprintf (file, "\n"); + } + else + { + do + { + int head; + int tail; + + if (line_read_line_sequence (l, &head, &tail)) + { + /* LIST 's' - 'e' */ + LineType *x; + if (head < MINLIN || head > MAXLIN) + { + WARN_UNDEFINED_LINE; + return (l); + } + if (tail < MINLIN || tail > MAXLIN) + { + WARN_UNDEFINED_LINE; + return (l); + } + if (head > tail) + { + WARN_UNDEFINED_LINE; + return (l); + } + /* valid range */ + /* now go through and list appropriate lines */ + My->LastLineNumber = -1; + for (x = My->StartMarker->next; x != My->EndMarker; x = x->next) + { + if (head <= x->number && x->number <= tail) + { + xl_line (file, x); + } + } + fprintf (file, "\n"); + } + else + { + WARN_SYNTAX_ERROR; + return (l); + } + } + while (line_skip_seperator (l)); + } + if (file == My->SYSOUT->cfp) + { + ResetConsoleColumn (); + } + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + LIST +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_LIST (LineType * l) +{ + /* + SYNTAX: LIST + SYNTAX: LIST line [,...] + SYNTAX: LIST line - line + */ + + assert (l != NULL); + + return bwb_xlist (l, My->SYSOUT->cfp); +} + +/* +-------------------------------------------------------------------------------------------- + LISTNH +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_LISTNH (LineType * l) +{ + /* + SYNTAX: LISTNH + SYNTAX: LISTNH line [,...] + SYNTAX: LISTNH line - line + */ + + assert (l != NULL); + + return bwb_xlist (l, My->SYSOUT->cfp); +} + +/* +-------------------------------------------------------------------------------------------- + LLIST +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_LLIST (LineType * l) +{ + /* + SYNTAX: LLIST + SYNTAX: LLIST line [,...] + SYNTAX: LLIST line - line + */ + + assert (l != NULL); + + return bwb_xlist (l, My->SYSPRN->cfp); +} + + + +/* +============================================================================================ + DELETE and so on +============================================================================================ +*/ + +static LineType * +bwb_delete (LineType * l) +{ + + assert (l != NULL); + assert( My != NULL ); + assert( My->CurrentVersion != NULL ); + assert( My->StartMarker != NULL ); + assert( My->EndMarker != NULL ); + + if (line_is_eol (l)) + { + /* DELETE */ + WARN_SYNTAX_ERROR; + return (l); + } + else if (My->CurrentVersion->OptionVersionValue & (C77)) + { + /* + SYNTAX: DELETE filenum [,...] + */ + do + { + int FileNumber; + + FileNumber = 0; + if (line_read_integer_expression (l, &FileNumber) == FALSE) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + if (FileNumber <= 0) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + + My->CurrentFile = find_file_by_number (FileNumber); + if (My->CurrentFile == NULL) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + if (My->CurrentFile->DevMode == DEVMODE_CLOSED) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + if (My->CurrentFile->cfp != NULL) + { + bwb_fclose (My->CurrentFile->cfp); + My->CurrentFile->cfp = NULL; + } + if (My->CurrentFile->buffer != NULL) + { + free (My->CurrentFile->buffer); + My->CurrentFile->buffer = NULL; + } + My->CurrentFile->width = 0; + My->CurrentFile->col = 1; + My->CurrentFile->row = 1; + My->CurrentFile->delimit = ','; + My->CurrentFile->DevMode = DEVMODE_CLOSED; + if (My->CurrentFile->FileName == NULL) + { + WARN_BAD_FILE_NAME; + return (l); + } + remove (My->CurrentFile->FileName); + free (My->CurrentFile->FileName); + My->CurrentFile->FileName = NULL; + } + while (line_skip_seperator (l)); + /* OK */ + return (l); + } + else + { + /* + SYNTAX: DELETE line [,...] + SYNTAX: DELETE line - line + */ + + do + { + int head; + int tail; + + if (line_read_line_sequence (l, &head, &tail)) + { + /* DELETE 's' - 'e' */ + LineType *x; + LineType *previous; + if (head < MINLIN || head > MAXLIN) + { + WARN_UNDEFINED_LINE; + return (l); + } + if (tail < MINLIN || tail > MAXLIN) + { + WARN_UNDEFINED_LINE; + return (l); + } + if (head > tail) + { + WARN_UNDEFINED_LINE; + return (l); + } + /* valid range */ + + /* avoid deleting ourself */ + + if (l->LineFlags & (LINE_USER)) + { + /* console line (immediate mode) */ + } + else if (head <= l->number && l->number <= tail) + { + /* 100 DELETE 100 */ + WARN_CANT_CONTINUE; + return (l); + } + /* now go through and list appropriate lines */ + previous = My->StartMarker; + for (x = My->StartMarker->next; x != My->EndMarker;) + { + LineType *next; + + next = x->next; + if (x->number < head) + { + previous = x; + } + else if (head <= x->number && x->number <= tail) + { + if (x == l) + { + /* 100 DELETE 100 */ + WARN_CANT_CONTINUE; + return (l); + } + bwb_freeline (x); + previous->next = next; + } + x = next; + } + } + else + { + WARN_SYNTAX_ERROR; + return (l); + } + } + while (line_skip_seperator (l)); + /* + ** + ** FORCE SCAN + ** + */ + if (bwb_scan () == FALSE) + { + WARN_CANT_CONTINUE; + return (l); + } + } + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + DELETE +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_DELETE (LineType * l) +{ + + assert (l != NULL); + + return bwb_delete (l); +} + +/* +-------------------------------------------------------------------------------------------- + PDEL +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_PDEL (LineType * l) +{ + + assert (l != NULL); + + return bwb_delete (l); +} + +#if FALSE /* keep the source to DONUM and DOUNNUM */ + +/* +-------------------------------------------------------------------------------------------- + DONUM +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_donum (LineType * l) +{ + /* + SYNTAX: DONUM + */ + LineType *current; + int lnumber; + + assert (l != NULL); + assert( My != NULL ); + assert( My->StartMarker != NULL ); + assert( My->EndMarker != NULL ); + + lnumber = 10; + for (current = My->StartMarker->next; current != My->EndMarker; + current = current->next) + { + current->number = lnumber; + + lnumber += 10; + if (lnumber > MAXLIN) + { + return (l); + } + } + + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + DOUNUM +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_dounnum (LineType * l) +{ + /* + SYNTAX: DOUNNUM + */ + LineType *current; + + assert (l != NULL); + assert( My != NULL ); + assert( My->StartMarker != NULL ); + assert( My->EndMarker != NULL ); + + for (current = My->StartMarker->next; current != My->EndMarker; + current = current->next) + { + current->number = 0; + } + + return (l); +} + +#endif /* FALSE */ + + + +/* +-------------------------------------------------------------------------------------------- + FILES +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_FILES (LineType * l) +{ + /* + SYNTAX: FILES A$ [, ...] + */ + /* open a list of files in READ mode */ + + assert (l != NULL); + assert( My != NULL ); + + do + { + int FileNumber; + + FileNumber = My->LastFileNumber; + FileNumber++; + if (FileNumber < 0) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + if (FileNumber == 0) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + My->CurrentFile = find_file_by_number (FileNumber); + if (My->CurrentFile == NULL) + { + My->CurrentFile = file_new (); + My->CurrentFile->FileNumber = FileNumber; + } + { + char *Value; + + Value = NULL; + if (line_read_string_expression (l, &Value) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (Value == NULL) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (My->CurrentFile->FileName != NULL) + { + free (My->CurrentFile->FileName); + My->CurrentFile->FileName = NULL; + } + My->CurrentFile->FileName = Value; + Value = NULL; + } + if (My->CurrentFile->DevMode != DEVMODE_CLOSED) + { + My->CurrentFile->DevMode = DEVMODE_CLOSED; + } + if (My->CurrentFile->cfp != NULL) + { + bwb_fclose (My->CurrentFile->cfp); + My->CurrentFile->cfp = NULL; + } + if (My->CurrentFile->buffer != NULL) + { + free (My->CurrentFile->buffer); + My->CurrentFile->buffer = NULL; + } + My->CurrentFile->width = 0; + My->CurrentFile->col = 1; + My->CurrentFile->row = 1; + My->CurrentFile->delimit = ','; + if (is_empty_string (My->CurrentFile->FileName)) + { + WARN_BAD_FILE_NAME; + return (l); + } + if (bwb_strcmp (My->CurrentFile->FileName, "*") != 0) + { + if ((My->CurrentFile->cfp = + fopen (My->CurrentFile->FileName, "r")) == NULL) + { + WARN_BAD_FILE_NAME; + return (l); + } + My->CurrentFile->DevMode = DEVMODE_INPUT; + } + My->LastFileNumber = FileNumber; + /* OK */ + } + while (line_skip_seperator (l)); + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + FILE +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_FILE (LineType * l) +{ + + assert (l != NULL); + assert( My != NULL ); + assert( My->CurrentVersion != NULL ); + + if (My->CurrentVersion->OptionVersionValue & (C77)) + { + /* + CBASIC-II: + FILE file_name$ ' filename$ must be a simple string scalar (no arrays) + FILE file_name$ ( record_length% ) ' filename$ must be a simple string scalar (no arrays) + -- if the file exists, + then it is used, + else it is created. + -- Does not trigger IF END # + */ + do + { + int FileNumber; + VariableType *v; + char varname[NameLengthMax + 1]; + + if (line_read_varname (l, varname) == FALSE) + { + WARN_BAD_FILE_NAME; + return (l); + } + if (is_empty_string (varname)) + { + WARN_BAD_FILE_NAME; + return (l); + } + v = find_variable_by_type (varname, 0, StringTypeCode); + if (v == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + if (VAR_IS_STRING (v)) + { + /* OK */ + } + else + { + WARN_TYPE_MISMATCH; + return (l); + } + + FileNumber = My->LastFileNumber; + FileNumber++; + if (FileNumber < 0) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + if (FileNumber == 0) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + My->CurrentFile = find_file_by_number (FileNumber); + if (My->CurrentFile == NULL) + { + My->CurrentFile = file_new (); + My->CurrentFile->FileNumber = FileNumber; + } + if (My->CurrentFile->DevMode != DEVMODE_CLOSED) + { + My->CurrentFile->DevMode = DEVMODE_CLOSED; + } + if (My->CurrentFile->cfp != NULL) + { + bwb_fclose (My->CurrentFile->cfp); + My->CurrentFile->cfp = NULL; + } + if (My->CurrentFile->buffer != NULL) + { + free (My->CurrentFile->buffer); + My->CurrentFile->buffer = NULL; + } + My->CurrentFile->width = 0; + My->CurrentFile->col = 1; + My->CurrentFile->row = 1; + My->CurrentFile->delimit = ','; + /* OK */ + if (line_skip_LparenChar (l)) + { + /* RANDOM file */ + int RecLen; + + if (line_read_integer_expression (l, &RecLen) == FALSE) + { + WARN_FIELD_OVERFLOW; + return (l); + } + if (RecLen <= 0) + { + WARN_FIELD_OVERFLOW; + return (l); + } + if (line_skip_RparenChar (l) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if ((My->CurrentFile->buffer = + (char *) calloc (RecLen + 1 /* NulChar */ , + sizeof (char))) == NULL) + { + WARN_OUT_OF_MEMORY; + return (l); + } + My->CurrentFile->width = RecLen; + } + + /* if( TRUE ) */ + { + VariantType variant; + CLEAR_VARIANT (&variant); + + if (var_get (v, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + if (variant.VariantTypeCode == StringTypeCode) + { + if (My->CurrentFile->FileName != NULL) + { + free (My->CurrentFile->FileName); + My->CurrentFile->FileName = NULL; + } + My->CurrentFile->FileName = variant.Buffer; + variant.Buffer = NULL; + } + else + { + WARN_TYPE_MISMATCH; + return (l); + } + } + if (is_empty_string (My->CurrentFile->FileName)) + { + WARN_BAD_FILE_NAME; + return (l); + } + My->CurrentFile->cfp = fopen (My->CurrentFile->FileName, "r+"); + if (My->CurrentFile->cfp == NULL) + { + My->CurrentFile->cfp = fopen (My->CurrentFile->FileName, "w"); + if (My->CurrentFile->cfp != NULL) + { + bwb_fclose (My->CurrentFile->cfp); + My->CurrentFile->cfp = fopen (My->CurrentFile->FileName, "r+"); + } + } + if (My->CurrentFile->cfp == NULL) + { + WARN_BAD_FILE_NAME; + return (l); + } + if (My->CurrentFile->width > 0) + { + /* RANDOM file */ + My->CurrentFile->DevMode = DEVMODE_RANDOM; + } + else + { + /* SERIAL file */ + My->CurrentFile->DevMode = DEVMODE_INPUT | DEVMODE_OUTPUT; + } + /* OK */ + My->LastFileNumber = FileNumber; + } + while (line_skip_seperator (l)); + /* OK */ + return (l); + } + if (line_skip_FilenumChar (l)) + { + /* + SYNTAX: FILE # X, A$ + */ + int FileNumber; + + if (line_read_integer_expression (l, &FileNumber) == FALSE) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + if (line_skip_seperator (l)) + { + /* OK */ + } + else + { + WARN_SYNTAX_ERROR; + return (l); + } + if (FileNumber < 0) + { + /* "FILE # -1" is an ERROR */ + WARN_BAD_FILE_NUMBER; + return (l); + } + if (FileNumber == 0) + { + /* "FILE # 0" is an ERROR */ + WARN_BAD_FILE_NUMBER; + return (l); + } + My->CurrentFile = find_file_by_number (FileNumber); + if (My->CurrentFile == NULL) + { + My->CurrentFile = file_new (); + My->CurrentFile->FileNumber = FileNumber; + } + { + char *Value; + + Value = NULL; + if (line_read_string_expression (l, &Value) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (Value == NULL) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (My->CurrentFile->FileName != NULL) + { + free (My->CurrentFile->FileName); + My->CurrentFile->FileName = NULL; + } + My->CurrentFile->FileName = Value; + Value = NULL; + } + if (My->CurrentFile->DevMode != DEVMODE_CLOSED) + { + My->CurrentFile->DevMode = DEVMODE_CLOSED; + } + if (My->CurrentFile->cfp != NULL) + { + bwb_fclose (My->CurrentFile->cfp); + My->CurrentFile->cfp = NULL; + } + if (My->CurrentFile->buffer != NULL) + { + free (My->CurrentFile->buffer); + My->CurrentFile->buffer = NULL; + } + My->CurrentFile->width = 0; + My->CurrentFile->col = 1; + My->CurrentFile->row = 1; + My->CurrentFile->delimit = ','; + if (is_empty_string (My->CurrentFile->FileName)) + { + WARN_BAD_FILE_NAME; + return (l); + } + if (bwb_strcmp (My->CurrentFile->FileName, "*") != 0) + { + if ((My->CurrentFile->cfp = + fopen (My->CurrentFile->FileName, "r")) == NULL) + { + WARN_BAD_FILE_NAME; + return (l); + } + My->CurrentFile->DevMode = DEVMODE_INPUT; + } + /* OK */ + return (l); + } + WARN_SYNTAX_ERROR; + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + DELIMIT +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_DELIMIT (LineType * l) +{ + /* + SYNTAX: DELIMIT # X, A$ + */ + + assert (l != NULL); + assert( My != NULL ); + assert( My->SYSIN != NULL ); + + if (line_skip_FilenumChar (l)) + { + /* DELIMIT # */ + int FileNumber; + char delimit; + + My->CurrentFile = My->SYSIN; + + if (line_read_integer_expression (l, &FileNumber) == FALSE) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + if (line_skip_seperator (l)) + { + /* OK */ + } + else + { + WARN_SYNTAX_ERROR; + return (l); + } + { + char *Value; + + Value = NULL; + if (line_read_string_expression (l, &Value) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (Value == NULL) + { + WARN_SYNTAX_ERROR; + return (l); + } + delimit = Value[0]; + free (Value); + Value = NULL; + if (bwb_ispunct (delimit)) + { + /* OK */ + } + else + { + WARN_ILLEGAL_FUNCTION_CALL; + return (l); + } + } + if (FileNumber < 0) + { + /* "DELIMIT # -1" is SYSPRN */ + My->SYSPRN->delimit = delimit; + return (l); + } + if (FileNumber == 0) + { + /* "DELIMIT # 0" is SYSOUT */ + My->SYSOUT->delimit = delimit; + return (l); + } + /* normal file */ + My->CurrentFile = find_file_by_number (FileNumber); + if (My->CurrentFile == NULL) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + My->CurrentFile->delimit = delimit; + /* OK */ + return (l); + } + WARN_SYNTAX_ERROR; + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + MARGIN +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_MARGIN (LineType * l) +{ + /* + SYNTAX: MARGIN # X, Y + */ + /* set width for OUTPUT */ + int FileNumber; + int Value; + + assert (l != NULL); + assert( My != NULL ); + assert( My->SYSIN != NULL ); + + if (line_skip_FilenumChar (l)) + { + /* MARGIN # */ + My->CurrentFile = My->SYSIN; + + if (line_read_integer_expression (l, &FileNumber) == FALSE) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + if (line_skip_seperator (l)) + { + /* OK */ + } + else + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_integer_expression (l, &Value) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (Value < 0) + { + WARN_ILLEGAL_FUNCTION_CALL; + return (l); + } + if (FileNumber < 0) + { + /* "MARGIN # -1" is SYSPRN */ + My->SYSPRN->width = Value; + return (l); + } + if (FileNumber == 0) + { + /* "MARGIN # 0" is SYSOUT */ + My->SYSOUT->width = Value; + return (l); + } + /* normal file */ + My->CurrentFile = find_file_by_number (FileNumber); + if (My->CurrentFile == NULL) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + if ((My->CurrentFile->DevMode & DEVMODE_WRITE) == 0) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + My->CurrentFile->width = Value; + /* OK */ + return (l); + } + WARN_SYNTAX_ERROR; + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + USE +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_USE (LineType * l) +{ + /* + SYNTAX: USE parameter$ ' CALL/360, System/360, System/370 + */ + VariableType *v; + + assert (l != NULL); + assert( My != NULL ); + + if ((v = line_read_scalar (l)) == NULL) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (v->VariableTypeCode != StringTypeCode) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* OK */ + if (My->UseParameterString) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + variant.VariantTypeCode = StringTypeCode; + variant.Buffer = My->UseParameterString; + variant.Length = bwb_strlen (My->UseParameterString); + var_set (v, &variant); + } + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + CHAIN +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_CHAIN (LineType * l) +{ + /* + SYNTAX: CHAIN file-name$ [, linenumber] ' most dialects + SYNTAX: CHAIN file-name$ [, parameter$] ' CALL/360, System/360, System/370 + */ + /* originally based upon bwb_load() */ + int LineNumber; + LineType *x; + + assert (l != NULL); + assert( My != NULL ); + assert( My->CurrentVersion != NULL ); + assert( My->StartMarker != NULL ); + assert( My->EndMarker != NULL ); + + /* Get an argument for filename */ + if (line_is_eol (l)) + { + WARN_BAD_FILE_NAME; + return (l); + } + else + { + char *Value; + + Value = NULL; + if (line_read_string_expression (l, &Value) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (is_empty_string (Value)) + { + WARN_BAD_FILE_NAME; + return (l); + } + if (My->ProgramFilename != NULL) + { + free (My->ProgramFilename); + My->ProgramFilename = NULL; + } + My->ProgramFilename = Value; + } + /* optional linenumber */ + LineNumber = 0; + if (line_skip_seperator (l)) + { + if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73)) + { + /* CHAIN filename$, parameter$ */ + { + char *Value; + + Value = NULL; + if (line_read_string_expression (l, &Value) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (Value == NULL) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (My->UseParameterString) + { + free (My->UseParameterString); + My->UseParameterString = NULL; + } + My->UseParameterString = Value; + } + } + else + { + /* CHAIN filename$, linenumber */ + if (line_read_integer_expression (l, &LineNumber) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (LineNumber < MINLIN || LineNumber > MAXLIN) + { + WARN_UNDEFINED_LINE; + return (l); + } + } + } + + /* deallocate all variables except common ones */ + var_delcvars (); + + /* remove old program from memory */ + bwb_xnew (My->StartMarker); + + /* load new program in memory */ + if (bwb_fload (NULL) == FALSE) + { + WARN_BAD_FILE_NAME; + return (l); + } + /* FIXME */ + x = My->StartMarker; + if (MINLIN <= LineNumber && LineNumber <= MAXLIN) + { + /* search for a matching line number */ + while (x->number != LineNumber && x != My->EndMarker) + { + x = x->next; + } + if (x == My->EndMarker) + { + /* NOT FOUND */ + x = My->StartMarker; + } + } + x->position = 0; + /* + ** + ** FORCE SCAN + ** + */ + if (bwb_scan () == FALSE) + { + WARN_CANT_CONTINUE; + return (l); + } + /* reset all stack counters */ + bwb_clrexec (); + if (bwb_incexec ()) + { + /* OK */ + My->StackHead->line = x; + My->StackHead->ExecCode = EXEC_NORM; + } + else + { + /* ERROR */ + WARN_OUT_OF_MEMORY; + return My->EndMarker; + } + + /* run the program */ + + /* CHAIN */ + WARN_CLEAR; /* bwb_CHAIN */ + My->ContinueLine = NULL; + SetOnError (0); + return x; +} + +/* +-------------------------------------------------------------------------------------------- + APPEND +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_APPEND (LineType * l) +{ + /* + SYNTAX: APPEND # filenumber ' Dartmouth, Mark-I, Mark-II, GCOS + SYNTAX: APPEND [filename$] ' all others + */ + + assert (l != NULL); + assert( My != NULL ); + assert( My->CurrentVersion != NULL ); + + if (My->CurrentVersion->OptionVersionValue & (D64 | G65 | G67 | G74)) + { + if (line_skip_FilenumChar (l)) + { + /* APPEND # filenumber */ + int FileNumber; + + if (line_read_integer_expression (l, &FileNumber) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (FileNumber < 0) + { + /* "APPEND # -1" is silently ignored */ + return (l); + } + if (FileNumber == 0) + { + /* "APPEND # 0" is silently ignored */ + return (l); + } + My->CurrentFile = find_file_by_number (FileNumber); + if (My->CurrentFile == NULL) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + /* normal file */ + fseek (My->CurrentFile->cfp, 0, SEEK_END); + My->CurrentFile->DevMode = DEVMODE_APPEND; + /* OK */ + return (l); + } + } + /* APPEND filename$ */ + return bwb_load (l, "APPEND FILE NAME:", FALSE); +} + + + +/* +-------------------------------------------------------------------------------------------- + ON ERROR and so on +-------------------------------------------------------------------------------------------- +*/ + +extern void +SetOnError (int LineNumber) +{ + /* scan the stack looking for a FUNCTION/SUB */ + StackType *StackItem; + assert( My != NULL ); + + + if (My->StackHead == NULL) + { + return; + } + + for (StackItem = My->StackHead; StackItem->next != NULL; + StackItem = StackItem->next) + { + LineType *current; + + current = StackItem->LoopTopLine; + if (current != NULL) + { + switch (current->cmdnum) + { + case C_FUNCTION: + case C_SUB: + /* FOUND */ + /* we are in a FUNCTION/SUB, so this is LOCAL */ + StackItem->OnErrorGoto = LineNumber; + return; + /* break; */ + } + } + } + /* StackItem->next == NULL */ + /* NOT FOUND */ + /* we are NOT in a FUNCTION/SUB */ + assert (StackItem != NULL); + StackItem->OnErrorGoto = LineNumber; +} + + +extern int +GetOnError (void) +{ + /* scan the stack looking for an active "ON ERROR GOTO linenumber" */ + StackType *StackItem; + assert( My != NULL ); + + + for (StackItem = My->StackHead; StackItem != NULL; + StackItem = StackItem->next) + { + if (StackItem->OnErrorGoto != 0) + { + /* FOUND */ + return StackItem->OnErrorGoto; + } + } + /* NOT FOUND */ + return 0; +} + +/* +-------------------------------------------------------------------------------------------- + ON ERROR +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_ON_ERROR (LineType * l) +{ + + assert (l != NULL); + WARN_SYNTAX_ERROR; + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + ON ERROR GOTO +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_ON_ERROR_GOTO (LineType * l) +{ + /* ON ERROR GOTO line */ + int LineNumber; + + assert (l != NULL); + + WARN_CLEAR; /* bwb_ON_ERROR_GOTO */ + + /* get the line number */ + LineNumber = 0; + if (line_is_eol (l)) + { + /* ON ERROR GOTO */ + SetOnError (0); + return (l); + } + if (line_read_integer_expression (l, &LineNumber) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* ON ERORR GOTO linenumber */ + if (LineNumber == 0) + { + /* ON ERROR GOTO 0 */ + SetOnError (0); + return (l); + } + if (LineNumber < MINLIN || LineNumber > MAXLIN) + { + /* ERROR */ + WARN_UNDEFINED_LINE; + return (l); + } + /* OK */ + SetOnError (LineNumber); + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + ON ERROR GOSUB +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_ON_ERROR_GOSUB (LineType * l) +{ + /* ON ERROR GOSUB line */ + + assert (l != NULL); + return bwb_ON_ERROR_GOTO (l); +} + +/* +-------------------------------------------------------------------------------------------- + ON ERROR RESUME +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_ON_ERROR_RESUME (LineType * l) +{ + + assert (l != NULL); + WARN_SYNTAX_ERROR; + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + ON ERROR RESUME NEXT +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_ON_ERROR_RESUME_NEXT (LineType * l) +{ + + assert (l != NULL); + WARN_CLEAR; /* bwb_ON_ERROR_RESUME_NEXT */ + SetOnError (-1); + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + ON ERROR RETURN +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_ON_ERROR_RETURN (LineType * l) +{ + + assert (l != NULL); + WARN_SYNTAX_ERROR; + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + ON ERROR RETURN NEXT +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_ON_ERROR_RETURN_NEXT (LineType * l) +{ + + assert (l != NULL); + return bwb_ON_ERROR_RESUME_NEXT (l); +} + +/* +-------------------------------------------------------------------------------------------- + ON TIMER +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_ON_TIMER (LineType * l) +{ + /* ON TIMER(...) GOSUB ... */ + DoubleType v; + DoubleType minv; + int LineNumber; + + assert (l != NULL); + assert( My != NULL ); + + My->IsTimerOn = FALSE; /* bwb_ON_TIMER */ + My->OnTimerLineNumber = 0; + My->OnTimerCount = 0; + + + /* get the SECOMDS parameter */ + if (line_read_numeric_expression (l, &v) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + + minv = 1; + assert (CLOCKS_PER_SEC > 0); + minv /= CLOCKS_PER_SEC; + if (v < minv) + { + /* ERROR */ + WARN_ILLEGAL_FUNCTION_CALL; + return (l); + } + + /* get the GOSUB keyword */ + if (line_skip_word (l, "GOSUB") == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* ON TIMER(X) GOSUB line */ + if (line_read_integer_expression (l, &LineNumber) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (LineNumber < MINLIN || LineNumber > MAXLIN) + { + /* ERROR */ + WARN_UNDEFINED_LINE; + return (l); + } + /* OK */ + My->OnTimerLineNumber = LineNumber; + My->OnTimerCount = v; + return (l); +} + + +/* +-------------------------------------------------------------------------------------------- + TIMER +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_TIMER (LineType * l) +{ + + assert (l != NULL); + assert( My != NULL ); + + My->IsTimerOn = FALSE; /* bwb_TIMER */ + WARN_SYNTAX_ERROR; + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + TIMER OFF +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_TIMER_OFF (LineType * l) +{ + + assert (l != NULL); + assert( My != NULL ); + + /* TIMER OFF */ + My->IsTimerOn = FALSE; /* bwb_TIMER_OFF */ + My->OnTimerLineNumber = 0; + My->OnTimerCount = 0; + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + TIMER ON +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_TIMER_ON (LineType * l) +{ + + assert (l != NULL); + assert( My != NULL ); + + My->IsTimerOn = FALSE; /* bwb_TIMER_ON */ + /* TIMER ON */ + if (My->OnTimerCount > 0 && My->OnTimerLineNumber > 0) + { + My->OnTimerExpires = bwx_TIMER (My->OnTimerCount); + My->IsTimerOn = TRUE; /* bwb_TIMER_ON */ + } + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + TIMER STOP +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_TIMER_STOP (LineType * l) +{ + + assert (l != NULL); + assert( My != NULL ); + + My->IsTimerOn = FALSE; /* bwb_TIMER_STOP */ + + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + RESUME +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_RESUME (LineType * l) +{ + int LineNumber; + LineType *x; + + assert (l != NULL); + assert( My != NULL ); + + LineNumber = 0; + x = My->ERL; /* bwb_RESUME */ + WARN_CLEAR; /* bwb_RESUME */ + + if (l->LineFlags & (LINE_USER)) + { + WARN_ILLEGAL_DIRECT; + return (l); + } + + if (x == NULL) + { + WARN_RESUME_WITHOUT_ERROR; + return (l); + } + /* Get optional argument for RESUME */ + if (line_is_eol (l)) + { + /* RESUME */ + /* + Execution resumes at the statement which caused the error + For structured commands, this is the top line of the structure. + */ + x->position = 0; + return x; + } + if (line_skip_word (l, "NEXT")) + { + /* RESUME NEXT */ + /* + Execution resumes at the statement immediately following the one which caused the error. + For structured commands, this is the bottom line of the structure. + */ + switch (x->cmdnum) + { + case C_IF8THEN: + /* skip to END_IF */ + assert (x->OtherLine != NULL); + for (x = x->OtherLine; x->cmdnum != C_END_IF; x = x->OtherLine); + break; + case C_SELECT_CASE: + /* skip to END_SELECT */ + assert (x->OtherLine != NULL); + for (x = x->OtherLine; x->cmdnum != C_END_SELECT; x = x->OtherLine); + break; + default: + x = x->next; + } + x->position = 0; + return x; + } + /* RESUME ### */ + if (line_read_integer_expression (l, &LineNumber) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (LineNumber == 0) + { + /* SPECIAL CASE */ + /* RESUME 0 */ + /* Execution resumes at the statement which caused the error */ + x->position = 0; + return x; + } + /* VERIFY LINE EXISTS */ + x = find_line_number (LineNumber); /* RESUME 100 */ + if (x != NULL) + { + /* FOUND */ + x->position = 0; + return x; + } + /* NOT FOUND */ + WARN_UNDEFINED_LINE; + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + CMDS +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_CMDS (LineType * l) +{ + int n; + int t; + + assert (l != NULL); + assert( My != NULL ); + assert( My->SYSOUT != NULL ); + assert( My->SYSOUT->cfp != NULL ); + + My->CurrentFile = My->SYSOUT; + fprintf (My->SYSOUT->cfp, "BWBASIC COMMANDS AVAILABLE:\n"); + + /* run through the command table and print comand names */ + + t = 0; + for (n = 0; n < NUM_COMMANDS; n++) + { + fprintf (My->SYSOUT->cfp, IntrinsicCommandTable[n].name); + if (t < 4) + { + fprintf (My->SYSOUT->cfp, "\t"); + t++; + } + else + { + fprintf (My->SYSOUT->cfp, "\n"); + t = 0; + } + } + if (t > 0) + { + fprintf (My->SYSOUT->cfp, "\n"); + } + ResetConsoleColumn (); + return (l); +} + +static void +FixUp (char *Name) +{ + char *C; + + assert (Name != NULL); + + C = Name; + while (*C) + { + if (bwb_isalnum (*C)) + { + /* OK */ + } + else + { + /* FIX */ + switch (*C) + { + case '!': + *C = '1'; + break; + case '@': + *C = '2'; + break; + case '#': + *C = '3'; + break; + case '$': + *C = '4'; + break; + case '%': + *C = '5'; + break; + case '^': + *C = '6'; + break; + case '&': + *C = '7'; + break; + case '*': + *C = '8'; + break; + case '(': + *C = '9'; + break; + case ')': + *C = '0'; + break; + default: + *C = '_'; + } + } + C++; + } +} + + +static void +CommandUniqueID (int i, char *UniqueID) +{ + + assert (UniqueID != NULL); + + bwb_strcpy (UniqueID, "C_"); + bwb_strcat (UniqueID, IntrinsicCommandTable[i].name); + FixUp (UniqueID); +} + +static void +CommandVector (int i, char *Vector) +{ + + assert (Vector != NULL); + + bwb_strcpy (Vector, "bwb_"); + bwb_strcat (Vector, IntrinsicCommandTable[i].name); + FixUp (Vector); +} + +static void +CommandOptionVersion (int n, char *OutputLine) +{ + int i; + int j; + + assert (OutputLine != NULL); + + bwb_strcpy (OutputLine, ""); + j = 0; + for (i = 0; i < NUM_VERSIONS; i++) + { + if (IntrinsicCommandTable[n].OptionVersionBitmask & bwb_vertable[i]. + OptionVersionValue) + { + if (j > 0) + { + bwb_strcat (OutputLine, " | "); + } + bwb_strcat (OutputLine, bwb_vertable[i].ID); + j++; + } + } +} + + +void +SortAllCommands (void) +{ + /* sort by name */ + int i; + assert( My != NULL ); + + + for (i = 0; i < NUM_COMMANDS - 1; i++) + { + int j; + int k; + k = i; + for (j = i + 1; j < NUM_COMMANDS; j++) + { + if (bwb_stricmp + (IntrinsicCommandTable[j].name, IntrinsicCommandTable[k].name) < 0) + { + k = j; + } + } + if (k > i) + { + CommandType t; + bwb_memcpy (&t, &(IntrinsicCommandTable[i]), sizeof (CommandType)); + bwb_memcpy (&(IntrinsicCommandTable[i]), &(IntrinsicCommandTable[k]), + sizeof (CommandType)); + bwb_memcpy (&(IntrinsicCommandTable[k]), &t, sizeof (CommandType)); + } + } +#if THE_PRICE_IS_RIGHT + for (i = 0; i < 26; i++) + { + My->CommandStart[i] = -1; + } + for (i = 0; i < NUM_COMMANDS; i++) + { + int j; + j = VarTypeIndex (IntrinsicCommandTable[i].name[0]); + if (j < 0) + { + /* non-alpha */ + } + else if (My->CommandStart[j] < 0) + { + /* this is the first command starting with this letter */ + My->CommandStart[j] = i; + } + } +#endif /* THE_PRICE_IS_RIGHT */ +} + +void +SortAllFunctions (void) +{ + /* sort by name then number of parameters */ + int i; + assert( My != NULL ); + + + for (i = 0; i < NUM_FUNCTIONS - 1; i++) + { + int j; + int k; + k = i; + for (j = i + 1; j < NUM_FUNCTIONS; j++) + { + int n; + n = + bwb_stricmp (IntrinsicFunctionTable[j].Name, + IntrinsicFunctionTable[k].Name); + if (n < 0) + { + k = j; + } + else if (n == 0) + { + if (IntrinsicFunctionTable[j].ParameterCount < + IntrinsicFunctionTable[k].ParameterCount) + { + k = j; + } + } + } + if (k > i) + { + IntrinsicFunctionType t; + bwb_memcpy (&t, &(IntrinsicFunctionTable[i]), + sizeof (IntrinsicFunctionType)); + bwb_memcpy (&(IntrinsicFunctionTable[i]), &(IntrinsicFunctionTable[k]), + sizeof (IntrinsicFunctionType)); + bwb_memcpy (&(IntrinsicFunctionTable[k]), &t, + sizeof (IntrinsicFunctionType)); + } + } +#if THE_PRICE_IS_RIGHT + for (i = 0; i < 26; i++) + { + My->IntrinsicFunctionStart[i] = -1; + } + for (i = 0; i < NUM_FUNCTIONS; i++) + { + int j; + j = VarTypeIndex (IntrinsicFunctionTable[i].Name[0]); + if (j < 0) + { + /* non-alpha */ + } + else if (My->IntrinsicFunctionStart[j] < 0) + { + /* this is the first command starting with this letter */ + My->IntrinsicFunctionStart[j] = i; + } + } +#endif /* THE_PRICE_IS_RIGHT */ +} + + +void +DumpAllCommandUniqueID (FILE * file) +{ + int i; + int j; + char LastUniqueID[NameLengthMax + 1]; + + assert (file != NULL); + + j = 0; + LastUniqueID[0] = NulChar; + + fprintf (file, "/* COMMANDS */\n"); + + /* run through the command table and print comand #define */ + + for (i = 0; i < NUM_COMMANDS; i++) + { + char UniqueID[NameLengthMax + 1]; + + CommandUniqueID (i, UniqueID); + if (bwb_stricmp (LastUniqueID, UniqueID) != 0) + { + /* not a duplicate */ + bwb_strcpy (LastUniqueID, UniqueID); + j = j + 1; + fprintf (file, "#define %-30s %3d /* %-30s */\n", UniqueID, j, + IntrinsicCommandTable[i].name); + } + } + fprintf (file, "#define NUM_COMMANDS %d\n", j); + fflush (file); +} + +static void +ProcessEscapeChars (const char *Input, char *Output) +{ + int n; + + assert (Input != NULL); + assert (Output != NULL); + + n = 0; + + while (*Input) + { + /* \a \b \f \n \r \t \v \" \\ */ + switch (*Input) + { + case '\a': + *Output = '\\'; + Output++; + *Output = 'a'; + Output++; + break; + case '\b': + *Output = '\\'; + Output++; + *Output = 'b'; + Output++; + break; + case '\f': + *Output = '\\'; + Output++; + *Output = 'f'; + Output++; + break; + case '\n': + *Output = '\\'; + Output++; + *Output = 'n'; + Output++; + break; + case '\r': + *Output = '\\'; + Output++; + *Output = 'r'; + Output++; + break; + case '\t': + *Output = '\\'; + Output++; + *Output = 't'; + Output++; + break; + case '\v': + *Output = '\\'; + Output++; + *Output = 'n'; + Output++; + break; + case '\"': + *Output = '\\'; + Output++; + *Output = '"'; + Output++; + break; + case '\\': + *Output = '\\'; + Output++; + *Output = '\\'; + Output++; + break; + default: + *Output = *Input; + Output++; + break; + } + *Output = NulChar; + n++; + if (n > 60 && *Input == ' ') + { + *Output = '\"'; + Output++; + *Output = '\n'; + Output++; + *Output = ' '; + Output++; + *Output = ' '; + Output++; + *Output = '\"'; + Output++; + *Output = NulChar; + n = 0; + } + Input++; + } +} + +void +DumpAllCommandTableDefinitions (FILE * file) +{ + /* generate bwd_cmd.c */ + + int i; + + assert (file != NULL); + + fprintf (file, "/* COMMAND TABLE */\n\n"); + fprintf (file, "#include \"bwbasic.h\"\n\n"); + fprintf (file, + "CommandType IntrinsicCommandTable[ /* NUM_COMMANDS */ ] =\n"); + fprintf (file, "{\n"); + + /* run through the command table and print comand #define */ + + for (i = 0; i < NUM_COMMANDS; i++) + { + char tbuf[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpAllCommandTableDefinitions */ + + + fprintf (file, "{\n"); + + fprintf (file, " "); + CommandUniqueID (i, tbuf); + fprintf (file, tbuf); + fprintf (file, ", /* UniqueID */\n"); + + fprintf (file, " "); + fprintf (file, "\""); + ProcessEscapeChars (IntrinsicCommandTable[i].Syntax, tbuf); + fprintf (file, tbuf); + fprintf (file, "\""); + fprintf (file, ", /* Syntax */\n"); + + fprintf (file, " "); + fprintf (file, "\""); + ProcessEscapeChars (IntrinsicCommandTable[i].Description, tbuf); + fprintf (file, tbuf); + fprintf (file, "\""); + fprintf (file, ", /* Description */\n"); + + fprintf (file, " "); + fprintf (file, "\""); + fprintf (file, IntrinsicCommandTable[i].name); + fprintf (file, "\""); + fprintf (file, ", /* Name */\n"); + + fprintf (file, " "); + CommandOptionVersion (i, tbuf); + fprintf (file, tbuf); + fprintf (file, " /* OptionVersionBitmask */\n"); + + fprintf (file, "},\n"); + } + fprintf (file, "};\n"); + fprintf (file, "\n"); + fprintf (file, + "const size_t NUM_COMMANDS = sizeof( IntrinsicCommandTable ) / sizeof( CommandType );\n"); + fprintf (file, "\n"); + fflush (file); +} + +void +DumpAllCommandSwitchStatement (FILE * file) +{ + int i; + char LastUniqueID[NameLengthMax + 1]; + + assert (file != NULL); + + LastUniqueID[0] = NulChar; + + /* run through the command table and print comand #define */ + fprintf (file, "/* SWITCH */\n"); + fprintf (file, "LineType *bwb_vector( LineType *l )\n"); + fprintf (file, "{\n"); + + fprintf (file, " "); + fprintf (file, "LineType *r;\n"); + + fprintf (file, " "); + fprintf (file, "switch( l->cmdnum )\n"); + + fprintf (file, " "); + fprintf (file, "{\n"); + + for (i = 0; i < NUM_COMMANDS; i++) + { + char tbuf[NameLengthMax + 1]; + + CommandUniqueID (i, tbuf); + if (bwb_stricmp (LastUniqueID, tbuf) != 0) + { + /* not a duplicate */ + bwb_strcpy (LastUniqueID, tbuf); + + fprintf (file, " "); + fprintf (file, "case "); + CommandUniqueID (i, tbuf); + fprintf (file, tbuf); + fprintf (file, ":\n"); + + fprintf (file, " "); + fprintf (file, " "); + fprintf (file, "r = "); + CommandVector (i, tbuf); + fprintf (file, tbuf); + fprintf (file, "( l );\n"); + + fprintf (file, " "); + fprintf (file, " "); + fprintf (file, "break;\n"); + } + } + + fprintf (file, " "); + fprintf (file, "default:\n"); + + fprintf (file, " "); + fprintf (file, " "); + fprintf (file, "WARN_INTERNAL_ERROR;\n"); + + fprintf (file, " "); + fprintf (file, " "); + fprintf (file, "r = l;\n"); + + fprintf (file, " "); + fprintf (file, " "); + fprintf (file, "break;\n"); + + + fprintf (file, " "); + fprintf (file, "}\n"); + + fprintf (file, " "); + fprintf (file, "return r;\n"); + + fprintf (file, "}\n"); + + fflush (file); +} + +void +FixDescription (FILE * file, const char *left, const char *right) +{ + char buffer[MAINTAINER_BUFFER_LENGTH + 1]; /* FixDescription */ + int l; /* length of left side */ + int p; /* current position */ + int n; /* position of the last space character, zero means none yet seen */ + int i; /* number of characters since last '\n' */ + + assert (left != NULL); + assert (right != NULL); + + l = bwb_strlen (left); + p = 0; + n = 0; + i = 0; + bwb_strcpy (buffer, right); + + while (buffer[p]) + { + if (buffer[p] == '\n') + { + n = p; + i = 0; + } + if (buffer[p] == ' ') + { + n = p; + } + if (i > 45 && n > 0) + { + buffer[n] = '\n'; + i = p - n; + } + p++; + i++; + } + fputs (left, file); + p = 0; + while (buffer[p]) + { + if (buffer[p] == '\n') + { + fputc (buffer[p], file); + p++; + while (buffer[p] == ' ') + { + p++; + } + for (i = 0; i < l; i++) + { + fputc (' ', file); + } + } + else + { + fputc (buffer[p], file); + p++; + } + } + fputc ('\n', file); + +} + +void +DumpOneCommandSyntax (FILE * file, int IsXref, int n) +{ + + assert (file != NULL); + + if (n < 0 || n >= NUM_COMMANDS) + { + return; + } + /* NAME */ + { + FixDescription (file, " SYNTAX: ", IntrinsicCommandTable[n].Syntax); + } + /* DESCRIPTION */ + { + FixDescription (file, "DESCRIPTION: ", + IntrinsicCommandTable[n].Description); + } + /* COMPATIBILITY */ + if (IsXref) + { + int i; + fprintf (file, " VERSIONS:\n"); + for (i = 0; i < NUM_VERSIONS; i++) + { + char X; + if (IntrinsicCommandTable[n].OptionVersionBitmask & bwb_vertable[i]. + OptionVersionValue) + { + /* SUPPORTED */ + X = 'X'; + } + else + { + /* NOT SUPPORTED */ + X = '_'; + } + fprintf (file, " [%c] %s\n", X, bwb_vertable[i].Name); + } + } + + fflush (file); +} + +void +DumpAllCommandSyntax (FILE * file, int IsXref, + OptionVersionType OptionVersionValue) +{ + /* for the C maintainer */ + int i; + + assert (file != NULL); + + fprintf (file, + "============================================================\n"); + fprintf (file, + " COMMANDS \n"); + fprintf (file, + "============================================================\n"); + fprintf (file, "\n"); + fprintf (file, "\n"); + for (i = 0; i < NUM_COMMANDS; i++) + { + if (IntrinsicCommandTable[i].OptionVersionBitmask & OptionVersionValue) + { + fprintf (file, + "------------------------------------------------------------\n"); + DumpOneCommandSyntax (file, IsXref, i); + } + + } + fprintf (file, + "------------------------------------------------------------\n"); + + + fprintf (file, "\n"); + fprintf (file, "\n"); + fflush (file); +} + + +void +DumpAllCommandHtmlTable (FILE * file) +{ + /* generate bwd_cmd.htm */ + + int i; + int j; + + assert (file != NULL); + + + /* LEGEND */ + fprintf (file, "<html><head><title>CMDS</title></head><body>\n"); + fprintf (file, "<h1>LEGEND</h1><br>\n"); + fprintf (file, "<table>\n"); + + fprintf (file, "<tr>"); + fprintf (file, "<td>"); + fprintf (file, "<b>"); + fprintf (file, "ID"); + fprintf (file, "</b>"); + fprintf (file, "</td>"); + fprintf (file, "<td>"); + fprintf (file, "<b>"); + fprintf (file, "NAME"); + fprintf (file, "</b>"); + fprintf (file, "</td>"); + fprintf (file, "<td>"); + fprintf (file, "<b>"); + fprintf (file, "DESCRIPTION"); + fprintf (file, "</b>"); + fprintf (file, "</td>"); + fprintf (file, "</tr>\n"); + + for (j = 0; j < NUM_VERSIONS; j++) + { + fprintf (file, "<tr>"); + fprintf (file, "<td>"); + fprintf (file, bwb_vertable[j].ID); + fprintf (file, "</td>"); + fprintf (file, "<td>"); + fprintf (file, bwb_vertable[j].Name); + fprintf (file, "</td>"); + fprintf (file, "<td>"); + fprintf (file, bwb_vertable[j].Description); + fprintf (file, "</td>"); + fprintf (file, "</tr>\n"); + } + fprintf (file, "</table>\n"); + fprintf (file, "<hr>\n"); + + + /* DETAILS */ + fprintf (file, "<h1>DETAILS</h1><br>\n"); + fprintf (file, "<table>\n"); + + fprintf (file, "<tr>"); + fprintf (file, "<td>"); + fprintf (file, "<b>"); + fprintf (file, "COMMAND"); + fprintf (file, "</b>"); + fprintf (file, "</td>"); + for (j = 0; j < NUM_VERSIONS; j++) + { + fprintf (file, "<td>"); + fprintf (file, "<b>"); + fprintf (file, bwb_vertable[j].ID); + fprintf (file, "</b>"); + fprintf (file, "</td>"); + } + fprintf (file, "</tr>\n"); + + + /* run through the command table and print comand -vs- OPTION VERSION */ + + for (i = 0; i < NUM_COMMANDS; i++) + { + fprintf (file, "<tr>"); + fprintf (file, "<td>"); + fprintf (file, (char *) IntrinsicCommandTable[i].Syntax); + fprintf (file, "</td>"); + + for (j = 0; j < NUM_VERSIONS; j++) + { + fprintf (file, "<td>"); + if (IntrinsicCommandTable[i].OptionVersionBitmask & bwb_vertable[j]. + OptionVersionValue) + { + fprintf (file, "X"); + } + else + { + fprintf (file, " "); + } + fprintf (file, "</td>"); + } + fprintf (file, "</tr>\n"); + } + fprintf (file, "</table>\n"); + fprintf (file, "</body></html>\n"); + fprintf (file, "\n"); + + fflush (file); +} + +/* +-------------------------------------------------------------------------------------------- + HELP +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_HELP (LineType * l) +{ + /* HELP ... */ + int n; + int Found; + char *C; + char *tbuf; + + assert (l != NULL); + assert( My != NULL ); + assert( My->ConsoleInput != NULL ); + assert( My->SYSOUT != NULL ); + assert( My->SYSOUT->cfp != NULL ); + + tbuf = My->ConsoleInput; + Found = FALSE; + + C = l->buffer; + C += l->position; + bwb_strcpy (tbuf, C); + + /* RTRIM$ */ + C = tbuf; + if (*C != 0) + { + /* not an empty line, so remove one (or more) trailing spaces */ + char *E; + + E = bwb_strchr (tbuf, 0); + E--; + while (E >= tbuf && *E == ' ') + { + *E = 0; + E--; + } + } + + + /* EXACT match */ + for (n = 0; n < NUM_COMMANDS; n++) + { + if (bwb_stricmp (IntrinsicCommandTable[n].name, tbuf) == 0) + { + fprintf (My->SYSOUT->cfp, + "------------------------------------------------------------\n"); + DumpOneCommandSyntax (My->SYSOUT->cfp, FALSE, n); + Found = TRUE; + } + } + + for (n = 0; n < NUM_FUNCTIONS; n++) + { + if (bwb_stricmp (IntrinsicFunctionTable[n].Name, tbuf) == 0) + { + fprintf (My->SYSOUT->cfp, + "------------------------------------------------------------\n"); + DumpOneFunctionSyntax (My->SYSOUT->cfp, FALSE, n); + Found = TRUE; + } + } + + if (Found == FALSE) + { + /* PARTIAL match */ + int Length; + Length = bwb_strlen (tbuf); + + for (n = 0; n < NUM_COMMANDS; n++) + { + if (bwb_strnicmp (IntrinsicCommandTable[n].name, tbuf, Length) == 0) + { + if (Found == FALSE) + { + fprintf (My->SYSOUT->cfp, + "The following topics are a partial match:\n"); + } + fprintf (My->SYSOUT->cfp, IntrinsicCommandTable[n].name); + fprintf (My->SYSOUT->cfp, "\t"); + Found = TRUE; + } + } + + for (n = 0; n < NUM_FUNCTIONS; n++) + { + if (bwb_strnicmp (IntrinsicFunctionTable[n].Name, tbuf, Length) == 0) + { + if (Found == FALSE) + { + fprintf (My->SYSOUT->cfp, + "The following topics are a partial match:\n"); + } + fprintf (My->SYSOUT->cfp, IntrinsicFunctionTable[n].Name); + fprintf (My->SYSOUT->cfp, "\t"); + Found = TRUE; + } + } + if (Found == TRUE) + { + /* match */ + fprintf (My->SYSOUT->cfp, "\n"); + } + } + if (Found == FALSE) + { + /* NO match */ + fprintf (My->SYSOUT->cfp, "No help found.\n"); + } + ResetConsoleColumn (); + line_skip_eol (l); + return (l); + +} + +int +NumberValueCheck (ParamTestType ParameterTests, DoubleType X) +{ + DoubleType XR; /* rounded value */ + unsigned char TestNibble; + + + + /* VerifyNumeric */ + if (isnan (X)) + { + /* INTERNAL ERROR */ + return -1; + } + if (isinf (X)) + { + /* - Evaluation of an expression results in an overflow + * (nonfatal, the recommended recovery procedure is to supply + * machine in- finity with the algebraically correct sign and + * continue). */ + if (X < 0) + { + X = MINDBL; + } + else + { + X = MAXDBL; + } + if (WARN_OVERFLOW) + { + /* ERROR */ + return -1; + } + /* CONTINUE */ + } + /* OK */ + /* VALID NUMERIC VALUE */ + XR = bwb_rint (X); + ParameterTests &= 0x0000000F; + TestNibble = (unsigned char) ParameterTests; + switch (TestNibble) + { + case P1ERR: + /* INTERNAL ERROR */ + return -1; + /* break; */ + case P1ANY: + if (X < MINDBL || X > MAXDBL) + { + /* ERROR */ + return -1; + } + /* OK */ + return 0; + /* break; */ + case P1BYT: + if (XR < MINBYT || XR > MAXBYT) + { + /* ERROR */ + return -1; + } + /* OK */ + return 0; + /* break; */ + case P1INT: + if (XR < MININT || XR > MAXINT) + { + /* ERROR */ + return -1; + } + /* OK */ + return 0; + /* break; */ + case P1LNG: + if (XR < MINLNG || XR > MAXLNG) + { + /* ERROR */ + return -1; + } + /* OK */ + return 0; + /* break; */ + case P1CUR: + if (XR < MINCUR || XR > MAXCUR) + { + /* ERROR */ + return -1; + } + /* OK */ + return 0; + /* break; */ + case P1FLT: + if (X < MINSNG || X > MAXSNG) + { + /* ERROR */ + return -1; + } + /* OK */ + return 0; + /* break; */ + case P1DBL: + if (X < MINDBL || X > MAXDBL) + { + /* ERROR */ + return -1; + } + /* OK */ + return 0; + /* break; */ + case P1DEV: + /* ERROR */ + return -1; + /* break; */ + case P1LEN: + if (XR < MINLEN || XR > MAXLEN) + { + /* ERROR */ + return -1; + } + /* OK */ + return 0; + /* break; */ + case P1POS: + if (XR < 1 || XR > MAXLEN) + { + /* ERROR */ + return -1; + } + /* OK */ + return 0; + /* break; */ + case P1COM: + /* ERROR */ + return -1; + /* break; */ + case P1LPT: + /* ERROR */ + return -1; + /* break; */ + case P1GTZ: + if (X > 0) + { + /* OK */ + return 0; + } + break; + case P1GEZ: + if (X >= 0) + { + /* OK */ + return 0; + } + break; + case P1NEZ: + if (X != 0) + { + /* OK */ + return 0; + } + break; + } + /* ERROR */ + return -1; +} + +int +StringLengthCheck (ParamTestType ParameterTests, int s) +{ + unsigned char TestNibble; + + + /* check for invalid string length */ + if (s < 0 || s > MAXLEN) + { + /* INTERNAL ERROR */ + return -1; + } + /* VALID STRING LENGTH */ + ParameterTests &= 0x0000000F; + TestNibble = (unsigned char) ParameterTests; + switch (TestNibble) + { + case P1ERR: + /* INTERNAL ERROR */ + return -1; + /* break; */ + case P1ANY: + /* OK */ + return 0; + /* break; */ + case P1BYT: + if (s >= sizeof (ByteType)) + { + /* OK */ + return 0; + } + break; + case P1INT: + if (s >= sizeof (IntegerType)) + { + /* OK */ + return 0; + } + break; + case P1LNG: + if (s >= sizeof (LongType)) + { + /* OK */ + return 0; + } + break; + case P1CUR: + if (s >= sizeof (CurrencyType)) + { + /* OK */ + return 0; + } + break; + case P1FLT: + if (s >= sizeof (SingleType)) + { + /* OK */ + return 0; + } + break; + case P1DBL: + if (s >= sizeof (DoubleType)) + { + /* OK */ + return 0; + } + break; + case P1DEV: + /* ERROR */ + return -1; + /* break; */ + case P1LEN: + /* ERROR */ + return -1; + /* break; */ + case P1POS: + /* ERROR */ + return -1; + /* break; */ + case P1GEZ: + /* ERROR */ + return -1; + /* break; */ + case P1GTZ: + /* ERROR */ + return -1; + /* break; */ + case P1NEZ: + /* ERROR */ + return -1; + /* break; */ + } + /* ERROR */ + return -1; +} + +void +IntrinsicFunctionDefinitionCheck (IntrinsicFunctionType * f) +{ + /* function definition check -- look for obvious errors */ + + assert (f != NULL); + assert( My != NULL ); + assert( My->SYSOUT != NULL ); + assert( My->SYSOUT->cfp != NULL ); + + + /* sanity check */ + if (f->ParameterCount == PNONE || f->ParameterCount == 0xFF) + { + /* function has NO explicit parameters */ + if (f->ParameterTypes == PNONE) + { + /* OK */ + } + else + { + /* oops */ + fprintf (My->SYSOUT->cfp, "invalid ParameterTypes <%s>\n", f->Name); + } + if (f->ParameterTests == PNONE) + { + /* OK */ + } + else + { + /* oops */ + fprintf (My->SYSOUT->cfp, "invalid ParameterTests <%s>\n", f->Name); + } + } + else + { + /* function HAS an explicit number of parameters */ + int i; + ParamTestType ParameterTests; + + ParameterTests = f->ParameterTests; + for (i = 0; i < f->ParameterCount; i++) + { + /* sanity check this parameter */ + ParamTestType thischeck; + thischeck = ParameterTests & 0x0000000F; + /* verify parameter check */ + if (f->ParameterTypes & (1 << i)) + { + /* STRING */ + if (thischeck >= P1ANY && thischeck <= P1DBL) + { + /* OK */ + } + else + { + /* oops */ + fprintf (My->SYSOUT->cfp, + "invalid ParameterTests <%s> parameter %d\n", f->Name, + i + 1); + } + } + else + { + /* NUMBER */ + if (thischeck >= P1ANY && thischeck <= P1NEZ) + { + /* OK */ + } + else + { + /* oops */ + fprintf (My->SYSOUT->cfp, + "invalid ParameterTests <%s> parameter %d\n", f->Name, + i + 1); + } + } + ParameterTests = ParameterTests >> 4; + } + if (ParameterTests != 0) + { + /* oops */ + fprintf (My->SYSOUT->cfp, "invalid ParameterTests <%s> parameter %d\n", + f->Name, i + 1); + } + } +} + +void +IntrinsicFunctionUniqueID (IntrinsicFunctionType * f, char *UniqueID) +{ + /* generate the function's UniqueID */ + /* manual fixup required for duplicates */ + char NumVar; + char StrVar; + + assert (f != NULL); + assert (UniqueID != NULL); + + + NumVar = 'X'; + StrVar = 'A'; + + /* F_ */ + bwb_strcpy (UniqueID, "F_"); + /* NAME */ + bwb_strcat (UniqueID, f->Name); + /* PARAMETERS */ + if (f->ParameterCount == PNONE || f->ParameterCount == 0xFF) + { + /* function has NO explicit parameters */ + } + else + { + /* function HAS explicit parameters */ + int i; + ParamBitsType ParameterTypes; + ParameterTypes = f->ParameterTypes; + for (i = 0; i < f->ParameterCount; i++) + { + char VarName[NameLengthMax + 1]; + if (ParameterTypes & 1) + { + /* STRING */ + sprintf (VarName, "_%c", StrVar); + StrVar++; + } + else + { + /* NUMBER */ + sprintf (VarName, "_%c", NumVar); + NumVar++; + } + bwb_strcat (UniqueID, VarName); + ParameterTypes = ParameterTypes >> 1; + } + } + /* RETURN TYPE */ + if (f->ReturnTypeCode == StringTypeCode) + { + bwb_strcat (UniqueID, "_S"); + } + else + { + bwb_strcat (UniqueID, "_N"); + } + /* fixup illegal characters, "DEF FN" "BLOAD:", "CLOAD*" */ + FixUp (UniqueID); +} + + +void +IntrinsicFunctionSyntax (IntrinsicFunctionType * f, char *Syntax) +{ + /* generate the function's Syntax */ + char NumVar; + char StrVar; + + assert (f != NULL); + assert (Syntax != NULL); + + + NumVar = 'X'; + StrVar = 'A'; + + /* RETURN TYPE */ + if (f->ReturnTypeCode == StringTypeCode) + { + bwb_strcpy (Syntax, "S$ = "); + } + else + { + bwb_strcpy (Syntax, "N = "); + } + /* NAME */ + bwb_strcat (Syntax, f->Name); + /* PARAMETERS */ + if (f->ParameterCount == PNONE) + { + /* function has NO explicit parameters */ + } + else if (f->ParameterCount == 0xFF) + { + /* function has a variable number of parameters */ + bwb_strcat (Syntax, "( ... )"); + } + else + { + /* function HAS explicit parameters */ + int i; + ParamBitsType ParameterTypes; + ParameterTypes = f->ParameterTypes; + + if (f->ReturnTypeCode == StringTypeCode) + { + bwb_strcat (Syntax, "( "); + } + else + { + bwb_strcat (Syntax, "( "); + } + + for (i = 0; i < f->ParameterCount; i++) + { + char VarName[NameLengthMax + 1]; + if (i > 0) + { + bwb_strcat (Syntax, ", "); + } + /* verify parameter check */ + if (ParameterTypes & 1) + { + /* STRING */ + sprintf (VarName, "%c$", StrVar); + StrVar++; + } + else + { + /* NUMBER */ + sprintf (VarName, "%c", NumVar); + NumVar++; + } + bwb_strcat (Syntax, VarName); + ParameterTypes = ParameterTypes >> 1; + } + if (f->ReturnTypeCode == StringTypeCode) + { + bwb_strcat (Syntax, " )"); + } + else + { + bwb_strcat (Syntax, " )"); + } + } +} + +void +DumpAllFunctionUniqueID (FILE * file) +{ + /* for the C maintainer */ + int i; + int j; + char LastUniqueID[NameLengthMax + 1]; + + assert (file != NULL); + + j = 0; + LastUniqueID[0] = NulChar; + + fprintf (file, "/* FUNCTIONS */\n"); + for (i = 0; i < NUM_FUNCTIONS; i++) + { + char UniqueID[NameLengthMax + 1]; + + IntrinsicFunctionUniqueID (&(IntrinsicFunctionTable[i]), UniqueID); + if (bwb_stricmp (LastUniqueID, UniqueID) != 0) + { + /* not a duplicate */ + char Syntax[NameLengthMax + 1]; + + bwb_strcpy (LastUniqueID, UniqueID); + j = j + 1; + IntrinsicFunctionSyntax (&(IntrinsicFunctionTable[i]), Syntax); + fprintf (file, "#define %-30s %3d /* %-30s */\n", UniqueID, j, Syntax); + } + } + fprintf (file, "#define NUM_FUNCTIONS %d\n", j); + fflush (file); +} + +void +DumpAllFunctionSwitch (FILE * file) +{ + /* for the C maintainer */ + int i; + + assert (file != NULL); + + + fprintf (file, "/* SWITCH */\n"); + fprintf (file, "switch( UniqueID )\n"); + fprintf (file, "{\n"); + for (i = 0; i < NUM_FUNCTIONS; i++) + { + char tbuf[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpAllFunctionSwitch */ + + fprintf (file, "case "); + IntrinsicFunctionUniqueID (&(IntrinsicFunctionTable[i]), tbuf); + fprintf (file, tbuf); + fprintf (file, ":\n"); + fprintf (file, " break;\n"); + } + fprintf (file, "}\n"); + fflush (file); +} + +static const char *ParameterRangeID[16] = { + "P%dERR", + "P%dANY", + "P%dBYT", + "P%dINT", + "P%dLNG", + "P%dCUR", + "P%dFLT", + "P%dDBL", + "P%dDEV", + "P%dLEN", + "P%dPOS", + "P%dCOM", + "P%dLPT", + "P%dGTZ", + "P%dGEZ", + "P%dNEZ", +}; + +static const char *NumberVariableRange[16] = { + /* P1ERR */ " PARAMETER: %c is a number, INTERNAL ERROR", + /* P1ANY */ " PARAMETER: %c is a number", + /* P1BYT */ " PARAMETER: %c is a number, [0,255]", + /* P1INT */ " PARAMETER: %c is a number, [MININT,MAXINT]", + /* P1LNG */ " PARAMETER: %c is a number, [MINLNG,MAXLNG]", + /* P1CUR */ " PARAMETER: %c is a number, [MINCUR,MAXCUR]", + /* P1FLT */ " PARAMETER: %c is a number, [MINFLT,MAXFLT]", + /* P1DBL */ " PARAMETER: %c is a number, [MINDBL,MAXDBL]", + /* P1DEV */ " PARAMETER: %c is a number, RESERVED", + /* P1LEN */ " PARAMETER: %c is a number, [0,MAXLEN]", + /* P1POS */ " PARAMETER: %c is a number, [1,MAXLEN]", + /* P1COM */ " PARAMETER: %c is a number, RESERVED", + /* P1LPT */ " PARAMETER: %c is a number, RESERVED", + /* P1GTZ */ " PARAMETER: %c is a number, > 0", + /* P1GEZ */ " PARAMETER: %c is a number, >= 0", + /* P1NEZ */ " PARAMETER: %c is a number, <> 0", +}; + +static const char *StringVariableRange[16] = { + /* P1ERR */ " PARAMETER: %c$ is a string, INTERNAL ERROR", + /* P1ANY */ " PARAMETER: %c$ is a string, LEN >= 0", + /* P1BYT */ " PARAMETER: %c$ is a string, LEN >= 1", + /* P1INT */ " PARAMETER: %c$ is a string, LEN >= sizeof(INT)", + /* P1LNG */ " PARAMETER: %c$ is a string, LEN >= sizeof(LNG)", + /* P1CUR */ " PARAMETER: %c$ is a string, LEN >= sizeof(CUR)", + /* P1FLT */ " PARAMETER: %c$ is a string, LEN >= sizeof(FLT)", + /* P1DBL */ " PARAMETER: %c$ is a string, LEN >= sizeof(DBL)", + /* P1DEV */ " PARAMETER: %c$ is a string, RESERVED", + /* P1LEN */ " PARAMETER: %c$ is a string, RESERVED", + /* P1POS */ " PARAMETER: %c$ is a string, RESERVED", + /* P1COM */ " PARAMETER: %c$ is a string, RESERVED", + /* P1LPT */ " PARAMETER: %c$ is a string, RESERVED", + /* P1GTZ */ " PARAMETER: %c$ is a string, RESERVED", + /* P1GEZ */ " PARAMETER: %c$ is a string, RESERVED", + /* P1NEZ */ " PARAMETER: %c$ is a string, RESERVED", +}; + +void +DumpAllFuctionTableDefinitions (FILE * file) +{ + /* generate bwd_fun.c */ + int n; + + assert (file != NULL); + + + fprintf (file, "/* FUNCTION TABLE */\n"); + fprintf (file, "\n"); + fprintf (file, "#include \"bwbasic.h\"\n"); + fprintf (file, "\n"); + fprintf (file, + "IntrinsicFunctionType IntrinsicFunctionTable[ /* NUM_FUNCTIONS */ ] =\n"); + fprintf (file, "{\n"); + for (n = 0; n < NUM_FUNCTIONS; n++) + { + int i; + int j; + char tbuf[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpAllFuctionTableDefinitions */ + char UniqueID[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpAllFuctionTableDefinitions */ + char Syntax[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpAllFuctionTableDefinitions */ + IntrinsicFunctionType *f; + + f = &(IntrinsicFunctionTable[n]); + + IntrinsicFunctionUniqueID (f, UniqueID); + IntrinsicFunctionSyntax (f, Syntax); + fprintf (file, "{\n"); + fprintf (file, " %s, /* UniqueID */\n", UniqueID); + fprintf (file, " \"%s\", /* Syntax */\n", Syntax); + fprintf (file, " "); + fprintf (file, "\""); + ProcessEscapeChars (f->Description, tbuf); + fprintf (file, tbuf); + fprintf (file, "\""); + fprintf (file, ", /* Description */\n"); + fprintf (file, " \"%s\", /* Name */\n", f->Name); + switch (f->ReturnTypeCode) + { + case ByteTypeCode: + fprintf (file, " %s, /* ReturnTypeCode */\n", "ByteTypeCode"); + break; + case IntegerTypeCode: + fprintf (file, " %s, /* ReturnTypeCode */\n", "IntegerTypeCode"); + break; + case LongTypeCode: + fprintf (file, " %s, /* ReturnTypeCode */\n", "LongTypeCode"); + break; + case CurrencyTypeCode: + fprintf (file, " %s, /* ReturnTypeCode */\n", "CurrencyTypeCode"); + break; + case SingleTypeCode: + fprintf (file, " %s, /* ReturnTypeCode */\n", "SingleTypeCode"); + break; + case DoubleTypeCode: + fprintf (file, " %s, /* ReturnTypeCode */\n", "DoubleTypeCode"); + break; + case StringTypeCode: + fprintf (file, " %s, /* ReturnTypeCode */\n", "StringTypeCode"); + break; + default: + fprintf (file, " %s, /* ReturnTypeCode */\n", "INTERNAL ERROR"); + break; + } + fprintf (file, " %d, /* ParameterCount */\n", f->ParameterCount); + if (f->ParameterCount == 0 || f->ParameterCount == 0xFF) + { + /* function has NO explicit parameters */ + fprintf (file, " %s, /* ParameterTypes */\n", "PNONE"); + fprintf (file, " %s, /* ParameterTests */\n", "PNONE"); + } + else + { + /* function has explicit parameters */ + bwb_strcpy (tbuf, " "); + for (i = 0; i < f->ParameterCount; i++) + { + ParamBitsType ParameterTypes; + ParameterTypes = f->ParameterTypes >> i; + ParameterTypes &= 0x1; + if (i > 0) + { + bwb_strcat (tbuf, " | "); + } + if (ParameterTypes) + { + sprintf (bwb_strchr (tbuf, NulChar), "P%dSTR", i + 1); + } + else + { + sprintf (bwb_strchr (tbuf, NulChar), "P%dNUM", i + 1); + } + } + bwb_strcat (tbuf, ", /* ParameterTypes */\n"); + fprintf (file, tbuf); + + + bwb_strcpy (tbuf, " "); + for (i = 0; i < f->ParameterCount; i++) + { + ParamTestType ParameterTests; + ParameterTests = f->ParameterTests >> (i * 4); + ParameterTests &= 0xF; + + if (i > 0) + { + bwb_strcat (tbuf, " | "); + } + sprintf (bwb_strchr (tbuf, 0), ParameterRangeID[ParameterTests], + i + 1); + /* Conversion may lose significant digits */ + } + bwb_strcat (tbuf, ", /* ParameterTests */\n"); + fprintf (file, tbuf); + } + bwb_strcpy (tbuf, " "); + j = 0; + for (i = 0; i < NUM_VERSIONS; i++) + { + if (f->OptionVersionBitmask & bwb_vertable[i].OptionVersionValue) + { + if (j > 0) + { + bwb_strcat (tbuf, " | "); + } + bwb_strcat (tbuf, bwb_vertable[i].ID); + j++; + } + } + bwb_strcat (tbuf, " /* OptionVersionBitmask */\n"); + fprintf (file, tbuf); + fprintf (file, "},\n"); + } + fprintf (file, "};\n"); + fprintf (file, "\n"); + fprintf (file, + "const size_t NUM_FUNCTIONS = sizeof( IntrinsicFunctionTable ) / sizeof( IntrinsicFunctionType );\n"); + fprintf (file, "\n"); + fflush (file); +} + +void +DumpOneFunctionSyntax (FILE * file, int IsXref, int n) +{ + IntrinsicFunctionType *f; + assert (file != NULL); + + + + if (n < 0 || n >= NUM_FUNCTIONS) + { + return; + } + f = &(IntrinsicFunctionTable[n]); + /* NAME */ + { + char UniqueID[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpOneFunctionSyntax */ + char Syntax[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpOneFunctionSyntax */ + + IntrinsicFunctionUniqueID (f, UniqueID); + IntrinsicFunctionSyntax (f, Syntax); + fprintf (file, " SYNTAX: %s\n", Syntax); + } + /* PARAMETERS */ + if (f->ParameterCount == PNONE || f->ParameterCount == 0xFF) + { + /* function has NO explicit parameters */ + } + else + { + /* function HAS explicit parameters */ + int i; + ParamBitsType ParameterTypes; + ParamTestType ParameterTests; + char NumVar; + char StrVar; + ParameterTypes = f->ParameterTypes; + ParameterTests = f->ParameterTests; + NumVar = 'X'; + StrVar = 'A'; + for (i = 0; i < f->ParameterCount; i++) + { + /* sanity check this parameter */ + unsigned long thischeck; + char tbuf[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpOneFunctionSyntax */ + + thischeck = ParameterTests & 0x0000000F; + /* verify parameter check */ + if (ParameterTypes & 1) + { + /* STRING */ + sprintf (tbuf, StringVariableRange[thischeck], StrVar); + /* Conversion may lose significant digits */ + StrVar++; + } + else + { + /* NUMBER */ + sprintf (tbuf, NumberVariableRange[thischeck], NumVar); + /* Conversion may lose significant digits */ + NumVar++; + } + fprintf (file, tbuf); + fprintf (file, "\n"); + ParameterTypes = ParameterTypes >> 1; + ParameterTests = ParameterTests >> 4; + } + } + /* DESCRIPTION */ + { + FixDescription (file, "DESCRIPTION: ", f->Description); + } + /* COMPATIBILITY */ + if (IsXref) + { + int i; + fprintf (file, " VERSIONS:\n"); + for (i = 0; i < NUM_VERSIONS; i++) + { + char X; + if (f->OptionVersionBitmask & bwb_vertable[i].OptionVersionValue) + { + /* SUPPORTED */ + X = 'X'; + } + else + { + /* NOT SUPPORTED */ + X = '_'; + } + fprintf (file, " [%c] %s\n", X, bwb_vertable[i].Name); + } + } + + fflush (file); +} + +void +DumpAllFunctionSyntax (FILE * file, int IsXref, + OptionVersionType OptionVersionValue) +{ + /* for the C maintainer */ + int i; + + assert (file != NULL); + + + fprintf (file, + "============================================================\n"); + fprintf (file, + " FUNCTIONS \n"); + fprintf (file, + "============================================================\n"); + fprintf (file, "\n"); + fprintf (file, "\n"); + for (i = 0; i < NUM_FUNCTIONS; i++) + { + if (IntrinsicFunctionTable[i].OptionVersionBitmask & OptionVersionValue) + { + fprintf (file, + "------------------------------------------------------------\n"); + DumpOneFunctionSyntax (file, IsXref, i); + } + } + fprintf (file, + "------------------------------------------------------------\n"); + fprintf (file, "\n"); + fprintf (file, "\n"); + fflush (file); +} + +void +DumpAllFunctionHtmlTable (FILE * file) +{ + /* generate bwd_cmd.htm */ + int i; + int j; + + assert (file != NULL); + + + /* LEGEND */ + fprintf (file, "<html><head><title>FNCS</title></head><body>\n"); + fprintf (file, "<h1>LEGEND</h1><br>\n"); + fprintf (file, "<table>\n"); + + fprintf (file, "<tr>"); + fprintf (file, "<td>"); + fprintf (file, "<b>"); + fprintf (file, "ID"); + fprintf (file, "</b>"); + fprintf (file, "</td>"); + fprintf (file, "<td>"); + fprintf (file, "<b>"); + fprintf (file, "NAME"); + fprintf (file, "</b>"); + fprintf (file, "</td>"); + fprintf (file, "<td>"); + fprintf (file, "<b>"); + fprintf (file, "DESCRIPTION"); + fprintf (file, "</b>"); + fprintf (file, "</td>"); + fprintf (file, "</tr>\n"); + + for (j = 0; j < NUM_VERSIONS; j++) + { + fprintf (file, "<tr>"); + fprintf (file, "<td>"); + fprintf (file, bwb_vertable[j].ID); + fprintf (file, "</td>"); + fprintf (file, "<td>"); + fprintf (file, bwb_vertable[j].Name); + fprintf (file, "</td>"); + fprintf (file, "<td>"); + fprintf (file, bwb_vertable[j].Description); + fprintf (file, "</td>"); + fprintf (file, "</tr>\n"); + } + fprintf (file, "</table>\n"); + fprintf (file, "<hr>\n"); + + + /* DETAILS */ + fprintf (file, "<h1>DETAILS</h1><br>\n"); + fprintf (file, "<table>\n"); + + fprintf (file, "<tr>"); + fprintf (file, "<td>"); + fprintf (file, "<b>"); + fprintf (file, "FUNCTION"); + fprintf (file, "</b>"); + fprintf (file, "</td>"); + for (j = 0; j < NUM_VERSIONS; j++) + { + fprintf (file, "<td>"); + fprintf (file, "<b>"); + fprintf (file, bwb_vertable[j].ID); + fprintf (file, "</b>"); + fprintf (file, "</td>"); + } + fprintf (file, "</tr>\n"); + + + /* run through the command table and print comand -vs- OPTION VERSION */ + + for (i = 0; i < NUM_FUNCTIONS; i++) + { + fprintf (file, "<tr>"); + fprintf (file, "<td>"); + fprintf (file, (char *) IntrinsicFunctionTable[i].Syntax); + fprintf (file, "</td>"); + + for (j = 0; j < NUM_VERSIONS; j++) + { + fprintf (file, "<td>"); + if (IntrinsicFunctionTable[i].OptionVersionBitmask & bwb_vertable[j]. + OptionVersionValue) + { + fprintf (file, "X"); + } + else + { + fprintf (file, " "); + } + fprintf (file, "</td>"); + } + fprintf (file, "</tr>\n"); + } + fprintf (file, "</table>\n"); + fprintf (file, "</body></html>\n"); + fprintf (file, "\n"); + + fflush (file); +} + +/* +-------------------------------------------------------------------------------------------- + FNCS +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_FNCS (LineType * l) +{ + int n; + int t; + + assert (l != NULL); + assert( My != NULL ); + assert( My->SYSOUT != NULL ); + assert( My->SYSOUT->cfp != NULL ); + + + My->CurrentFile = My->SYSOUT; + fprintf (My->SYSOUT->cfp, "BWBASIC FUNCTIONS AVAILABLE:\n"); + + /* run through the command table and print comand names */ + + t = 0; + for (n = 0; n < NUM_FUNCTIONS; n++) + { + fprintf (My->SYSOUT->cfp, IntrinsicFunctionTable[n].Name); + if (t < 4) + { + fprintf (My->SYSOUT->cfp, "\t"); + t++; + } + else + { + fprintf (My->SYSOUT->cfp, "\n"); + t = 0; + } + } + if (t > 0) + { + fprintf (My->SYSOUT->cfp, "\n"); + } + ResetConsoleColumn (); + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + MAINTAINER +-------------------------------------------------------------------------------------------- +*/ +LineType * +bwb_MAINTAINER (LineType * l) +{ + + assert (l != NULL); + WARN_SYNTAX_ERROR; + return (l); +} + +LineType * +bwb_MAINTAINER_CMDS (LineType * l) +{ + + assert (l != NULL); + WARN_SYNTAX_ERROR; + return (l); +} + +LineType * +bwb_MAINTAINER_CMDS_HTML (LineType * l) +{ + + assert (l != NULL); + assert(My != NULL); + assert(My->SYSPRN != NULL); + assert(My->SYSPRN->cfp != NULL); + DumpAllCommandHtmlTable (My->SYSPRN->cfp); + return (l); +} + +LineType * +bwb_MAINTAINER_CMDS_ID (LineType * l) +{ + + assert (l != NULL); + assert(My != NULL); + assert(My->SYSPRN != NULL); + assert(My->SYSPRN->cfp != NULL); + DumpAllCommandUniqueID (My->SYSPRN->cfp); + return (l); +} + +LineType * +bwb_MAINTAINER_CMDS_MANUAL (LineType * l) +{ + + assert (l != NULL); + assert(My != NULL); + assert(My->SYSPRN != NULL); + assert(My->SYSPRN->cfp != NULL); + DumpAllCommandSyntax (My->SYSPRN->cfp, TRUE, (OptionVersionType)(-1)); + return (l); +} + +LineType * +bwb_MAINTAINER_CMDS_SWITCH (LineType * l) +{ + + assert (l != NULL); + assert(My != NULL); + assert(My->SYSPRN != NULL); + assert(My->SYSPRN->cfp != NULL); + DumpAllCommandSwitchStatement (My->SYSPRN->cfp); + return (l); +} + +LineType * +bwb_MAINTAINER_CMDS_TABLE (LineType * l) +{ + + assert (l != NULL); + assert(My != NULL); + assert(My->SYSPRN != NULL); + assert(My->SYSPRN->cfp != NULL); + DumpAllCommandTableDefinitions (My->SYSPRN->cfp); + return (l); +} + +LineType * +bwb_MAINTAINER_DEBUG (LineType * l) +{ + + assert (l != NULL); + WARN_SYNTAX_ERROR; + return (l); +} + +LineType * +bwb_MAINTAINER_DEBUG_ON (LineType * l) +{ + + assert (l != NULL); + return (l); +} + +LineType * +bwb_MAINTAINER_DEBUG_OFF (LineType * l) +{ + + assert (l != NULL); + return (l); +} + +LineType * +bwb_MAINTAINER_FNCS (LineType * l) +{ + + assert (l != NULL); + WARN_SYNTAX_ERROR; + return (l); +} + +LineType * +bwb_MAINTAINER_FNCS_HTML (LineType * l) +{ + + assert (l != NULL); + assert(My != NULL); + assert(My->SYSPRN != NULL); + assert(My->SYSPRN->cfp != NULL); + DumpAllFunctionHtmlTable (My->SYSPRN->cfp); + return (l); +} + +LineType * +bwb_MAINTAINER_FNCS_ID (LineType * l) +{ + + assert (l != NULL); + assert(My != NULL); + assert(My->SYSPRN != NULL); + assert(My->SYSPRN->cfp != NULL); + DumpAllFunctionUniqueID (My->SYSPRN->cfp); + return (l); +} + +LineType * +bwb_MAINTAINER_FNCS_MANUAL (LineType * l) +{ + + assert (l != NULL); + assert(My != NULL); + assert(My->SYSPRN != NULL); + assert(My->SYSPRN->cfp != NULL); + DumpAllFunctionSyntax (My->SYSPRN->cfp, TRUE, (OptionVersionType)(-1)); + DumpAllOperatorSyntax (My->SYSPRN->cfp, TRUE, (OptionVersionType)(-1)); + return (l); +} + +LineType * +bwb_MAINTAINER_FNCS_SWITCH (LineType * l) +{ + + assert (l != NULL); + assert(My != NULL); + assert(My->SYSPRN != NULL); + assert(My->SYSPRN->cfp != NULL); + DumpAllFunctionSwitch (My->SYSPRN->cfp); + return (l); +} + +LineType * +bwb_MAINTAINER_FNCS_TABLE (LineType * l) +{ + + assert (l != NULL); + assert(My != NULL); + assert(My->SYSPRN != NULL); + assert(My->SYSPRN->cfp != NULL); + DumpAllFuctionTableDefinitions (My->SYSPRN->cfp); + return (l); +} + +void +DumpHeader (FILE * file) +{ + char c; + + assert (file != NULL); + assert(My != NULL); + assert(My->CurrentVersion != NULL); + + fprintf (file, + "============================================================\n"); + fprintf (file, + " GENERAL \n"); + fprintf (file, + "============================================================\n"); + fprintf (file, "\n"); + fprintf (file, "\n"); + + fprintf (file, "OPTION VERSION \"%s\"\n", My->CurrentVersion->Name); + fprintf (file, "REM INTERNAL ID: %s\n", My->CurrentVersion->ID); + fprintf (file, "REM DESCRIPTION: %s\n", My->CurrentVersion->Description); + fprintf (file, "REM REFERENCE: %s\n", My->CurrentVersion->ReferenceTitle); + fprintf (file, "REM %s\n", + My->CurrentVersion->ReferenceAuthor); + fprintf (file, "REM %s\n", + My->CurrentVersion->ReferenceCopyright); + fprintf (file, "REM %s\n", My->CurrentVersion->ReferenceURL1); + fprintf (file, "REM %s\n", My->CurrentVersion->ReferenceURL2); + fprintf (file, "REM\n"); + + if (My->CurrentVersion->OptionFlags & (OPTION_STRICT_ON)) + { + fprintf (file, "OPTION STRICT ON\n"); + } + else + { + fprintf (file, "OPTION STRICT OFF\n"); + } + + if (My->CurrentVersion->OptionFlags & (OPTION_ANGLE_DEGREES)) + { + fprintf (file, "OPTION ANGLE DEGREES\n"); + } + else if (My->CurrentVersion->OptionFlags & (OPTION_ANGLE_GRADIANS)) + { + fprintf (file, "OPTION ANGLE GRADIANS\n"); + } + else + { + fprintf (file, "OPTION ANGLE RADIANS\n"); + } + + if (My->CurrentVersion->OptionFlags & (OPTION_BUGS_ON)) + { + fprintf (file, "OPTION BUGS ON\n"); + } + else + { + fprintf (file, "OPTION BUGS OFF\n"); + } + + if (My->CurrentVersion->OptionFlags & (OPTION_LABELS_ON)) + { + fprintf (file, "OPTION LABELS ON\n"); + } + else + { + fprintf (file, "OPTION LABELS OFF\n"); + } + + if (My->CurrentVersion->OptionFlags & (OPTION_COMPARE_TEXT)) + { + fprintf (file, "OPTION COMPARE TEXT\n"); + } + else + { + fprintf (file, "OPTION COMPARE BINARY\n"); + } + + if (My->CurrentVersion->OptionFlags & (OPTION_COVERAGE_ON)) + { + fprintf (file, "OPTION COVERAGE ON\n"); + } + else + { + fprintf (file, "OPTION COVERAGE OFF\n"); + } + + if (My->CurrentVersion->OptionFlags & (OPTION_TRACE_ON)) + { + fprintf (file, "OPTION TRACE ON\n"); + } + else + { + fprintf (file, "OPTION TRACE OFF\n"); + } + + if (My->CurrentVersion->OptionFlags & (OPTION_ERROR_GOSUB)) + { + fprintf (file, "OPTION ERROR GOSUB\n"); + } + else + { + fprintf (file, "OPTION ERROR GOTO\n"); + } + + if (My->CurrentVersion->OptionFlags & (OPTION_EXPLICIT_ON)) + { + fprintf (file, "OPTION EXPLICIT\n"); + } + else + { + fprintf (file, "OPTION IMPLICIT\n"); + } + + fprintf (file, "OPTION BASE %d\n", + My->CurrentVersion->OptionBaseInteger); + fprintf (file, "OPTION RECLEN %d\n", + My->CurrentVersion->OptionReclenInteger); + fprintf (file, "OPTION DATE \"%s\"\n", + My->CurrentVersion->OptionDateFormat); + fprintf (file, "OPTION TIME \"%s\"\n", + My->CurrentVersion->OptionTimeFormat); + + c = My->CurrentVersion->OptionStringChar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION PUNCT STRING \"%c\"\n", c); + + c = My->CurrentVersion->OptionDoubleChar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION PUNCT DOUBLE \"%c\"\n", c); + + c = My->CurrentVersion->OptionSingleChar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION PUNCT SINGLE \"%c\"\n", c); + + c = My->CurrentVersion->OptionCurrencyChar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION PUNCT CURRENCY \"%c\"\n", c); + + c = My->CurrentVersion->OptionLongChar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION PUNCT LONG \"%c\"\n", c); + + c = My->CurrentVersion->OptionIntegerChar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION PUNCT INTEGER \"%c\"\n", c); + + c = My->CurrentVersion->OptionByteChar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION PUNCT BYTE \"%c\"\n", c); + + c = My->CurrentVersion->OptionQuoteChar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION PUNCT QUOTE \"%c\"\n", c); + + c = My->CurrentVersion->OptionCommentChar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION PUNCT COMMENT \"%c\"\n", c); + + c = My->CurrentVersion->OptionStatementChar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION PUNCT STATEMENT \"%c\"\n", c); + + c = My->CurrentVersion->OptionPrintChar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION PUNCT PRINT \"%c\"\n", c); + + c = My->CurrentVersion->OptionInputChar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION PUNCT INPUT \"%c\"\n", c); + + c = My->CurrentVersion->OptionImageChar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION PUNCT IMAGE \"%c\"\n", c); + + c = My->CurrentVersion->OptionLparenChar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION PUNCT LPAREN \"%c\"\n", c); + + c = My->CurrentVersion->OptionRparenChar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION PUNCT RPAREN \"%c\"\n", c); + + c = My->CurrentVersion->OptionFilenumChar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION PUNCT FILENUM \"%c\"\n", c); + + c = My->CurrentVersion->OptionAtChar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION PUNCT AT \"%c\"\n", c); + + c = My->CurrentVersion->OptionUsingDigit; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION USING DIGIT \"%c\"\n", c); + + c = My->CurrentVersion->OptionUsingComma; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION USING COMMA \"%c\"\n", c); + + c = My->CurrentVersion->OptionUsingPeriod; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION USING PERIOD \"%c\"\n", c); + + c = My->CurrentVersion->OptionUsingPlus; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION USING PLUS \"%c\"\n", c); + + c = My->CurrentVersion->OptionUsingMinus; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION USING MINUS \"%c\"\n", c); + + c = My->CurrentVersion->OptionUsingExrad; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION USING EXRAD \"%c\"\n", c); + + c = My->CurrentVersion->OptionUsingDollar; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION USING DOLLAR \"%c\"\n", c); + + c = My->CurrentVersion->OptionUsingFiller; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION USING FILLER \"%c\"\n", c); + + c = My->CurrentVersion->OptionUsingLiteral; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION USING LITERAL \"%c\"\n", c); + + c = My->CurrentVersion->OptionUsingFirst; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION USING FIRST \"%c\"\n", c); + + c = My->CurrentVersion->OptionUsingAll; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION USING ALL \"%c\"\n", c); + + c = My->CurrentVersion->OptionUsingLength; + if (!bwb_isgraph (c)) + { + c = ' '; + }; + fprintf (file, "OPTION USING LENGTH \"%c\"\n", c); + + fprintf (file, "\n"); + fprintf (file, "\n"); + fflush (file); +} + +LineType * +bwb_MAINTAINER_MANUAL (LineType * l) +{ + + assert (l != NULL); + + DumpHeader (My->SYSPRN->cfp); + DumpAllCommandSyntax (My->SYSPRN->cfp, FALSE, + My->CurrentVersion->OptionVersionValue); + DumpAllFunctionSyntax (My->SYSPRN->cfp, FALSE, + My->CurrentVersion->OptionVersionValue); + DumpAllOperatorSyntax (My->SYSPRN->cfp, FALSE, + My->CurrentVersion->OptionVersionValue); + return (l); +} + +LineType * +bwb_MAINTAINER_STACK (LineType * l) +{ + /* + dump the current execution stack, + Leftmost is the top, + Rigthmost is the bottom. + */ + StackType *StackItem; + + assert (l != NULL); + + for (StackItem = My->StackHead; StackItem != NULL; + StackItem = StackItem->next) + { + LineType *l; + + l = StackItem->line; + if (l != NULL) + { + fprintf (My->SYSOUT->cfp, "%d:", l->number); + } + } + fprintf (My->SYSOUT->cfp, "\n"); + ResetConsoleColumn (); + return (l); +} + + +/*************************************************************** + + FUNCTION: IntrinsicFunction_init() + + DESCRIPTION: This command initializes the function + linked list, placing all predefined functions + in the list. + +***************************************************************/ + +int +IntrinsicFunction_init (void) +{ + int n; + + + for (n = 0; n < NUM_FUNCTIONS; n++) + { + IntrinsicFunctionDefinitionCheck (&(IntrinsicFunctionTable[n])); + } + return TRUE; +} + + + +VariableType * +IntrinsicFunction_deffn (int argc, VariableType * argv, UserFunctionType * f) +{ + /* + The generic handler for user defined functions. + When called by exp_function(), f->id will be set to the line number of a specific DEF USR. + */ + VariableType *v; + VariableType *argn; + int i; + LineType *call_line; + StackType *save_elevel; + + assert (argc >= 0); + assert (argv != NULL); + assert (f != NULL); + assert(My != NULL); + + /* initialize the variable if necessary */ + + /* these errors should not occur */ + if (f == NULL) + { + WARN_INTERNAL_ERROR; + return NULL; + } + if (f->line == NULL) + { + WARN_INTERNAL_ERROR; + return NULL; + } + if (argv == NULL) + { + WARN_INTERNAL_ERROR; + return NULL; + } + if (f->ParameterCount == 0xFF) + { + /* VARIANT */ + } + else if (argc != f->ParameterCount) + { + WARN_INTERNAL_ERROR; + return NULL; + } + if (f->ParameterCount == 0xFF) + { + /* VARIANT */ + f->local_variable = argv; + } + else if (argc > 0) + { + v = f->local_variable; + argn = argv; + for (i = 0; i < argc; i++) + { + argn = argn->next; + if (v == NULL) + { + WARN_INTERNAL_ERROR; + return NULL; + } + if (argn == NULL) + { + WARN_INTERNAL_ERROR; + return NULL; + } + if (VAR_IS_STRING (v) != VAR_IS_STRING (argn)) + { + WARN_INTERNAL_ERROR; + return NULL; + } + if (is_empty_string (v->name) == FALSE) + { + int IsError; + IsError = 0; + switch (v->VariableTypeCode) + { + case ByteTypeCode: + IsError = NumberValueCheck (P1BYT, PARAM_NUMBER); + break; + case IntegerTypeCode: + IsError = NumberValueCheck (P1INT, PARAM_NUMBER); + break; + case LongTypeCode: + IsError = NumberValueCheck (P1LNG, PARAM_NUMBER); + break; + case CurrencyTypeCode: + IsError = NumberValueCheck (P1CUR, PARAM_NUMBER); + break; + case SingleTypeCode: + IsError = NumberValueCheck (P1FLT, PARAM_NUMBER); + break; + case DoubleTypeCode: + IsError = NumberValueCheck (P1DBL, PARAM_NUMBER); + break; + case StringTypeCode: + IsError = StringLengthCheck (P1ANY, PARAM_LENGTH); + break; + default: + WARN_TYPE_MISMATCH; + return NULL; + } + if (IsError != 0) + { + WARN_ILLEGAL_FUNCTION_CALL; + return argv; + } + } + v = v->next; + } + } + /* OK */ + call_line = f->line; /* line to call for function */ + call_line->position = f->startpos; + + if (call_line->cmdnum == C_DEF) + { + if (line_skip_EqualChar (call_line) == FALSE) + { + WARN_INTERNAL_ERROR; + return NULL; + } + } +/* PUSH STACK */ + + save_elevel = My->StackHead; + if (bwb_incexec ()) + { + /* OK */ + My->StackHead->line = call_line; + My->StackHead->ExecCode = EXEC_FUNCTION; + } + else + { + /* ERROR */ + WARN_OUT_OF_MEMORY; + return NULL; + } + + + /* create variable chain */ + if (f->ParameterCount == 0xFF) + { + /* VARIANT */ + } + else if (argc > 0) + { + VariableType *source = NULL; /* source variable */ + source = f->local_variable; + argn = argv; + for (i = 0; i < argc; i++) + { + argn = argn->next; + /* copy the name */ + bwb_strcpy (argn->name, source->name); + + if (VAR_IS_STRING (source)) + { + } + else + { + int IsError; + double Value; + VariantType variant; + CLEAR_VARIANT (&variant); + + if (var_get (argn, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return NULL; + } + if (variant.VariantTypeCode == StringTypeCode) + { + WARN_TYPE_MISMATCH; + return NULL; + } + Value = variant.Number; + IsError = 0; + switch (source->VariableTypeCode) + { + case ByteTypeCode: + IsError = NumberValueCheck (P1BYT, Value); + Value = bwb_rint (Value); + break; + case IntegerTypeCode: + IsError = NumberValueCheck (P1INT, Value); + Value = bwb_rint (Value); + break; + case LongTypeCode: + IsError = NumberValueCheck (P1LNG, Value); + Value = bwb_rint (Value); + break; + case CurrencyTypeCode: + IsError = NumberValueCheck (P1CUR, Value); + Value = bwb_rint (Value); + break; + case SingleTypeCode: + IsError = NumberValueCheck (P1FLT, Value); + break; + case DoubleTypeCode: + IsError = NumberValueCheck (P1DBL, Value); + break; + case StringTypeCode: + WARN_TYPE_MISMATCH; + return NULL; + /* break; */ + default: + WARN_TYPE_MISMATCH; + return NULL; + } + if (IsError != 0) + { + WARN_ILLEGAL_FUNCTION_CALL; + return argv; + } + variant.Number = Value; + if (var_set (argn, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return NULL; + } + } + source = source->next; + } + } + if (call_line->cmdnum == C_DEF) + { + VariantType x; + VariantType *X; + + X = &x; + CLEAR_VARIANT (X); + /* the function return variable is hidden */ + My->StackHead->local_variable = argv->next; + /* var_islocal() uses the LoopTopLine to find local variables */ + My->StackHead->LoopTopLine = call_line; /* FUNCTION, SUB */ + + /* evaluate the expression */ + if (line_read_expression (call_line, X) == FALSE) /* IntrinsicFunction_deffn */ + { + WARN_SYNTAX_ERROR; + goto EXIT; + } + + /* save the value */ + switch (X->VariantTypeCode) + { + case ByteTypeCode: + case IntegerTypeCode: + case LongTypeCode: + case CurrencyTypeCode: + case SingleTypeCode: + case DoubleTypeCode: + if (argv->VariableTypeCode == StringTypeCode) + { + WARN_TYPE_MISMATCH; + goto EXIT; + } + /* OK */ + { + int IsError; + double Value; + + IsError = 0; + Value = X->Number; + /* VerifyNumeric */ + if (isnan (Value)) + { + /*** FATAL - INTERNAL ERROR - SHOULD NEVER HAPPEN ***/ + WARN_INTERNAL_ERROR; + return FALSE; + } + if (isinf (Value)) + { + /* - Evaluation of an expression results in an overflow + * (nonfatal, the recommended recovery procedure is to supply + * machine in- finity with the algebraically correct sign and + * continue). */ + if (Value < 0) + { + Value = MINDBL; + } + else + { + Value = MAXDBL; + } + if (WARN_OVERFLOW) + { + /* ERROR */ + goto EXIT; + } + /* CONTINUE */ + } + /* OK */ + switch (argv->VariableTypeCode) + { + case ByteTypeCode: + IsError = NumberValueCheck (P1BYT, Value); + Value = bwb_rint (Value); + break; + case IntegerTypeCode: + IsError = NumberValueCheck (P1INT, Value); + Value = bwb_rint (Value); + break; + case LongTypeCode: + IsError = NumberValueCheck (P1LNG, Value); + Value = bwb_rint (Value); + break; + case CurrencyTypeCode: + IsError = NumberValueCheck (P1CUR, Value); + Value = bwb_rint (Value); + break; + case SingleTypeCode: + IsError = NumberValueCheck (P1FLT, Value); + break; + case DoubleTypeCode: + IsError = NumberValueCheck (P1DBL, Value); + break; + default: + WARN_TYPE_MISMATCH; + goto EXIT; + /* break; */ + } + if (IsError != 0) + { + if (WARN_OVERFLOW) + { + /* ERROR */ + goto EXIT; + } + /* CONTINUE */ + } + /* assign Value */ + RESULT_NUMBER = Value; + } + break; + case StringTypeCode: + if (argv->VariableTypeCode != StringTypeCode) + { + WARN_TYPE_MISMATCH; + goto EXIT; + } + /* OK */ + if (RESULT_BUFFER != My->MaxLenBuffer) + { + WARN_INTERNAL_ERROR; + goto EXIT; + } + if (X->Length > MAXLEN) + { + WARN_STRING_TOO_LONG; /* IntrinsicFunction_deffn */ + X->Length = MAXLEN; + } + bwb_memcpy (RESULT_BUFFER, X->Buffer, X->Length); + RESULT_LENGTH = X->Length; + break; + default: + WARN_TYPE_MISMATCH; + goto EXIT; + /* break; */ + } + EXIT: + RELEASE_VARIANT (X); + + + /* break variable chain */ + My->StackHead->local_variable = NULL; + + + +/* POP STACK */ + bwb_decexec (); + + } + else + { + /* the function return variable is visible */ + My->StackHead->local_variable = argv; + /* var_islocal() uses the LoopTopLine to find local variables */ + My->StackHead->LoopTopLine = call_line; /* FUNCTION, SUB */ + /* execute until function returns */ + while (My->StackHead != save_elevel) + { + bwb_execline (); + } + } + + if (f->ParameterCount == 0xFF) + { + /* VARIANT */ + f->local_variable = NULL; + } + + if (is_empty_string (argv->name) == FALSE) + { + int IsError; + + IsError = 0; + switch (argv->VariableTypeCode) + { + case ByteTypeCode: + IsError = NumberValueCheck (P1BYT, RESULT_NUMBER); + break; + case IntegerTypeCode: + IsError = NumberValueCheck (P1INT, RESULT_NUMBER); + break; + case LongTypeCode: + IsError = NumberValueCheck (P1LNG, RESULT_NUMBER); + break; + case CurrencyTypeCode: + IsError = NumberValueCheck (P1CUR, RESULT_NUMBER); + break; + case SingleTypeCode: + IsError = NumberValueCheck (P1FLT, RESULT_NUMBER); + break; + case DoubleTypeCode: + IsError = NumberValueCheck (P1DBL, RESULT_NUMBER); + break; + case StringTypeCode: + IsError = StringLengthCheck (P1ANY, RESULT_LENGTH); + break; + default: + /* no check */ + break; + } + if (IsError != 0) + { + if (WARN_OVERFLOW) + { + /* ERROR */ + } + /* CONTINUE */ + } + } + return argv; +} + +/*************************************************************** + + FUNCTION: IntrinsicFunction_find() + + DESCRIPTION: This C function attempts to locate + a BASIC function with the specified name. + If successful, it returns a pointer to + the C structure for the BASIC function, + if not successful, it returns NULL. + +***************************************************************/ + +extern int +IntrinsicFunction_name (char *name) +{ + /* search INTRINSIC functions */ + IntrinsicFunctionType *f; + int i; + + assert (name != NULL); + assert(My != NULL); + assert(My->CurrentVersion != NULL); + + +#if THE_PRICE_IS_RIGHT + /* start with the closest function, without going over */ + i = VarTypeIndex (name[0]); + if (i < 0) + { + /* non-alpha */ + return FALSE; + } + i = My->IntrinsicFunctionStart[i]; /* first function starting with this letter */ + if (i < 0) + { + /* NOT FOUND */ + return FALSE; + } +#else /* THE_PRICE_IS_RIGHT */ + i = 0; +#endif /* THE_PRICE_IS_RIGHT */ + for (; i < NUM_FUNCTIONS; i++) + { + f = &IntrinsicFunctionTable[i]; + if (My->CurrentVersion->OptionVersionValue & f->OptionVersionBitmask) + { + int result; + + result = bwb_stricmp (f->Name, name); + + if (result == 0) + { + /* FOUND */ + return TRUE; + } + if (result > 0 /* found > searched */ ) + { + /* NOT FOUND */ + return FALSE; + } + } + } + /* NOT FOUND */ + return FALSE; +} + + +IntrinsicFunctionType * +IntrinsicFunction_find_exact (char *name, int ParameterCount, + ParamBitsType ParameterTypes) +{ + IntrinsicFunctionType *f; + int i; + + assert (name != NULL); + assert(My != NULL); + assert(My->CurrentVersion != NULL); + + /* search INTRINSIC functions */ +#if THE_PRICE_IS_RIGHT + /* start with the closest function, without going over */ + i = VarTypeIndex (name[0]); + if (i < 0) + { + /* non-alpha */ + return NULL; + } + i = My->IntrinsicFunctionStart[i]; /* first function starting with this letter */ + if (i < 0) + { + /* NOT FOUND */ + return NULL; + } +#else /* THE_PRICE_IS_RIGHT */ + i = 0; +#endif /* THE_PRICE_IS_RIGHT */ + for (; i < NUM_FUNCTIONS; i++) + { + f = &IntrinsicFunctionTable[i]; + if (My->CurrentVersion->OptionVersionValue & f->OptionVersionBitmask) + { + if (f->ParameterCount == ParameterCount) + { + if (f->ParameterTypes == ParameterTypes) + { + int result; + + result = bwb_stricmp (f->Name, name); + + if (result == 0) + { + /* FOUND */ + return f; + } + if (result > 0 /* found > searched */ ) + { + /* NOT FOUND */ + return NULL; + } + } + } + } + } + /* NOT FOUND */ + return NULL; +} + +static VariableType * +find_variable_by_type (char *name, int dimensions, char VariableTypeCode) +{ + VariableType *v = NULL; + + assert (name != NULL); + + v = var_find (name, dimensions, FALSE); + if (v) + { + if (VAR_IS_STRING (v)) + { + if (VariableTypeCode == StringTypeCode) + { + /* found */ + return v; + } + } + else + { + if (VariableTypeCode != StringTypeCode) + { + /* found */ + return v; + } + } + } + /* not found */ + return NULL; +} + +/* +-------------------------------------------------------------------------------------------- + CHANGE +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_CHANGE (LineType * l) +{ + /* SYNTAX: CHANGE A$ TO X */ + /* SYNTAX: CHANGE X TO A$ */ + char varname[NameLengthMax + 1]; + VariableType *v; + VariableType *A; + VariableType *X; + int IsStringToArray; + + assert (l != NULL); + + v = NULL; + A = NULL; + X = NULL; + IsStringToArray = FALSE; + + /* get 1st variable */ + if (line_read_varname (l, varname) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + + v = find_variable_by_type (varname, 0, StringTypeCode); + if (v) + { + /* STRING to ARRAY */ + A = v; + IsStringToArray = TRUE; + } + else + { + /* ARRAY to STRING */ + v = find_variable_by_type (varname, 1, DoubleTypeCode); + if (v) + { + X = v; + IsStringToArray = FALSE; + } + } + if (v == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + + /* get "TO" */ + if (line_skip_word (l, "TO") == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + /* get 2nd variable */ + if (line_read_varname (l, varname) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + + if (IsStringToArray) + { + /* STRING to ARRAY */ + v = find_variable_by_type (varname, 1, DoubleTypeCode); + if (v == NULL) + { + v = var_find (varname, 1, TRUE); + } + if (v) + { + X = v; + } + } + else + { + /* ARRAY to STRING */ + v = find_variable_by_type (varname, 0, StringTypeCode); + if (v == NULL) + { + v = var_find (varname, 0, TRUE); + } + if (v) + { + A = v; + } + } + + if (v == NULL) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + assert(A != NULL); + assert(X != NULL); + if (IsStringToArray) + { + /* CHANGE A$ TO X */ + int i; + int n; + char *a; + DoubleType *x; + unsigned long t; + + if (A->Value.String == NULL) + { + WARN_INTERNAL_ERROR; + return (l); + } + if (A->Value.String->sbuffer == NULL) + { + WARN_INTERNAL_ERROR; + return (l); + } + /* variable storage is a mess, we bypass that tradition here. */ + t = 1; + for (n = 0; n < X->dimensions; n++) + { + t *= X->UBOUND[n] - X->LBOUND[n] + 1; + } + if (t <= A->Value.String->length) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + n = A->Value.String->length; + a = A->Value.String->sbuffer; + x = X->Value.Number; + *x = n; + x++; + for (i = 0; i < n; i++) + { + char C; + DoubleType V; + + C = *a; + V = C; + *x = V; + x++; + a++; + } + } + else + { + /* CHANGE X TO A$ */ + int i; + int n; + char *a; + DoubleType *x; + unsigned long t; + + /* variable storage is a mess, we bypass that tradition here. */ + t = 1; + for (n = 0; n < X->dimensions; n++) + { + t *= X->UBOUND[n] - X->LBOUND[n] + 1; + } + if (t <= 1) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + if (t > MAXLEN) + { + WARN_STRING_TOO_LONG; /* bwb_CHANGE */ + t = MAXLEN; + } + if (A->Value.String == NULL) + { + if ((A->Value.String = + (StringType *) calloc (1, sizeof (StringType))) == NULL) + { + WARN_OUT_OF_MEMORY; + return (l); + } + A->Value.String->sbuffer = NULL; + A->Value.String->length = 0; + } + if (A->Value.String->sbuffer != NULL) + { + free (A->Value.String->sbuffer); + A->Value.String->sbuffer = NULL; + A->Value.String->length = 0; + } + if (A->Value.String->sbuffer == NULL) + { + A->Value.String->length = 0; + if ((A->Value.String->sbuffer = + (char *) calloc (t + 1 /* NulChar */ , sizeof (char))) == NULL) + { + WARN_OUT_OF_MEMORY; + return (l); + } + } + a = A->Value.String->sbuffer; + x = X->Value.Number; + n = (int) bwb_rint (*x); + if (n > MAXLEN) + { + WARN_STRING_TOO_LONG; /* bwb_CHANGE */ + n = MAXLEN; + } + A->Value.String->length = n; + x++; + for (i = 0; i < n; i++) + { + char C; + DoubleType V; + + V = *x; + C = V; + *a = C; + x++; + a++; + } + } + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + CONSOLE +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_CONSOLE (LineType * l) +{ + /* SYNTAX: CONSOLE */ + /* SYNTAX: CONSOLE WIDTH width */ + + assert (l != NULL); + assert(My != NULL); + assert(My->SYSPRN != NULL); + assert(My->SYSPRN->cfp != NULL); + assert(My->SYSOUT != NULL); + assert(My->SYSOUT->cfp != NULL); + + + if (My->IsPrinter == TRUE) + { + /* reset printer column */ + if (My->SYSPRN->col != 1) + { + fputc ('\n', My->SYSPRN->cfp); + My->SYSPRN->col = 1; + } + My->IsPrinter = FALSE; + } + if (line_skip_word (l, "WIDTH")) + { + int width; + + width = 0; + if (line_read_integer_expression (l, &width) == FALSE) + { + WARN_ILLEGAL_FUNCTION_CALL; + return (l); + } + if (width < 0) + { + WARN_ILLEGAL_FUNCTION_CALL; + return (l); + } + My->SYSOUT->width = width; + } + + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + LPRINTER +-------------------------------------------------------------------------------------------- +*/ + + +LineType * +bwb_LPRINTER (LineType * l) +{ + /* SYNTAX: LPRINTER */ + /* SYNTAX: LPRINTER WIDTH width */ + + assert (l != NULL); + assert(My != NULL); + assert(My->SYSPRN != NULL); + assert(My->SYSPRN->cfp != NULL); + assert(My->SYSOUT != NULL); + assert(My->SYSOUT->cfp != NULL); + + + if (My->IsPrinter == FALSE) + { + /* reset console column */ + if (My->SYSOUT->col != 1) + { + fputc ('\n', My->SYSOUT->cfp); + My->SYSOUT->col = 1; + } + My->IsPrinter = TRUE; + } + if (line_skip_word (l, "WIDTH")) + { + int width; + + width = 0; + if (line_read_integer_expression (l, &width) == FALSE) + { + WARN_ILLEGAL_FUNCTION_CALL; + return (l); + } + if (width < 0) + { + WARN_ILLEGAL_FUNCTION_CALL; + return (l); + } + My->SYSPRN->width = width; + } + return (l); +} + +extern void +bwb_fclose (FILE * file) +{ + if (file == NULL) + { + /* don't close */ + } + else if (file == stdin) + { + /* don't close */ + } + else if (file == stdout) + { + /* don't close */ + } + else if (file == stderr) + { + /* don't close */ + } + else + { + fclose (file); + } +} +LineType * +bwb_LPT (LineType * l) +{ + /* SYNTAX: LPT */ + /* SYNTAX: LPT filename$ */ + FILE *file; + char *filename; + + assert (l != NULL); + assert(My != NULL); + assert(My->SYSOUT != NULL); + assert(My->SYSOUT->cfp != NULL); + + + file = NULL; + filename = NULL; + if (line_is_eol (l)) + { + /* OK */ + file = stderr; + } + else if (line_read_string_expression (l, &filename)) + { + /* OK */ + if (is_empty_string (filename)) + { + WARN_BAD_FILE_NAME; + return (l); + } + file = fopen (filename, "w"); + free (filename); + } + else + { + WARN_SYNTAX_ERROR; + return (l); + } + if (file == NULL) + { + WARN_BAD_FILE_NAME; + return (l); + } + bwb_fclose (My->SYSOUT->cfp); + My->SYSOUT->cfp = file; + return (l); +} + +LineType * +bwb_PTP (LineType * l) +{ + /* SYNTAX: PTP */ + /* SYNTAX: PTP filename$ */ + FILE *file; + char *filename; + + assert (l != NULL); + assert(My != NULL); + assert(My->SYSOUT != NULL); + assert(My->SYSOUT->cfp != NULL); + + file = NULL; + filename = NULL; + if (line_is_eol (l)) + { + /* OK */ + file = fopen ("PTP", "w"); + } + else if (line_read_string_expression (l, &filename)) + { + /* OK */ + if (is_empty_string (filename)) + { + WARN_BAD_FILE_NAME; + return (l); + } + file = fopen (filename, "w"); + free (filename); + } + else + { + WARN_SYNTAX_ERROR; + return (l); + } + if (file == NULL) + { + WARN_BAD_FILE_NAME; + return (l); + } + bwb_fclose (My->SYSOUT->cfp); + My->SYSOUT->cfp = file; + return (l); +} + +LineType * +bwb_PTR (LineType * l) +{ + /* SYNTAX: PTR */ + /* SYNTAX: PTR filename$ */ + FILE *file; + char *filename; + + assert (l != NULL); + assert(My != NULL); + assert(My->SYSIN != NULL); + assert(My->SYSIN->cfp != NULL); + + file = NULL; + filename = NULL; + if (line_is_eol (l)) + { + /* OK */ + file = fopen ("PTR", "r"); + } + else if (line_read_string_expression (l, &filename)) + { + /* OK */ + if (is_empty_string (filename)) + { + WARN_BAD_FILE_NAME; + return (l); + } + file = fopen (filename, "r"); + free (filename); + } + else + { + WARN_SYNTAX_ERROR; + return (l); + } + if (file == NULL) + { + WARN_BAD_FILE_NAME; + return (l); + } + bwb_fclose (My->SYSIN->cfp); + My->SYSIN->cfp = file; + return (l); +} + +LineType * +bwb_TTY (LineType * l) +{ + /* SYNTAX: TTY */ + assert (l != NULL); + + bwb_TTY_IN (l); + bwb_TTY_OUT (l); + return (l); +} + +LineType * +bwb_TTY_IN (LineType * l) +{ + /* SYNTAX: TTY IN */ + assert (l != NULL); + assert(My != NULL); + assert(My->SYSIN != NULL); + assert(My->SYSIN->cfp != NULL); + + bwb_fclose (My->SYSIN->cfp); + My->SYSIN->cfp = stdin; + return (l); +} + +LineType * +bwb_TTY_OUT (LineType * l) +{ + /* SYNTAX: TTY OUT */ + assert (l != NULL); + assert(My != NULL); + assert(My->SYSOUT != NULL); + assert(My->SYSOUT->cfp != NULL); + + bwb_fclose (My->SYSOUT->cfp); + My->SYSOUT->cfp = stdout; + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + CREATE +-------------------------------------------------------------------------------------------- +*/ + +LineType * +bwb_CREATE (LineType * l) +{ + /* SYNTAX: CREATE filename$ [ RECL reclen ] AS filenum [ BUFF number ] [ RECS size ] */ + int FileNumber; + int width; + int buffnum; + int recsnum; + char *filename; + + assert (l != NULL); + assert(My != NULL); + + + FileNumber = 0; + width = 0; + buffnum = 0; + recsnum = 0; + filename = NULL; + if (line_read_string_expression (l, &filename) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (is_empty_string (filename)) + { + WARN_BAD_FILE_NAME; + return (l); + } + if (line_skip_word (l, "RECL")) + { + if (line_read_integer_expression (l, &width) == FALSE) + { + WARN_FIELD_OVERFLOW; + return (l); + } + if (width <= 0) + { + WARN_FIELD_OVERFLOW; + return (l); + } + } + if (line_skip_word (l, "AS") == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_integer_expression (l, &FileNumber) == FALSE) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + if (FileNumber <= 0) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + if (line_skip_word (l, "BUFF")) + { + if (line_read_integer_expression (l, &buffnum) == FALSE) + { + WARN_FIELD_OVERFLOW; + return (l); + } + if (buffnum <= 0) + { + WARN_FIELD_OVERFLOW; + return (l); + } + } + if (line_skip_word (l, "RECS")) + { + if (line_read_integer_expression (l, &recsnum) == FALSE) + { + WARN_FIELD_OVERFLOW; + return (l); + } + if (recsnum <= 0) + { + WARN_FIELD_OVERFLOW; + return (l); + } + } + /* now, we are ready to create the file */ + My->CurrentFile = find_file_by_number (FileNumber); + if (My->CurrentFile == NULL) + { + My->CurrentFile = file_new (); + My->CurrentFile->FileNumber = FileNumber; + } + if (My->CurrentFile->FileName != NULL) + { + free (My->CurrentFile->FileName); + My->CurrentFile->FileName = NULL; + } + My->CurrentFile->FileName = filename; + filename = NULL; + if (My->CurrentFile->DevMode != DEVMODE_CLOSED) + { + My->CurrentFile->DevMode = DEVMODE_CLOSED; + } + if (My->CurrentFile->cfp != NULL) + { + bwb_fclose (My->CurrentFile->cfp); + My->CurrentFile->cfp = NULL; + } + if (My->CurrentFile->buffer != NULL) + { + free (My->CurrentFile->buffer); + My->CurrentFile->buffer = NULL; + } + My->CurrentFile->width = 0; + My->CurrentFile->col = 1; + My->CurrentFile->row = 1; + My->CurrentFile->delimit = ','; + /* truncate to zero length or create text file for update (reading and writing) */ + if (is_empty_string (My->CurrentFile->FileName)) + { + WARN_BAD_FILE_NAME; + return (l); + } + if ((My->CurrentFile->cfp = + fopen (My->CurrentFile->FileName, "w+")) == NULL) + { + WARN_BAD_FILE_NAME; + return (l); + } + if (width > 0) + { + My->CurrentFile->width = width; + My->CurrentFile->DevMode = DEVMODE_RANDOM; + } + else + { + My->CurrentFile->DevMode = DEVMODE_INPUT | DEVMODE_OUTPUT; + } + return (l); +} + +/* +-------------------------------------------------------------------------------------------- + COPY +-------------------------------------------------------------------------------------------- +*/ + +static void +bwb_copy_file (char *Source, char *Target) +{ + FILE *source; + FILE *target; + + source = NULL; + target = NULL; + + if (is_empty_string (Source)) + { + WARN_BAD_FILE_NAME; + goto EXIT; + } + if (is_empty_string (Target)) + { + WARN_BAD_FILE_NAME; + goto EXIT; + } + source = fopen (Source, "rb"); + if (source == NULL) + { + WARN_BAD_FILE_NAME; + goto EXIT; + } + target = fopen (Target, "wb"); + if (target == NULL) + { + WARN_BAD_FILE_NAME; + goto EXIT; + } + /* OK */ + while (TRUE) + { + int C; + + C = fgetc (source); + if (C < 0 /* EOF */ || feof (source) || ferror (source)) + { + break; + } + fputc (C, target); + if (ferror (target)) + { + break; + } + } + /* DONE */ +EXIT: + if (source) + { + fclose (source); + } + if (target) + { + fclose (target); + } +} + +LineType * +bwb_COPY (LineType * Line) +{ + /* SYNTAX: COPY source$ TO target$ */ + char *Source; + char *Target; + + assert (Line != NULL); + + Source = NULL; + Target = NULL; + if (line_read_string_expression (Line, &Source) == FALSE) + { + WARN_SYNTAX_ERROR; + goto EXIT; + } + if (line_skip_word (Line, "TO") == FALSE) + { + WARN_SYNTAX_ERROR; + goto EXIT; + } + if (line_read_string_expression (Line, &Target) == FALSE) + { + WARN_SYNTAX_ERROR; + goto EXIT; + } + bwb_copy_file (Source, Target); +EXIT: + if (Source) + { + free (Source); + } + if (Target) + { + free (Target); + } + return (Line); +} + +/* +-------------------------------------------------------------------------------------------- + DISPLAY +-------------------------------------------------------------------------------------------- +*/ + +static void +bwb_display_file (char *Source) +{ + FILE *source; + + assert (My->SYSOUT != NULL); + assert (My->SYSOUT->cfp != NULL); + + source = NULL; + + if (is_empty_string (Source)) + { + WARN_BAD_FILE_NAME; + goto EXIT; + } + source = fopen (Source, "rb"); + if (source == NULL) + { + WARN_BAD_FILE_NAME; + goto EXIT; + } + /* OK */ + while (TRUE) + { + int C; + + C = fgetc (source); + if (C < 0 /* EOF */ || feof (source) || ferror (source)) + { + break; + } + fputc (C, My->SYSOUT->cfp); + } + /* DONE */ +EXIT: + if (source) + { + fclose (source); + } +} + +LineType * +bwb_DISPLAY (LineType * Line) +{ + /* SYNTAX: DISPLAY source$ */ + char *Source; + + assert (Line != NULL); + Source = NULL; + if (line_read_string_expression (Line, &Source) == FALSE) + { + WARN_SYNTAX_ERROR; + goto EXIT; + } + bwb_display_file (Source); +EXIT: + if (Source) + { + free (Source); + } + return (Line); +} + +/* +-------------------------------------------------------------------------------------------- + EOF +-------------------------------------------------------------------------------------------- +*/ + + + +/* EOF */ |