ChipMaster's bwBASIC This also includes history going back to v2.10. *WARN* some binary files might have been corrupted by CRLF.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

3555 lines
78 KiB

  1. /***************************************************************
  2. bwb_inp.c Input Routines
  3. for Bywater BASIC Interpreter
  4. Copyright (c) 1993, Ted A. Campbell
  5. Bywater Software
  6. email: tcamp@delphi.com
  7. Copyright and Permissions Information:
  8. All U.S. and international rights are claimed by the author,
  9. Ted A. Campbell.
  10. This software is released under the terms of the GNU General
  11. Public License (GPL), which is distributed with this software
  12. in the file "COPYING". The GPL specifies the terms under
  13. which users may copy and use the software in this distribution.
  14. A separate license is available for commercial distribution,
  15. for information on which you should contact the author.
  16. ***************************************************************/
  17. /*---------------------------------------------------------------*/
  18. /* NOTE: Modifications marked "JBV" were made by Jon B. Volkoff, */
  19. /* 11/1995 (eidetics@cerf.net). */
  20. /* */
  21. /* Those additionally marked with "DD" were at the suggestion of */
  22. /* Dale DePriest (daled@cadence.com). */
  23. /* */
  24. /* Version 3.00 by Howard Wulf, AF5NE */
  25. /* */
  26. /* Version 3.10 by Howard Wulf, AF5NE */
  27. /* */
  28. /* Version 3.20 by Howard Wulf, AF5NE */
  29. /* */
  30. /*---------------------------------------------------------------*/
  31. #include "bwbasic.h"
  32. static LineType *C77_file_input (LineType * Line, int FileNumber);
  33. static LineType *C77_file_input_finish (LineType * Line);
  34. static LineType *C77_file_input_line (LineType * Line);
  35. static LineType *C77_user_input_line (LineType * Line, char *Prompt,
  36. int IsDisplayQuestionMark);
  37. static void CleanTextInput (char *buffer);
  38. static LineType *D71_GET (LineType * Line);
  39. static LineType *data_if_end (LineType * Line);
  40. static LineType *data_restore (LineType * Line);
  41. static ResultType file_data (VariableType * Variable, char *tbuf, int tlen);
  42. static LineType *file_if_end (LineType * Line);
  43. static LineType *file_input (LineType * Line);
  44. static LineType *file_read_matrix (LineType * Line);
  45. static LineType *file_restore (LineType * Line);
  46. static LineType *H14_GET (LineType * Line);
  47. static ResultType input_data (VariableType * Variable, char *tbuf, int tlen);
  48. static ResultType parse_number (char *buffer, int *position, VariantType * X,
  49. int IsConsoleInput);
  50. static ResultType parse_string (char *buffer, int *position, VariantType * X);
  51. static ResultType parse_string_isquoted (char *buffer, int *position,
  52. VariantType * X);
  53. static ResultType parse_string_unquoted (char *buffer, int *position,
  54. VariantType * X);
  55. static ResultType read_data (VariableType * Variable);
  56. static LineType *read_file (LineType * Line);
  57. static LineType *read_list (LineType * Line);
  58. static LineType *S70_GET (LineType * Line);
  59. static LineType *user_input_loop (LineType * Line);
  60. static ResultType user_input_values (LineType * Line, char *buffer,
  61. int IsReal);
  62. int
  63. bwb_is_eof (FILE * fp)
  64. {
  65. /*
  66. Have you ever wondered why C file I/O is slow? Here is the reason:
  67. feof() is not set until after a file read error occurs; sad but true.
  68. In order to determine whether you are at the end-of-file,
  69. you have to call both ftell() and fseek() twice,
  70. which effectively trashes any I/O cache scheme.
  71. */
  72. assert (fp != NULL);
  73. if (fp != NULL)
  74. {
  75. long current;
  76. long total;
  77. current = ftell (fp);
  78. fseek (fp, 0, SEEK_END);
  79. total = ftell (fp);
  80. if (total == current)
  81. {
  82. /* EOF */
  83. return TRUE;
  84. }
  85. else
  86. {
  87. /* NOT EOF */
  88. fseek (fp, current, SEEK_SET);
  89. return FALSE;
  90. }
  91. }
  92. /* a closed file is always EOF */
  93. return TRUE;
  94. }
  95. static void
  96. CleanTextInput (char *buffer)
  97. {
  98. /*
  99. **
  100. ** Clean the TEXT in the INPUT buffer after fgets(). Not for RANDOM or BINARY.
  101. **
  102. */
  103. char *E;
  104. assert (buffer != NULL);
  105. /*
  106. **
  107. ** some compilers remove CR, but not LF.
  108. ** some compilers remove LF, but not CR.
  109. ** some compilers remove CR/LF but not LF/CR.
  110. ** some compilers remove both CR and LF.
  111. ** some compilers remove the first CR or LF, but not the second LF or CR.
  112. ** some compilers don't remove either CR or LF.
  113. ** and so on.
  114. **
  115. */
  116. E = bwb_strchr (buffer, '\r');
  117. if (E != NULL)
  118. {
  119. *E = NulChar;
  120. }
  121. E = bwb_strchr (buffer, '\n');
  122. if (E != NULL)
  123. {
  124. *E = NulChar;
  125. }
  126. /*
  127. **
  128. ** Suppress all control characters.
  129. ** In theory, there should not be any control characters at all.
  130. ** In reality, they occassionally occur.
  131. **
  132. */
  133. while (*buffer)
  134. {
  135. if (bwb_isprint (*buffer) == FALSE)
  136. {
  137. *buffer = ' ';
  138. }
  139. buffer++;
  140. }
  141. }
  142. /***************************************************************
  143. FUNCTION: bwx_input()
  144. DESCRIPTION: This function outputs the string pointed
  145. to by 'prompt', then inputs a character
  146. string.
  147. ***************************************************************/
  148. extern int
  149. bwx_input (char *prompt, int IsDisplayQuestionMark, char *answer, int MaxLen)
  150. {
  151. assert (answer != NULL);
  152. assert(My != NULL);
  153. assert(My->SYSOUT != NULL);
  154. assert(My->SYSOUT->cfp != NULL);
  155. assert(My->SYSIN != NULL);
  156. assert(My->SYSIN->cfp != NULL);
  157. if (prompt != NULL)
  158. {
  159. while (*prompt)
  160. {
  161. if (*prompt == '\n')
  162. {
  163. My->SYSOUT->col = 0; /* incremented below */
  164. My->SYSOUT->row++;
  165. }
  166. else
  167. if (My->SYSOUT->width > 0
  168. && My->SYSOUT->col > My->SYSOUT->width /* && *prompt != '\n' */ )
  169. {
  170. fputc ('\n', My->SYSOUT->cfp);
  171. My->SYSOUT->col = 0; /* incremented below */
  172. My->SYSOUT->row++;
  173. }
  174. fputc (*prompt, My->SYSOUT->cfp);
  175. My->SYSOUT->col++;
  176. prompt++;
  177. }
  178. }
  179. if (IsDisplayQuestionMark)
  180. {
  181. fputs ("? ", My->SYSOUT->cfp);
  182. My->SYSOUT->col += 2;
  183. }
  184. fflush (My->SYSOUT->cfp);
  185. /*
  186. **
  187. ** for PTR or OPTION STDIN ...
  188. **
  189. */
  190. if (My->SYSIN->cfp != stdin)
  191. {
  192. /* this file was opened by PTR or OPTION STDIN commands */
  193. if (fgets (answer, MaxLen, My->SYSIN->cfp)) /* bwx_input */
  194. {
  195. answer[MaxLen] = NulChar;
  196. CleanTextInput (answer);
  197. fputs (answer, My->SYSOUT->cfp);
  198. fputc ('\n', My->SYSOUT->cfp);
  199. fflush (My->SYSOUT->cfp);
  200. ResetConsoleColumn ();
  201. return TRUE;
  202. }
  203. /* stop reading from PTR or OPTION STDIN once all INPUT lines have been read */
  204. bwb_fclose (My->SYSIN->cfp);
  205. My->SYSIN->cfp = stdin;
  206. /* INPUT reverts to stdin */
  207. }
  208. /* My->SYSIN->cfp == stdin */
  209. /*
  210. **
  211. ** ... for PTR or OPTION STDIN
  212. **
  213. */
  214. /*
  215. **
  216. ** for automated testing ...
  217. **
  218. */
  219. if (My->ExternalInputFile != NULL)
  220. {
  221. /* this file was opened by --TAPE command line parameter */
  222. if (fgets (answer, MaxLen, My->ExternalInputFile)) /* bwx_input */
  223. {
  224. answer[MaxLen] = NulChar;
  225. CleanTextInput (answer);
  226. fputs (answer, My->SYSOUT->cfp);
  227. fputc ('\n', My->SYSOUT->cfp);
  228. fflush (My->SYSOUT->cfp);
  229. ResetConsoleColumn ();
  230. return TRUE;
  231. }
  232. /* stop reading from --TAPE once all INPUT lines have been read */
  233. bwb_fclose (My->ExternalInputFile);
  234. My->ExternalInputFile = NULL;
  235. /* INPUT reverts to My->SYSIN->cfp */
  236. }
  237. /*
  238. **
  239. ** ... for automated testing
  240. **
  241. */
  242. if (fgets (answer, MaxLen, My->SYSIN->cfp)) /* bwx_input */
  243. {
  244. /* this is stdin */
  245. answer[MaxLen] = NulChar;
  246. CleanTextInput (answer);
  247. ResetConsoleColumn ();
  248. return TRUE;
  249. }
  250. /* nothing was read from stdin */
  251. answer[0] = NulChar;
  252. CleanTextInput (answer);
  253. ResetConsoleColumn ();
  254. return FALSE;
  255. }
  256. extern LineType *
  257. bwb_BACKSPACE (LineType * Line)
  258. {
  259. assert (Line != NULL);
  260. assert(My != NULL);
  261. assert(My->SYSIN != NULL);
  262. assert(My->SYSIN->cfp != NULL);
  263. My->CurrentFile = My->SYSIN;
  264. if (line_skip_FilenumChar (Line))
  265. {
  266. /* BACKSPACE # filenum */
  267. int FileNumber;
  268. if (line_read_integer_expression (Line, &FileNumber) == FALSE)
  269. {
  270. WARN_SYNTAX_ERROR;
  271. return (Line);
  272. }
  273. if (FileNumber < 0)
  274. {
  275. /* "BACKSPACE # -1" is silently ignored */
  276. return (Line);
  277. }
  278. if (FileNumber == 0)
  279. {
  280. /* "BACKSPACE # 0" is silently ignored */
  281. return (Line);
  282. }
  283. My->CurrentFile = find_file_by_number (FileNumber);
  284. if (My->CurrentFile == NULL)
  285. {
  286. WARN_BAD_FILE_NUMBER;
  287. return (Line);
  288. }
  289. if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
  290. {
  291. WARN_BAD_FILE_NUMBER;
  292. return (Line);
  293. }
  294. /* not for the console */
  295. /* if( TRUE ) */
  296. {
  297. FILE *f;
  298. long Offset;
  299. int DelimiterCount;
  300. int InQuote;
  301. int C;
  302. f = My->CurrentFile->cfp;
  303. Offset = ftell (f);
  304. Offset--;
  305. DelimiterCount = 0;
  306. InQuote = FALSE;
  307. AGAIN:
  308. if (Offset <= 0)
  309. {
  310. goto DONE;
  311. }
  312. fseek (f, Offset, SEEK_SET);
  313. C = fgetc (f);
  314. if (InQuote)
  315. {
  316. if (C == My->CurrentVersion->OptionQuoteChar)
  317. {
  318. InQuote = FALSE;
  319. }
  320. Offset--;
  321. goto AGAIN;
  322. }
  323. if (C == My->CurrentVersion->OptionQuoteChar)
  324. {
  325. InQuote = TRUE;
  326. Offset--;
  327. goto AGAIN;
  328. }
  329. if (C == ',')
  330. {
  331. DelimiterCount++;
  332. if (DelimiterCount > 1)
  333. {
  334. Offset++;
  335. goto DONE;
  336. }
  337. Offset--;
  338. goto AGAIN;
  339. }
  340. if (C == '\n')
  341. {
  342. DelimiterCount++;
  343. if (DelimiterCount > 1)
  344. {
  345. Offset++;
  346. goto DONE;
  347. }
  348. Offset--;
  349. if (Offset <= 0)
  350. {
  351. goto DONE;
  352. }
  353. fseek (f, Offset, SEEK_SET);
  354. C = fgetc (f);
  355. if (C == '\r')
  356. {
  357. Offset--;
  358. }
  359. goto AGAIN;
  360. }
  361. if (C == '\r')
  362. {
  363. DelimiterCount++;
  364. if (DelimiterCount > 1)
  365. {
  366. Offset++;
  367. goto DONE;
  368. }
  369. Offset--;
  370. if (Offset <= 0)
  371. {
  372. goto DONE;
  373. }
  374. fseek (f, Offset, SEEK_SET);
  375. C = fgetc (f);
  376. if (C == '\n')
  377. {
  378. Offset--;
  379. }
  380. goto AGAIN;
  381. }
  382. Offset--;
  383. goto AGAIN;
  384. DONE:
  385. if (Offset < 0)
  386. {
  387. Offset = 0;
  388. }
  389. fseek (f, Offset, SEEK_SET);
  390. }
  391. }
  392. /* BACKSPACE for console is silently ignored */
  393. return (Line);
  394. }
  395. /***************************************************************
  396. FUNCTION: bwb_read()
  397. DESCRIPTION: This function implements the BASIC READ
  398. statement.
  399. SYNTAX: READ variable[, variable...]
  400. ***************************************************************/
  401. static LineType *
  402. C77_file_input (LineType * Line, int FileNumber)
  403. {
  404. /*
  405. CBASIC-II: SERIAL & RANDOM file reads
  406. READ # FileNumber ; [ scalar [ , ... ] ] ' SERIAL
  407. READ # FileNumber , RecordNumber ; [ scalar [ , ... ] ] ' RANDOM
  408. */
  409. assert (Line != NULL);
  410. assert(My != NULL);
  411. if (FileNumber <= 0)
  412. {
  413. WARN_BAD_FILE_NUMBER;
  414. return (Line);
  415. }
  416. /* normal file */
  417. My->CurrentFile = find_file_by_number (FileNumber);
  418. if (My->CurrentFile == NULL)
  419. {
  420. WARN_BAD_FILE_NUMBER;
  421. return (Line);
  422. }
  423. if (line_skip_CommaChar (Line) /* comma-specific */ )
  424. {
  425. /*
  426. READ # FileNumber , RecordNumber ; [ scalar [ , ... ] ] ' RANDOM
  427. */
  428. /* get the RecordNumber */
  429. int RecordNumber;
  430. if ((My->CurrentFile->DevMode & DEVMODE_RANDOM) == 0)
  431. {
  432. WARN_BAD_FILE_MODE;
  433. return (Line);
  434. }
  435. if (My->CurrentFile->width <= 0)
  436. {
  437. WARN_FIELD_OVERFLOW;
  438. return (Line);
  439. }
  440. if (line_read_integer_expression (Line, &RecordNumber) == FALSE)
  441. {
  442. WARN_SYNTAX_ERROR;
  443. return (Line);
  444. }
  445. if (RecordNumber <= 0)
  446. {
  447. WARN_BAD_RECORD_NUMBER;
  448. return (Line);
  449. }
  450. RecordNumber--; /* BASIC to C */
  451. /* if( TRUE ) */
  452. {
  453. long offset;
  454. offset = RecordNumber;
  455. offset *= My->CurrentFile->width;
  456. fseek (My->CurrentFile->cfp, offset, SEEK_SET);
  457. }
  458. }
  459. if (line_is_eol (Line))
  460. {
  461. /* READ # filenum */
  462. /* READ # filenum , recnum */
  463. return (Line);
  464. }
  465. if (line_skip_SemicolonChar (Line) /* semicolon specific */ )
  466. {
  467. /* READ # filenum ; */
  468. /* READ # filenum , recnum ; */
  469. }
  470. else
  471. {
  472. WARN_SYNTAX_ERROR;
  473. return (Line);
  474. }
  475. if (line_is_eol (Line))
  476. {
  477. return (Line);
  478. }
  479. /* input is not from #0, so branch to file_input() */
  480. return file_input (Line);
  481. }
  482. static LineType *
  483. data_if_end (LineType * Line)
  484. {
  485. WARN_OUT_OF_DATA;
  486. return (Line);
  487. }
  488. static ResultType
  489. read_data (VariableType * Variable)
  490. {
  491. /*
  492. **
  493. ** read one DATA item
  494. **
  495. */
  496. ResultType Result;
  497. VariantType Variant;
  498. VariantType *X;
  499. assert (Variable != NULL);
  500. assert(My != NULL);
  501. assert(My->SYSIN != NULL);
  502. assert(My->SYSIN->cfp != NULL);
  503. assert (My->CurrentFile == My->SYSIN);
  504. assert(My->DataLine != NULL);
  505. assert(My->EndMarker != NULL);
  506. Result = RESULT_UNPARSED;
  507. X = &Variant;
  508. CLEAR_VARIANT (X);
  509. if (My->DataLine == My->EndMarker)
  510. {
  511. return RESULT_UNPARSED;
  512. }
  513. if (My->DataLine->cmdnum != C_DATA)
  514. {
  515. WARN_INTERNAL_ERROR;
  516. return RESULT_UNPARSED;
  517. }
  518. if (VAR_IS_STRING (Variable))
  519. {
  520. Result = parse_string (My->DataLine->buffer, &My->DataPosition, X);
  521. }
  522. else
  523. {
  524. Result = parse_number (My->DataLine->buffer, &My->DataPosition, X, FALSE);
  525. }
  526. if (Result == RESULT_UNPARSED)
  527. {
  528. WARN_BAD_DATA;
  529. }
  530. if (Result != RESULT_SUCCESS)
  531. {
  532. return Result;
  533. }
  534. /*
  535. **
  536. ** OK
  537. **
  538. */
  539. if (X->VariantTypeCode == StringTypeCode
  540. && My->CurrentVersion->OptionFlags & OPTION_BUGS_ON ) /* DATA allows embedded quote pairs */
  541. {
  542. int i;
  543. int n;
  544. n = X->Length;
  545. for (i = 0; i < n; i++)
  546. {
  547. if (X->Buffer[i + 0] == My->CurrentVersion->OptionQuoteChar
  548. && X->Buffer[i + 1] == My->CurrentVersion->OptionQuoteChar)
  549. {
  550. bwb_strncpy (&X->Buffer[i + 0], &X->Buffer[i + 1], n - i);
  551. n--;
  552. }
  553. }
  554. X->Length = n;
  555. }
  556. if (var_set (Variable, X) == FALSE)
  557. {
  558. WARN_VARIABLE_NOT_DECLARED;
  559. return RESULT_UNPARSED;
  560. }
  561. /*
  562. **
  563. ** Note: do NOT free() or RELEASE_VARIANT because 'X->Buffer' points into 'buffer'
  564. **
  565. */
  566. if (buff_is_eol (My->DataLine->buffer, &My->DataPosition))
  567. {
  568. /* at the end of the current DATA statement */
  569. if (My->CurrentVersion->OptionFlags & OPTION_COVERAGE_ON)
  570. {
  571. /* this line has been READ */
  572. My->DataLine->LineFlags |= LINE_EXECUTED;
  573. }
  574. My->DataLine = My->DataLine->OtherLine;
  575. My->DataPosition = My->DataLine->Startpos;
  576. return RESULT_SUCCESS;
  577. }
  578. if (buff_skip_char (My->DataLine->buffer, &My->DataPosition, My->CurrentFile->delimit)) /* buff_skip_comma */
  579. {
  580. return RESULT_SUCCESS;
  581. }
  582. /* garbage after the value we just READ */
  583. WARN_BAD_DATA;
  584. return RESULT_UNPARSED;
  585. }
  586. static LineType *
  587. read_list (LineType * Line)
  588. {
  589. /* READ varlist */
  590. assert (Line != NULL);
  591. assert(My != NULL);
  592. assert(My->SYSIN != NULL);
  593. assert(My->SYSIN->cfp != NULL);
  594. assert (My->CurrentFile == My->SYSIN);
  595. do
  596. {
  597. VariableType *Variable;
  598. /* get a variable */
  599. if ((Variable = line_read_scalar (Line)) == NULL)
  600. {
  601. WARN_SYNTAX_ERROR;
  602. return (Line);
  603. }
  604. /* READ data into the variable */
  605. if (read_data (Variable) != RESULT_SUCCESS)
  606. {
  607. return data_if_end (Line);
  608. }
  609. }
  610. while (line_skip_seperator (Line));
  611. return (Line);
  612. }
  613. static LineType *
  614. read_file (LineType * Line)
  615. {
  616. /* READ # filenum, varlist */
  617. int FileNumber;
  618. assert (Line != NULL);
  619. assert(My != NULL);
  620. assert(My->CurrentVersion != NULL);
  621. if (line_read_integer_expression (Line, &FileNumber) == FALSE)
  622. {
  623. WARN_SYNTAX_ERROR;
  624. return (Line);
  625. }
  626. if (My->CurrentVersion->OptionVersionValue & (C77))
  627. {
  628. return C77_file_input (Line, FileNumber);
  629. }
  630. /*
  631. SERIAL file reads:
  632. READ # FileNumber
  633. READ # FileNumber [, scalar]
  634. */
  635. if (line_skip_seperator (Line))
  636. {
  637. /* required */
  638. }
  639. else
  640. {
  641. WARN_SYNTAX_ERROR;
  642. return (Line);
  643. }
  644. if (FileNumber < 0)
  645. {
  646. /* "READ # -1" is an error */
  647. WARN_BAD_FILE_NUMBER;
  648. return (Line);
  649. }
  650. if (FileNumber > 0)
  651. {
  652. /* normal file */
  653. My->CurrentFile = find_file_by_number (FileNumber);
  654. if (My->CurrentFile == NULL)
  655. {
  656. WARN_BAD_FILE_NUMBER;
  657. return (Line);
  658. }
  659. if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
  660. {
  661. WARN_BAD_FILE_NUMBER;
  662. return (Line);
  663. }
  664. /* input is not from #0, so branch to file_input() */
  665. return file_input (Line);
  666. }
  667. /* "READ # 0, varlist" is the same as "READ varlist" */
  668. return read_list (Line);
  669. }
  670. extern LineType *
  671. bwb_READ (LineType * Line)
  672. {
  673. assert (Line != NULL);
  674. assert(My != NULL);
  675. assert(My->SYSIN != NULL);
  676. assert(My->SYSIN->cfp != NULL);
  677. My->CurrentFile = My->SYSIN;
  678. if (line_skip_FilenumChar (Line))
  679. {
  680. return read_file (Line);
  681. }
  682. return read_list (Line);
  683. }
  684. /***************************************************************
  685. FUNCTION: bwb_data()
  686. DESCRIPTION: This function implements the BASIC DATA
  687. statement, although at the point at which
  688. DATA statements are encountered, no
  689. processing is done. All actual processing
  690. of DATA statements is accomplished by READ
  691. (bwb_read()).
  692. SYNTAX: DATA constant[, constant]...
  693. ***************************************************************/
  694. extern LineType *
  695. bwb_DATA (LineType * Line)
  696. {
  697. assert (Line != NULL);
  698. if (Line->LineFlags & (LINE_USER))
  699. {
  700. WARN_ILLEGAL_DIRECT;
  701. return (Line);
  702. }
  703. line_skip_eol (Line);
  704. return (Line);
  705. }
  706. /***************************************************************
  707. FUNCTION: bwb_restore()
  708. DESCRIPTION: This function implements the BASIC RESTORE
  709. statement.
  710. SYNTAX: RESTORE [line number]
  711. ***************************************************************/
  712. extern LineType *
  713. bwb_RESET (LineType * Line)
  714. {
  715. /* RESET filename$ [, ...] */
  716. VariantType E;
  717. VariantType *e;
  718. assert (Line != NULL);
  719. assert(My != NULL);
  720. assert(My->SYSIN != NULL);
  721. assert(My->SYSIN->cfp != NULL);
  722. e = &E; /* no leaks */
  723. My->CurrentFile = My->SYSIN;
  724. do
  725. {
  726. CLEAR_VARIANT (e);
  727. if (line_read_expression (Line, e) == FALSE) /* bwb_RESET */
  728. {
  729. WARN_SYNTAX_ERROR;
  730. return (Line);
  731. }
  732. if (e->VariantTypeCode == StringTypeCode)
  733. {
  734. /* STRING */
  735. /* RESET filename$ ... */
  736. My->CurrentFile = find_file_by_name (e->Buffer);
  737. }
  738. else
  739. {
  740. /* NUMBER -- file must already be OPEN */
  741. /* RESET filenumber ... */
  742. My->CurrentFile = find_file_by_number ((int) bwb_rint (e->Number));
  743. }
  744. RELEASE_VARIANT (e);
  745. if (My->CurrentFile == NULL)
  746. {
  747. /* file not OPEN */
  748. /* silently ignored */
  749. }
  750. else if (My->CurrentFile == My->SYSIN)
  751. {
  752. /* silently ignored */
  753. }
  754. else if (My->CurrentFile == My->SYSOUT)
  755. {
  756. /* silently ignored */
  757. }
  758. else if (My->CurrentFile == My->SYSPRN)
  759. {
  760. /* silently ignored */
  761. }
  762. else
  763. {
  764. /* normal file is OPEN */
  765. My->CurrentFile->width = 0;
  766. My->CurrentFile->col = 1;
  767. My->CurrentFile->row = 1;
  768. My->CurrentFile->delimit = ',';
  769. fseek (My->CurrentFile->cfp, 0, SEEK_SET);
  770. }
  771. }
  772. while (line_skip_seperator (Line));
  773. return (Line);
  774. }
  775. extern LineType *
  776. bwb_CLOSE (LineType * Line)
  777. {
  778. /* CLOSE filename$ ' can be any string expression */
  779. /* CLOSE filenumber ' can be any numeric expression */
  780. assert (Line != NULL);
  781. assert(My != NULL);
  782. assert(My->SYSIN != NULL);
  783. assert(My->SYSIN->cfp != NULL);
  784. assert(My->SYSOUT != NULL);
  785. assert(My->SYSOUT->cfp != NULL);
  786. assert(My->SYSPRN != NULL);
  787. assert(My->SYSPRN->cfp != NULL);
  788. My->CurrentFile = My->SYSIN;
  789. if (line_is_eol (Line))
  790. {
  791. /* CLOSE */
  792. FileType *F;
  793. for (F = My->FileHead; F != NULL; F = F->next)
  794. {
  795. field_close_file (F);
  796. file_clear (F);
  797. }
  798. return (Line);
  799. }
  800. do
  801. {
  802. VariantType E;
  803. VariantType *e;
  804. e = &E;
  805. if (line_read_expression (Line, e) == FALSE) /* bwb_CLOSE */
  806. {
  807. WARN_SYNTAX_ERROR;
  808. return (Line);
  809. }
  810. if (e->VariantTypeCode == StringTypeCode)
  811. {
  812. /* STRING */
  813. /* CLOSE filename$ ... */
  814. My->CurrentFile = find_file_by_name (e->Buffer);
  815. }
  816. else
  817. {
  818. /* CLOSE filenumber */
  819. My->CurrentFile = find_file_by_number (e->Number);
  820. }
  821. if (My->CurrentFile == NULL)
  822. {
  823. /* file not OPEN */
  824. /* silently ignored */
  825. }
  826. else if (My->CurrentFile == My->SYSIN)
  827. {
  828. /* silently ignored */
  829. }
  830. else if (My->CurrentFile == My->SYSOUT)
  831. {
  832. /* silently ignored */
  833. }
  834. else if (My->CurrentFile == My->SYSPRN)
  835. {
  836. /* silently ignored */
  837. }
  838. else
  839. {
  840. /* normal file is OPEN */
  841. field_close_file (My->CurrentFile);
  842. file_clear (My->CurrentFile);
  843. }
  844. RELEASE_VARIANT (e);
  845. }
  846. while (line_skip_seperator (Line));
  847. return (Line);
  848. }
  849. static LineType *
  850. data_restore (LineType * Line)
  851. {
  852. int LineNumber;
  853. LineType *x;
  854. assert (Line != NULL);
  855. assert(My != NULL);
  856. if (line_is_eol (Line))
  857. {
  858. /* RESTORE */
  859. assert (My->StartMarker != NULL);
  860. My->DataLine = My->StartMarker->OtherLine;
  861. assert (My->DataLine != NULL);
  862. My->DataPosition = My->DataLine->Startpos;
  863. return (Line);
  864. }
  865. if (line_read_integer_expression (Line, &LineNumber))
  866. {
  867. /* RESTORE linenumber */
  868. x = find_line_number (LineNumber); /* RESTORE 100 */
  869. if (x != NULL)
  870. {
  871. for (; x->cmdnum != C_DATA && x != My->EndMarker; x = x->next);
  872. My->DataLine = x;
  873. assert (My->DataLine != NULL);
  874. My->DataPosition = My->DataLine->Startpos;
  875. return (Line);
  876. }
  877. }
  878. WARN_SYNTAX_ERROR;
  879. return (Line);
  880. }
  881. static LineType *
  882. file_restore (LineType * Line)
  883. {
  884. /* RESTORE # FileNumber */
  885. int FileNumber;
  886. assert (Line != NULL);
  887. assert(My != NULL);
  888. if (line_read_integer_expression (Line, &FileNumber) == FALSE)
  889. {
  890. WARN_BAD_FILE_NUMBER;
  891. return (Line);
  892. }
  893. if (FileNumber < 0)
  894. {
  895. /* "RESTORE # -1" is silently ignored */
  896. return (Line);
  897. }
  898. if (FileNumber > 0)
  899. {
  900. /* normal file */
  901. My->CurrentFile = find_file_by_number (FileNumber);
  902. if (My->CurrentFile == NULL)
  903. {
  904. WARN_BAD_FILE_NUMBER;
  905. return (Line);
  906. }
  907. if (My->CurrentFile->DevMode != DEVMODE_CLOSED)
  908. {
  909. My->CurrentFile->DevMode = DEVMODE_CLOSED;
  910. }
  911. if (My->CurrentFile->cfp != NULL)
  912. {
  913. bwb_fclose (My->CurrentFile->cfp);
  914. My->CurrentFile->cfp = NULL;
  915. }
  916. if (My->CurrentFile->buffer != NULL)
  917. {
  918. free (My->CurrentFile->buffer);
  919. My->CurrentFile->buffer = NULL;
  920. }
  921. My->CurrentFile->width = 0;
  922. My->CurrentFile->col = 1;
  923. My->CurrentFile->row = 1;
  924. My->CurrentFile->delimit = ',';
  925. if (is_empty_string (My->CurrentFile->FileName))
  926. {
  927. WARN_BAD_FILE_NAME;
  928. return (Line);
  929. }
  930. if (bwb_strcmp (My->CurrentFile->FileName, "*") != 0)
  931. {
  932. if ((My->CurrentFile->cfp =
  933. fopen (My->CurrentFile->FileName, "r")) == NULL)
  934. {
  935. WARN_BAD_FILE_NAME;
  936. return (Line);
  937. }
  938. My->CurrentFile->DevMode = DEVMODE_INPUT;
  939. }
  940. /* OK */
  941. return (Line);
  942. }
  943. /* "RESTORE # 0" is the same as "RESTORE" */
  944. return data_restore (Line);
  945. }
  946. extern LineType *
  947. bwb_RESTORE (LineType * Line)
  948. {
  949. assert (Line != NULL);
  950. assert(My != NULL);
  951. assert(My->CurrentVersion != NULL);
  952. assert(My->SYSIN != NULL);
  953. assert(My->SYSIN->cfp != NULL);
  954. My->CurrentFile = My->SYSIN;
  955. if (line_skip_FilenumChar (Line))
  956. {
  957. return file_restore (Line);
  958. }
  959. if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
  960. {
  961. /* RESTORE [comment] */
  962. line_skip_eol (Line);
  963. /* fall-thru */
  964. }
  965. return data_restore (Line);
  966. }
  967. /***************************************************************
  968. FUNCTION: bwb_input()
  969. DESCRIPTION: This function implements the BASIC INPUT
  970. statement.
  971. SYNTAX: INPUT [;][prompt$;]variable[$,variable]...
  972. INPUT#n variable[$,variable]...
  973. ***************************************************************/
  974. static LineType *
  975. S70_GET (LineType * Line)
  976. {
  977. /* GET filename$ , scalar [, ...] */
  978. VariantType E;
  979. VariantType *e;
  980. assert (Line != NULL);
  981. assert(My != NULL);
  982. assert(My->CurrentVersion != NULL);
  983. assert(My->SYSIN != NULL);
  984. assert(My->SYSIN->cfp != NULL);
  985. e = &E;
  986. My->CurrentFile = My->SYSIN;
  987. if (line_read_expression (Line, e) == FALSE) /* bwb_GET */
  988. {
  989. WARN_SYNTAX_ERROR;
  990. return (Line);
  991. }
  992. if (e->VariantTypeCode == StringTypeCode)
  993. {
  994. /* STRING */
  995. /* GET filename$ ... */
  996. if (is_empty_string (e->Buffer))
  997. {
  998. /* GET "", ... is an error */
  999. WARN_BAD_FILE_NAME;
  1000. return (Line);
  1001. }
  1002. My->CurrentFile = find_file_by_name (e->Buffer);
  1003. if (My->CurrentFile == NULL)
  1004. {
  1005. /* implicitly OPEN for reading */
  1006. My->CurrentFile = file_new ();
  1007. My->CurrentFile->cfp = fopen (e->Buffer, "r");
  1008. if (My->CurrentFile->cfp == NULL)
  1009. {
  1010. WARN_BAD_FILE_NAME;
  1011. return (Line);
  1012. }
  1013. My->CurrentFile->FileNumber = file_next_number ();
  1014. My->CurrentFile->DevMode = DEVMODE_INPUT;
  1015. My->CurrentFile->width = 0;
  1016. /* WIDTH == RECLEN */
  1017. My->CurrentFile->col = 1;
  1018. My->CurrentFile->row = 1;
  1019. My->CurrentFile->delimit = ',';
  1020. My->CurrentFile->buffer = NULL;
  1021. if (My->CurrentFile->FileName != NULL)
  1022. {
  1023. free (My->CurrentFile->FileName);
  1024. My->CurrentFile->FileName = NULL;
  1025. }
  1026. My->CurrentFile->FileName = e->Buffer;
  1027. e->Buffer = NULL;
  1028. }
  1029. }
  1030. else
  1031. {
  1032. /* NUMBER -- file must already be OPEN */
  1033. /* GET filenumber ... */
  1034. if (e->Number < 0)
  1035. {
  1036. /* "GET # -1" is an error */
  1037. WARN_BAD_FILE_NUMBER;
  1038. return (Line);
  1039. }
  1040. if (e->Number == 0)
  1041. {
  1042. /* "GET # 0" is an error */
  1043. WARN_BAD_FILE_NUMBER;
  1044. return (Line);
  1045. }
  1046. My->CurrentFile = find_file_by_number ((int) bwb_rint (e->Number));
  1047. if (My->CurrentFile == NULL)
  1048. {
  1049. /* file not OPEN */
  1050. WARN_BAD_FILE_NUMBER;
  1051. return (Line);
  1052. }
  1053. }
  1054. if (My->CurrentFile == NULL)
  1055. {
  1056. WARN_BAD_FILE_NUMBER;
  1057. return (Line);
  1058. }
  1059. if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
  1060. {
  1061. WARN_BAD_FILE_NUMBER;
  1062. return (Line);
  1063. }
  1064. if (line_skip_seperator (Line))
  1065. {
  1066. /* OK */
  1067. }
  1068. else
  1069. {
  1070. WARN_SYNTAX_ERROR;
  1071. return (Line);
  1072. }
  1073. return file_input (Line);
  1074. }
  1075. static LineType *
  1076. D71_GET (LineType * Line)
  1077. {
  1078. /* GET # FileNumber [ , RECORD RecordNumber ] */
  1079. int FileNumber;
  1080. assert (Line != NULL);
  1081. assert(My != NULL);
  1082. FileNumber = 0;
  1083. if (line_skip_FilenumChar (Line))
  1084. {
  1085. /* OPTIONAL */
  1086. }
  1087. if (line_read_integer_expression (Line, &FileNumber) == FALSE)
  1088. {
  1089. WARN_BAD_FILE_NUMBER;
  1090. return (Line);
  1091. }
  1092. if (FileNumber < 1)
  1093. {
  1094. WARN_BAD_FILE_NUMBER;
  1095. return (Line);
  1096. }
  1097. My->CurrentFile = find_file_by_number (FileNumber);
  1098. if (My->CurrentFile == NULL)
  1099. {
  1100. WARN_BAD_FILE_NUMBER;
  1101. return (Line);
  1102. }
  1103. if (My->CurrentFile->DevMode != DEVMODE_RANDOM)
  1104. {
  1105. WARN_BAD_FILE_NUMBER;
  1106. return (Line);
  1107. }
  1108. if (My->CurrentFile->width <= 0)
  1109. {
  1110. WARN_BAD_FILE_NUMBER;
  1111. return (Line);
  1112. }
  1113. if (line_is_eol (Line))
  1114. {
  1115. /* GET # FileNumber */
  1116. }
  1117. else
  1118. {
  1119. /* GET # FileNumber , RECORD RecordNumber */
  1120. int RecordNumber;
  1121. long offset;
  1122. RecordNumber = 0;
  1123. offset = 0;
  1124. if (line_skip_seperator (Line) == FALSE)
  1125. {
  1126. WARN_SYNTAX_ERROR;
  1127. return (Line);
  1128. }
  1129. if (line_skip_word (Line, "RECORD") == FALSE)
  1130. {
  1131. WARN_SYNTAX_ERROR;
  1132. return (Line);
  1133. }
  1134. if (line_read_integer_expression (Line, &RecordNumber) == FALSE)
  1135. {
  1136. WARN_BAD_RECORD_NUMBER;
  1137. return (Line);
  1138. }
  1139. if (RecordNumber <= 0)
  1140. {
  1141. WARN_BAD_RECORD_NUMBER;
  1142. return (Line);
  1143. }
  1144. RecordNumber--; /* BASIC to C */
  1145. offset = RecordNumber;
  1146. offset *= My->CurrentFile->width;
  1147. if (fseek (My->CurrentFile->cfp, offset, SEEK_SET) != 0)
  1148. {
  1149. WARN_BAD_RECORD_NUMBER;
  1150. return (Line);
  1151. }
  1152. }
  1153. /* if( TRUE ) */
  1154. {
  1155. int i;
  1156. for (i = 0; i < My->CurrentFile->width; i++)
  1157. {
  1158. int c;
  1159. c = fgetc (My->CurrentFile->cfp);
  1160. if ( /* EOF */ c < 0)
  1161. {
  1162. c = NulChar;
  1163. }
  1164. My->CurrentFile->buffer[i] = c;
  1165. }
  1166. }
  1167. field_get (My->CurrentFile);
  1168. /* OK */
  1169. return (Line);
  1170. }
  1171. /* 20210916-ChipMaster: BINARY read/write macros - to tailor for each
  1172. platform, ASSuming it will need to be. Returns TRUE on success. */
  1173. #if TRUE /* Linux */
  1174. #define BWRITE(F,V) (write(fileno(F), &V, sizeof(V))==sizeof(V))
  1175. #define BREAD(F,V) (read(fileno(F), &V, sizeof(V))==sizeof(V))
  1176. #define BWRITES(F,V) (write(fileno(F), V->Buffer, V->Length)==V->Length)
  1177. #define BREADS(F,V) (read(fileno(F), V->Buffer, V->Length)==V->Length)
  1178. #else /* What it was */
  1179. #define BWRITE(F,V) (fwrite(&V, sizeof(V), 1, F)==F)
  1180. #define BREAD(F,V) (fread(&V, sizeof(V), 1, F)==F)
  1181. #define BWRITES(F,V) (fwrite(V->Buffer, V->Length, 1, F)==1)
  1182. #define BREADS(F,V) (fread(V->Buffer, V->Length, 1, F)==1)
  1183. #endif
  1184. extern int
  1185. binary_get_put (VariableType * Variable, int IsPUT)
  1186. {
  1187. VariantType variant;
  1188. VariantType *Variant;
  1189. assert(My != NULL);
  1190. assert (My->CurrentFile != NULL);
  1191. assert (My->CurrentFile->cfp != NULL);
  1192. assert (My->CurrentFile->DevMode == DEVMODE_BINARY);
  1193. Variant = &variant;
  1194. CLEAR_VARIANT (Variant);
  1195. if (var_get (Variable, Variant) == FALSE)
  1196. {
  1197. WARN_VARIABLE_NOT_DECLARED;
  1198. return FALSE;
  1199. }
  1200. #ifdef CMDEBUG
  1201. errno = 0;
  1202. fputs("errno=0\n", stderr);
  1203. #endif
  1204. switch (Variant->VariantTypeCode)
  1205. {
  1206. case ByteTypeCode:
  1207. {
  1208. ByteType Value;
  1209. Value = (ByteType) Variant->Number;
  1210. if (IsPUT)
  1211. {
  1212. if(!BWRITE(My->CurrentFile->cfp, Value))
  1213. {
  1214. WARN_DISK_IO_ERROR;
  1215. return FALSE;
  1216. }
  1217. }
  1218. else
  1219. {
  1220. if(!BREAD(My->CurrentFile->cfp, Value))
  1221. {
  1222. WARN_DISK_IO_ERROR;
  1223. return FALSE;
  1224. }
  1225. }
  1226. Variant->Number = Value;
  1227. }
  1228. break;
  1229. case IntegerTypeCode:
  1230. {
  1231. IntegerType Value;
  1232. Value = (IntegerType) Variant->Number;
  1233. if (IsPUT)
  1234. {
  1235. if(!BWRITE(My->CurrentFile->cfp, Value))
  1236. {
  1237. WARN_DISK_IO_ERROR;
  1238. return FALSE;
  1239. }
  1240. }
  1241. else
  1242. {
  1243. if(!BREAD(My->CurrentFile->cfp, Value))
  1244. {
  1245. WARN_DISK_IO_ERROR;
  1246. return FALSE;
  1247. }
  1248. }
  1249. Variant->Number = Value;
  1250. }
  1251. break;
  1252. case LongTypeCode:
  1253. {
  1254. LongType Value;
  1255. Value = (LongType) Variant->Number;
  1256. if (IsPUT)
  1257. {
  1258. if(!BWRITE(My->CurrentFile->cfp, Value))
  1259. {
  1260. WARN_DISK_IO_ERROR;
  1261. return FALSE;
  1262. }
  1263. }
  1264. else
  1265. {
  1266. if(!BREAD(My->CurrentFile->cfp, Value))
  1267. {
  1268. WARN_DISK_IO_ERROR;
  1269. return FALSE;
  1270. }
  1271. }
  1272. Variant->Number = Value;
  1273. }
  1274. break;
  1275. case CurrencyTypeCode:
  1276. {
  1277. CurrencyType Value;
  1278. Value = (CurrencyType) Variant->Number;
  1279. if (IsPUT)
  1280. {
  1281. if(!BWRITE(My->CurrentFile->cfp, Value))
  1282. {
  1283. WARN_DISK_IO_ERROR;
  1284. return FALSE;
  1285. }
  1286. }
  1287. else
  1288. {
  1289. if(!BREAD(My->CurrentFile->cfp, Value))
  1290. {
  1291. WARN_DISK_IO_ERROR;
  1292. return FALSE;
  1293. }
  1294. }
  1295. Variant->Number = Value;
  1296. }
  1297. break;
  1298. case SingleTypeCode:
  1299. {
  1300. SingleType Value;
  1301. Value = (SingleType) Variant->Number;
  1302. if (IsPUT)
  1303. {
  1304. if(!BWRITE(My->CurrentFile->cfp, Value))
  1305. {
  1306. WARN_DISK_IO_ERROR;
  1307. return FALSE;
  1308. }
  1309. }
  1310. else
  1311. {
  1312. if(!BREAD(My->CurrentFile->cfp, Value))
  1313. {
  1314. WARN_DISK_IO_ERROR;
  1315. return FALSE;
  1316. }
  1317. }
  1318. Variant->Number = Value;
  1319. }
  1320. break;
  1321. case DoubleTypeCode:
  1322. {
  1323. DoubleType Value;
  1324. Value = (DoubleType) Variant->Number;
  1325. if (IsPUT)
  1326. {
  1327. if(!BWRITE(My->CurrentFile->cfp, Value))
  1328. {
  1329. WARN_DISK_IO_ERROR;
  1330. return FALSE;
  1331. }
  1332. }
  1333. else
  1334. {
  1335. if(!BREAD(My->CurrentFile->cfp, Value))
  1336. {
  1337. WARN_DISK_IO_ERROR;
  1338. return FALSE;
  1339. }
  1340. }
  1341. Variant->Number = Value;
  1342. }
  1343. break;
  1344. case StringTypeCode:
  1345. if (IsPUT)
  1346. {
  1347. #if FALSE /* keep this ... */
  1348. if(!BWRITE(My->CurrentFile->cfp, Variant->Length))
  1349. {
  1350. WARN_DISK_IO_ERROR;
  1351. return FALSE;
  1352. }
  1353. #endif
  1354. if(!BWRITES(My->CurrentFile->cfp, Variant))
  1355. {
  1356. WARN_DISK_IO_ERROR;
  1357. return FALSE;
  1358. }
  1359. }
  1360. else
  1361. {
  1362. #if FALSE /* keep this ... */
  1363. if(!BREAD(My->CurrentFile->cfp, Variant->Length))
  1364. {
  1365. WARN_DISK_IO_ERROR;
  1366. return FALSE;
  1367. }
  1368. #endif
  1369. if(!BREADS(My->CurrentFile->cfp, Variant))
  1370. {
  1371. WARN_DISK_IO_ERROR;
  1372. return FALSE;
  1373. }
  1374. Variant->Buffer[Variant->Length] = NulChar;
  1375. }
  1376. break;
  1377. default:
  1378. {
  1379. WARN_INTERNAL_ERROR;
  1380. return FALSE;
  1381. }
  1382. }
  1383. if (IsPUT)
  1384. {
  1385. /* not needed */
  1386. }
  1387. else
  1388. {
  1389. if (var_set (Variable, Variant) == FALSE)
  1390. {
  1391. WARN_VARIABLE_NOT_DECLARED;
  1392. return FALSE;
  1393. }
  1394. }
  1395. RELEASE_VARIANT (Variant);
  1396. /* OK */
  1397. return TRUE;
  1398. }
  1399. static LineType *
  1400. H14_GET (LineType * Line)
  1401. {
  1402. /* GET # FileNumber [ , RecordNumber ] ' RANDOM */
  1403. /* GET # FileNumber , [ BytePosition ] , scalar [,...] ' BINARY */
  1404. int FileNumber;
  1405. assert (Line != NULL);
  1406. assert(My != NULL);
  1407. FileNumber = 0;
  1408. if (line_skip_FilenumChar (Line))
  1409. {
  1410. /* OPTIONAL */
  1411. }
  1412. if (line_read_integer_expression (Line, &FileNumber) == FALSE)
  1413. {
  1414. WARN_BAD_FILE_NUMBER;
  1415. return (Line);
  1416. }
  1417. if (FileNumber < 1)
  1418. {
  1419. WARN_BAD_FILE_NUMBER;
  1420. return (Line);
  1421. }
  1422. My->CurrentFile = find_file_by_number (FileNumber);
  1423. if (My->CurrentFile == NULL)
  1424. {
  1425. WARN_BAD_FILE_NUMBER;
  1426. return (Line);
  1427. }
  1428. if (My->CurrentFile->DevMode == DEVMODE_RANDOM)
  1429. {
  1430. /* GET # FileNumber [ , RecordNumber ] ' RANDOM */
  1431. if (My->CurrentFile->width <= 0)
  1432. {
  1433. WARN_BAD_FILE_NUMBER;
  1434. return (Line);
  1435. }
  1436. if (line_is_eol (Line))
  1437. {
  1438. /* GET # FileNumber */
  1439. }
  1440. else
  1441. {
  1442. /* GET # FileNumber , RecordNumber */
  1443. int RecordNumber;
  1444. long offset;
  1445. RecordNumber = 0;
  1446. offset = 0;
  1447. if (line_skip_seperator (Line) == FALSE)
  1448. {
  1449. WARN_SYNTAX_ERROR;
  1450. return (Line);
  1451. }
  1452. if (line_read_integer_expression (Line, &RecordNumber) == FALSE)
  1453. {
  1454. WARN_BAD_RECORD_NUMBER;
  1455. return (Line);
  1456. }
  1457. if (RecordNumber <= 0)
  1458. {
  1459. WARN_BAD_RECORD_NUMBER;
  1460. return (Line);
  1461. }
  1462. RecordNumber--; /* BASIC to C */
  1463. offset = RecordNumber;
  1464. offset *= My->CurrentFile->width;
  1465. if (fseek (My->CurrentFile->cfp, offset, SEEK_SET) != 0)
  1466. {
  1467. WARN_BAD_RECORD_NUMBER;
  1468. return (Line);
  1469. }
  1470. }
  1471. /* if( TRUE ) */
  1472. {
  1473. int i;
  1474. for (i = 0; i < My->CurrentFile->width; i++)
  1475. {
  1476. int c;
  1477. c = fgetc (My->CurrentFile->cfp);
  1478. if ( /* EOF */ c < 0)
  1479. {
  1480. c = NulChar;
  1481. }
  1482. My->CurrentFile->buffer[i] = c;
  1483. }
  1484. }
  1485. field_get (My->CurrentFile);
  1486. /* OK */
  1487. return (Line);
  1488. }
  1489. else if (My->CurrentFile->DevMode == DEVMODE_BINARY)
  1490. {
  1491. /* GET # FileNumber , [ BytePosition ] , scalar [,...] ' BINARY */
  1492. if (line_skip_seperator (Line) == FALSE)
  1493. {
  1494. WARN_SYNTAX_ERROR;
  1495. return (Line);
  1496. }
  1497. if (line_skip_seperator (Line))
  1498. {
  1499. /* BytePosition not provided */
  1500. }
  1501. else
  1502. {
  1503. int RecordNumber;
  1504. long offset;
  1505. RecordNumber = 0;
  1506. offset = 0;
  1507. if (line_read_integer_expression (Line, &RecordNumber) == FALSE)
  1508. {
  1509. WARN_BAD_RECORD_NUMBER;
  1510. return (Line);
  1511. }
  1512. if (RecordNumber <= 0)
  1513. {
  1514. WARN_BAD_RECORD_NUMBER;
  1515. return (Line);
  1516. }
  1517. RecordNumber--; /* BASIC to C */
  1518. offset = RecordNumber;
  1519. if (fseek (My->CurrentFile->cfp, offset, SEEK_SET) != 0)
  1520. {
  1521. WARN_BAD_RECORD_NUMBER;
  1522. return (Line);
  1523. }
  1524. if (line_skip_seperator (Line) == FALSE)
  1525. {
  1526. WARN_SYNTAX_ERROR;
  1527. return (Line);
  1528. }
  1529. }
  1530. do
  1531. {
  1532. VariableType *v;
  1533. if ((v = line_read_scalar (Line)) == NULL)
  1534. {
  1535. WARN_SYNTAX_ERROR;
  1536. return (Line);
  1537. }
  1538. if (binary_get_put (v, FALSE) == FALSE)
  1539. {
  1540. WARN_SYNTAX_ERROR;
  1541. return (Line);
  1542. }
  1543. }
  1544. while (line_skip_seperator (Line));
  1545. /* OK */
  1546. return (Line);
  1547. }
  1548. WARN_BAD_FILE_MODE;
  1549. return (Line);
  1550. }
  1551. extern LineType *
  1552. bwb_GET (LineType * Line)
  1553. {
  1554. assert (Line != NULL);
  1555. assert(My != NULL);
  1556. assert(My->CurrentVersion != NULL);
  1557. if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
  1558. {
  1559. return S70_GET (Line);
  1560. }
  1561. if (My->CurrentVersion->OptionVersionValue & (D71 | T79 | R86))
  1562. {
  1563. return D71_GET (Line);
  1564. }
  1565. if (My->CurrentVersion->OptionVersionValue & (H14))
  1566. {
  1567. return H14_GET (Line);
  1568. }
  1569. WARN_INTERNAL_ERROR;
  1570. return (Line);
  1571. }
  1572. static ResultType
  1573. file_data (VariableType * Variable, char *tbuf, int tlen)
  1574. {
  1575. ResultType Result;
  1576. VariantType Variant;
  1577. VariantType *X;
  1578. int p;
  1579. assert (Variable != NULL);
  1580. assert (tbuf != NULL);
  1581. assert (tlen > 0);
  1582. assert(My != NULL);
  1583. assert(My->CurrentVersion != NULL);
  1584. assert (My->CurrentFile != NULL);
  1585. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  1586. Result = RESULT_UNPARSED;
  1587. X = &Variant;
  1588. p = 0;
  1589. CLEAR_VARIANT (X);
  1590. if (tbuf[0] == NulChar)
  1591. {
  1592. /* Get more data */
  1593. if (fgets (tbuf, tlen, My->CurrentFile->cfp)) /* file_data */
  1594. {
  1595. tbuf[tlen] = NulChar;
  1596. CleanTextInput (tbuf);
  1597. }
  1598. else
  1599. {
  1600. return RESULT_UNPARSED; /* causes file_if_end() */
  1601. }
  1602. }
  1603. if (VAR_IS_STRING (Variable))
  1604. {
  1605. Result = parse_string (tbuf, &p, X);
  1606. }
  1607. else
  1608. {
  1609. Result = parse_number (tbuf, &p, X, FALSE);
  1610. }
  1611. if (Result == RESULT_UNPARSED)
  1612. {
  1613. WARN_BAD_DATA;
  1614. }
  1615. if (Result != RESULT_SUCCESS)
  1616. {
  1617. return Result;
  1618. }
  1619. /*
  1620. **
  1621. ** OK
  1622. **
  1623. */
  1624. if (X->VariantTypeCode == StringTypeCode
  1625. && My->CurrentVersion->
  1626. OptionFlags & OPTION_BUGS_ON /* DATA allows embedded quote pairs */ )
  1627. {
  1628. int i;
  1629. int n;
  1630. n = X->Length;
  1631. for (i = 0; i < n; i++)
  1632. {
  1633. if (X->Buffer[i + 0] == My->CurrentVersion->OptionQuoteChar
  1634. && X->Buffer[i + 1] == My->CurrentVersion->OptionQuoteChar)
  1635. {
  1636. bwb_strncpy (&X->Buffer[i + 0], &X->Buffer[i + 1], n - i);
  1637. n--;
  1638. }
  1639. }
  1640. X->Length = n;
  1641. }
  1642. if (var_set (Variable, X) == FALSE)
  1643. {
  1644. WARN_VARIABLE_NOT_DECLARED;
  1645. return RESULT_UNPARSED;
  1646. }
  1647. /*
  1648. **
  1649. ** Note: do NOT free() or RELEASE_VARIANT because 'X->Buffer' points into 'buffer'
  1650. **
  1651. */
  1652. if (buff_is_eol (tbuf, &p))
  1653. {
  1654. tbuf[0] = NulChar;
  1655. return RESULT_SUCCESS;
  1656. }
  1657. if (buff_skip_char (tbuf, &p, My->CurrentFile->delimit)) /* buff_skip_comma */
  1658. {
  1659. /* shift left past comma */
  1660. bwb_strcpy (tbuf, &tbuf[p]);
  1661. return RESULT_SUCCESS;
  1662. }
  1663. /* garbage after the value we just READ */
  1664. WARN_BAD_DATA;
  1665. return RESULT_UNPARSED;
  1666. }
  1667. static LineType *
  1668. C77_file_input_line (LineType * Line)
  1669. {
  1670. /*
  1671. CBASIC-II: READ # filenumber [, recnum ] ; LINE variable$
  1672. */
  1673. /* a flavor of LINE INPUT */
  1674. VariableType *v;
  1675. assert (Line != NULL);
  1676. assert(My != NULL);
  1677. assert (My->CurrentFile != NULL);
  1678. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  1679. if ((v = line_read_scalar (Line)) == NULL)
  1680. {
  1681. WARN_SYNTAX_ERROR;
  1682. return (Line);
  1683. }
  1684. if (VAR_IS_STRING (v))
  1685. {
  1686. char *tbuf;
  1687. int tlen;
  1688. assert (My->ConsoleInput != NULL);
  1689. tbuf = My->ConsoleInput;
  1690. tlen = MAX_LINE_LENGTH;
  1691. /* CBASIC-II: RANDOM files are padded on the right with spaces with a '\n' in the last position */
  1692. if (My->CurrentFile->width > MAX_LINE_LENGTH)
  1693. {
  1694. if (My->CurrentFile->buffer != NULL)
  1695. {
  1696. /* use the bigger buffer */
  1697. tbuf = My->CurrentFile->buffer;
  1698. tlen = My->CurrentFile->width;
  1699. }
  1700. }
  1701. if (fgets (tbuf, tlen, My->CurrentFile->cfp)) /* C77_file_input_line */
  1702. {
  1703. tbuf[tlen] = NulChar;
  1704. CleanTextInput (tbuf);
  1705. }
  1706. else
  1707. {
  1708. return file_if_end (Line);
  1709. }
  1710. /* if( TRUE ) */
  1711. {
  1712. VariantType variant;
  1713. variant.VariantTypeCode = StringTypeCode;
  1714. variant.Buffer = tbuf;
  1715. variant.Length = bwb_strlen (variant.Buffer);
  1716. if (var_set (v, &variant) == FALSE)
  1717. {
  1718. WARN_VARIABLE_NOT_DECLARED;
  1719. return (Line);
  1720. }
  1721. }
  1722. return (Line);
  1723. }
  1724. WARN_TYPE_MISMATCH;
  1725. return (Line);
  1726. }
  1727. static LineType *
  1728. C77_file_input_finish (LineType * Line)
  1729. {
  1730. /*
  1731. CBASIC-II: RANDOM file reads always acccess a complete record
  1732. */
  1733. long ByteOffset;
  1734. assert (Line != NULL);
  1735. assert(My != NULL);
  1736. assert (My->CurrentFile != NULL);
  1737. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  1738. /* advance to the end-of-record */
  1739. if (My->CurrentFile->width <= 0)
  1740. {
  1741. WARN_FIELD_OVERFLOW;
  1742. return (Line);
  1743. }
  1744. ByteOffset = ftell (My->CurrentFile->cfp);
  1745. ByteOffset %= My->CurrentFile->width;
  1746. if (ByteOffset != 0)
  1747. {
  1748. long RecordNumber;
  1749. RecordNumber = ftell (My->CurrentFile->cfp);
  1750. RecordNumber /= My->CurrentFile->width;
  1751. RecordNumber++;
  1752. RecordNumber *= My->CurrentFile->width;
  1753. fseek (My->CurrentFile->cfp, RecordNumber, SEEK_SET);
  1754. }
  1755. return (Line);
  1756. }
  1757. static LineType *
  1758. file_if_end (LineType * Line)
  1759. {
  1760. /* IF END # FileNumber THEN LineNumber */
  1761. assert (Line != NULL);
  1762. assert(My != NULL);
  1763. assert (My->CurrentFile != NULL);
  1764. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  1765. if (My->CurrentFile->EOF_LineNumber > 0)
  1766. {
  1767. LineType *x;
  1768. x = find_line_number (My->CurrentFile->EOF_LineNumber); /* not found in the cache */
  1769. if (x != NULL)
  1770. {
  1771. /* FOUND */
  1772. line_skip_eol (Line);
  1773. x->position = 0;
  1774. return x;
  1775. }
  1776. /* NOT FOUND */
  1777. WARN_UNDEFINED_LINE;
  1778. return (Line);
  1779. }
  1780. WARN_INPUT_PAST_END;
  1781. return (Line);
  1782. }
  1783. static LineType *
  1784. file_input (LineType * Line)
  1785. {
  1786. /* INPUT # is similar to READ, where each file line is a DATA line */
  1787. char *tbuf;
  1788. int tlen;
  1789. assert (Line != NULL);
  1790. assert(My != NULL);
  1791. assert(My->CurrentVersion != NULL);
  1792. assert (My->CurrentFile != NULL);
  1793. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  1794. tbuf = My->ConsoleInput;
  1795. tlen = MAX_LINE_LENGTH;
  1796. if (My->CurrentVersion->OptionVersionValue & (C77))
  1797. {
  1798. if (line_skip_word (Line, "LINE"))
  1799. {
  1800. return C77_file_input_line (Line);
  1801. }
  1802. }
  1803. if (My->CurrentFile->width > 0 && My->CurrentFile->buffer != NULL)
  1804. {
  1805. tlen = My->CurrentFile->width;
  1806. tbuf = My->CurrentFile->buffer;
  1807. }
  1808. tbuf[0] = NulChar;
  1809. /* Process each variable read from the INPUT # statement */
  1810. do
  1811. {
  1812. VariableType *v;
  1813. /* Read a variable name */
  1814. if ((v = line_read_scalar (Line)) == NULL)
  1815. {
  1816. WARN_SYNTAX_ERROR;
  1817. return (Line);
  1818. }
  1819. /* Read a file value */
  1820. if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
  1821. {
  1822. return file_if_end (Line);
  1823. }
  1824. /* OK */
  1825. }
  1826. while (line_skip_seperator (Line));
  1827. if (My->CurrentVersion->OptionVersionValue & (C77)
  1828. && My->CurrentFile->DevMode & DEVMODE_RANDOM)
  1829. {
  1830. return C77_file_input_finish (Line);
  1831. }
  1832. return (Line);
  1833. }
  1834. /***************************************************************
  1835. FUNCTION: user_input_*()
  1836. DESCRIPTION: This function does INPUT processing
  1837. from a determined string of input
  1838. data and a determined variable list
  1839. (both in memory). This presupposes
  1840. that input has been taken from My->SYSIN,
  1841. not from a disk file or device.
  1842. ***************************************************************/
  1843. static ResultType
  1844. parse_string_isquoted (char *buffer, int *position, VariantType * X)
  1845. {
  1846. /*
  1847. **
  1848. ** QUOTED STRING
  1849. **
  1850. ** Note: do NOT free() or RELEASE_VARIANT because 'X->Buffer' points into 'buffer'
  1851. **
  1852. */
  1853. int p;
  1854. assert (buffer != NULL);
  1855. assert (position != NULL);
  1856. assert (X != NULL);
  1857. assert(My != NULL);
  1858. assert(My->CurrentVersion != NULL);
  1859. assert (My->CurrentFile != NULL);
  1860. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  1861. p = *position;
  1862. buff_skip_spaces (buffer, &p); /* keep this */
  1863. if (buffer[p] == My->CurrentVersion->OptionQuoteChar)
  1864. {
  1865. int Length;
  1866. int Start;
  1867. int QuoteCount;
  1868. Length = 0;
  1869. QuoteCount = 0;
  1870. QuoteCount++;
  1871. p++;
  1872. Start = p;
  1873. while (buffer[p])
  1874. {
  1875. if (buffer[p] == My->CurrentVersion->OptionQuoteChar
  1876. && buffer[p + 1] == My->CurrentVersion->OptionQuoteChar
  1877. && My->CurrentVersion->
  1878. OptionFlags & OPTION_BUGS_ON /* INPUT allows embedded quote pairs */
  1879. )
  1880. {
  1881. /* embedded quote pair "...""..." */
  1882. QuoteCount++;
  1883. QuoteCount++;
  1884. p++;
  1885. p++;
  1886. Length++;
  1887. Length++;
  1888. }
  1889. else if (buffer[p] == My->CurrentVersion->OptionQuoteChar)
  1890. {
  1891. /* properly terminated string "...xx..." */
  1892. QuoteCount++;
  1893. p++;
  1894. break;
  1895. }
  1896. else
  1897. {
  1898. /* normal character */
  1899. p++;
  1900. Length++;
  1901. }
  1902. }
  1903. if (My->CurrentVersion->
  1904. OptionFlags & OPTION_BUGS_ON /* INPUT allows unmatched quotes pairs */
  1905. )
  1906. {
  1907. /* silently ignore */
  1908. }
  1909. else if (QuoteCount & 1)
  1910. {
  1911. /* an ODD number of quotes (including embedded quotes) is an ERROR */
  1912. return RESULT_UNPARSED;
  1913. }
  1914. /*
  1915. **
  1916. ** OK
  1917. **
  1918. */
  1919. X->VariantTypeCode = StringTypeCode;
  1920. X->Buffer = &buffer[Start];
  1921. X->Length = Length;
  1922. *position = p;
  1923. return RESULT_SUCCESS;
  1924. }
  1925. return RESULT_UNPARSED;
  1926. }
  1927. static ResultType
  1928. parse_string_unquoted (char *buffer, int *position, VariantType * X)
  1929. {
  1930. /*
  1931. **
  1932. ** UNQUOTED STRING
  1933. **
  1934. ** Note: do NOT free() or RELEASE_VARIANT because 'X->Buffer' points into 'buffer'
  1935. **
  1936. */
  1937. int p;
  1938. int Length;
  1939. int Start;
  1940. assert (buffer != NULL);
  1941. assert (position != NULL);
  1942. assert (X != NULL);
  1943. assert(My != NULL);
  1944. assert(My->CurrentVersion != NULL);
  1945. assert (My->CurrentFile != NULL);
  1946. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  1947. Length = 0;
  1948. p = *position;
  1949. buff_skip_spaces (buffer, &p); /* keep this */
  1950. Start = p;
  1951. while (buffer[p] != NulChar && buffer[p] != My->CurrentFile->delimit)
  1952. {
  1953. char C;
  1954. C = buffer[p];
  1955. if (My->CurrentVersion->
  1956. OptionFlags & OPTION_BUGS_ON /* INPUT allows unquoted strings */ )
  1957. {
  1958. /* silently ignore */
  1959. }
  1960. else if (C == ' ' || C == '+' || C == '-' || C == '.' || bwb_isalnum (C))
  1961. {
  1962. /* if was NOT quoted, then the only valid chars are ' ', '+', '-', '.', digit, letter */
  1963. }
  1964. else
  1965. {
  1966. /* ERROR */
  1967. return RESULT_UNPARSED;
  1968. }
  1969. Length++;
  1970. p++;
  1971. }
  1972. /* RTRIM */
  1973. while (Length > 0 && buffer[Start + Length - 1] == ' ')
  1974. {
  1975. Length--;
  1976. }
  1977. /*
  1978. **
  1979. ** OK
  1980. **
  1981. */
  1982. X->VariantTypeCode = StringTypeCode;
  1983. X->Buffer = &buffer[Start];
  1984. X->Length = Length;
  1985. *position = p;
  1986. return RESULT_SUCCESS;
  1987. }
  1988. static ResultType
  1989. parse_string (char *buffer, int *position, VariantType * X)
  1990. {
  1991. /*
  1992. **
  1993. ** STRING
  1994. **
  1995. ** Note: do NOT free() or RELEASE_VARIANT because 'X->Buffer' points into 'buffer'
  1996. **
  1997. */
  1998. ResultType Result;
  1999. int p;
  2000. assert (buffer != NULL);
  2001. assert (position != NULL);
  2002. assert (X != NULL);
  2003. assert(My != NULL);
  2004. assert(My->CurrentVersion != NULL);
  2005. assert (My->CurrentFile != NULL);
  2006. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  2007. p = *position;
  2008. buff_skip_spaces (buffer, &p); /* keep this */
  2009. if (buff_is_eol (buffer, &p)
  2010. || buff_peek_char (buffer, &p, My->CurrentFile->delimit))
  2011. {
  2012. /* process EMPTY response */
  2013. if (My->CurrentVersion->
  2014. OptionFlags & OPTION_BUGS_ON /* INPUT allows empty values */ )
  2015. {
  2016. /* silently ignore, value is "" */
  2017. X->VariantTypeCode = StringTypeCode;
  2018. X->Buffer = &buffer[p];
  2019. X->Length = 0;
  2020. Result = RESULT_SUCCESS;
  2021. }
  2022. else
  2023. {
  2024. return RESULT_UNPARSED;
  2025. }
  2026. }
  2027. Result = parse_string_isquoted (buffer, &p, X);
  2028. if (Result == RESULT_UNPARSED)
  2029. {
  2030. Result = parse_string_unquoted (buffer, &p, X);
  2031. }
  2032. if (Result == RESULT_SUCCESS)
  2033. {
  2034. *position = p;
  2035. }
  2036. return Result;
  2037. }
  2038. static ResultType
  2039. parse_number (char *buffer, int *position, VariantType * X,
  2040. int IsConsoleInput)
  2041. {
  2042. ResultType Result = RESULT_UNPARSED;
  2043. int p;
  2044. assert (buffer != NULL);
  2045. assert (position != NULL);
  2046. assert (X != NULL);
  2047. assert(My != NULL);
  2048. assert(My->CurrentVersion != NULL);
  2049. assert (My->CurrentFile != NULL);
  2050. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  2051. p = *position;
  2052. buff_skip_spaces (buffer, &p); /* keep this */
  2053. if (buff_is_eol (buffer, &p)
  2054. || buff_peek_char (buffer, &p, My->CurrentFile->delimit))
  2055. {
  2056. /* process EMPTY response */
  2057. if (My->CurrentVersion->
  2058. OptionFlags & OPTION_BUGS_ON /* INPUT allows empty values */ )
  2059. {
  2060. /* silently ignore, value is 0 */
  2061. X->VariantTypeCode = DoubleTypeCode;
  2062. X->Number = 0;
  2063. return RESULT_SUCCESS;
  2064. }
  2065. else
  2066. {
  2067. return RESULT_UNPARSED;
  2068. }
  2069. }
  2070. Result = buff_read_hexadecimal_constant (buffer, &p, X, IsConsoleInput);
  2071. if (Result == RESULT_UNPARSED)
  2072. {
  2073. Result = buff_read_octal_constant (buffer, &p, X, IsConsoleInput);
  2074. }
  2075. if (Result == RESULT_UNPARSED)
  2076. {
  2077. int IsNegative;
  2078. IsNegative = FALSE;
  2079. if (buff_skip_PlusChar (buffer, &p))
  2080. {
  2081. /* ignore */
  2082. }
  2083. else if (buff_skip_MinusChar (buffer, &p))
  2084. {
  2085. IsNegative = TRUE;
  2086. }
  2087. Result = buff_read_decimal_constant (buffer, &p, X, IsConsoleInput);
  2088. if (Result == RESULT_SUCCESS)
  2089. {
  2090. if (IsNegative)
  2091. {
  2092. X->Number = -X->Number;
  2093. }
  2094. }
  2095. }
  2096. if (Result == RESULT_SUCCESS)
  2097. {
  2098. *position = p;
  2099. }
  2100. return Result;
  2101. }
  2102. static ResultType
  2103. user_input_values (LineType * Line, char *buffer, int IsReal)
  2104. {
  2105. /*
  2106. **
  2107. ** given a response, match with the list of variables
  2108. **
  2109. */
  2110. int p;
  2111. assert (Line != NULL);
  2112. assert (buffer != NULL);
  2113. assert(My != NULL);
  2114. assert(My->CurrentVersion != NULL);
  2115. assert (My->CurrentFile == My->SYSIN);
  2116. p = 0;
  2117. /* Read elements in buffer and assign them to variables in Line */
  2118. do
  2119. {
  2120. ResultType Result;
  2121. VariableType *Variable;
  2122. VariantType Variant;
  2123. VariantType *X;
  2124. X = &Variant;
  2125. CLEAR_VARIANT (X);
  2126. /* get a variable name from the list */
  2127. if ((Variable = line_read_scalar (Line)) == NULL)
  2128. {
  2129. WARN_SYNTAX_ERROR;
  2130. return RESULT_UNPARSED;
  2131. }
  2132. /* get a value from the console response */
  2133. Result = RESULT_UNPARSED;
  2134. if (VAR_IS_STRING (Variable))
  2135. {
  2136. Result = parse_string (buffer, &p, X);
  2137. }
  2138. else
  2139. {
  2140. Result = parse_number (buffer, &p, X, TRUE);
  2141. }
  2142. if (Result != RESULT_SUCCESS)
  2143. {
  2144. return Result;
  2145. }
  2146. /*
  2147. **
  2148. ** OK
  2149. **
  2150. */
  2151. if (IsReal)
  2152. {
  2153. /*
  2154. **
  2155. ** actually assign the value
  2156. **
  2157. */
  2158. if (X->VariantTypeCode == StringTypeCode
  2159. && My->CurrentVersion->
  2160. OptionFlags & OPTION_BUGS_ON /* INPUT allows embedded quote pairs */
  2161. )
  2162. {
  2163. int i;
  2164. int n;
  2165. n = X->Length;
  2166. for (i = 0; i < n; i++)
  2167. {
  2168. if (X->Buffer[i + 0] == My->CurrentVersion->OptionQuoteChar
  2169. && X->Buffer[i + 1] == My->CurrentVersion->OptionQuoteChar)
  2170. {
  2171. bwb_strncpy (&X->Buffer[i + 0], &X->Buffer[i + 1], n - i);
  2172. n--;
  2173. }
  2174. }
  2175. X->Length = n;
  2176. }
  2177. if (var_set (Variable, X) == FALSE)
  2178. {
  2179. WARN_VARIABLE_NOT_DECLARED;
  2180. return RESULT_UNPARSED;
  2181. }
  2182. }
  2183. /*
  2184. **
  2185. ** STRING
  2186. **
  2187. ** Note: do NOT free() or RELEASE_VARIANT because 'X->Buffer' points into 'buffer'
  2188. **
  2189. */
  2190. }
  2191. while (line_skip_seperator (Line)
  2192. && buff_skip_char (buffer, &p, My->CurrentFile->delimit));
  2193. /* verify all variables and values consumed */
  2194. if (line_is_eol (Line) && buff_is_eol (buffer, &p))
  2195. {
  2196. /*
  2197. **
  2198. ** OK
  2199. **
  2200. */
  2201. return RESULT_SUCCESS;
  2202. }
  2203. /* Count mismatch */
  2204. return RESULT_UNPARSED;
  2205. }
  2206. static LineType *
  2207. C77_user_input_line (LineType * Line, char *Prompt, int IsDisplayQuestionMark)
  2208. {
  2209. /*
  2210. **
  2211. ** CBASIC-II: INPUT "prompt" ; LINE variable$
  2212. **
  2213. */
  2214. VariableType *v;
  2215. assert (Line != NULL);
  2216. assert(My != NULL);
  2217. assert (My->CurrentFile != NULL);
  2218. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  2219. if ((v = line_read_scalar (Line)) == NULL)
  2220. {
  2221. WARN_SYNTAX_ERROR;
  2222. return (Line);
  2223. }
  2224. if (v->VariableFlags & (VARIABLE_CONSTANT))
  2225. {
  2226. WARN_VARIABLE_NOT_DECLARED;
  2227. return (Line);
  2228. }
  2229. if (VAR_IS_STRING (v))
  2230. {
  2231. VariantType variant;
  2232. char *tbuf;
  2233. int tlen;
  2234. tbuf = My->ConsoleInput;
  2235. tlen = MAX_LINE_LENGTH;
  2236. bwx_input (Prompt, IsDisplayQuestionMark, tbuf, tlen);
  2237. variant.VariantTypeCode = StringTypeCode;
  2238. variant.Buffer = tbuf;
  2239. variant.Length = bwb_strlen (variant.Buffer);
  2240. if (var_set (v, &variant) == FALSE)
  2241. {
  2242. WARN_VARIABLE_NOT_DECLARED;
  2243. return (Line);
  2244. }
  2245. /* OK */
  2246. if (Prompt != NULL)
  2247. {
  2248. free (Prompt);
  2249. /* Prompt = NULL; */
  2250. }
  2251. return (Line);
  2252. }
  2253. WARN_TYPE_MISMATCH;
  2254. return (Line);
  2255. }
  2256. static LineType *
  2257. user_input_loop (LineType * Line)
  2258. {
  2259. char *Prompt;
  2260. int IsDisplayQuestionMark;
  2261. int SavePosition;
  2262. assert (Line != NULL);
  2263. assert(My != NULL);
  2264. assert(My->SYSIN != NULL);
  2265. assert(My->SYSIN->cfp != NULL);
  2266. Prompt = NULL;
  2267. IsDisplayQuestionMark = TRUE;
  2268. My->CurrentFile = My->SYSIN;
  2269. /*
  2270. **
  2271. ** Step 1. Determine the prompt
  2272. ** Step 2. Verify all variables exist and are not CONST
  2273. ** Step 3. Display prompt and get user response
  2274. ** Step 4. Assign user response to variables
  2275. **
  2276. */
  2277. /*
  2278. **
  2279. ** Step 1. Determine the prompt
  2280. **
  2281. */
  2282. /* INPUT , "prompt" A, B, C */
  2283. /* INPUT ; "prompt" A, B ,C */
  2284. /* INPUT : "prompt" A, B, C */
  2285. if (line_skip_seperator (Line))
  2286. {
  2287. /* optional */
  2288. IsDisplayQuestionMark = FALSE;
  2289. }
  2290. if (line_peek_QuoteChar (Line))
  2291. {
  2292. /* get prompt string */
  2293. if (line_read_string_expression (Line, &Prompt) == FALSE)
  2294. {
  2295. WARN_SYNTAX_ERROR;
  2296. return (Line);
  2297. }
  2298. if (line_skip_seperator (Line) == ',' /* comma-specific */ )
  2299. {
  2300. /* optional */
  2301. IsDisplayQuestionMark = FALSE;
  2302. }
  2303. }
  2304. if (My->CurrentVersion->OptionVersionValue & (C77)
  2305. && line_skip_word (Line, "LINE"))
  2306. {
  2307. /* INPUT "prompt" ; LINE variable$ */
  2308. return C77_user_input_line (Line, Prompt, IsDisplayQuestionMark);
  2309. }
  2310. /*
  2311. **
  2312. ** Step 2. Verify all variables exist and are not CONST
  2313. **
  2314. */
  2315. SavePosition = Line->position;
  2316. do
  2317. {
  2318. VariableType *v;
  2319. if ((v = line_read_scalar (Line)) == NULL)
  2320. {
  2321. WARN_SYNTAX_ERROR;
  2322. return (Line);
  2323. }
  2324. if (v->VariableFlags & (VARIABLE_CONSTANT))
  2325. {
  2326. WARN_VARIABLE_NOT_DECLARED;
  2327. return (Line);
  2328. }
  2329. }
  2330. while (line_skip_seperator (Line));
  2331. if (line_is_eol (Line))
  2332. {
  2333. /* OK */
  2334. }
  2335. else
  2336. {
  2337. WARN_SYNTAX_ERROR;
  2338. return (Line);
  2339. }
  2340. while (TRUE)
  2341. {
  2342. char *tbuf;
  2343. int tlen;
  2344. ResultType Result;
  2345. tbuf = My->ConsoleInput;
  2346. tlen = MAX_LINE_LENGTH;
  2347. /*
  2348. **
  2349. ** Step 3. Display prompt and get user response
  2350. **
  2351. */
  2352. bwx_input (Prompt, IsDisplayQuestionMark, tbuf, tlen);
  2353. /*
  2354. **
  2355. ** Step 4. Assign user response to variables
  2356. **
  2357. */
  2358. Line->position = SavePosition;
  2359. Result = user_input_values (Line, tbuf, FALSE /* FAKE run */ ); /* bwb_INPUT, user_input_loop */
  2360. if (Result == RESULT_SUCCESS) /* bwb_INPUT */
  2361. {
  2362. /* successful input, FAKE run */
  2363. Line->position = SavePosition;
  2364. Result = user_input_values (Line, tbuf, TRUE /* REAL run */ ); /* bwb_INPUT, user_input_loop */
  2365. if (Result == RESULT_SUCCESS)
  2366. {
  2367. /* successful input, REAL run */
  2368. if (Prompt != NULL)
  2369. {
  2370. free (Prompt);
  2371. Prompt = NULL;
  2372. }
  2373. return (Line);
  2374. }
  2375. }
  2376. /* Result == RESULT_UNPARSED, RETRY */
  2377. fputs ("?Redo from start\n", My->SYSOUT->cfp); /* "*** Retry INPUT ***\n" */
  2378. ResetConsoleColumn ();
  2379. }
  2380. /* never reached */
  2381. return (Line);
  2382. }
  2383. extern LineType *
  2384. bwb_INPUT (LineType * Line)
  2385. {
  2386. assert (Line != NULL);
  2387. assert(My != NULL);
  2388. assert(My->CurrentVersion != NULL);
  2389. assert(My->SYSIN != NULL);
  2390. assert(My->SYSIN->cfp != NULL);
  2391. My->CurrentFile = My->SYSIN;
  2392. if (line_skip_FilenumChar (Line))
  2393. {
  2394. /* INPUT # X */
  2395. int FileNumber;
  2396. if (line_read_integer_expression (Line, &FileNumber) == FALSE)
  2397. {
  2398. WARN_SYNTAX_ERROR;
  2399. return (Line);
  2400. }
  2401. if (line_skip_seperator (Line))
  2402. {
  2403. /* required */
  2404. }
  2405. else
  2406. {
  2407. WARN_SYNTAX_ERROR;
  2408. return (Line);
  2409. }
  2410. /* INPUT # X , */
  2411. if (FileNumber < 0)
  2412. {
  2413. /* "INPUT # -1" is an error */
  2414. WARN_BAD_FILE_NUMBER;
  2415. return (Line);
  2416. }
  2417. if (FileNumber > 0)
  2418. {
  2419. /* normal file */
  2420. My->CurrentFile = find_file_by_number (FileNumber);
  2421. if (My->CurrentFile == NULL)
  2422. {
  2423. WARN_BAD_FILE_NUMBER;
  2424. return (Line);
  2425. }
  2426. if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
  2427. {
  2428. WARN_BAD_FILE_NUMBER;
  2429. return (Line);
  2430. }
  2431. return file_input (Line);
  2432. }
  2433. /* "INPUT #0, varlist" is the same as "INPUT varlist" */
  2434. }
  2435. /* input is from My->SYSIN */
  2436. return user_input_loop (Line);
  2437. }
  2438. /***************************************************************
  2439. FUNCTION: bwb_LINE()
  2440. DESCRIPTION: This function implements the BASIC LINE
  2441. INPUT statement.
  2442. SYNTAX: LINE INPUT [[#] device-number,]["prompt string";] string-variable$
  2443. ***************************************************************/
  2444. extern LineType *
  2445. bwb_LINE (LineType * Line)
  2446. {
  2447. assert (Line != NULL);
  2448. WARN_SYNTAX_ERROR;
  2449. return (Line);
  2450. }
  2451. extern LineType *
  2452. bwb_INPUT_LINE (LineType * Line)
  2453. {
  2454. assert (Line != NULL);
  2455. return bwb_LINE_INPUT (Line);
  2456. }
  2457. extern LineType *
  2458. bwb_LINE_INPUT (LineType * Line)
  2459. {
  2460. int FileNumber;
  2461. VariableType *v;
  2462. char *tbuf;
  2463. int tlen;
  2464. char *Prompt;
  2465. assert (Line != NULL);
  2466. assert(My != NULL);
  2467. assert(My->SYSIN != NULL);
  2468. assert(My->SYSIN->cfp != NULL);
  2469. assert(My->ConsoleInput != NULL);
  2470. assert(MAX_LINE_LENGTH > 1);
  2471. /* assign default values */
  2472. tbuf = My->ConsoleInput;
  2473. tlen = MAX_LINE_LENGTH;
  2474. Prompt = NULL;
  2475. My->CurrentFile = My->SYSIN;
  2476. /* check for leading semicolon */
  2477. if (line_skip_seperator (Line))
  2478. {
  2479. /* optional */
  2480. }
  2481. if (line_skip_FilenumChar (Line))
  2482. {
  2483. if (line_read_integer_expression (Line, &FileNumber) == FALSE)
  2484. {
  2485. WARN_SYNTAX_ERROR;
  2486. return (Line);
  2487. }
  2488. if (FileNumber < 0)
  2489. {
  2490. /* "LINE INPUT # -1" is an error */
  2491. WARN_BAD_FILE_NUMBER;
  2492. return (Line);
  2493. }
  2494. if (FileNumber > 0)
  2495. {
  2496. /* normal file */
  2497. My->CurrentFile = find_file_by_number (FileNumber);
  2498. if (My->CurrentFile == NULL)
  2499. {
  2500. WARN_BAD_FILE_NUMBER;
  2501. return (Line);
  2502. }
  2503. if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
  2504. {
  2505. WARN_BAD_FILE_NUMBER;
  2506. return (Line);
  2507. }
  2508. if (My->CurrentFile->cfp == NULL)
  2509. {
  2510. WARN_BAD_FILE_NUMBER;
  2511. return (Line);
  2512. }
  2513. }
  2514. /* check for comma */
  2515. if (line_skip_seperator (Line))
  2516. {
  2517. /* optional */
  2518. }
  2519. }
  2520. /* check for quotation mark indicating prompt */
  2521. if (line_peek_QuoteChar (Line))
  2522. {
  2523. /* get prompt string */
  2524. if (line_read_string_expression (Line, &Prompt) == FALSE)
  2525. {
  2526. WARN_SYNTAX_ERROR;
  2527. return (Line);
  2528. }
  2529. /* check for comma */
  2530. if (line_skip_seperator (Line))
  2531. {
  2532. /* optional */
  2533. }
  2534. }
  2535. /* read the variable for assignment */
  2536. if ((v = line_read_scalar (Line)) == NULL)
  2537. {
  2538. WARN_SYNTAX_ERROR;
  2539. return (Line);
  2540. }
  2541. if (VAR_IS_STRING (v))
  2542. {
  2543. /* OK */
  2544. }
  2545. else
  2546. {
  2547. /* ERROR */
  2548. WARN_TYPE_MISMATCH;
  2549. return (Line);
  2550. }
  2551. /* read a line of text into the bufffer */
  2552. if (My->CurrentFile == My->SYSIN)
  2553. {
  2554. /* LINE INPUT never displays a '?' regardless of the ',' or ';' */
  2555. bwx_input (Prompt, FALSE, tbuf, tlen);
  2556. }
  2557. else
  2558. {
  2559. if (fgets (tbuf, tlen, My->CurrentFile->cfp)) /* bwb_LINE_INPUT */
  2560. {
  2561. tbuf[tlen] = NulChar;
  2562. /* jaf-20211006 CleanTextInput() converts all <' ' chars to ' '. None of
  2563. the dialects I've used did this with `LINE INPUT ...` You could read a
  2564. whole file, verbatim, control codes and all (other than EOL), assuming
  2565. it had line breaks frequently enough. I was just going to patch
  2566. CleanTextInput, but it appears it may have valid uses in other
  2567. contexts. So lets replace the call to it with a simple EOL filter.
  2568. Depending on OS and compiler and since we're not opening files in
  2569. "text" mode we'll strip off up to two CRs or LFs. This means that CRLF
  2570. endings will be handled the same as LF, even on UNIX. I don't think
  2571. this will cause problems... I think its an advantage.
  2572. //CleanTextInput (tbuf); */
  2573. tlen=strlen(tbuf);
  2574. if(tlen--) {
  2575. if(tbuf[tlen]=='\r' || tbuf[tlen]=='\n') {
  2576. tlen--;
  2577. if(tlen>=0 && (tbuf[tlen]=='\r' || tbuf[tlen]=='\n')) tlen--;
  2578. tbuf[tlen+1] = NulChar;
  2579. }
  2580. }
  2581. }
  2582. else
  2583. {
  2584. return file_if_end (Line);
  2585. }
  2586. }
  2587. /* if( TRUE ) */
  2588. {
  2589. VariantType variant;
  2590. variant.VariantTypeCode = StringTypeCode;
  2591. variant.Buffer = tbuf;
  2592. variant.Length = bwb_strlen (variant.Buffer);
  2593. if (var_set (v, &variant) == FALSE)
  2594. {
  2595. WARN_VARIABLE_NOT_DECLARED;
  2596. return (Line);
  2597. }
  2598. }
  2599. if (Prompt != NULL)
  2600. {
  2601. free (Prompt);
  2602. Prompt = NULL;
  2603. }
  2604. return (Line);
  2605. }
  2606. static LineType *
  2607. file_read_matrix (LineType * Line)
  2608. {
  2609. /* MAT GET filename$ , matrix [, ...] */
  2610. /* MAT READ arrayname [;|,] */
  2611. /* Array must be 1, 2 or 3 dimensions */
  2612. /* Array may be either NUMBER or STRING */
  2613. VariableType *v;
  2614. assert (Line != NULL);
  2615. assert(My != NULL);
  2616. assert(My->CurrentVersion != NULL);
  2617. assert(My->SYSIN != NULL);
  2618. assert(My->SYSIN->cfp != NULL);
  2619. assert(My->ConsoleInput != NULL);
  2620. assert(MAX_LINE_LENGTH > 1);
  2621. assert(My->CurrentFile != NULL);
  2622. My->LastInputCount = 0;
  2623. do
  2624. {
  2625. char *tbuf;
  2626. int tlen;
  2627. tbuf = My->ConsoleInput;
  2628. tlen = MAX_LINE_LENGTH;
  2629. if (My->CurrentFile->width > 0 && My->CurrentFile->buffer != NULL)
  2630. {
  2631. tlen = My->CurrentFile->width;
  2632. tbuf = My->CurrentFile->buffer;
  2633. }
  2634. tbuf[0] = NulChar;
  2635. My->LastInputCount = 0;
  2636. if ((v = line_read_matrix (Line)) == NULL)
  2637. {
  2638. WARN_SUBSCRIPT_OUT_OF_RANGE;
  2639. return (Line);
  2640. }
  2641. /* variable MUST be an array of 1, 2 or 3 dimensions */
  2642. if (v->dimensions < 1)
  2643. {
  2644. WARN_SUBSCRIPT_OUT_OF_RANGE;
  2645. return (Line);
  2646. }
  2647. if (v->dimensions > 3)
  2648. {
  2649. WARN_SUBSCRIPT_OUT_OF_RANGE;
  2650. return (Line);
  2651. }
  2652. /* READ array */
  2653. switch (v->dimensions)
  2654. {
  2655. case 1:
  2656. {
  2657. /*
  2658. OPTION BASE 0
  2659. DIM A(5)
  2660. ...
  2661. MAT READ A
  2662. ...
  2663. FOR I = 0 TO 5
  2664. READ A(I)
  2665. NEXT I
  2666. ...
  2667. */
  2668. for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
  2669. v->VINDEX[0]++)
  2670. {
  2671. if (My->CurrentFile == My->SYSIN)
  2672. {
  2673. if (read_data (v) != RESULT_SUCCESS)
  2674. {
  2675. return data_if_end (Line);
  2676. }
  2677. }
  2678. else
  2679. {
  2680. if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
  2681. {
  2682. return file_if_end (Line);
  2683. }
  2684. }
  2685. /* OK */
  2686. My->LastInputCount++;
  2687. }
  2688. }
  2689. break;
  2690. case 2:
  2691. {
  2692. /*
  2693. OPTION BASE 0
  2694. DIM B(2,3)
  2695. ...
  2696. MAT READ B
  2697. ...
  2698. FOR I = 0 TO 2
  2699. FOR J = 0 TO 3
  2700. READ B(I,J)
  2701. NEXT J
  2702. PRINT
  2703. NEXT I
  2704. ...
  2705. */
  2706. for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
  2707. v->VINDEX[0]++)
  2708. {
  2709. for (v->VINDEX[1] = v->LBOUND[1]; v->VINDEX[1] <= v->UBOUND[1];
  2710. v->VINDEX[1]++)
  2711. {
  2712. if (My->CurrentFile == My->SYSIN)
  2713. {
  2714. if (read_data (v) != RESULT_SUCCESS)
  2715. {
  2716. return data_if_end (Line);
  2717. }
  2718. }
  2719. else
  2720. {
  2721. if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
  2722. {
  2723. return file_if_end (Line);
  2724. }
  2725. }
  2726. /* OK */
  2727. My->LastInputCount++;
  2728. }
  2729. }
  2730. }
  2731. break;
  2732. case 3:
  2733. {
  2734. /*
  2735. OPTION BASE 0
  2736. DIM C(2,3,4)
  2737. ...
  2738. MAT READ C
  2739. ...
  2740. FOR I = 0 TO 2
  2741. FOR J = 0 TO 3
  2742. FOR K = 0 TO 4
  2743. READ C(I,J,K)
  2744. NEXT K
  2745. PRINT
  2746. NEXT J
  2747. PRINT
  2748. NEXT I
  2749. ...
  2750. */
  2751. for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
  2752. v->VINDEX[0]++)
  2753. {
  2754. for (v->VINDEX[1] = v->LBOUND[1]; v->VINDEX[1] <= v->UBOUND[1];
  2755. v->VINDEX[1]++)
  2756. {
  2757. for (v->VINDEX[2] = v->LBOUND[2]; v->VINDEX[2] <= v->UBOUND[2];
  2758. v->VINDEX[2]++)
  2759. {
  2760. if (My->CurrentFile == My->SYSIN)
  2761. {
  2762. if (read_data (v) != RESULT_SUCCESS)
  2763. {
  2764. return data_if_end (Line);
  2765. }
  2766. }
  2767. else
  2768. {
  2769. if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
  2770. {
  2771. return file_if_end (Line);
  2772. }
  2773. }
  2774. /* OK */
  2775. My->LastInputCount++;
  2776. }
  2777. }
  2778. }
  2779. }
  2780. break;
  2781. }
  2782. /* process the next variable, if any */
  2783. }
  2784. while (line_skip_seperator (Line));
  2785. return (Line);
  2786. }
  2787. extern LineType *
  2788. bwb_MAT_GET (LineType * Line)
  2789. {
  2790. /* MAT GET filename$ , matrix [, ...] */
  2791. VariantType E;
  2792. VariantType *e;
  2793. assert (Line != NULL);
  2794. assert(My != NULL);
  2795. assert(My->SYSIN != NULL);
  2796. assert(My->SYSIN->cfp != NULL);
  2797. e = &E;
  2798. My->CurrentFile = My->SYSIN;
  2799. if (line_read_expression (Line, e) == FALSE) /* bwb_MAT_GET */
  2800. {
  2801. WARN_SYNTAX_ERROR;
  2802. return (Line);
  2803. }
  2804. if (e->VariantTypeCode == StringTypeCode)
  2805. {
  2806. /* STRING */
  2807. /* MAT GET filename$ ... */
  2808. if (is_empty_string (e->Buffer))
  2809. {
  2810. /* MAT GET "" ... is an error */
  2811. WARN_BAD_FILE_NAME;
  2812. return (Line);
  2813. }
  2814. My->CurrentFile = find_file_by_name (e->Buffer);
  2815. if (My->CurrentFile == NULL)
  2816. {
  2817. /* implicitly OPEN for reading */
  2818. My->CurrentFile = file_new ();
  2819. My->CurrentFile->cfp = fopen (e->Buffer, "r");
  2820. if (My->CurrentFile->cfp == NULL)
  2821. {
  2822. WARN_BAD_FILE_NAME;
  2823. return (Line);
  2824. }
  2825. My->CurrentFile->FileNumber = file_next_number ();
  2826. My->CurrentFile->DevMode = DEVMODE_INPUT;
  2827. My->CurrentFile->width = 0;
  2828. /* WIDTH == RECLEN */
  2829. My->CurrentFile->col = 1;
  2830. My->CurrentFile->row = 1;
  2831. My->CurrentFile->delimit = ',';
  2832. My->CurrentFile->buffer = NULL;
  2833. if (My->CurrentFile->FileName != NULL)
  2834. {
  2835. free (My->CurrentFile->FileName);
  2836. My->CurrentFile->FileName = NULL;
  2837. }
  2838. My->CurrentFile->FileName = e->Buffer;
  2839. e->Buffer = NULL;
  2840. }
  2841. }
  2842. else
  2843. {
  2844. /* NUMBER -- file must already be OPEN */
  2845. /* GET filenumber ... */
  2846. if (e->Number < 0)
  2847. {
  2848. /* "MAT GET # -1" is an error */
  2849. WARN_BAD_FILE_NUMBER;
  2850. return (Line);
  2851. }
  2852. if (e->Number == 0)
  2853. {
  2854. /* "MAT GET # 0" is an error */
  2855. WARN_BAD_FILE_NUMBER;
  2856. return (Line);
  2857. }
  2858. /* normal file */
  2859. My->CurrentFile = find_file_by_number ((int) bwb_rint (e->Number));
  2860. if (My->CurrentFile == NULL)
  2861. {
  2862. /* file not OPEN */
  2863. WARN_BAD_FILE_NUMBER;
  2864. return (Line);
  2865. }
  2866. }
  2867. if (My->CurrentFile == NULL)
  2868. {
  2869. WARN_BAD_FILE_NUMBER;
  2870. return (Line);
  2871. }
  2872. if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
  2873. {
  2874. WARN_BAD_FILE_NUMBER;
  2875. return (Line);
  2876. }
  2877. if (line_skip_seperator (Line))
  2878. {
  2879. /* OK */
  2880. }
  2881. else
  2882. {
  2883. WARN_SYNTAX_ERROR;
  2884. return (Line);
  2885. }
  2886. return file_read_matrix (Line);
  2887. }
  2888. extern LineType *
  2889. bwb_MAT_READ (LineType * Line)
  2890. {
  2891. /* MAT READ arrayname [;|,] */
  2892. /* Array must be 1, 2 or 3 dimensions */
  2893. /* Array may be either NUMBER or STRING */
  2894. assert (Line != NULL);
  2895. assert(My != NULL);
  2896. assert(My->CurrentVersion != NULL);
  2897. assert(My->SYSIN != NULL);
  2898. assert(My->SYSIN->cfp != NULL);
  2899. My->CurrentFile = My->SYSIN;
  2900. My->LastInputCount = 0;
  2901. if (line_skip_FilenumChar (Line))
  2902. {
  2903. /* MAT READ # filenum, varlist */
  2904. int FileNumber;
  2905. if (line_read_integer_expression (Line, &FileNumber) == FALSE)
  2906. {
  2907. WARN_SYNTAX_ERROR;
  2908. return (Line);
  2909. }
  2910. if (line_skip_seperator (Line))
  2911. {
  2912. /* OK */
  2913. }
  2914. else
  2915. {
  2916. WARN_SYNTAX_ERROR;
  2917. return (Line);
  2918. }
  2919. My->CurrentFile = find_file_by_number (FileNumber);
  2920. if (My->CurrentFile == NULL)
  2921. {
  2922. WARN_BAD_FILE_NUMBER;
  2923. return (Line);
  2924. }
  2925. if (My->CurrentFile != My->SYSIN)
  2926. {
  2927. if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
  2928. {
  2929. WARN_BAD_FILE_NUMBER;
  2930. return (Line);
  2931. }
  2932. if (My->CurrentFile->cfp == NULL)
  2933. {
  2934. WARN_BAD_FILE_NUMBER;
  2935. return (Line);
  2936. }
  2937. }
  2938. /* "MAT READ # 0, varlist" is the same as "MAT READ varlist" */
  2939. }
  2940. return file_read_matrix (Line);
  2941. }
  2942. static ResultType
  2943. input_data (VariableType * Variable, char *tbuf, int tlen)
  2944. {
  2945. /*
  2946. **
  2947. ** read one INPUT item
  2948. **
  2949. */
  2950. int p;
  2951. ResultType Result;
  2952. VariantType Variant;
  2953. VariantType *X;
  2954. assert (Variable != NULL);
  2955. assert (tbuf != NULL);
  2956. assert(My != NULL);
  2957. assert(My->CurrentVersion != NULL);
  2958. assert(My->SYSIN != NULL);
  2959. assert(My->SYSIN->cfp != NULL);
  2960. assert(My->CurrentFile != NULL);
  2961. assert (My->CurrentFile == My->SYSIN);
  2962. Result = RESULT_UNPARSED;
  2963. X = &Variant;
  2964. CLEAR_VARIANT (X);
  2965. if (tbuf[0] == NulChar)
  2966. {
  2967. /* Get more data */
  2968. bwx_input ("?", FALSE, tbuf, tlen);
  2969. if (tbuf[0] == NulChar)
  2970. {
  2971. return RESULT_UNPARSED;
  2972. }
  2973. /*
  2974. **
  2975. ** make sure we can parse everything in tbuf
  2976. **
  2977. */
  2978. p = 0;
  2979. do
  2980. {
  2981. do
  2982. {
  2983. if (VAR_IS_STRING (Variable))
  2984. {
  2985. Result = parse_string (tbuf, &p, X);
  2986. }
  2987. else
  2988. {
  2989. Result = parse_number (tbuf, &p, X, FALSE);
  2990. }
  2991. }
  2992. while (buff_skip_seperator (tbuf, &p) && Result == RESULT_SUCCESS);
  2993. /* verify we consumed all user values */
  2994. if (buff_is_eol (tbuf, &p))
  2995. {
  2996. /* we reached the end of the user's input */
  2997. }
  2998. else
  2999. {
  3000. /* garbage in user's input */
  3001. Result = RESULT_UNPARSED;
  3002. }
  3003. if (Result != RESULT_SUCCESS)
  3004. {
  3005. tbuf[0] = NulChar;
  3006. bwx_input ("?Redo", FALSE, tbuf, tlen);
  3007. if (tbuf[0] == NulChar)
  3008. {
  3009. return RESULT_UNPARSED;
  3010. }
  3011. p = 0;
  3012. }
  3013. }
  3014. while (Result != RESULT_SUCCESS);
  3015. /*
  3016. **
  3017. ** so, we can parse all of the user's input (everything in tbuf)
  3018. **
  3019. */
  3020. }
  3021. /* process one value */
  3022. p = 0;
  3023. if (VAR_IS_STRING (Variable))
  3024. {
  3025. Result = parse_string (tbuf, &p, X);
  3026. }
  3027. else
  3028. {
  3029. Result = parse_number (tbuf, &p, X, FALSE);
  3030. }
  3031. if (Result != RESULT_SUCCESS)
  3032. {
  3033. WARN_INTERNAL_ERROR;
  3034. return RESULT_UNPARSED;
  3035. }
  3036. if (X->VariantTypeCode == StringTypeCode
  3037. && My->CurrentVersion->
  3038. OptionFlags & OPTION_BUGS_ON /* DATA allows embedded quote pairs */ )
  3039. {
  3040. int i;
  3041. int n;
  3042. n = X->Length;
  3043. for (i = 0; i < n; i++)
  3044. {
  3045. if (X->Buffer[i + 0] == My->CurrentVersion->OptionQuoteChar
  3046. && X->Buffer[i + 1] == My->CurrentVersion->OptionQuoteChar)
  3047. {
  3048. bwb_strncpy (&X->Buffer[i + 0], &X->Buffer[i + 1], n - i);
  3049. n--;
  3050. }
  3051. }
  3052. X->Length = n;
  3053. }
  3054. if (var_set (Variable, X) == FALSE)
  3055. {
  3056. WARN_VARIABLE_NOT_DECLARED;
  3057. return RESULT_UNPARSED;
  3058. }
  3059. /* determine whether all user input was consumed */
  3060. if (buff_is_eol (tbuf, &p))
  3061. {
  3062. /* we have consumed the entire buffer */
  3063. tbuf[0] = NulChar;
  3064. return RESULT_SUCCESS;
  3065. }
  3066. if (buff_skip_char (tbuf, &p, My->CurrentFile->delimit)) /* buff_skip_comma */
  3067. {
  3068. /* shift the buffer left, just past the comma (,) */
  3069. bwb_strcpy (tbuf, &tbuf[p]);
  3070. return RESULT_SUCCESS;
  3071. }
  3072. /* garbage after the value we just READ */
  3073. WARN_BAD_DATA;
  3074. return RESULT_UNPARSED;
  3075. }
  3076. extern LineType *
  3077. bwb_MAT_INPUT (LineType * Line)
  3078. {
  3079. /* MAT INPUT arrayname [;|,] */
  3080. /* Array must be 1, 2 or 3 dimensions */
  3081. /* Array may be either NUMBER or STRING */
  3082. VariableType *v;
  3083. assert (Line != NULL);
  3084. assert(My != NULL);
  3085. assert(My->CurrentVersion != NULL);
  3086. assert(My->SYSIN != NULL);
  3087. assert(My->SYSIN->cfp != NULL);
  3088. assert(My->ConsoleInput != NULL);
  3089. assert(MAX_LINE_LENGTH > 1);
  3090. My->CurrentFile = My->SYSIN;
  3091. My->LastInputCount = 0;
  3092. if (line_skip_FilenumChar (Line))
  3093. {
  3094. /* MAT INPUT # filenum, varlist */
  3095. int FileNumber;
  3096. if (line_read_integer_expression (Line, &FileNumber) == FALSE)
  3097. {
  3098. WARN_SYNTAX_ERROR;
  3099. return (Line);
  3100. }
  3101. if (line_skip_seperator (Line))
  3102. {
  3103. /* OK */
  3104. }
  3105. else
  3106. {
  3107. WARN_SYNTAX_ERROR;
  3108. return (Line);
  3109. }
  3110. My->CurrentFile = find_file_by_number (FileNumber);
  3111. if (My->CurrentFile == NULL)
  3112. {
  3113. WARN_BAD_FILE_NUMBER;
  3114. return (Line);
  3115. }
  3116. if (My->CurrentFile != My->SYSIN)
  3117. {
  3118. if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
  3119. {
  3120. WARN_BAD_FILE_NUMBER;
  3121. return (Line);
  3122. }
  3123. if (My->CurrentFile->cfp == NULL)
  3124. {
  3125. WARN_BAD_FILE_NUMBER;
  3126. return (Line);
  3127. }
  3128. }
  3129. /* "MAT INPUT # 0, varlist" is the same as "MAT INPUT varlist" */
  3130. }
  3131. do
  3132. {
  3133. char *tbuf;
  3134. int tlen;
  3135. tbuf = My->ConsoleInput;
  3136. tlen = MAX_LINE_LENGTH;
  3137. if (My->CurrentFile->width > 0 && My->CurrentFile->buffer != NULL)
  3138. {
  3139. tlen = My->CurrentFile->width;
  3140. tbuf = My->CurrentFile->buffer;
  3141. }
  3142. tbuf[0] = NulChar;
  3143. My->LastInputCount = 0;
  3144. if ((v = line_read_matrix (Line)) == NULL)
  3145. {
  3146. WARN_SUBSCRIPT_OUT_OF_RANGE;
  3147. return (Line);
  3148. }
  3149. /* variable MUST be an array of 1, 2 or 3 dimensions */
  3150. if (v->dimensions < 1)
  3151. {
  3152. WARN_SUBSCRIPT_OUT_OF_RANGE;
  3153. return (Line);
  3154. }
  3155. if (v->dimensions > 3)
  3156. {
  3157. WARN_SUBSCRIPT_OUT_OF_RANGE;
  3158. return (Line);
  3159. }
  3160. /* INPUT array */
  3161. switch (v->dimensions)
  3162. {
  3163. case 1:
  3164. {
  3165. /*
  3166. OPTION BASE 0
  3167. DIM A(5)
  3168. ...
  3169. MAT INPUT A
  3170. ...
  3171. FOR I = 0 TO 5
  3172. INPUT A(I)
  3173. NEXT I
  3174. ...
  3175. */
  3176. My->LastInputCount = 0;
  3177. for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
  3178. v->VINDEX[0]++)
  3179. {
  3180. if (My->CurrentFile == My->SYSIN)
  3181. {
  3182. if (input_data (v, tbuf, tlen) != RESULT_SUCCESS)
  3183. {
  3184. /*
  3185. WARN_INPUT_PAST_END;
  3186. */
  3187. return (Line);
  3188. }
  3189. }
  3190. else
  3191. {
  3192. if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
  3193. {
  3194. return file_if_end (Line);
  3195. }
  3196. }
  3197. /* OK */
  3198. My->LastInputCount++;
  3199. }
  3200. }
  3201. break;
  3202. case 2:
  3203. {
  3204. /*
  3205. OPTION BASE 0
  3206. DIM B(2,3)
  3207. ...
  3208. MAT INPUT B
  3209. ...
  3210. FOR I = 0 TO 2
  3211. FOR J = 0 TO 3
  3212. INPUT B(I,J)
  3213. NEXT J
  3214. PRINT
  3215. NEXT I
  3216. ...
  3217. */
  3218. My->LastInputCount = 0;
  3219. for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
  3220. v->VINDEX[0]++)
  3221. {
  3222. for (v->VINDEX[1] = v->LBOUND[1]; v->VINDEX[1] <= v->UBOUND[1];
  3223. v->VINDEX[1]++)
  3224. {
  3225. if (My->CurrentFile == My->SYSIN)
  3226. {
  3227. if (input_data (v, tbuf, tlen) != RESULT_SUCCESS)
  3228. {
  3229. /*
  3230. WARN_INPUT_PAST_END;
  3231. */
  3232. return (Line);
  3233. }
  3234. }
  3235. else
  3236. {
  3237. if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
  3238. {
  3239. return file_if_end (Line);
  3240. }
  3241. }
  3242. /* OK */
  3243. My->LastInputCount++;
  3244. }
  3245. }
  3246. }
  3247. break;
  3248. case 3:
  3249. {
  3250. /*
  3251. OPTION BASE 0
  3252. DIM C(2,3,4)
  3253. ...
  3254. MAT INPUT C
  3255. ...
  3256. FOR I = 0 TO 2
  3257. FOR J = 0 TO 3
  3258. FOR K = 0 TO 4
  3259. INPUT C(I,J,K)
  3260. NEXT K
  3261. PRINT
  3262. NEXT J
  3263. PRINT
  3264. NEXT I
  3265. ...
  3266. */
  3267. My->LastInputCount = 0;
  3268. for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
  3269. v->VINDEX[0]++)
  3270. {
  3271. for (v->VINDEX[1] = v->LBOUND[1]; v->VINDEX[1] <= v->UBOUND[1];
  3272. v->VINDEX[1]++)
  3273. {
  3274. for (v->VINDEX[2] = v->LBOUND[2]; v->VINDEX[2] <= v->UBOUND[2];
  3275. v->VINDEX[2]++)
  3276. {
  3277. if (My->CurrentFile == My->SYSIN)
  3278. {
  3279. if (input_data (v, tbuf, tlen) != RESULT_SUCCESS)
  3280. {
  3281. /*
  3282. WARN_INPUT_PAST_END;
  3283. */
  3284. return (Line);
  3285. }
  3286. }
  3287. else
  3288. {
  3289. if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
  3290. {
  3291. return file_if_end (Line);
  3292. }
  3293. }
  3294. /* OK */
  3295. My->LastInputCount++;
  3296. }
  3297. }
  3298. }
  3299. }
  3300. break;
  3301. }
  3302. /* process the next variable, if any */
  3303. }
  3304. while (line_skip_seperator (Line));
  3305. return (Line);
  3306. }
  3307. /* EOF */