|
- /***************************************************************
-
- bwb_inp.c Input Routines
- for Bywater BASIC Interpreter
-
- Copyright (c) 1993, Ted A. Campbell
- Bywater Software
-
- email: tcamp@delphi.com
-
- Copyright and Permissions Information:
-
- All U.S. and international rights are claimed by the author,
- Ted A. Campbell.
-
- This software is released under the terms of the GNU General
- Public License (GPL), which is distributed with this software
- in the file "COPYING". The GPL specifies the terms under
- which users may copy and use the software in this distribution.
-
- A separate license is available for commercial distribution,
- for information on which you should contact the author.
-
- ***************************************************************/
-
- /*---------------------------------------------------------------*/
- /* NOTE: Modifications marked "JBV" were made by Jon B. Volkoff, */
- /* 11/1995 (eidetics@cerf.net). */
- /* */
- /* Those additionally marked with "DD" were at the suggestion of */
- /* Dale DePriest (daled@cadence.com). */
- /* */
- /* Version 3.00 by Howard Wulf, AF5NE */
- /* */
- /* Version 3.10 by Howard Wulf, AF5NE */
- /* */
- /* Version 3.20 by Howard Wulf, AF5NE */
- /* */
- /*---------------------------------------------------------------*/
-
-
-
- #include "bwbasic.h"
-
-
- static LineType *C77_file_input (LineType * Line, int FileNumber);
- static LineType *C77_file_input_finish (LineType * Line);
- static LineType *C77_file_input_line (LineType * Line);
- static LineType *C77_user_input_line (LineType * Line, char *Prompt,
- int IsDisplayQuestionMark);
- static void CleanTextInput (char *buffer);
- static LineType *D71_GET (LineType * Line);
- static LineType *data_if_end (LineType * Line);
- static LineType *data_restore (LineType * Line);
- static ResultType file_data (VariableType * Variable, char *tbuf, int tlen);
- static LineType *file_if_end (LineType * Line);
- static LineType *file_input (LineType * Line);
- static LineType *file_read_matrix (LineType * Line);
- static LineType *file_restore (LineType * Line);
- static LineType *H14_GET (LineType * Line);
- static ResultType input_data (VariableType * Variable, char *tbuf, int tlen);
- static ResultType parse_number (char *buffer, int *position, VariantType * X,
- int IsConsoleInput);
- static ResultType parse_string (char *buffer, int *position, VariantType * X);
- static ResultType parse_string_isquoted (char *buffer, int *position,
- VariantType * X);
- static ResultType parse_string_unquoted (char *buffer, int *position,
- VariantType * X);
- static ResultType read_data (VariableType * Variable);
- static LineType *read_file (LineType * Line);
- static LineType *read_list (LineType * Line);
- static LineType *S70_GET (LineType * Line);
- static LineType *user_input_loop (LineType * Line);
- static ResultType user_input_values (LineType * Line, char *buffer,
- int IsReal);
-
-
- int
- bwb_is_eof (FILE * fp)
- {
- /*
- Have you ever wondered why C file I/O is slow? Here is the reason:
- feof() is not set until after a file read error occurs; sad but true.
- In order to determine whether you are at the end-of-file,
- you have to call both ftell() and fseek() twice,
- which effectively trashes any I/O cache scheme.
- */
-
- assert (fp != NULL);
-
- if (fp != NULL)
- {
- long current;
- long total;
-
- current = ftell (fp);
- fseek (fp, 0, SEEK_END);
- total = ftell (fp);
- if (total == current)
- {
- /* EOF */
- return TRUE;
- }
- else
- {
- /* NOT EOF */
- fseek (fp, current, SEEK_SET);
- return FALSE;
- }
- }
- /* a closed file is always EOF */
- return TRUE;
- }
-
-
- static void
- CleanTextInput (char *buffer)
- {
- /*
- **
- ** Clean the TEXT in the INPUT buffer after fgets(). Not for RANDOM or BINARY.
- **
- */
- char *E;
-
- assert (buffer != NULL);
- /*
- **
- ** some compilers remove CR, but not LF.
- ** some compilers remove LF, but not CR.
- ** some compilers remove CR/LF but not LF/CR.
- ** some compilers remove both CR and LF.
- ** some compilers remove the first CR or LF, but not the second LF or CR.
- ** some compilers don't remove either CR or LF.
- ** and so on.
- **
- */
- E = bwb_strchr (buffer, '\r');
- if (E != NULL)
- {
- *E = NulChar;
- }
- E = bwb_strchr (buffer, '\n');
- if (E != NULL)
- {
- *E = NulChar;
- }
- /*
- **
- ** Suppress all control characters.
- ** In theory, there should not be any control characters at all.
- ** In reality, they occassionally occur.
- **
- */
- while (*buffer)
- {
- if (bwb_isprint (*buffer) == FALSE)
- {
- *buffer = ' ';
- }
- buffer++;
- }
- }
-
- void bwb_close_all() {
- FileType *F;
-
- for (F = My->FileHead; F != NULL; F = F->next)
- {
- field_close_file (F);
- file_clear (F);
- }
- }
-
-
-
- /***************************************************************
-
- FUNCTION: bwx_input()
-
- DESCRIPTION: This function outputs the string pointed
- to by 'prompt', then inputs a character
- string.
-
- ***************************************************************/
-
- extern int
- bwx_input (char *prompt, int IsDisplayQuestionMark, char *answer, int MaxLen)
- {
-
- assert (answer != NULL);
- assert(My != NULL);
- assert(My->SYSOUT != NULL);
- assert(My->SYSOUT->cfp != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
-
- if (prompt != NULL)
- {
- while (*prompt)
- {
- if (*prompt == '\n')
- {
- My->SYSOUT->col = 0; /* incremented below */
- My->SYSOUT->row++;
- }
- else
- if (My->SYSOUT->width > 0
- && My->SYSOUT->col > My->SYSOUT->width /* && *prompt != '\n' */ )
- {
- fputc ('\n', My->SYSOUT->cfp);
- My->SYSOUT->col = 0; /* incremented below */
- My->SYSOUT->row++;
- }
- fputc (*prompt, My->SYSOUT->cfp);
- My->SYSOUT->col++;
- prompt++;
- }
- }
- if (IsDisplayQuestionMark)
- {
- fputs ("? ", My->SYSOUT->cfp);
- My->SYSOUT->col += 2;
- }
- fflush (My->SYSOUT->cfp);
- /*
- **
- ** for PTR or OPTION STDIN ...
- **
- */
- if (My->SYSIN->cfp != stdin)
- {
- /* this file was opened by PTR or OPTION STDIN commands */
- if (fgets (answer, MaxLen, My->SYSIN->cfp)) /* bwx_input */
- {
- answer[MaxLen] = NulChar;
- CleanTextInput (answer);
- fputs (answer, My->SYSOUT->cfp);
- fputc ('\n', My->SYSOUT->cfp);
- fflush (My->SYSOUT->cfp);
- ResetConsoleColumn ();
- return TRUE;
- }
- /* stop reading from PTR or OPTION STDIN once all INPUT lines have been read */
- bwb_fclose (My->SYSIN->cfp);
- My->SYSIN->cfp = stdin;
- /* INPUT reverts to stdin */
- }
- /* My->SYSIN->cfp == stdin */
- /*
- **
- ** ... for PTR or OPTION STDIN
- **
- */
- /*
- **
- ** for automated testing ...
- **
- */
- if (My->ExternalInputFile != NULL)
- {
- /* this file was opened by --TAPE command line parameter */
- if (fgets (answer, MaxLen, My->ExternalInputFile)) /* bwx_input */
- {
- answer[MaxLen] = NulChar;
- CleanTextInput (answer);
- fputs (answer, My->SYSOUT->cfp);
- fputc ('\n', My->SYSOUT->cfp);
- fflush (My->SYSOUT->cfp);
- ResetConsoleColumn ();
- return TRUE;
- }
- /* stop reading from --TAPE once all INPUT lines have been read */
- bwb_fclose (My->ExternalInputFile);
- My->ExternalInputFile = NULL;
- /* INPUT reverts to My->SYSIN->cfp */
- }
- /*
- **
- ** ... for automated testing
- **
- */
- if (fgets (answer, MaxLen, My->SYSIN->cfp)) /* bwx_input */
- {
- /* this is stdin */
- answer[MaxLen] = NulChar;
- CleanTextInput (answer);
- ResetConsoleColumn ();
- return TRUE;
- }
- /* nothing was read from stdin */
- answer[0] = NulChar;
- CleanTextInput (answer);
- ResetConsoleColumn ();
- return FALSE;
- }
-
-
- extern LineType *
- bwb_BACKSPACE (LineType * Line)
- {
-
-
- assert (Line != NULL);
- assert(My != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
-
- My->CurrentFile = My->SYSIN;
-
- if (line_skip_FilenumChar (Line))
- {
- /* BACKSPACE # filenum */
- int FileNumber;
-
- if (line_read_integer_expression (Line, &FileNumber) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (FileNumber < 0)
- {
- /* "BACKSPACE # -1" is silently ignored */
- return (Line);
- }
- if (FileNumber == 0)
- {
- /* "BACKSPACE # 0" is silently ignored */
- return (Line);
- }
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- /* not for the console */
- /* if( TRUE ) */
- {
- FILE *f;
- long Offset;
- int DelimiterCount;
- int InQuote;
- int C;
-
- f = My->CurrentFile->cfp;
- Offset = ftell (f);
- Offset--;
- DelimiterCount = 0;
- InQuote = FALSE;
-
- AGAIN:
- if (Offset <= 0)
- {
- goto DONE;
- }
- fseek (f, Offset, SEEK_SET);
- C = fgetc (f);
-
- if (InQuote)
- {
- if (C == My->CurrentVersion->OptionQuoteChar)
- {
- InQuote = FALSE;
- }
- Offset--;
- goto AGAIN;
- }
-
- if (C == My->CurrentVersion->OptionQuoteChar)
- {
- InQuote = TRUE;
- Offset--;
- goto AGAIN;
- }
-
-
- if (C == ',')
- {
- DelimiterCount++;
- if (DelimiterCount > 1)
- {
- Offset++;
- goto DONE;
- }
- Offset--;
- goto AGAIN;
- }
-
- if (C == '\n')
- {
- DelimiterCount++;
- if (DelimiterCount > 1)
- {
- Offset++;
- goto DONE;
- }
- Offset--;
- if (Offset <= 0)
- {
- goto DONE;
- }
- fseek (f, Offset, SEEK_SET);
- C = fgetc (f);
- if (C == '\r')
- {
- Offset--;
- }
- goto AGAIN;
- }
-
- if (C == '\r')
- {
- DelimiterCount++;
- if (DelimiterCount > 1)
- {
- Offset++;
- goto DONE;
- }
- Offset--;
- if (Offset <= 0)
- {
- goto DONE;
- }
- fseek (f, Offset, SEEK_SET);
- C = fgetc (f);
- if (C == '\n')
- {
- Offset--;
- }
- goto AGAIN;
- }
-
- Offset--;
- goto AGAIN;
-
- DONE:
- if (Offset < 0)
- {
- Offset = 0;
- }
- fseek (f, Offset, SEEK_SET);
- }
- }
- /* BACKSPACE for console is silently ignored */
- return (Line);
- }
-
-
-
-
- /***************************************************************
-
- FUNCTION: bwb_read()
-
- DESCRIPTION: This function implements the BASIC READ
- statement.
-
- SYNTAX: READ variable[, variable...]
-
- ***************************************************************/
-
- static LineType *
- C77_file_input (LineType * Line, int FileNumber)
- {
- /*
- CBASIC-II: SERIAL & RANDOM file reads
- READ # FileNumber ; [ scalar [ , ... ] ] ' SERIAL
- READ # FileNumber , RecordNumber ; [ scalar [ , ... ] ] ' RANDOM
- */
- assert (Line != NULL);
- assert(My != NULL);
-
- if (FileNumber <= 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- /* normal file */
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (line_skip_CommaChar (Line) /* comma-specific */ )
- {
- /*
- READ # FileNumber , RecordNumber ; [ scalar [ , ... ] ] ' RANDOM
- */
- /* get the RecordNumber */
- int RecordNumber;
-
- if ((My->CurrentFile->DevMode & DEVMODE_RANDOM) == 0)
- {
- WARN_BAD_FILE_MODE;
- return (Line);
- }
- if (My->CurrentFile->width <= 0)
- {
- WARN_FIELD_OVERFLOW;
- return (Line);
- }
- if (line_read_integer_expression (Line, &RecordNumber) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (RecordNumber <= 0)
- {
- WARN_BAD_RECORD_NUMBER;
- return (Line);
- }
- RecordNumber--; /* BASIC to C */
- /* if( TRUE ) */
- {
- long offset;
- offset = RecordNumber;
- offset *= My->CurrentFile->width;
- fseek (My->CurrentFile->cfp, offset, SEEK_SET);
- }
- }
-
- if (line_is_eol (Line))
- {
- /* READ # filenum */
- /* READ # filenum , recnum */
- return (Line);
- }
-
- if (line_skip_SemicolonChar (Line) /* semicolon specific */ )
- {
- /* READ # filenum ; */
- /* READ # filenum , recnum ; */
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (line_is_eol (Line))
- {
- return (Line);
- }
- /* input is not from #0, so branch to file_input() */
- return file_input (Line);
- }
-
- static LineType *
- data_if_end (LineType * Line)
- {
- WARN_OUT_OF_DATA;
- return (Line);
- }
-
- static ResultType
- read_data (VariableType * Variable)
- {
- /*
- **
- ** read one DATA item
- **
- */
- ResultType Result;
- VariantType Variant;
- VariantType *X;
-
- assert (Variable != NULL);
- assert(My != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
- assert (My->CurrentFile == My->SYSIN);
- assert(My->DataLine != NULL);
- assert(My->EndMarker != NULL);
-
- Result = RESULT_UNPARSED;
- X = &Variant;
- CLEAR_VARIANT (X);
- if (My->DataLine == My->EndMarker)
- {
- return RESULT_UNPARSED;
- }
- if (My->DataLine->cmdnum != C_DATA)
- {
- WARN_INTERNAL_ERROR;
- return RESULT_UNPARSED;
- }
- if (VAR_IS_STRING (Variable))
- {
- Result = parse_string (My->DataLine->buffer, &My->DataPosition, X);
- }
- else
- {
- Result = parse_number (My->DataLine->buffer, &My->DataPosition, X, FALSE);
- }
- if (Result == RESULT_UNPARSED)
- {
- WARN_BAD_DATA;
- }
- if (Result != RESULT_SUCCESS)
- {
- return Result;
- }
- /*
- **
- ** OK
- **
- */
- if (X->VariantTypeCode == StringTypeCode
- && My->CurrentVersion->OptionFlags & OPTION_BUGS_ON ) /* DATA allows embedded quote pairs */
- {
- int i;
- int n;
- n = X->Length;
- for (i = 0; i < n; i++)
- {
- if (X->Buffer[i + 0] == My->CurrentVersion->OptionQuoteChar
- && X->Buffer[i + 1] == My->CurrentVersion->OptionQuoteChar)
- {
- bwb_strncpy (&X->Buffer[i + 0], &X->Buffer[i + 1], n - i);
- n--;
- }
- }
- X->Length = n;
- }
- if (var_set (Variable, X) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return RESULT_UNPARSED;
- }
- /*
- **
- ** Note: do NOT free() or RELEASE_VARIANT because 'X->Buffer' points into 'buffer'
- **
- */
- if (buff_is_eol (My->DataLine->buffer, &My->DataPosition))
- {
- /* at the end of the current DATA statement */
- if (My->CurrentVersion->OptionFlags & OPTION_COVERAGE_ON)
- {
- /* this line has been READ */
- My->DataLine->LineFlags |= LINE_EXECUTED;
- }
- My->DataLine = My->DataLine->OtherLine;
- My->DataPosition = My->DataLine->Startpos;
- return RESULT_SUCCESS;
- }
- if (buff_skip_char (My->DataLine->buffer, &My->DataPosition, My->CurrentFile->delimit)) /* buff_skip_comma */
- {
- return RESULT_SUCCESS;
- }
- /* garbage after the value we just READ */
- WARN_BAD_DATA;
- return RESULT_UNPARSED;
- }
-
- static LineType *
- read_list (LineType * Line)
- {
- /* READ varlist */
- assert (Line != NULL);
- assert(My != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
- assert (My->CurrentFile == My->SYSIN);
-
- do
- {
- VariableType *Variable;
-
- /* get a variable */
- if ((Variable = line_read_scalar (Line)) == NULL)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- /* READ data into the variable */
- if (read_data (Variable) != RESULT_SUCCESS)
- {
- return data_if_end (Line);
- }
- }
- while (line_skip_seperator (Line));
- return (Line);
- }
-
- static LineType *
- read_file (LineType * Line)
- {
- /* READ # filenum, varlist */
- int FileNumber;
- assert (Line != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
-
- if (line_read_integer_expression (Line, &FileNumber) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (My->CurrentVersion->OptionVersionValue & (C77))
- {
- return C77_file_input (Line, FileNumber);
- }
- /*
- SERIAL file reads:
- READ # FileNumber
- READ # FileNumber [, scalar]
- */
- if (line_skip_seperator (Line))
- {
- /* required */
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (FileNumber < 0)
- {
- /* "READ # -1" is an error */
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (FileNumber > 0)
- {
- /* normal file */
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- /* input is not from #0, so branch to file_input() */
- return file_input (Line);
- }
- /* "READ # 0, varlist" is the same as "READ varlist" */
- return read_list (Line);
- }
-
- extern LineType *
- bwb_READ (LineType * Line)
- {
-
-
- assert (Line != NULL);
- assert(My != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
-
- My->CurrentFile = My->SYSIN;
-
- if (line_skip_FilenumChar (Line))
- {
- return read_file (Line);
- }
- return read_list (Line);
- }
-
- /***************************************************************
-
- FUNCTION: bwb_data()
-
- DESCRIPTION: This function implements the BASIC DATA
- statement, although at the point at which
- DATA statements are encountered, no
- processing is done. All actual processing
- of DATA statements is accomplished by READ
- (bwb_read()).
-
- SYNTAX: DATA constant[, constant]...
-
- ***************************************************************/
-
- extern LineType *
- bwb_DATA (LineType * Line)
- {
-
- assert (Line != NULL);
-
- if (Line->LineFlags & (LINE_USER))
- {
- WARN_ILLEGAL_DIRECT;
- return (Line);
- }
- line_skip_eol (Line);
- return (Line);
- }
-
-
-
-
-
-
- /***************************************************************
-
- FUNCTION: bwb_restore()
-
- DESCRIPTION: This function implements the BASIC RESTORE
- statement.
-
- SYNTAX: RESTORE [line number]
-
- ***************************************************************/
-
- extern LineType *
- bwb_RESET (LineType * Line)
- {
- /* RESET filename$ [, ...] */
- VariantType E;
- VariantType *e;
-
- assert (Line != NULL);
- assert(My != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
-
- e = &E; /* no leaks */
- My->CurrentFile = My->SYSIN;
-
- do
- {
- CLEAR_VARIANT (e);
- if (line_read_expression (Line, e) == FALSE) /* bwb_RESET */
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (e->VariantTypeCode == StringTypeCode)
- {
- /* STRING */
- /* RESET filename$ ... */
- My->CurrentFile = find_file_by_name (e->Buffer);
- }
- else
- {
- /* NUMBER -- file must already be OPEN */
- /* RESET filenumber ... */
- My->CurrentFile = find_file_by_number ((int) bwb_rint (e->Number));
- }
- RELEASE_VARIANT (e);
- if (My->CurrentFile == NULL)
- {
- /* file not OPEN */
- /* silently ignored */
- }
- else if (My->CurrentFile == My->SYSIN)
- {
- /* silently ignored */
- }
- else if (My->CurrentFile == My->SYSOUT)
- {
- /* silently ignored */
- }
- else if (My->CurrentFile == My->SYSPRN)
- {
- /* silently ignored */
- }
- else
- {
- /* normal file is OPEN */
- My->CurrentFile->width = 0;
- My->CurrentFile->col = 1;
- My->CurrentFile->row = 1;
- My->CurrentFile->delimit = ',';
- fseek (My->CurrentFile->cfp, 0, SEEK_SET);
- }
- }
- while (line_skip_seperator (Line));
- return (Line);
- }
-
- extern LineType *
- bwb_CLOSE (LineType * Line)
- {
- /* CLOSE filename$ ' can be any string expression */
- /* CLOSE filenumber ' can be any numeric expression */
-
- assert (Line != NULL);
- assert(My != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
- assert(My->SYSOUT != NULL);
- assert(My->SYSOUT->cfp != NULL);
- assert(My->SYSPRN != NULL);
- assert(My->SYSPRN->cfp != NULL);
-
- My->CurrentFile = My->SYSIN;
-
- if (line_is_eol (Line))
- {
- /* CLOSE */
- bwb_close_all();
- return (Line);
- }
-
- do
- {
- VariantType E;
- VariantType *e;
- e = &E;
-
- if (line_read_expression (Line, e) == FALSE) /* bwb_CLOSE */
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (e->VariantTypeCode == StringTypeCode)
- {
- /* STRING */
- /* CLOSE filename$ ... */
- My->CurrentFile = find_file_by_name (e->Buffer);
- }
- else
- {
- /* CLOSE filenumber */
- My->CurrentFile = find_file_by_number (e->Number);
- }
- if (My->CurrentFile == NULL)
- {
- /* file not OPEN */
- /* silently ignored */
- }
- else if (My->CurrentFile == My->SYSIN)
- {
- /* silently ignored */
- }
- else if (My->CurrentFile == My->SYSOUT)
- {
- /* silently ignored */
- }
- else if (My->CurrentFile == My->SYSPRN)
- {
- /* silently ignored */
- }
- else
- {
- /* normal file is OPEN */
- field_close_file (My->CurrentFile);
- file_clear (My->CurrentFile);
- }
- RELEASE_VARIANT (e);
- }
- while (line_skip_seperator (Line));
- return (Line);
- }
-
- static LineType *
- data_restore (LineType * Line)
- {
- int LineNumber;
- LineType *x;
- assert (Line != NULL);
- assert(My != NULL);
-
- if (line_is_eol (Line))
- {
- /* RESTORE */
- assert (My->StartMarker != NULL);
- My->DataLine = My->StartMarker->OtherLine;
- assert (My->DataLine != NULL);
- My->DataPosition = My->DataLine->Startpos;
- return (Line);
- }
- if (line_read_integer_expression (Line, &LineNumber))
- {
- /* RESTORE linenumber */
- x = find_line_number (LineNumber); /* RESTORE 100 */
- if (x != NULL)
- {
- for (; x->cmdnum != C_DATA && x != My->EndMarker; x = x->next);
- My->DataLine = x;
- assert (My->DataLine != NULL);
- My->DataPosition = My->DataLine->Startpos;
- return (Line);
- }
- }
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- static LineType *
- file_restore (LineType * Line)
- {
- /* RESTORE # FileNumber */
- int FileNumber;
- assert (Line != NULL);
- assert(My != NULL);
-
- if (line_read_integer_expression (Line, &FileNumber) == FALSE)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (FileNumber < 0)
- {
- /* "RESTORE # -1" is silently ignored */
- return (Line);
- }
- if (FileNumber > 0)
- {
- /* normal file */
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- 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 (Line);
- }
- if (bwb_strcmp (My->CurrentFile->FileName, "*") != 0)
- {
- if ((My->CurrentFile->cfp =
- fopen (My->CurrentFile->FileName, "r")) == NULL)
- {
- WARN_BAD_FILE_NAME;
- return (Line);
- }
- My->CurrentFile->DevMode = DEVMODE_INPUT;
- }
- /* OK */
- return (Line);
- }
- /* "RESTORE # 0" is the same as "RESTORE" */
- return data_restore (Line);
- }
-
- extern LineType *
- bwb_RESTORE (LineType * Line)
- {
-
- assert (Line != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
-
- My->CurrentFile = My->SYSIN;
-
- if (line_skip_FilenumChar (Line))
- {
- return file_restore (Line);
- }
- if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
- {
- /* RESTORE [comment] */
- line_skip_eol (Line);
- /* fall-thru */
- }
- return data_restore (Line);
- }
-
- /***************************************************************
-
- FUNCTION: bwb_input()
-
- DESCRIPTION: This function implements the BASIC INPUT
- statement.
-
- SYNTAX: INPUT [;][prompt$;]variable[$,variable]...
- INPUT#n variable[$,variable]...
-
- ***************************************************************/
-
- static LineType *
- S70_GET (LineType * Line)
- {
- /* GET filename$ , scalar [, ...] */
- VariantType E;
- VariantType *e;
-
- assert (Line != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
-
- e = &E;
- My->CurrentFile = My->SYSIN;
-
- if (line_read_expression (Line, e) == FALSE) /* bwb_GET */
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (e->VariantTypeCode == StringTypeCode)
- {
- /* STRING */
- /* GET filename$ ... */
- if (is_empty_string (e->Buffer))
- {
- /* GET "", ... is an error */
- WARN_BAD_FILE_NAME;
- return (Line);
- }
- My->CurrentFile = find_file_by_name (e->Buffer);
- if (My->CurrentFile == NULL)
- {
- /* implicitly OPEN for reading */
- My->CurrentFile = file_new ();
- My->CurrentFile->cfp = fopen (e->Buffer, "r");
- if (My->CurrentFile->cfp == NULL)
- {
- WARN_BAD_FILE_NAME;
- return (Line);
- }
- My->CurrentFile->FileNumber = file_next_number ();
- My->CurrentFile->DevMode = DEVMODE_INPUT;
- My->CurrentFile->width = 0;
- /* WIDTH == RECLEN */
- My->CurrentFile->col = 1;
- My->CurrentFile->row = 1;
- My->CurrentFile->delimit = ',';
- My->CurrentFile->buffer = NULL;
- if (My->CurrentFile->FileName != NULL)
- {
- free (My->CurrentFile->FileName);
- My->CurrentFile->FileName = NULL;
- }
- My->CurrentFile->FileName = e->Buffer;
- e->Buffer = NULL;
- }
- }
- else
- {
- /* NUMBER -- file must already be OPEN */
- /* GET filenumber ... */
- if (e->Number < 0)
- {
- /* "GET # -1" is an error */
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (e->Number == 0)
- {
- /* "GET # 0" is an error */
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- My->CurrentFile = find_file_by_number ((int) bwb_rint (e->Number));
- if (My->CurrentFile == NULL)
- {
- /* file not OPEN */
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- }
- if (My->CurrentFile == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (line_skip_seperator (Line))
- {
- /* OK */
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- return file_input (Line);
- }
-
- static LineType *
- D71_GET (LineType * Line)
- {
- /* GET # FileNumber [ , RECORD RecordNumber ] */
- int FileNumber;
-
- assert (Line != NULL);
- assert(My != NULL);
-
- FileNumber = 0;
- if (line_skip_FilenumChar (Line))
- {
- /* OPTIONAL */
- }
- if (line_read_integer_expression (Line, &FileNumber) == FALSE)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (FileNumber < 1)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (My->CurrentFile->DevMode != DEVMODE_RANDOM)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (My->CurrentFile->width <= 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (line_is_eol (Line))
- {
- /* GET # FileNumber */
- }
- else
- {
- /* GET # FileNumber , RECORD RecordNumber */
- int RecordNumber;
- long offset;
-
- RecordNumber = 0;
- offset = 0;
- if (line_skip_seperator (Line) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (line_skip_word (Line, "RECORD") == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (line_read_integer_expression (Line, &RecordNumber) == FALSE)
- {
- WARN_BAD_RECORD_NUMBER;
- return (Line);
- }
- if (RecordNumber <= 0)
- {
- WARN_BAD_RECORD_NUMBER;
- return (Line);
- }
- RecordNumber--; /* BASIC to C */
- offset = RecordNumber;
- offset *= My->CurrentFile->width;
- if (fseek (My->CurrentFile->cfp, offset, SEEK_SET) != 0)
- {
- WARN_BAD_RECORD_NUMBER;
- return (Line);
- }
- }
- /* if( TRUE ) */
- {
- int i;
- for (i = 0; i < My->CurrentFile->width; i++)
- {
- int c;
- c = fgetc (My->CurrentFile->cfp);
- if ( /* EOF */ c < 0)
- {
- c = NulChar;
- }
- My->CurrentFile->buffer[i] = c;
- }
- }
- field_get (My->CurrentFile);
- /* OK */
- return (Line);
- }
-
- /* 20210916-ChipMaster: BINARY read/write macros - to tailor for each
- platform, ASSuming it will need to be. Returns TRUE on success. */
- #if TRUE /* Linux */
- #define BWRITE(F,V) (write(fileno(F), &V, sizeof(V))==sizeof(V))
- #define BREAD(F,V) (read(fileno(F), &V, sizeof(V))==sizeof(V))
- #define BWRITES(F,V) (write(fileno(F), V->Buffer, V->Length)==V->Length)
- #define BREADS(F,V) (read(fileno(F), V->Buffer, V->Length)==V->Length)
- #else /* What it was */
- #define BWRITE(F,V) (fwrite(&V, sizeof(V), 1, F)==F)
- #define BREAD(F,V) (fread(&V, sizeof(V), 1, F)==F)
- #define BWRITES(F,V) (fwrite(V->Buffer, V->Length, 1, F)==1)
- #define BREADS(F,V) (fread(V->Buffer, V->Length, 1, F)==1)
- #endif
- extern int
- binary_get_put (VariableType * Variable, int IsPUT)
- {
- VariantType variant;
- VariantType *Variant;
-
- assert(My != NULL);
- assert (My->CurrentFile != NULL);
- assert (My->CurrentFile->cfp != NULL);
- assert (My->CurrentFile->DevMode == DEVMODE_BINARY);
-
- Variant = &variant;
- CLEAR_VARIANT (Variant);
- if (var_get (Variable, Variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return FALSE;
- }
- #ifdef CMDEBUG
- errno = 0;
- fputs("errno=0\n", stderr);
- #endif
- switch (Variant->VariantTypeCode)
- {
- case ByteTypeCode:
- {
- ByteType Value;
- Value = (ByteType) Variant->Number;
- if (IsPUT)
- {
- if(!BWRITE(My->CurrentFile->cfp, Value))
- {
- WARN_DISK_IO_ERROR;
- return FALSE;
- }
- }
- else
- {
- if(!BREAD(My->CurrentFile->cfp, Value))
- {
- WARN_DISK_IO_ERROR;
- return FALSE;
- }
- }
- Variant->Number = Value;
- }
- break;
- case IntegerTypeCode:
- {
- IntegerType Value;
- Value = (IntegerType) Variant->Number;
- if (IsPUT)
- {
- if(!BWRITE(My->CurrentFile->cfp, Value))
- {
- WARN_DISK_IO_ERROR;
- return FALSE;
- }
- }
- else
- {
- if(!BREAD(My->CurrentFile->cfp, Value))
- {
- WARN_DISK_IO_ERROR;
- return FALSE;
- }
- }
- Variant->Number = Value;
- }
- break;
- case LongTypeCode:
- {
- LongType Value;
- Value = (LongType) Variant->Number;
- if (IsPUT)
- {
- if(!BWRITE(My->CurrentFile->cfp, Value))
- {
- WARN_DISK_IO_ERROR;
- return FALSE;
- }
- }
- else
- {
- if(!BREAD(My->CurrentFile->cfp, Value))
- {
- WARN_DISK_IO_ERROR;
- return FALSE;
- }
- }
- Variant->Number = Value;
- }
- break;
- case CurrencyTypeCode:
- {
- CurrencyType Value;
- Value = (CurrencyType) Variant->Number;
- if (IsPUT)
- {
- if(!BWRITE(My->CurrentFile->cfp, Value))
- {
- WARN_DISK_IO_ERROR;
- return FALSE;
- }
- }
- else
- {
- if(!BREAD(My->CurrentFile->cfp, Value))
- {
- WARN_DISK_IO_ERROR;
- return FALSE;
- }
- }
- Variant->Number = Value;
- }
- break;
- case SingleTypeCode:
- {
- SingleType Value;
- Value = (SingleType) Variant->Number;
- if (IsPUT)
- {
- if(!BWRITE(My->CurrentFile->cfp, Value))
- {
- WARN_DISK_IO_ERROR;
- return FALSE;
- }
- }
- else
- {
- if(!BREAD(My->CurrentFile->cfp, Value))
- {
- WARN_DISK_IO_ERROR;
- return FALSE;
- }
- }
- Variant->Number = Value;
- }
- break;
- case DoubleTypeCode:
- {
- DoubleType Value;
- Value = (DoubleType) Variant->Number;
- if (IsPUT)
- {
- if(!BWRITE(My->CurrentFile->cfp, Value))
- {
- WARN_DISK_IO_ERROR;
- return FALSE;
- }
- }
- else
- {
- if(!BREAD(My->CurrentFile->cfp, Value))
- {
- WARN_DISK_IO_ERROR;
- return FALSE;
- }
- }
- Variant->Number = Value;
- }
- break;
- case StringTypeCode:
- if (IsPUT)
- {
- #if FALSE /* keep this ... */
- if(!BWRITE(My->CurrentFile->cfp, Variant->Length))
- {
- WARN_DISK_IO_ERROR;
- return FALSE;
- }
- #endif
- if(!BWRITES(My->CurrentFile->cfp, Variant))
- {
- WARN_DISK_IO_ERROR;
- return FALSE;
- }
- }
- else
- {
- #if FALSE /* keep this ... */
- if(!BREAD(My->CurrentFile->cfp, Variant->Length))
- {
- WARN_DISK_IO_ERROR;
- return FALSE;
- }
- #endif
- if(!BREADS(My->CurrentFile->cfp, Variant))
- {
- WARN_DISK_IO_ERROR;
- return FALSE;
- }
- Variant->Buffer[Variant->Length] = NulChar;
- }
- break;
- default:
- {
- WARN_INTERNAL_ERROR;
- return FALSE;
- }
- }
- if (IsPUT)
- {
- /* not needed */
- }
- else
- {
- if (var_set (Variable, Variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return FALSE;
- }
- }
- RELEASE_VARIANT (Variant);
- /* OK */
- return TRUE;
- }
-
- static LineType *
- H14_GET (LineType * Line)
- {
- /* GET # FileNumber [ , RecordNumber ] ' RANDOM */
- /* GET # FileNumber , [ BytePosition ] , scalar [,...] ' BINARY */
- int FileNumber;
-
- assert (Line != NULL);
- assert(My != NULL);
-
- FileNumber = 0;
- if (line_skip_FilenumChar (Line))
- {
- /* OPTIONAL */
- }
- if (line_read_integer_expression (Line, &FileNumber) == FALSE)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (FileNumber < 1)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (My->CurrentFile->DevMode == DEVMODE_RANDOM)
- {
- /* GET # FileNumber [ , RecordNumber ] ' RANDOM */
- if (My->CurrentFile->width <= 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (line_is_eol (Line))
- {
- /* GET # FileNumber */
- }
- else
- {
- /* GET # FileNumber , RecordNumber */
- int RecordNumber;
- long offset;
-
- RecordNumber = 0;
- offset = 0;
- if (line_skip_seperator (Line) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (line_read_integer_expression (Line, &RecordNumber) == FALSE)
- {
- WARN_BAD_RECORD_NUMBER;
- return (Line);
- }
- if (RecordNumber <= 0)
- {
- WARN_BAD_RECORD_NUMBER;
- return (Line);
- }
- RecordNumber--; /* BASIC to C */
- offset = RecordNumber;
- offset *= My->CurrentFile->width;
- if (fseek (My->CurrentFile->cfp, offset, SEEK_SET) != 0)
- {
- WARN_BAD_RECORD_NUMBER;
- return (Line);
- }
- }
- /* if( TRUE ) */
- {
- int i;
- for (i = 0; i < My->CurrentFile->width; i++)
- {
- int c;
- c = fgetc (My->CurrentFile->cfp);
- if ( /* EOF */ c < 0)
- {
- c = NulChar;
- }
- My->CurrentFile->buffer[i] = c;
- }
- }
- field_get (My->CurrentFile);
- /* OK */
- return (Line);
- }
- else if (My->CurrentFile->DevMode == DEVMODE_BINARY)
- {
- /* GET # FileNumber , [ BytePosition ] , scalar [,...] ' BINARY */
- if (line_skip_seperator (Line) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (line_skip_seperator (Line))
- {
- /* BytePosition not provided */
- }
- else
- {
- int RecordNumber;
- long offset;
-
- RecordNumber = 0;
- offset = 0;
- if (line_read_integer_expression (Line, &RecordNumber) == FALSE)
- {
- WARN_BAD_RECORD_NUMBER;
- return (Line);
- }
- if (RecordNumber <= 0)
- {
- WARN_BAD_RECORD_NUMBER;
- return (Line);
- }
- RecordNumber--; /* BASIC to C */
- offset = RecordNumber;
- if (fseek (My->CurrentFile->cfp, offset, SEEK_SET) != 0)
- {
- WARN_BAD_RECORD_NUMBER;
- return (Line);
- }
- if (line_skip_seperator (Line) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- }
- do
- {
- VariableType *v;
-
- if ((v = line_read_scalar (Line)) == NULL)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (binary_get_put (v, FALSE) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- }
- while (line_skip_seperator (Line));
- /* OK */
- return (Line);
- }
- WARN_BAD_FILE_MODE;
- return (Line);
- }
-
- extern LineType *
- bwb_GET (LineType * Line)
- {
-
- assert (Line != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
-
- if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
- {
- return S70_GET (Line);
- }
- if (My->CurrentVersion->OptionVersionValue & (D71 | T79 | R86))
- {
- return D71_GET (Line);
- }
- if (My->CurrentVersion->OptionVersionValue & (H14))
- {
- return H14_GET (Line);
- }
- WARN_INTERNAL_ERROR;
- return (Line);
- }
-
- static ResultType
- file_data (VariableType * Variable, char *tbuf, int tlen)
- {
- ResultType Result;
- VariantType Variant;
- VariantType *X;
- int p;
-
- assert (Variable != NULL);
- assert (tbuf != NULL);
- assert (tlen > 0);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
- assert (My->CurrentFile != NULL);
- assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
-
-
- Result = RESULT_UNPARSED;
- X = &Variant;
- p = 0;
- CLEAR_VARIANT (X);
- if (tbuf[0] == NulChar)
- {
- /* Get more data */
- if (fgets (tbuf, tlen, My->CurrentFile->cfp)) /* file_data */
- {
- tbuf[tlen] = NulChar;
- CleanTextInput (tbuf);
- }
- else
- {
- return RESULT_UNPARSED; /* causes file_if_end() */
- }
- }
- if (VAR_IS_STRING (Variable))
- {
- Result = parse_string (tbuf, &p, X);
- }
- else
- {
- Result = parse_number (tbuf, &p, X, FALSE);
- }
- if (Result == RESULT_UNPARSED)
- {
- WARN_BAD_DATA;
- }
- if (Result != RESULT_SUCCESS)
- {
- return Result;
- }
- /*
- **
- ** OK
- **
- */
- if (X->VariantTypeCode == StringTypeCode
- && My->CurrentVersion->
- OptionFlags & OPTION_BUGS_ON /* DATA allows embedded quote pairs */ )
- {
- int i;
- int n;
- n = X->Length;
- for (i = 0; i < n; i++)
- {
- if (X->Buffer[i + 0] == My->CurrentVersion->OptionQuoteChar
- && X->Buffer[i + 1] == My->CurrentVersion->OptionQuoteChar)
- {
- bwb_strncpy (&X->Buffer[i + 0], &X->Buffer[i + 1], n - i);
- n--;
- }
- }
- X->Length = n;
- }
- if (var_set (Variable, X) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return RESULT_UNPARSED;
- }
- /*
- **
- ** Note: do NOT free() or RELEASE_VARIANT because 'X->Buffer' points into 'buffer'
- **
- */
- if (buff_is_eol (tbuf, &p))
- {
- tbuf[0] = NulChar;
- return RESULT_SUCCESS;
- }
- if (buff_skip_char (tbuf, &p, My->CurrentFile->delimit)) /* buff_skip_comma */
- {
- /* shift left past comma */
- bwb_strcpy (tbuf, &tbuf[p]);
- return RESULT_SUCCESS;
- }
- /* garbage after the value we just READ */
- WARN_BAD_DATA;
- return RESULT_UNPARSED;
- }
-
- static LineType *
- C77_file_input_line (LineType * Line)
- {
- /*
- CBASIC-II: READ # filenumber [, recnum ] ; LINE variable$
- */
- /* a flavor of LINE INPUT */
- VariableType *v;
- assert (Line != NULL);
- assert(My != NULL);
- assert (My->CurrentFile != NULL);
- assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
-
- if ((v = line_read_scalar (Line)) == NULL)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (VAR_IS_STRING (v))
- {
-
- char *tbuf;
- int tlen;
-
- assert (My->ConsoleInput != NULL);
- tbuf = My->ConsoleInput;
- tlen = MAX_LINE_LENGTH;
- /* CBASIC-II: RANDOM files are padded on the right with spaces with a '\n' in the last position */
- if (My->CurrentFile->width > MAX_LINE_LENGTH)
- {
- if (My->CurrentFile->buffer != NULL)
- {
- /* use the bigger buffer */
- tbuf = My->CurrentFile->buffer;
- tlen = My->CurrentFile->width;
- }
- }
- if (fgets (tbuf, tlen, My->CurrentFile->cfp)) /* C77_file_input_line */
- {
- tbuf[tlen] = NulChar;
- CleanTextInput (tbuf);
- }
- else
- {
- return file_if_end (Line);
- }
- /* if( TRUE ) */
- {
- VariantType variant;
-
- variant.VariantTypeCode = StringTypeCode;
- variant.Buffer = tbuf;
- variant.Length = bwb_strlen (variant.Buffer);
- if (var_set (v, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (Line);
- }
- }
- return (Line);
- }
- WARN_TYPE_MISMATCH;
- return (Line);
- }
-
- static LineType *
- C77_file_input_finish (LineType * Line)
- {
- /*
- CBASIC-II: RANDOM file reads always acccess a complete record
- */
- long ByteOffset;
- assert (Line != NULL);
- assert(My != NULL);
- assert (My->CurrentFile != NULL);
- assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
-
- /* advance to the end-of-record */
- if (My->CurrentFile->width <= 0)
- {
- WARN_FIELD_OVERFLOW;
- return (Line);
- }
- ByteOffset = ftell (My->CurrentFile->cfp);
- ByteOffset %= My->CurrentFile->width;
- if (ByteOffset != 0)
- {
- long RecordNumber;
- RecordNumber = ftell (My->CurrentFile->cfp);
- RecordNumber /= My->CurrentFile->width;
- RecordNumber++;
- RecordNumber *= My->CurrentFile->width;
- fseek (My->CurrentFile->cfp, RecordNumber, SEEK_SET);
- }
- return (Line);
- }
-
-
- static LineType *
- file_if_end (LineType * Line)
- {
- /* IF END # FileNumber THEN LineNumber */
- assert (Line != NULL);
- assert(My != NULL);
- assert (My->CurrentFile != NULL);
- assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
-
- if (My->CurrentFile->EOF_LineNumber > 0)
- {
- LineType *x;
-
- x = find_line_number (My->CurrentFile->EOF_LineNumber); /* not found in the cache */
- if (x != NULL)
- {
- /* FOUND */
- line_skip_eol (Line);
- x->position = 0;
- return x;
- }
- /* NOT FOUND */
- WARN_UNDEFINED_LINE;
- return (Line);
- }
- WARN_INPUT_PAST_END;
- return (Line);
- }
-
- static LineType *
- file_input (LineType * Line)
- {
- /* INPUT # is similar to READ, where each file line is a DATA line */
- char *tbuf;
- int tlen;
-
-
- assert (Line != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
- assert (My->CurrentFile != NULL);
- assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
-
- tbuf = My->ConsoleInput;
- tlen = MAX_LINE_LENGTH;
- if (My->CurrentVersion->OptionVersionValue & (C77))
- {
- if (line_skip_word (Line, "LINE"))
- {
- return C77_file_input_line (Line);
- }
- }
-
- if (My->CurrentFile->width > 0 && My->CurrentFile->buffer != NULL)
- {
- tlen = My->CurrentFile->width;
- tbuf = My->CurrentFile->buffer;
- }
- tbuf[0] = NulChar;
-
- /* Process each variable read from the INPUT # statement */
- do
- {
- VariableType *v;
-
- /* Read a variable name */
- if ((v = line_read_scalar (Line)) == NULL)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
-
- /* Read a file value */
- if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
- {
- return file_if_end (Line);
- }
- /* OK */
- }
- while (line_skip_seperator (Line));
-
- if (My->CurrentVersion->OptionVersionValue & (C77)
- && My->CurrentFile->DevMode & DEVMODE_RANDOM)
- {
- return C77_file_input_finish (Line);
- }
- return (Line);
- }
-
-
- /***************************************************************
-
- FUNCTION: user_input_*()
-
- DESCRIPTION: This function does INPUT processing
- from a determined string of input
- data and a determined variable list
- (both in memory). This presupposes
- that input has been taken from My->SYSIN,
- not from a disk file or device.
-
- ***************************************************************/
- static ResultType
- parse_string_isquoted (char *buffer, int *position, VariantType * X)
- {
- /*
- **
- ** QUOTED STRING
- **
- ** Note: do NOT free() or RELEASE_VARIANT because 'X->Buffer' points into 'buffer'
- **
- */
- int p;
- assert (buffer != NULL);
- assert (position != NULL);
- assert (X != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
- assert (My->CurrentFile != NULL);
- assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
-
- p = *position;
-
- buff_skip_spaces (buffer, &p); /* keep this */
- if (buffer[p] == My->CurrentVersion->OptionQuoteChar)
- {
- int Length;
- int Start;
- int QuoteCount;
-
- Length = 0;
- QuoteCount = 0;
-
- QuoteCount++;
- p++;
- Start = p;
- while (buffer[p])
- {
- if (buffer[p] == My->CurrentVersion->OptionQuoteChar
- && buffer[p + 1] == My->CurrentVersion->OptionQuoteChar
- && My->CurrentVersion->
- OptionFlags & OPTION_BUGS_ON /* INPUT allows embedded quote pairs */
- )
- {
- /* embedded quote pair "...""..." */
- QuoteCount++;
- QuoteCount++;
- p++;
- p++;
- Length++;
- Length++;
- }
- else if (buffer[p] == My->CurrentVersion->OptionQuoteChar)
- {
- /* properly terminated string "...xx..." */
- QuoteCount++;
- p++;
- break;
- }
- else
- {
- /* normal character */
- p++;
- Length++;
- }
- }
- if (My->CurrentVersion->
- OptionFlags & OPTION_BUGS_ON /* INPUT allows unmatched quotes pairs */
- )
- {
- /* silently ignore */
- }
- else if (QuoteCount & 1)
- {
- /* an ODD number of quotes (including embedded quotes) is an ERROR */
- return RESULT_UNPARSED;
- }
- /*
- **
- ** OK
- **
- */
- X->VariantTypeCode = StringTypeCode;
- X->Buffer = &buffer[Start];
- X->Length = Length;
- *position = p;
- return RESULT_SUCCESS;
- }
- return RESULT_UNPARSED;
- }
- static ResultType
- parse_string_unquoted (char *buffer, int *position, VariantType * X)
- {
- /*
- **
- ** UNQUOTED STRING
- **
- ** Note: do NOT free() or RELEASE_VARIANT because 'X->Buffer' points into 'buffer'
- **
- */
- int p;
- int Length;
- int Start;
- assert (buffer != NULL);
- assert (position != NULL);
- assert (X != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
- assert (My->CurrentFile != NULL);
- assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
-
- Length = 0;
- p = *position;
- buff_skip_spaces (buffer, &p); /* keep this */
- Start = p;
- while (buffer[p] != NulChar && buffer[p] != My->CurrentFile->delimit)
- {
- char C;
- C = buffer[p];
-
- if (My->CurrentVersion->
- OptionFlags & OPTION_BUGS_ON /* INPUT allows unquoted strings */ )
- {
- /* silently ignore */
- }
- else if (C == ' ' || C == '+' || C == '-' || C == '.' || bwb_isalnum (C))
- {
- /* if was NOT quoted, then the only valid chars are ' ', '+', '-', '.', digit, letter */
- }
- else
- {
- /* ERROR */
- return RESULT_UNPARSED;
- }
- Length++;
- p++;
- }
- /* RTRIM */
- while (Length > 0 && buffer[Start + Length - 1] == ' ')
- {
- Length--;
- }
- /*
- **
- ** OK
- **
- */
- X->VariantTypeCode = StringTypeCode;
- X->Buffer = &buffer[Start];
- X->Length = Length;
- *position = p;
- return RESULT_SUCCESS;
- }
-
- static ResultType
- parse_string (char *buffer, int *position, VariantType * X)
- {
- /*
- **
- ** STRING
- **
- ** Note: do NOT free() or RELEASE_VARIANT because 'X->Buffer' points into 'buffer'
- **
- */
- ResultType Result;
- int p;
- assert (buffer != NULL);
- assert (position != NULL);
- assert (X != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
- assert (My->CurrentFile != NULL);
- assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
-
- p = *position;
- buff_skip_spaces (buffer, &p); /* keep this */
- if (buff_is_eol (buffer, &p)
- || buff_peek_char (buffer, &p, My->CurrentFile->delimit))
- {
- /* process EMPTY response */
- if (My->CurrentVersion->
- OptionFlags & OPTION_BUGS_ON /* INPUT allows empty values */ )
- {
- /* silently ignore, value is "" */
- X->VariantTypeCode = StringTypeCode;
- X->Buffer = &buffer[p];
- X->Length = 0;
- Result = RESULT_SUCCESS;
- }
- else
- {
- return RESULT_UNPARSED;
- }
- }
- Result = parse_string_isquoted (buffer, &p, X);
- if (Result == RESULT_UNPARSED)
- {
- Result = parse_string_unquoted (buffer, &p, X);
- }
- if (Result == RESULT_SUCCESS)
- {
- *position = p;
- }
- return Result;
- }
-
- static ResultType
- parse_number (char *buffer, int *position, VariantType * X,
- int IsConsoleInput)
- {
- ResultType Result = RESULT_UNPARSED;
- int p;
- assert (buffer != NULL);
- assert (position != NULL);
- assert (X != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
- assert (My->CurrentFile != NULL);
- assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
-
- p = *position;
- buff_skip_spaces (buffer, &p); /* keep this */
- if (buff_is_eol (buffer, &p)
- || buff_peek_char (buffer, &p, My->CurrentFile->delimit))
- {
- /* process EMPTY response */
- if (My->CurrentVersion->
- OptionFlags & OPTION_BUGS_ON /* INPUT allows empty values */ )
- {
- /* silently ignore, value is 0 */
- X->VariantTypeCode = DoubleTypeCode;
- X->Number = 0;
- return RESULT_SUCCESS;
- }
- else
- {
- return RESULT_UNPARSED;
- }
- }
- Result = buff_read_hexadecimal_constant (buffer, &p, X, IsConsoleInput);
- if (Result == RESULT_UNPARSED)
- {
- Result = buff_read_octal_constant (buffer, &p, X, IsConsoleInput);
- }
- if (Result == RESULT_UNPARSED)
- {
- int IsNegative;
-
- IsNegative = FALSE;
- if (buff_skip_PlusChar (buffer, &p))
- {
- /* ignore */
- }
- else if (buff_skip_MinusChar (buffer, &p))
- {
- IsNegative = TRUE;
- }
- Result = buff_read_decimal_constant (buffer, &p, X, IsConsoleInput);
- if (Result == RESULT_SUCCESS)
- {
- if (IsNegative)
- {
- X->Number = -X->Number;
- }
- }
- }
- if (Result == RESULT_SUCCESS)
- {
- *position = p;
- }
- return Result;
- }
-
- static ResultType
- user_input_values (LineType * Line, char *buffer, int IsReal)
- {
- /*
- **
- ** given a response, match with the list of variables
- **
- */
- int p;
-
- assert (Line != NULL);
- assert (buffer != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
- assert (My->CurrentFile == My->SYSIN);
-
- p = 0;
- /* Read elements in buffer and assign them to variables in Line */
- do
- {
- ResultType Result;
- VariableType *Variable;
- VariantType Variant;
- VariantType *X;
-
- X = &Variant;
- CLEAR_VARIANT (X);
-
- /* get a variable name from the list */
- if ((Variable = line_read_scalar (Line)) == NULL)
- {
- WARN_SYNTAX_ERROR;
- return RESULT_UNPARSED;
- }
-
- /* get a value from the console response */
- Result = RESULT_UNPARSED;
- if (VAR_IS_STRING (Variable))
- {
- Result = parse_string (buffer, &p, X);
- }
- else
- {
- Result = parse_number (buffer, &p, X, TRUE);
- }
- if (Result != RESULT_SUCCESS)
- {
- return Result;
- }
- /*
- **
- ** OK
- **
- */
- if (IsReal)
- {
- /*
- **
- ** actually assign the value
- **
- */
- if (X->VariantTypeCode == StringTypeCode
- && My->CurrentVersion->
- OptionFlags & OPTION_BUGS_ON /* INPUT allows embedded quote pairs */
- )
- {
- int i;
- int n;
- n = X->Length;
- for (i = 0; i < n; i++)
- {
- if (X->Buffer[i + 0] == My->CurrentVersion->OptionQuoteChar
- && X->Buffer[i + 1] == My->CurrentVersion->OptionQuoteChar)
- {
- bwb_strncpy (&X->Buffer[i + 0], &X->Buffer[i + 1], n - i);
- n--;
- }
- }
- X->Length = n;
- }
- if (var_set (Variable, X) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return RESULT_UNPARSED;
- }
- }
- /*
- **
- ** STRING
- **
- ** Note: do NOT free() or RELEASE_VARIANT because 'X->Buffer' points into 'buffer'
- **
- */
- }
- while (line_skip_seperator (Line)
- && buff_skip_char (buffer, &p, My->CurrentFile->delimit));
-
- /* verify all variables and values consumed */
- if (line_is_eol (Line) && buff_is_eol (buffer, &p))
- {
- /*
- **
- ** OK
- **
- */
- return RESULT_SUCCESS;
- }
- /* Count mismatch */
- return RESULT_UNPARSED;
- }
-
- static LineType *
- C77_user_input_line (LineType * Line, char *Prompt, int IsDisplayQuestionMark)
- {
- /*
- **
- ** CBASIC-II: INPUT "prompt" ; LINE variable$
- **
- */
- VariableType *v;
- assert (Line != NULL);
- assert(My != NULL);
- assert (My->CurrentFile != NULL);
- assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
-
- if ((v = line_read_scalar (Line)) == NULL)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (v->VariableFlags & (VARIABLE_CONSTANT))
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (Line);
- }
- if (VAR_IS_STRING (v))
- {
- VariantType variant;
- char *tbuf;
- int tlen;
-
- tbuf = My->ConsoleInput;
- tlen = MAX_LINE_LENGTH;
- bwx_input (Prompt, IsDisplayQuestionMark, tbuf, tlen);
- variant.VariantTypeCode = StringTypeCode;
- variant.Buffer = tbuf;
- variant.Length = bwb_strlen (variant.Buffer);
- if (var_set (v, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (Line);
- }
- /* OK */
- if (Prompt != NULL)
- {
- free (Prompt);
- /* Prompt = NULL; */
- }
- return (Line);
- }
- WARN_TYPE_MISMATCH;
- return (Line);
- }
-
- static LineType *
- user_input_loop (LineType * Line)
- {
- char *Prompt;
- int IsDisplayQuestionMark;
- int SavePosition;
- assert (Line != NULL);
- assert(My != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
-
- Prompt = NULL;
- IsDisplayQuestionMark = TRUE;
- My->CurrentFile = My->SYSIN;
- /*
- **
- ** Step 1. Determine the prompt
- ** Step 2. Verify all variables exist and are not CONST
- ** Step 3. Display prompt and get user response
- ** Step 4. Assign user response to variables
- **
- */
-
- /*
- **
- ** Step 1. Determine the prompt
- **
- */
- /* INPUT , "prompt" A, B, C */
- /* INPUT ; "prompt" A, B ,C */
- /* INPUT : "prompt" A, B, C */
- if (line_skip_seperator (Line))
- {
- /* optional */
- IsDisplayQuestionMark = FALSE;
- }
-
- if (line_peek_QuoteChar (Line))
- {
- /* get prompt string */
- if (line_read_string_expression (Line, &Prompt) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (line_skip_seperator (Line) == ',' /* comma-specific */ )
- {
- /* optional */
- IsDisplayQuestionMark = FALSE;
- }
- }
-
- if (My->CurrentVersion->OptionVersionValue & (C77)
- && line_skip_word (Line, "LINE"))
- {
- /* INPUT "prompt" ; LINE variable$ */
- return C77_user_input_line (Line, Prompt, IsDisplayQuestionMark);
- }
- /*
- **
- ** Step 2. Verify all variables exist and are not CONST
- **
- */
- SavePosition = Line->position;
- do
- {
- VariableType *v;
-
- if ((v = line_read_scalar (Line)) == NULL)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (v->VariableFlags & (VARIABLE_CONSTANT))
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (Line);
- }
- }
- while (line_skip_seperator (Line));
- if (line_is_eol (Line))
- {
- /* OK */
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- while (TRUE)
- {
- char *tbuf;
- int tlen;
- ResultType Result;
-
- tbuf = My->ConsoleInput;
- tlen = MAX_LINE_LENGTH;
- /*
- **
- ** Step 3. Display prompt and get user response
- **
- */
- bwx_input (Prompt, IsDisplayQuestionMark, tbuf, tlen);
- /*
- **
- ** Step 4. Assign user response to variables
- **
- */
- Line->position = SavePosition;
- Result = user_input_values (Line, tbuf, FALSE /* FAKE run */ ); /* bwb_INPUT, user_input_loop */
- if (Result == RESULT_SUCCESS) /* bwb_INPUT */
- {
- /* successful input, FAKE run */
- Line->position = SavePosition;
- Result = user_input_values (Line, tbuf, TRUE /* REAL run */ ); /* bwb_INPUT, user_input_loop */
- if (Result == RESULT_SUCCESS)
- {
- /* successful input, REAL run */
- if (Prompt != NULL)
- {
- free (Prompt);
- Prompt = NULL;
- }
- return (Line);
- }
- }
- /* Result == RESULT_UNPARSED, RETRY */
- fputs ("?Redo from start\n", My->SYSOUT->cfp); /* "*** Retry INPUT ***\n" */
- ResetConsoleColumn ();
- }
- /* never reached */
- return (Line);
- }
-
- extern LineType *
- bwb_INPUT (LineType * Line)
- {
-
- assert (Line != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
-
- My->CurrentFile = My->SYSIN;
- if (line_skip_FilenumChar (Line))
- {
- /* INPUT # X */
- int FileNumber;
-
- if (line_read_integer_expression (Line, &FileNumber) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (line_skip_seperator (Line))
- {
- /* required */
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- /* INPUT # X , */
- if (FileNumber < 0)
- {
- /* "INPUT # -1" is an error */
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (FileNumber > 0)
- {
- /* normal file */
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- return file_input (Line);
- }
- /* "INPUT #0, varlist" is the same as "INPUT varlist" */
- }
- /* input is from My->SYSIN */
- return user_input_loop (Line);
- }
-
-
-
- /***************************************************************
-
- FUNCTION: bwb_LINE()
-
- DESCRIPTION: This function implements the BASIC LINE
- INPUT statement.
-
- SYNTAX: LINE INPUT [[#] device-number,]["prompt string";] string-variable$
-
- ***************************************************************/
- extern LineType *
- bwb_LINE (LineType * Line)
- {
-
- assert (Line != NULL);
-
- WARN_SYNTAX_ERROR;
- return (Line);
- }
-
- extern LineType *
- bwb_INPUT_LINE (LineType * Line)
- {
-
- assert (Line != NULL);
-
- return bwb_LINE_INPUT (Line);
- }
-
- extern LineType *
- bwb_LINE_INPUT (LineType * Line)
- {
- int FileNumber;
- VariableType *v;
- char *tbuf;
- int tlen;
- char *Prompt;
-
- assert (Line != NULL);
- assert(My != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
- assert(My->ConsoleInput != NULL);
- assert(MAX_LINE_LENGTH > 1);
-
- /* assign default values */
-
- tbuf = My->ConsoleInput;
- tlen = MAX_LINE_LENGTH;
- Prompt = NULL;
- My->CurrentFile = My->SYSIN;
-
- /* check for leading semicolon */
- if (line_skip_seperator (Line))
- {
- /* optional */
- }
- if (line_skip_FilenumChar (Line))
- {
- if (line_read_integer_expression (Line, &FileNumber) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (FileNumber < 0)
- {
- /* "LINE INPUT # -1" is an error */
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (FileNumber > 0)
- {
- /* normal file */
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (My->CurrentFile->cfp == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- }
- /* check for comma */
- if (line_skip_seperator (Line))
- {
- /* optional */
- }
- }
-
- /* check for quotation mark indicating prompt */
- if (line_peek_QuoteChar (Line))
- {
- /* get prompt string */
- if (line_read_string_expression (Line, &Prompt) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- /* check for comma */
- if (line_skip_seperator (Line))
- {
- /* optional */
- }
- }
-
- /* read the variable for assignment */
- if ((v = line_read_scalar (Line)) == NULL)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (VAR_IS_STRING (v))
- {
- /* OK */
- }
- else
- {
- /* ERROR */
- WARN_TYPE_MISMATCH;
- return (Line);
- }
-
- /* read a line of text into the bufffer */
- if (My->CurrentFile == My->SYSIN)
- {
- /* LINE INPUT never displays a '?' regardless of the ',' or ';' */
- bwx_input (Prompt, FALSE, tbuf, tlen);
- }
- else
- {
- if (fgets (tbuf, tlen, My->CurrentFile->cfp)) /* bwb_LINE_INPUT */
- {
- tbuf[tlen] = NulChar;
- /* jaf-20211006 CleanTextInput() converts all <' ' chars to ' '. None of
- the dialects I've used did this with `LINE INPUT ...` You could read a
- whole file, verbatim, control codes and all (other than EOL), assuming
- it had line breaks frequently enough. I was just going to patch
- CleanTextInput, but it appears it may have valid uses in other
- contexts. So lets replace the call to it with a simple EOL filter.
- Depending on OS and compiler and since we're not opening files in
- "text" mode we'll strip off up to two CRs or LFs. This means that CRLF
- endings will be handled the same as LF, even on UNIX. I don't think
- this will cause problems... I think its an advantage.
- //CleanTextInput (tbuf); */
- tlen=strlen(tbuf);
- if(tlen--) {
- if(tbuf[tlen]=='\r' || tbuf[tlen]=='\n') {
- tlen--;
- if(tlen>=0 && (tbuf[tlen]=='\r' || tbuf[tlen]=='\n')) tlen--;
- tbuf[tlen+1] = NulChar;
- }
- }
- }
- else
- {
- return file_if_end (Line);
- }
- }
- /* if( TRUE ) */
- {
- VariantType variant;
-
- variant.VariantTypeCode = StringTypeCode;
- variant.Buffer = tbuf;
- variant.Length = bwb_strlen (variant.Buffer);
- if (var_set (v, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (Line);
- }
- }
- if (Prompt != NULL)
- {
- free (Prompt);
- Prompt = NULL;
- }
- return (Line);
- }
-
- static LineType *
- file_read_matrix (LineType * Line)
- {
- /* MAT GET filename$ , matrix [, ...] */
- /* MAT READ arrayname [;|,] */
- /* Array must be 1, 2 or 3 dimensions */
- /* Array may be either NUMBER or STRING */
- VariableType *v;
-
- assert (Line != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
- assert(My->ConsoleInput != NULL);
- assert(MAX_LINE_LENGTH > 1);
- assert(My->CurrentFile != NULL);
-
- My->LastInputCount = 0;
- do
- {
- char *tbuf;
- int tlen;
-
- tbuf = My->ConsoleInput;
- tlen = MAX_LINE_LENGTH;
- if (My->CurrentFile->width > 0 && My->CurrentFile->buffer != NULL)
- {
- tlen = My->CurrentFile->width;
- tbuf = My->CurrentFile->buffer;
- }
- tbuf[0] = NulChar;
-
- My->LastInputCount = 0;
- if ((v = line_read_matrix (Line)) == NULL)
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (Line);
- }
- /* variable MUST be an array of 1, 2 or 3 dimensions */
- if (v->dimensions < 1)
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (Line);
- }
- if (v->dimensions > 3)
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (Line);
- }
-
- /* READ array */
- switch (v->dimensions)
- {
- case 1:
- {
- /*
- OPTION BASE 0
- DIM A(5)
- ...
- MAT READ A
- ...
- FOR I = 0 TO 5
- READ A(I)
- NEXT I
- ...
- */
- for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
- v->VINDEX[0]++)
- {
- if (My->CurrentFile == My->SYSIN)
- {
- if (read_data (v) != RESULT_SUCCESS)
- {
- return data_if_end (Line);
- }
- }
- else
- {
- if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
- {
- return file_if_end (Line);
- }
- }
- /* OK */
- My->LastInputCount++;
- }
- }
- break;
- case 2:
- {
- /*
- OPTION BASE 0
- DIM B(2,3)
- ...
- MAT READ B
- ...
- FOR I = 0 TO 2
- FOR J = 0 TO 3
- READ B(I,J)
- NEXT J
- PRINT
- NEXT I
- ...
- */
- for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
- v->VINDEX[0]++)
- {
- for (v->VINDEX[1] = v->LBOUND[1]; v->VINDEX[1] <= v->UBOUND[1];
- v->VINDEX[1]++)
- {
- if (My->CurrentFile == My->SYSIN)
- {
- if (read_data (v) != RESULT_SUCCESS)
- {
- return data_if_end (Line);
- }
- }
- else
- {
- if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
- {
- return file_if_end (Line);
- }
- }
- /* OK */
- My->LastInputCount++;
- }
- }
- }
- break;
- case 3:
- {
- /*
- OPTION BASE 0
- DIM C(2,3,4)
- ...
- MAT READ C
- ...
- FOR I = 0 TO 2
- FOR J = 0 TO 3
- FOR K = 0 TO 4
- READ C(I,J,K)
- NEXT K
- PRINT
- NEXT J
- PRINT
- NEXT I
- ...
- */
- for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
- v->VINDEX[0]++)
- {
- for (v->VINDEX[1] = v->LBOUND[1]; v->VINDEX[1] <= v->UBOUND[1];
- v->VINDEX[1]++)
- {
- for (v->VINDEX[2] = v->LBOUND[2]; v->VINDEX[2] <= v->UBOUND[2];
- v->VINDEX[2]++)
- {
- if (My->CurrentFile == My->SYSIN)
- {
- if (read_data (v) != RESULT_SUCCESS)
- {
- return data_if_end (Line);
- }
- }
- else
- {
- if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
- {
- return file_if_end (Line);
- }
- }
- /* OK */
- My->LastInputCount++;
- }
- }
- }
- }
- break;
- }
- /* process the next variable, if any */
- }
- while (line_skip_seperator (Line));
- return (Line);
- }
-
- extern LineType *
- bwb_MAT_GET (LineType * Line)
- {
- /* MAT GET filename$ , matrix [, ...] */
- VariantType E;
- VariantType *e;
-
- assert (Line != NULL);
- assert(My != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
-
- e = &E;
- My->CurrentFile = My->SYSIN;
- if (line_read_expression (Line, e) == FALSE) /* bwb_MAT_GET */
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (e->VariantTypeCode == StringTypeCode)
- {
- /* STRING */
- /* MAT GET filename$ ... */
- if (is_empty_string (e->Buffer))
- {
- /* MAT GET "" ... is an error */
- WARN_BAD_FILE_NAME;
- return (Line);
- }
- My->CurrentFile = find_file_by_name (e->Buffer);
- if (My->CurrentFile == NULL)
- {
- /* implicitly OPEN for reading */
- My->CurrentFile = file_new ();
- My->CurrentFile->cfp = fopen (e->Buffer, "r");
- if (My->CurrentFile->cfp == NULL)
- {
- WARN_BAD_FILE_NAME;
- return (Line);
- }
- My->CurrentFile->FileNumber = file_next_number ();
- My->CurrentFile->DevMode = DEVMODE_INPUT;
- My->CurrentFile->width = 0;
- /* WIDTH == RECLEN */
- My->CurrentFile->col = 1;
- My->CurrentFile->row = 1;
- My->CurrentFile->delimit = ',';
- My->CurrentFile->buffer = NULL;
- if (My->CurrentFile->FileName != NULL)
- {
- free (My->CurrentFile->FileName);
- My->CurrentFile->FileName = NULL;
- }
- My->CurrentFile->FileName = e->Buffer;
- e->Buffer = NULL;
- }
- }
- else
- {
- /* NUMBER -- file must already be OPEN */
- /* GET filenumber ... */
- if (e->Number < 0)
- {
- /* "MAT GET # -1" is an error */
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (e->Number == 0)
- {
- /* "MAT GET # 0" is an error */
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- /* normal file */
- My->CurrentFile = find_file_by_number ((int) bwb_rint (e->Number));
- if (My->CurrentFile == NULL)
- {
- /* file not OPEN */
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- }
- if (My->CurrentFile == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (line_skip_seperator (Line))
- {
- /* OK */
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- return file_read_matrix (Line);
- }
-
-
- extern LineType *
- bwb_MAT_READ (LineType * Line)
- {
- /* MAT READ arrayname [;|,] */
- /* Array must be 1, 2 or 3 dimensions */
- /* Array may be either NUMBER or STRING */
-
- assert (Line != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
-
- My->CurrentFile = My->SYSIN;
- My->LastInputCount = 0;
- if (line_skip_FilenumChar (Line))
- {
- /* MAT READ # filenum, varlist */
- int FileNumber;
-
- if (line_read_integer_expression (Line, &FileNumber) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
-
- if (line_skip_seperator (Line))
- {
- /* OK */
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (My->CurrentFile != My->SYSIN)
- {
- if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (My->CurrentFile->cfp == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- }
- /* "MAT READ # 0, varlist" is the same as "MAT READ varlist" */
- }
- return file_read_matrix (Line);
- }
-
- static ResultType
- input_data (VariableType * Variable, char *tbuf, int tlen)
- {
- /*
- **
- ** read one INPUT item
- **
- */
- int p;
- ResultType Result;
- VariantType Variant;
- VariantType *X;
-
- assert (Variable != NULL);
- assert (tbuf != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
- assert(My->CurrentFile != NULL);
- assert (My->CurrentFile == My->SYSIN);
-
- Result = RESULT_UNPARSED;
- X = &Variant;
- CLEAR_VARIANT (X);
- if (tbuf[0] == NulChar)
- {
- /* Get more data */
- bwx_input ("?", FALSE, tbuf, tlen);
- if (tbuf[0] == NulChar)
- {
- return RESULT_UNPARSED;
- }
- /*
- **
- ** make sure we can parse everything in tbuf
- **
- */
- p = 0;
- do
- {
- do
- {
- if (VAR_IS_STRING (Variable))
- {
- Result = parse_string (tbuf, &p, X);
- }
- else
- {
- Result = parse_number (tbuf, &p, X, FALSE);
- }
- }
- while (buff_skip_seperator (tbuf, &p) && Result == RESULT_SUCCESS);
- /* verify we consumed all user values */
- if (buff_is_eol (tbuf, &p))
- {
- /* we reached the end of the user's input */
- }
- else
- {
- /* garbage in user's input */
- Result = RESULT_UNPARSED;
- }
- if (Result != RESULT_SUCCESS)
- {
- tbuf[0] = NulChar;
- bwx_input ("?Redo", FALSE, tbuf, tlen);
- if (tbuf[0] == NulChar)
- {
- return RESULT_UNPARSED;
- }
- p = 0;
- }
- }
- while (Result != RESULT_SUCCESS);
- /*
- **
- ** so, we can parse all of the user's input (everything in tbuf)
- **
- */
- }
- /* process one value */
- p = 0;
- if (VAR_IS_STRING (Variable))
- {
- Result = parse_string (tbuf, &p, X);
- }
- else
- {
- Result = parse_number (tbuf, &p, X, FALSE);
- }
- if (Result != RESULT_SUCCESS)
- {
- WARN_INTERNAL_ERROR;
- return RESULT_UNPARSED;
- }
- if (X->VariantTypeCode == StringTypeCode
- && My->CurrentVersion->
- OptionFlags & OPTION_BUGS_ON /* DATA allows embedded quote pairs */ )
- {
- int i;
- int n;
- n = X->Length;
- for (i = 0; i < n; i++)
- {
- if (X->Buffer[i + 0] == My->CurrentVersion->OptionQuoteChar
- && X->Buffer[i + 1] == My->CurrentVersion->OptionQuoteChar)
- {
- bwb_strncpy (&X->Buffer[i + 0], &X->Buffer[i + 1], n - i);
- n--;
- }
- }
- X->Length = n;
- }
- if (var_set (Variable, X) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return RESULT_UNPARSED;
- }
- /* determine whether all user input was consumed */
- if (buff_is_eol (tbuf, &p))
- {
- /* we have consumed the entire buffer */
- tbuf[0] = NulChar;
- return RESULT_SUCCESS;
- }
- if (buff_skip_char (tbuf, &p, My->CurrentFile->delimit)) /* buff_skip_comma */
- {
- /* shift the buffer left, just past the comma (,) */
- bwb_strcpy (tbuf, &tbuf[p]);
- return RESULT_SUCCESS;
- }
- /* garbage after the value we just READ */
- WARN_BAD_DATA;
- return RESULT_UNPARSED;
- }
-
- extern LineType *
- bwb_MAT_INPUT (LineType * Line)
- {
- /* MAT INPUT arrayname [;|,] */
- /* Array must be 1, 2 or 3 dimensions */
- /* Array may be either NUMBER or STRING */
- VariableType *v;
-
- assert (Line != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
- assert(My->ConsoleInput != NULL);
- assert(MAX_LINE_LENGTH > 1);
-
- My->CurrentFile = My->SYSIN;
- My->LastInputCount = 0;
- if (line_skip_FilenumChar (Line))
- {
- /* MAT INPUT # filenum, varlist */
- int FileNumber;
-
- if (line_read_integer_expression (Line, &FileNumber) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
-
- if (line_skip_seperator (Line))
- {
- /* OK */
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (My->CurrentFile != My->SYSIN)
- {
- if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- if (My->CurrentFile->cfp == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (Line);
- }
- }
- /* "MAT INPUT # 0, varlist" is the same as "MAT INPUT varlist" */
- }
-
- do
- {
- char *tbuf;
- int tlen;
-
- tbuf = My->ConsoleInput;
- tlen = MAX_LINE_LENGTH;
- if (My->CurrentFile->width > 0 && My->CurrentFile->buffer != NULL)
- {
- tlen = My->CurrentFile->width;
- tbuf = My->CurrentFile->buffer;
- }
- tbuf[0] = NulChar;
-
-
- My->LastInputCount = 0;
- if ((v = line_read_matrix (Line)) == NULL)
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (Line);
- }
- /* variable MUST be an array of 1, 2 or 3 dimensions */
- if (v->dimensions < 1)
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (Line);
- }
- if (v->dimensions > 3)
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (Line);
- }
-
- /* INPUT array */
- switch (v->dimensions)
- {
- case 1:
- {
- /*
- OPTION BASE 0
- DIM A(5)
- ...
- MAT INPUT A
- ...
- FOR I = 0 TO 5
- INPUT A(I)
- NEXT I
- ...
- */
- My->LastInputCount = 0;
- for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
- v->VINDEX[0]++)
- {
- if (My->CurrentFile == My->SYSIN)
- {
- if (input_data (v, tbuf, tlen) != RESULT_SUCCESS)
- {
- /*
- WARN_INPUT_PAST_END;
- */
- return (Line);
- }
- }
- else
- {
- if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
- {
- return file_if_end (Line);
- }
- }
- /* OK */
- My->LastInputCount++;
- }
- }
- break;
- case 2:
- {
- /*
- OPTION BASE 0
- DIM B(2,3)
- ...
- MAT INPUT B
- ...
- FOR I = 0 TO 2
- FOR J = 0 TO 3
- INPUT B(I,J)
- NEXT J
- PRINT
- NEXT I
- ...
- */
- My->LastInputCount = 0;
- for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
- v->VINDEX[0]++)
- {
- for (v->VINDEX[1] = v->LBOUND[1]; v->VINDEX[1] <= v->UBOUND[1];
- v->VINDEX[1]++)
- {
- if (My->CurrentFile == My->SYSIN)
- {
- if (input_data (v, tbuf, tlen) != RESULT_SUCCESS)
- {
- /*
- WARN_INPUT_PAST_END;
- */
- return (Line);
- }
- }
- else
- {
- if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
- {
- return file_if_end (Line);
- }
- }
- /* OK */
- My->LastInputCount++;
- }
- }
- }
- break;
- case 3:
- {
- /*
- OPTION BASE 0
- DIM C(2,3,4)
- ...
- MAT INPUT C
- ...
- FOR I = 0 TO 2
- FOR J = 0 TO 3
- FOR K = 0 TO 4
- INPUT C(I,J,K)
- NEXT K
- PRINT
- NEXT J
- PRINT
- NEXT I
- ...
- */
- My->LastInputCount = 0;
- for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
- v->VINDEX[0]++)
- {
- for (v->VINDEX[1] = v->LBOUND[1]; v->VINDEX[1] <= v->UBOUND[1];
- v->VINDEX[1]++)
- {
- for (v->VINDEX[2] = v->LBOUND[2]; v->VINDEX[2] <= v->UBOUND[2];
- v->VINDEX[2]++)
- {
- if (My->CurrentFile == My->SYSIN)
- {
- if (input_data (v, tbuf, tlen) != RESULT_SUCCESS)
- {
- /*
- WARN_INPUT_PAST_END;
- */
- return (Line);
- }
- }
- else
- {
- if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
- {
- return file_if_end (Line);
- }
- }
- /* OK */
- My->LastInputCount++;
- }
- }
- }
- }
- break;
- }
- /* process the next variable, if any */
- }
- while (line_skip_seperator (Line));
- return (Line);
- }
-
- /* EOF */
|