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.
 
 
 
 
 
 

3526 lines
77 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. extern int
  1172. binary_get_put (VariableType * Variable, int IsPUT)
  1173. {
  1174. VariantType variant;
  1175. VariantType *Variant;
  1176. assert(My != NULL);
  1177. assert (My->CurrentFile != NULL);
  1178. assert (My->CurrentFile->cfp != NULL);
  1179. assert (My->CurrentFile->DevMode == DEVMODE_BINARY);
  1180. Variant = &variant;
  1181. CLEAR_VARIANT (Variant);
  1182. if (var_get (Variable, Variant) == FALSE)
  1183. {
  1184. WARN_VARIABLE_NOT_DECLARED;
  1185. return FALSE;
  1186. }
  1187. switch (Variant->VariantTypeCode)
  1188. {
  1189. case ByteTypeCode:
  1190. {
  1191. ByteType Value;
  1192. Value = (ByteType) Variant->Number;
  1193. if (IsPUT)
  1194. {
  1195. if (fwrite (&(Value), sizeof (Value), 1, My->CurrentFile->cfp) != 1)
  1196. {
  1197. WARN_DISK_IO_ERROR;
  1198. return FALSE;
  1199. }
  1200. }
  1201. else
  1202. {
  1203. if (fread (&(Value), sizeof (Value), 1, My->CurrentFile->cfp) != 1)
  1204. {
  1205. WARN_DISK_IO_ERROR;
  1206. return FALSE;
  1207. }
  1208. }
  1209. Variant->Number = Value;
  1210. }
  1211. break;
  1212. case IntegerTypeCode:
  1213. {
  1214. IntegerType Value;
  1215. Value = (IntegerType) Variant->Number;
  1216. if (IsPUT)
  1217. {
  1218. if (fwrite (&(Value), sizeof (Value), 1, My->CurrentFile->cfp) != 1)
  1219. {
  1220. WARN_DISK_IO_ERROR;
  1221. return FALSE;
  1222. }
  1223. }
  1224. else
  1225. {
  1226. if (fread (&(Value), sizeof (Value), 1, My->CurrentFile->cfp) != 1)
  1227. {
  1228. WARN_DISK_IO_ERROR;
  1229. return FALSE;
  1230. }
  1231. }
  1232. Variant->Number = Value;
  1233. }
  1234. break;
  1235. case LongTypeCode:
  1236. {
  1237. LongType Value;
  1238. Value = (LongType) Variant->Number;
  1239. if (IsPUT)
  1240. {
  1241. if (fwrite (&(Value), sizeof (Value), 1, My->CurrentFile->cfp) != 1)
  1242. {
  1243. WARN_DISK_IO_ERROR;
  1244. return FALSE;
  1245. }
  1246. }
  1247. else
  1248. {
  1249. if (fread (&(Value), sizeof (Value), 1, My->CurrentFile->cfp) != 1)
  1250. {
  1251. WARN_DISK_IO_ERROR;
  1252. return FALSE;
  1253. }
  1254. }
  1255. Variant->Number = Value;
  1256. }
  1257. break;
  1258. case CurrencyTypeCode:
  1259. {
  1260. CurrencyType Value;
  1261. Value = (CurrencyType) Variant->Number;
  1262. if (IsPUT)
  1263. {
  1264. if (fwrite (&(Value), sizeof (Value), 1, My->CurrentFile->cfp) != 1)
  1265. {
  1266. WARN_DISK_IO_ERROR;
  1267. return FALSE;
  1268. }
  1269. }
  1270. else
  1271. {
  1272. if (fread (&(Value), sizeof (Value), 1, My->CurrentFile->cfp) != 1)
  1273. {
  1274. WARN_DISK_IO_ERROR;
  1275. return FALSE;
  1276. }
  1277. }
  1278. Variant->Number = Value;
  1279. }
  1280. break;
  1281. case SingleTypeCode:
  1282. {
  1283. SingleType Value;
  1284. Value = (SingleType) Variant->Number;
  1285. if (IsPUT)
  1286. {
  1287. if (fwrite (&(Value), sizeof (Value), 1, My->CurrentFile->cfp) != 1)
  1288. {
  1289. WARN_DISK_IO_ERROR;
  1290. return FALSE;
  1291. }
  1292. }
  1293. else
  1294. {
  1295. if (fread (&(Value), sizeof (Value), 1, My->CurrentFile->cfp) != 1)
  1296. {
  1297. WARN_DISK_IO_ERROR;
  1298. return FALSE;
  1299. }
  1300. }
  1301. Variant->Number = Value;
  1302. }
  1303. break;
  1304. case DoubleTypeCode:
  1305. {
  1306. DoubleType Value;
  1307. Value = (DoubleType) Variant->Number;
  1308. if (IsPUT)
  1309. {
  1310. if (fwrite (&(Value), sizeof (Value), 1, My->CurrentFile->cfp) != 1)
  1311. {
  1312. WARN_DISK_IO_ERROR;
  1313. return FALSE;
  1314. }
  1315. }
  1316. else
  1317. {
  1318. if (fread (&(Value), sizeof (Value), 1, My->CurrentFile->cfp) != 1)
  1319. {
  1320. WARN_DISK_IO_ERROR;
  1321. return FALSE;
  1322. }
  1323. }
  1324. Variant->Number = Value;
  1325. }
  1326. break;
  1327. case StringTypeCode:
  1328. if (IsPUT)
  1329. {
  1330. #if FALSE /* keep this ... */
  1331. if (fwrite
  1332. (&(Variant->Length), sizeof (Variant->Length), 1,
  1333. My->CurrentFile->cfp) != 1)
  1334. {
  1335. WARN_DISK_IO_ERROR;
  1336. return FALSE;
  1337. }
  1338. #endif
  1339. if (fwrite (Variant->Buffer, Variant->Length, 1, My->CurrentFile->cfp)
  1340. != 1)
  1341. {
  1342. WARN_DISK_IO_ERROR;
  1343. return FALSE;
  1344. }
  1345. }
  1346. else
  1347. {
  1348. #if FALSE /* keep this ... */
  1349. if (fread
  1350. (&(Variant->Length), sizeof (Variant->Length), 1,
  1351. My->CurrentFile->cfp) != 1)
  1352. {
  1353. WARN_DISK_IO_ERROR;
  1354. return FALSE;
  1355. }
  1356. #endif
  1357. if (fread (Variant->Buffer, Variant->Length, 1, My->CurrentFile->cfp) !=
  1358. 1)
  1359. {
  1360. WARN_DISK_IO_ERROR;
  1361. return FALSE;
  1362. }
  1363. Variant->Buffer[Variant->Length] = NulChar;
  1364. }
  1365. break;
  1366. default:
  1367. {
  1368. WARN_INTERNAL_ERROR;
  1369. return FALSE;
  1370. }
  1371. }
  1372. if (IsPUT)
  1373. {
  1374. /* not needed */
  1375. }
  1376. else
  1377. {
  1378. if (var_set (Variable, Variant) == FALSE)
  1379. {
  1380. WARN_VARIABLE_NOT_DECLARED;
  1381. return FALSE;
  1382. }
  1383. }
  1384. RELEASE_VARIANT (Variant);
  1385. /* OK */
  1386. return TRUE;
  1387. }
  1388. static LineType *
  1389. H14_GET (LineType * Line)
  1390. {
  1391. /* GET # FileNumber [ , RecordNumber ] ' RANDOM */
  1392. /* GET # FileNumber , [ BytePosition ] , scalar [,...] ' BINARY */
  1393. int FileNumber;
  1394. assert (Line != NULL);
  1395. assert(My != NULL);
  1396. FileNumber = 0;
  1397. if (line_skip_FilenumChar (Line))
  1398. {
  1399. /* OPTIONAL */
  1400. }
  1401. if (line_read_integer_expression (Line, &FileNumber) == FALSE)
  1402. {
  1403. WARN_BAD_FILE_NUMBER;
  1404. return (Line);
  1405. }
  1406. if (FileNumber < 1)
  1407. {
  1408. WARN_BAD_FILE_NUMBER;
  1409. return (Line);
  1410. }
  1411. My->CurrentFile = find_file_by_number (FileNumber);
  1412. if (My->CurrentFile == NULL)
  1413. {
  1414. WARN_BAD_FILE_NUMBER;
  1415. return (Line);
  1416. }
  1417. if (My->CurrentFile->DevMode == DEVMODE_RANDOM)
  1418. {
  1419. /* GET # FileNumber [ , RecordNumber ] ' RANDOM */
  1420. if (My->CurrentFile->width <= 0)
  1421. {
  1422. WARN_BAD_FILE_NUMBER;
  1423. return (Line);
  1424. }
  1425. if (line_is_eol (Line))
  1426. {
  1427. /* GET # FileNumber */
  1428. }
  1429. else
  1430. {
  1431. /* GET # FileNumber , RecordNumber */
  1432. int RecordNumber;
  1433. long offset;
  1434. RecordNumber = 0;
  1435. offset = 0;
  1436. if (line_skip_seperator (Line) == FALSE)
  1437. {
  1438. WARN_SYNTAX_ERROR;
  1439. return (Line);
  1440. }
  1441. if (line_read_integer_expression (Line, &RecordNumber) == FALSE)
  1442. {
  1443. WARN_BAD_RECORD_NUMBER;
  1444. return (Line);
  1445. }
  1446. if (RecordNumber <= 0)
  1447. {
  1448. WARN_BAD_RECORD_NUMBER;
  1449. return (Line);
  1450. }
  1451. RecordNumber--; /* BASIC to C */
  1452. offset = RecordNumber;
  1453. offset *= My->CurrentFile->width;
  1454. if (fseek (My->CurrentFile->cfp, offset, SEEK_SET) != 0)
  1455. {
  1456. WARN_BAD_RECORD_NUMBER;
  1457. return (Line);
  1458. }
  1459. }
  1460. /* if( TRUE ) */
  1461. {
  1462. int i;
  1463. for (i = 0; i < My->CurrentFile->width; i++)
  1464. {
  1465. int c;
  1466. c = fgetc (My->CurrentFile->cfp);
  1467. if ( /* EOF */ c < 0)
  1468. {
  1469. c = NulChar;
  1470. }
  1471. My->CurrentFile->buffer[i] = c;
  1472. }
  1473. }
  1474. field_get (My->CurrentFile);
  1475. /* OK */
  1476. return (Line);
  1477. }
  1478. else if (My->CurrentFile->DevMode == DEVMODE_BINARY)
  1479. {
  1480. /* GET # FileNumber , [ BytePosition ] , scalar [,...] ' BINARY */
  1481. if (line_skip_seperator (Line) == FALSE)
  1482. {
  1483. WARN_SYNTAX_ERROR;
  1484. return (Line);
  1485. }
  1486. if (line_skip_seperator (Line))
  1487. {
  1488. /* BytePosition not provided */
  1489. }
  1490. else
  1491. {
  1492. int RecordNumber;
  1493. long offset;
  1494. RecordNumber = 0;
  1495. offset = 0;
  1496. if (line_read_integer_expression (Line, &RecordNumber) == FALSE)
  1497. {
  1498. WARN_BAD_RECORD_NUMBER;
  1499. return (Line);
  1500. }
  1501. if (RecordNumber <= 0)
  1502. {
  1503. WARN_BAD_RECORD_NUMBER;
  1504. return (Line);
  1505. }
  1506. RecordNumber--; /* BASIC to C */
  1507. offset = RecordNumber;
  1508. if (fseek (My->CurrentFile->cfp, offset, SEEK_SET) != 0)
  1509. {
  1510. WARN_BAD_RECORD_NUMBER;
  1511. return (Line);
  1512. }
  1513. if (line_skip_seperator (Line) == FALSE)
  1514. {
  1515. WARN_SYNTAX_ERROR;
  1516. return (Line);
  1517. }
  1518. }
  1519. do
  1520. {
  1521. VariableType *v;
  1522. if ((v = line_read_scalar (Line)) == NULL)
  1523. {
  1524. WARN_SYNTAX_ERROR;
  1525. return (Line);
  1526. }
  1527. if (binary_get_put (v, FALSE) == FALSE)
  1528. {
  1529. WARN_SYNTAX_ERROR;
  1530. return (Line);
  1531. }
  1532. }
  1533. while (line_skip_seperator (Line));
  1534. /* OK */
  1535. return (Line);
  1536. }
  1537. WARN_BAD_FILE_MODE;
  1538. return (Line);
  1539. }
  1540. extern LineType *
  1541. bwb_GET (LineType * Line)
  1542. {
  1543. assert (Line != NULL);
  1544. assert(My != NULL);
  1545. assert(My->CurrentVersion != NULL);
  1546. if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
  1547. {
  1548. return S70_GET (Line);
  1549. }
  1550. if (My->CurrentVersion->OptionVersionValue & (D71 | T79 | R86))
  1551. {
  1552. return D71_GET (Line);
  1553. }
  1554. if (My->CurrentVersion->OptionVersionValue & (H14))
  1555. {
  1556. return H14_GET (Line);
  1557. }
  1558. WARN_INTERNAL_ERROR;
  1559. return (Line);
  1560. }
  1561. static ResultType
  1562. file_data (VariableType * Variable, char *tbuf, int tlen)
  1563. {
  1564. ResultType Result;
  1565. VariantType Variant;
  1566. VariantType *X;
  1567. int p;
  1568. assert (Variable != NULL);
  1569. assert (tbuf != NULL);
  1570. assert (tlen > 0);
  1571. assert(My != NULL);
  1572. assert(My->CurrentVersion != NULL);
  1573. assert (My->CurrentFile != NULL);
  1574. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  1575. Result = RESULT_UNPARSED;
  1576. X = &Variant;
  1577. p = 0;
  1578. CLEAR_VARIANT (X);
  1579. if (tbuf[0] == NulChar)
  1580. {
  1581. /* Get more data */
  1582. if (fgets (tbuf, tlen, My->CurrentFile->cfp)) /* file_data */
  1583. {
  1584. tbuf[tlen] = NulChar;
  1585. CleanTextInput (tbuf);
  1586. }
  1587. else
  1588. {
  1589. return RESULT_UNPARSED; /* causes file_if_end() */
  1590. }
  1591. }
  1592. if (VAR_IS_STRING (Variable))
  1593. {
  1594. Result = parse_string (tbuf, &p, X);
  1595. }
  1596. else
  1597. {
  1598. Result = parse_number (tbuf, &p, X, FALSE);
  1599. }
  1600. if (Result == RESULT_UNPARSED)
  1601. {
  1602. WARN_BAD_DATA;
  1603. }
  1604. if (Result != RESULT_SUCCESS)
  1605. {
  1606. return Result;
  1607. }
  1608. /*
  1609. **
  1610. ** OK
  1611. **
  1612. */
  1613. if (X->VariantTypeCode == StringTypeCode
  1614. && My->CurrentVersion->
  1615. OptionFlags & OPTION_BUGS_ON /* DATA allows embedded quote pairs */ )
  1616. {
  1617. int i;
  1618. int n;
  1619. n = X->Length;
  1620. for (i = 0; i < n; i++)
  1621. {
  1622. if (X->Buffer[i + 0] == My->CurrentVersion->OptionQuoteChar
  1623. && X->Buffer[i + 1] == My->CurrentVersion->OptionQuoteChar)
  1624. {
  1625. bwb_strncpy (&X->Buffer[i + 0], &X->Buffer[i + 1], n - i);
  1626. n--;
  1627. }
  1628. }
  1629. X->Length = n;
  1630. }
  1631. if (var_set (Variable, X) == FALSE)
  1632. {
  1633. WARN_VARIABLE_NOT_DECLARED;
  1634. return RESULT_UNPARSED;
  1635. }
  1636. /*
  1637. **
  1638. ** Note: do NOT free() or RELEASE_VARIANT because 'X->Buffer' points into 'buffer'
  1639. **
  1640. */
  1641. if (buff_is_eol (tbuf, &p))
  1642. {
  1643. tbuf[0] = NulChar;
  1644. return RESULT_SUCCESS;
  1645. }
  1646. if (buff_skip_char (tbuf, &p, My->CurrentFile->delimit)) /* buff_skip_comma */
  1647. {
  1648. /* shift left past comma */
  1649. bwb_strcpy (tbuf, &tbuf[p]);
  1650. return RESULT_SUCCESS;
  1651. }
  1652. /* garbage after the value we just READ */
  1653. WARN_BAD_DATA;
  1654. return RESULT_UNPARSED;
  1655. }
  1656. static LineType *
  1657. C77_file_input_line (LineType * Line)
  1658. {
  1659. /*
  1660. CBASIC-II: READ # filenumber [, recnum ] ; LINE variable$
  1661. */
  1662. /* a flavor of LINE INPUT */
  1663. VariableType *v;
  1664. assert (Line != NULL);
  1665. assert(My != NULL);
  1666. assert (My->CurrentFile != NULL);
  1667. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  1668. if ((v = line_read_scalar (Line)) == NULL)
  1669. {
  1670. WARN_SYNTAX_ERROR;
  1671. return (Line);
  1672. }
  1673. if (VAR_IS_STRING (v))
  1674. {
  1675. char *tbuf;
  1676. int tlen;
  1677. assert (My->ConsoleInput != NULL);
  1678. tbuf = My->ConsoleInput;
  1679. tlen = MAX_LINE_LENGTH;
  1680. /* CBASIC-II: RANDOM files are padded on the right with spaces with a '\n' in the last position */
  1681. if (My->CurrentFile->width > MAX_LINE_LENGTH)
  1682. {
  1683. if (My->CurrentFile->buffer != NULL)
  1684. {
  1685. /* use the bigger buffer */
  1686. tbuf = My->CurrentFile->buffer;
  1687. tlen = My->CurrentFile->width;
  1688. }
  1689. }
  1690. if (fgets (tbuf, tlen, My->CurrentFile->cfp)) /* C77_file_input_line */
  1691. {
  1692. tbuf[tlen] = NulChar;
  1693. CleanTextInput (tbuf);
  1694. }
  1695. else
  1696. {
  1697. return file_if_end (Line);
  1698. }
  1699. /* if( TRUE ) */
  1700. {
  1701. VariantType variant;
  1702. variant.VariantTypeCode = StringTypeCode;
  1703. variant.Buffer = tbuf;
  1704. variant.Length = bwb_strlen (variant.Buffer);
  1705. if (var_set (v, &variant) == FALSE)
  1706. {
  1707. WARN_VARIABLE_NOT_DECLARED;
  1708. return (Line);
  1709. }
  1710. }
  1711. return (Line);
  1712. }
  1713. WARN_TYPE_MISMATCH;
  1714. return (Line);
  1715. }
  1716. static LineType *
  1717. C77_file_input_finish (LineType * Line)
  1718. {
  1719. /*
  1720. CBASIC-II: RANDOM file reads always acccess a complete record
  1721. */
  1722. long ByteOffset;
  1723. assert (Line != NULL);
  1724. assert(My != NULL);
  1725. assert (My->CurrentFile != NULL);
  1726. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  1727. /* advance to the end-of-record */
  1728. if (My->CurrentFile->width <= 0)
  1729. {
  1730. WARN_FIELD_OVERFLOW;
  1731. return (Line);
  1732. }
  1733. ByteOffset = ftell (My->CurrentFile->cfp);
  1734. ByteOffset %= My->CurrentFile->width;
  1735. if (ByteOffset != 0)
  1736. {
  1737. long RecordNumber;
  1738. RecordNumber = ftell (My->CurrentFile->cfp);
  1739. RecordNumber /= My->CurrentFile->width;
  1740. RecordNumber++;
  1741. RecordNumber *= My->CurrentFile->width;
  1742. fseek (My->CurrentFile->cfp, RecordNumber, SEEK_SET);
  1743. }
  1744. return (Line);
  1745. }
  1746. static LineType *
  1747. file_if_end (LineType * Line)
  1748. {
  1749. /* IF END # FileNumber THEN LineNumber */
  1750. assert (Line != NULL);
  1751. assert(My != NULL);
  1752. assert (My->CurrentFile != NULL);
  1753. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  1754. if (My->CurrentFile->EOF_LineNumber > 0)
  1755. {
  1756. LineType *x;
  1757. x = find_line_number (My->CurrentFile->EOF_LineNumber); /* not found in the cache */
  1758. if (x != NULL)
  1759. {
  1760. /* FOUND */
  1761. line_skip_eol (Line);
  1762. x->position = 0;
  1763. return x;
  1764. }
  1765. /* NOT FOUND */
  1766. WARN_UNDEFINED_LINE;
  1767. return (Line);
  1768. }
  1769. WARN_INPUT_PAST_END;
  1770. return (Line);
  1771. }
  1772. static LineType *
  1773. file_input (LineType * Line)
  1774. {
  1775. /* INPUT # is similar to READ, where each file line is a DATA line */
  1776. char *tbuf;
  1777. int tlen;
  1778. assert (Line != NULL);
  1779. assert(My != NULL);
  1780. assert(My->CurrentVersion != NULL);
  1781. assert (My->CurrentFile != NULL);
  1782. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  1783. tbuf = My->ConsoleInput;
  1784. tlen = MAX_LINE_LENGTH;
  1785. if (My->CurrentVersion->OptionVersionValue & (C77))
  1786. {
  1787. if (line_skip_word (Line, "LINE"))
  1788. {
  1789. return C77_file_input_line (Line);
  1790. }
  1791. }
  1792. if (My->CurrentFile->width > 0 && My->CurrentFile->buffer != NULL)
  1793. {
  1794. tlen = My->CurrentFile->width;
  1795. tbuf = My->CurrentFile->buffer;
  1796. }
  1797. tbuf[0] = NulChar;
  1798. /* Process each variable read from the INPUT # statement */
  1799. do
  1800. {
  1801. VariableType *v;
  1802. /* Read a variable name */
  1803. if ((v = line_read_scalar (Line)) == NULL)
  1804. {
  1805. WARN_SYNTAX_ERROR;
  1806. return (Line);
  1807. }
  1808. /* Read a file value */
  1809. if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
  1810. {
  1811. return file_if_end (Line);
  1812. }
  1813. /* OK */
  1814. }
  1815. while (line_skip_seperator (Line));
  1816. if (My->CurrentVersion->OptionVersionValue & (C77)
  1817. && My->CurrentFile->DevMode & DEVMODE_RANDOM)
  1818. {
  1819. return C77_file_input_finish (Line);
  1820. }
  1821. return (Line);
  1822. }
  1823. /***************************************************************
  1824. FUNCTION: user_input_*()
  1825. DESCRIPTION: This function does INPUT processing
  1826. from a determined string of input
  1827. data and a determined variable list
  1828. (both in memory). This presupposes
  1829. that input has been taken from My->SYSIN,
  1830. not from a disk file or device.
  1831. ***************************************************************/
  1832. static ResultType
  1833. parse_string_isquoted (char *buffer, int *position, VariantType * X)
  1834. {
  1835. /*
  1836. **
  1837. ** QUOTED STRING
  1838. **
  1839. ** Note: do NOT free() or RELEASE_VARIANT because 'X->Buffer' points into 'buffer'
  1840. **
  1841. */
  1842. int p;
  1843. assert (buffer != NULL);
  1844. assert (position != NULL);
  1845. assert (X != NULL);
  1846. assert(My != NULL);
  1847. assert(My->CurrentVersion != NULL);
  1848. assert (My->CurrentFile != NULL);
  1849. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  1850. p = *position;
  1851. buff_skip_spaces (buffer, &p); /* keep this */
  1852. if (buffer[p] == My->CurrentVersion->OptionQuoteChar)
  1853. {
  1854. int Length;
  1855. int Start;
  1856. int QuoteCount;
  1857. Length = 0;
  1858. QuoteCount = 0;
  1859. QuoteCount++;
  1860. p++;
  1861. Start = p;
  1862. while (buffer[p])
  1863. {
  1864. if (buffer[p] == My->CurrentVersion->OptionQuoteChar
  1865. && buffer[p + 1] == My->CurrentVersion->OptionQuoteChar
  1866. && My->CurrentVersion->
  1867. OptionFlags & OPTION_BUGS_ON /* INPUT allows embedded quote pairs */
  1868. )
  1869. {
  1870. /* embedded quote pair "...""..." */
  1871. QuoteCount++;
  1872. QuoteCount++;
  1873. p++;
  1874. p++;
  1875. Length++;
  1876. Length++;
  1877. }
  1878. else if (buffer[p] == My->CurrentVersion->OptionQuoteChar)
  1879. {
  1880. /* properly terminated string "...xx..." */
  1881. QuoteCount++;
  1882. p++;
  1883. break;
  1884. }
  1885. else
  1886. {
  1887. /* normal character */
  1888. p++;
  1889. Length++;
  1890. }
  1891. }
  1892. if (My->CurrentVersion->
  1893. OptionFlags & OPTION_BUGS_ON /* INPUT allows unmatched quotes pairs */
  1894. )
  1895. {
  1896. /* silently ignore */
  1897. }
  1898. else if (QuoteCount & 1)
  1899. {
  1900. /* an ODD number of quotes (including embedded quotes) is an ERROR */
  1901. return RESULT_UNPARSED;
  1902. }
  1903. /*
  1904. **
  1905. ** OK
  1906. **
  1907. */
  1908. X->VariantTypeCode = StringTypeCode;
  1909. X->Buffer = &buffer[Start];
  1910. X->Length = Length;
  1911. *position = p;
  1912. return RESULT_SUCCESS;
  1913. }
  1914. return RESULT_UNPARSED;
  1915. }
  1916. static ResultType
  1917. parse_string_unquoted (char *buffer, int *position, VariantType * X)
  1918. {
  1919. /*
  1920. **
  1921. ** UNQUOTED STRING
  1922. **
  1923. ** Note: do NOT free() or RELEASE_VARIANT because 'X->Buffer' points into 'buffer'
  1924. **
  1925. */
  1926. int p;
  1927. int Length;
  1928. int Start;
  1929. assert (buffer != NULL);
  1930. assert (position != NULL);
  1931. assert (X != NULL);
  1932. assert(My != NULL);
  1933. assert(My->CurrentVersion != NULL);
  1934. assert (My->CurrentFile != NULL);
  1935. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  1936. Length = 0;
  1937. p = *position;
  1938. buff_skip_spaces (buffer, &p); /* keep this */
  1939. Start = p;
  1940. while (buffer[p] != NulChar && buffer[p] != My->CurrentFile->delimit)
  1941. {
  1942. char C;
  1943. C = buffer[p];
  1944. if (My->CurrentVersion->
  1945. OptionFlags & OPTION_BUGS_ON /* INPUT allows unquoted strings */ )
  1946. {
  1947. /* silently ignore */
  1948. }
  1949. else if (C == ' ' || C == '+' || C == '-' || C == '.' || bwb_isalnum (C))
  1950. {
  1951. /* if was NOT quoted, then the only valid chars are ' ', '+', '-', '.', digit, letter */
  1952. }
  1953. else
  1954. {
  1955. /* ERROR */
  1956. return RESULT_UNPARSED;
  1957. }
  1958. Length++;
  1959. p++;
  1960. }
  1961. /* RTRIM */
  1962. while (Length > 0 && buffer[Start + Length - 1] == ' ')
  1963. {
  1964. Length--;
  1965. }
  1966. /*
  1967. **
  1968. ** OK
  1969. **
  1970. */
  1971. X->VariantTypeCode = StringTypeCode;
  1972. X->Buffer = &buffer[Start];
  1973. X->Length = Length;
  1974. *position = p;
  1975. return RESULT_SUCCESS;
  1976. }
  1977. static ResultType
  1978. parse_string (char *buffer, int *position, VariantType * X)
  1979. {
  1980. /*
  1981. **
  1982. ** STRING
  1983. **
  1984. ** Note: do NOT free() or RELEASE_VARIANT because 'X->Buffer' points into 'buffer'
  1985. **
  1986. */
  1987. ResultType Result;
  1988. int p;
  1989. assert (buffer != NULL);
  1990. assert (position != NULL);
  1991. assert (X != NULL);
  1992. assert(My != NULL);
  1993. assert(My->CurrentVersion != NULL);
  1994. assert (My->CurrentFile != NULL);
  1995. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  1996. p = *position;
  1997. buff_skip_spaces (buffer, &p); /* keep this */
  1998. if (buff_is_eol (buffer, &p)
  1999. || buff_peek_char (buffer, &p, My->CurrentFile->delimit))
  2000. {
  2001. /* process EMPTY response */
  2002. if (My->CurrentVersion->
  2003. OptionFlags & OPTION_BUGS_ON /* INPUT allows empty values */ )
  2004. {
  2005. /* silently ignore, value is "" */
  2006. X->VariantTypeCode = StringTypeCode;
  2007. X->Buffer = &buffer[p];
  2008. X->Length = 0;
  2009. Result = RESULT_SUCCESS;
  2010. }
  2011. else
  2012. {
  2013. return RESULT_UNPARSED;
  2014. }
  2015. }
  2016. Result = parse_string_isquoted (buffer, &p, X);
  2017. if (Result == RESULT_UNPARSED)
  2018. {
  2019. Result = parse_string_unquoted (buffer, &p, X);
  2020. }
  2021. if (Result == RESULT_SUCCESS)
  2022. {
  2023. *position = p;
  2024. }
  2025. return Result;
  2026. }
  2027. static ResultType
  2028. parse_number (char *buffer, int *position, VariantType * X,
  2029. int IsConsoleInput)
  2030. {
  2031. ResultType Result = RESULT_UNPARSED;
  2032. int p;
  2033. assert (buffer != NULL);
  2034. assert (position != NULL);
  2035. assert (X != NULL);
  2036. assert(My != NULL);
  2037. assert(My->CurrentVersion != NULL);
  2038. assert (My->CurrentFile != NULL);
  2039. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  2040. p = *position;
  2041. buff_skip_spaces (buffer, &p); /* keep this */
  2042. if (buff_is_eol (buffer, &p)
  2043. || buff_peek_char (buffer, &p, My->CurrentFile->delimit))
  2044. {
  2045. /* process EMPTY response */
  2046. if (My->CurrentVersion->
  2047. OptionFlags & OPTION_BUGS_ON /* INPUT allows empty values */ )
  2048. {
  2049. /* silently ignore, value is 0 */
  2050. X->VariantTypeCode = DoubleTypeCode;
  2051. X->Number = 0;
  2052. return RESULT_SUCCESS;
  2053. }
  2054. else
  2055. {
  2056. return RESULT_UNPARSED;
  2057. }
  2058. }
  2059. Result = buff_read_hexadecimal_constant (buffer, &p, X, IsConsoleInput);
  2060. if (Result == RESULT_UNPARSED)
  2061. {
  2062. Result = buff_read_octal_constant (buffer, &p, X, IsConsoleInput);
  2063. }
  2064. if (Result == RESULT_UNPARSED)
  2065. {
  2066. int IsNegative;
  2067. IsNegative = FALSE;
  2068. if (buff_skip_PlusChar (buffer, &p))
  2069. {
  2070. /* ignore */
  2071. }
  2072. else if (buff_skip_MinusChar (buffer, &p))
  2073. {
  2074. IsNegative = TRUE;
  2075. }
  2076. Result = buff_read_decimal_constant (buffer, &p, X, IsConsoleInput);
  2077. if (Result == RESULT_SUCCESS)
  2078. {
  2079. if (IsNegative)
  2080. {
  2081. X->Number = -X->Number;
  2082. }
  2083. }
  2084. }
  2085. if (Result == RESULT_SUCCESS)
  2086. {
  2087. *position = p;
  2088. }
  2089. return Result;
  2090. }
  2091. static ResultType
  2092. user_input_values (LineType * Line, char *buffer, int IsReal)
  2093. {
  2094. /*
  2095. **
  2096. ** given a response, match with the list of variables
  2097. **
  2098. */
  2099. int p;
  2100. assert (Line != NULL);
  2101. assert (buffer != NULL);
  2102. assert(My != NULL);
  2103. assert(My->CurrentVersion != NULL);
  2104. assert (My->CurrentFile == My->SYSIN);
  2105. p = 0;
  2106. /* Read elements in buffer and assign them to variables in Line */
  2107. do
  2108. {
  2109. ResultType Result;
  2110. VariableType *Variable;
  2111. VariantType Variant;
  2112. VariantType *X;
  2113. X = &Variant;
  2114. CLEAR_VARIANT (X);
  2115. /* get a variable name from the list */
  2116. if ((Variable = line_read_scalar (Line)) == NULL)
  2117. {
  2118. WARN_SYNTAX_ERROR;
  2119. return RESULT_UNPARSED;
  2120. }
  2121. /* get a value from the console response */
  2122. Result = RESULT_UNPARSED;
  2123. if (VAR_IS_STRING (Variable))
  2124. {
  2125. Result = parse_string (buffer, &p, X);
  2126. }
  2127. else
  2128. {
  2129. Result = parse_number (buffer, &p, X, TRUE);
  2130. }
  2131. if (Result != RESULT_SUCCESS)
  2132. {
  2133. return Result;
  2134. }
  2135. /*
  2136. **
  2137. ** OK
  2138. **
  2139. */
  2140. if (IsReal)
  2141. {
  2142. /*
  2143. **
  2144. ** actually assign the value
  2145. **
  2146. */
  2147. if (X->VariantTypeCode == StringTypeCode
  2148. && My->CurrentVersion->
  2149. OptionFlags & OPTION_BUGS_ON /* INPUT allows embedded quote pairs */
  2150. )
  2151. {
  2152. int i;
  2153. int n;
  2154. n = X->Length;
  2155. for (i = 0; i < n; i++)
  2156. {
  2157. if (X->Buffer[i + 0] == My->CurrentVersion->OptionQuoteChar
  2158. && X->Buffer[i + 1] == My->CurrentVersion->OptionQuoteChar)
  2159. {
  2160. bwb_strncpy (&X->Buffer[i + 0], &X->Buffer[i + 1], n - i);
  2161. n--;
  2162. }
  2163. }
  2164. X->Length = n;
  2165. }
  2166. if (var_set (Variable, X) == FALSE)
  2167. {
  2168. WARN_VARIABLE_NOT_DECLARED;
  2169. return RESULT_UNPARSED;
  2170. }
  2171. }
  2172. /*
  2173. **
  2174. ** STRING
  2175. **
  2176. ** Note: do NOT free() or RELEASE_VARIANT because 'X->Buffer' points into 'buffer'
  2177. **
  2178. */
  2179. }
  2180. while (line_skip_seperator (Line)
  2181. && buff_skip_char (buffer, &p, My->CurrentFile->delimit));
  2182. /* verify all variables and values consumed */
  2183. if (line_is_eol (Line) && buff_is_eol (buffer, &p))
  2184. {
  2185. /*
  2186. **
  2187. ** OK
  2188. **
  2189. */
  2190. return RESULT_SUCCESS;
  2191. }
  2192. /* Count mismatch */
  2193. return RESULT_UNPARSED;
  2194. }
  2195. static LineType *
  2196. C77_user_input_line (LineType * Line, char *Prompt, int IsDisplayQuestionMark)
  2197. {
  2198. /*
  2199. **
  2200. ** CBASIC-II: INPUT "prompt" ; LINE variable$
  2201. **
  2202. */
  2203. VariableType *v;
  2204. assert (Line != NULL);
  2205. assert(My != NULL);
  2206. assert (My->CurrentFile != NULL);
  2207. assert ((My->CurrentFile->DevMode & DEVMODE_READ) != 0);
  2208. if ((v = line_read_scalar (Line)) == NULL)
  2209. {
  2210. WARN_SYNTAX_ERROR;
  2211. return (Line);
  2212. }
  2213. if (v->VariableFlags & (VARIABLE_CONSTANT))
  2214. {
  2215. WARN_VARIABLE_NOT_DECLARED;
  2216. return (Line);
  2217. }
  2218. if (VAR_IS_STRING (v))
  2219. {
  2220. VariantType variant;
  2221. char *tbuf;
  2222. int tlen;
  2223. tbuf = My->ConsoleInput;
  2224. tlen = MAX_LINE_LENGTH;
  2225. bwx_input (Prompt, IsDisplayQuestionMark, tbuf, tlen);
  2226. variant.VariantTypeCode = StringTypeCode;
  2227. variant.Buffer = tbuf;
  2228. variant.Length = bwb_strlen (variant.Buffer);
  2229. if (var_set (v, &variant) == FALSE)
  2230. {
  2231. WARN_VARIABLE_NOT_DECLARED;
  2232. return (Line);
  2233. }
  2234. /* OK */
  2235. if (Prompt != NULL)
  2236. {
  2237. free (Prompt);
  2238. /* Prompt = NULL; */
  2239. }
  2240. return (Line);
  2241. }
  2242. WARN_TYPE_MISMATCH;
  2243. return (Line);
  2244. }
  2245. static LineType *
  2246. user_input_loop (LineType * Line)
  2247. {
  2248. char *Prompt;
  2249. int IsDisplayQuestionMark;
  2250. int SavePosition;
  2251. assert (Line != NULL);
  2252. assert(My != NULL);
  2253. assert(My->SYSIN != NULL);
  2254. assert(My->SYSIN->cfp != NULL);
  2255. Prompt = NULL;
  2256. IsDisplayQuestionMark = TRUE;
  2257. My->CurrentFile = My->SYSIN;
  2258. /*
  2259. **
  2260. ** Step 1. Determine the prompt
  2261. ** Step 2. Verify all variables exist and are not CONST
  2262. ** Step 3. Display prompt and get user response
  2263. ** Step 4. Assign user response to variables
  2264. **
  2265. */
  2266. /*
  2267. **
  2268. ** Step 1. Determine the prompt
  2269. **
  2270. */
  2271. /* INPUT , "prompt" A, B, C */
  2272. /* INPUT ; "prompt" A, B ,C */
  2273. /* INPUT : "prompt" A, B, C */
  2274. if (line_skip_seperator (Line))
  2275. {
  2276. /* optional */
  2277. IsDisplayQuestionMark = FALSE;
  2278. }
  2279. if (line_peek_QuoteChar (Line))
  2280. {
  2281. /* get prompt string */
  2282. if (line_read_string_expression (Line, &Prompt) == FALSE)
  2283. {
  2284. WARN_SYNTAX_ERROR;
  2285. return (Line);
  2286. }
  2287. if (line_skip_seperator (Line) == ',' /* comma-specific */ )
  2288. {
  2289. /* optional */
  2290. IsDisplayQuestionMark = FALSE;
  2291. }
  2292. }
  2293. if (My->CurrentVersion->OptionVersionValue & (C77)
  2294. && line_skip_word (Line, "LINE"))
  2295. {
  2296. /* INPUT "prompt" ; LINE variable$ */
  2297. return C77_user_input_line (Line, Prompt, IsDisplayQuestionMark);
  2298. }
  2299. /*
  2300. **
  2301. ** Step 2. Verify all variables exist and are not CONST
  2302. **
  2303. */
  2304. SavePosition = Line->position;
  2305. do
  2306. {
  2307. VariableType *v;
  2308. if ((v = line_read_scalar (Line)) == NULL)
  2309. {
  2310. WARN_SYNTAX_ERROR;
  2311. return (Line);
  2312. }
  2313. if (v->VariableFlags & (VARIABLE_CONSTANT))
  2314. {
  2315. WARN_VARIABLE_NOT_DECLARED;
  2316. return (Line);
  2317. }
  2318. }
  2319. while (line_skip_seperator (Line));
  2320. if (line_is_eol (Line))
  2321. {
  2322. /* OK */
  2323. }
  2324. else
  2325. {
  2326. WARN_SYNTAX_ERROR;
  2327. return (Line);
  2328. }
  2329. while (TRUE)
  2330. {
  2331. char *tbuf;
  2332. int tlen;
  2333. ResultType Result;
  2334. tbuf = My->ConsoleInput;
  2335. tlen = MAX_LINE_LENGTH;
  2336. /*
  2337. **
  2338. ** Step 3. Display prompt and get user response
  2339. **
  2340. */
  2341. bwx_input (Prompt, IsDisplayQuestionMark, tbuf, tlen);
  2342. /*
  2343. **
  2344. ** Step 4. Assign user response to variables
  2345. **
  2346. */
  2347. Line->position = SavePosition;
  2348. Result = user_input_values (Line, tbuf, FALSE /* FAKE run */ ); /* bwb_INPUT, user_input_loop */
  2349. if (Result == RESULT_SUCCESS) /* bwb_INPUT */
  2350. {
  2351. /* successful input, FAKE run */
  2352. Line->position = SavePosition;
  2353. Result = user_input_values (Line, tbuf, TRUE /* REAL run */ ); /* bwb_INPUT, user_input_loop */
  2354. if (Result == RESULT_SUCCESS)
  2355. {
  2356. /* successful input, REAL run */
  2357. if (Prompt != NULL)
  2358. {
  2359. free (Prompt);
  2360. Prompt = NULL;
  2361. }
  2362. return (Line);
  2363. }
  2364. }
  2365. /* Result == RESULT_UNPARSED, RETRY */
  2366. fputs ("?Redo from start\n", My->SYSOUT->cfp); /* "*** Retry INPUT ***\n" */
  2367. ResetConsoleColumn ();
  2368. }
  2369. /* never reached */
  2370. return (Line);
  2371. }
  2372. extern LineType *
  2373. bwb_INPUT (LineType * Line)
  2374. {
  2375. assert (Line != NULL);
  2376. assert(My != NULL);
  2377. assert(My->CurrentVersion != NULL);
  2378. assert(My->SYSIN != NULL);
  2379. assert(My->SYSIN->cfp != NULL);
  2380. My->CurrentFile = My->SYSIN;
  2381. if (line_skip_FilenumChar (Line))
  2382. {
  2383. /* INPUT # X */
  2384. int FileNumber;
  2385. if (line_read_integer_expression (Line, &FileNumber) == FALSE)
  2386. {
  2387. WARN_SYNTAX_ERROR;
  2388. return (Line);
  2389. }
  2390. if (line_skip_seperator (Line))
  2391. {
  2392. /* required */
  2393. }
  2394. else
  2395. {
  2396. WARN_SYNTAX_ERROR;
  2397. return (Line);
  2398. }
  2399. /* INPUT # X , */
  2400. if (FileNumber < 0)
  2401. {
  2402. /* "INPUT # -1" is an error */
  2403. WARN_BAD_FILE_NUMBER;
  2404. return (Line);
  2405. }
  2406. if (FileNumber > 0)
  2407. {
  2408. /* normal file */
  2409. My->CurrentFile = find_file_by_number (FileNumber);
  2410. if (My->CurrentFile == NULL)
  2411. {
  2412. WARN_BAD_FILE_NUMBER;
  2413. return (Line);
  2414. }
  2415. if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
  2416. {
  2417. WARN_BAD_FILE_NUMBER;
  2418. return (Line);
  2419. }
  2420. return file_input (Line);
  2421. }
  2422. /* "INPUT #0, varlist" is the same as "INPUT varlist" */
  2423. }
  2424. /* input is from My->SYSIN */
  2425. return user_input_loop (Line);
  2426. }
  2427. /***************************************************************
  2428. FUNCTION: bwb_LINE()
  2429. DESCRIPTION: This function implements the BASIC LINE
  2430. INPUT statement.
  2431. SYNTAX: LINE INPUT [[#] device-number,]["prompt string";] string-variable$
  2432. ***************************************************************/
  2433. extern LineType *
  2434. bwb_LINE (LineType * Line)
  2435. {
  2436. assert (Line != NULL);
  2437. WARN_SYNTAX_ERROR;
  2438. return (Line);
  2439. }
  2440. extern LineType *
  2441. bwb_INPUT_LINE (LineType * Line)
  2442. {
  2443. assert (Line != NULL);
  2444. return bwb_LINE_INPUT (Line);
  2445. }
  2446. extern LineType *
  2447. bwb_LINE_INPUT (LineType * Line)
  2448. {
  2449. int FileNumber;
  2450. VariableType *v;
  2451. char *tbuf;
  2452. int tlen;
  2453. char *Prompt;
  2454. assert (Line != NULL);
  2455. assert(My != NULL);
  2456. assert(My->SYSIN != NULL);
  2457. assert(My->SYSIN->cfp != NULL);
  2458. assert(My->ConsoleInput != NULL);
  2459. assert(MAX_LINE_LENGTH > 1);
  2460. /* assign default values */
  2461. tbuf = My->ConsoleInput;
  2462. tlen = MAX_LINE_LENGTH;
  2463. Prompt = NULL;
  2464. My->CurrentFile = My->SYSIN;
  2465. /* check for leading semicolon */
  2466. if (line_skip_seperator (Line))
  2467. {
  2468. /* optional */
  2469. }
  2470. if (line_skip_FilenumChar (Line))
  2471. {
  2472. if (line_read_integer_expression (Line, &FileNumber) == FALSE)
  2473. {
  2474. WARN_SYNTAX_ERROR;
  2475. return (Line);
  2476. }
  2477. if (FileNumber < 0)
  2478. {
  2479. /* "LINE INPUT # -1" is an error */
  2480. WARN_BAD_FILE_NUMBER;
  2481. return (Line);
  2482. }
  2483. if (FileNumber > 0)
  2484. {
  2485. /* normal file */
  2486. My->CurrentFile = find_file_by_number (FileNumber);
  2487. if (My->CurrentFile == NULL)
  2488. {
  2489. WARN_BAD_FILE_NUMBER;
  2490. return (Line);
  2491. }
  2492. if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
  2493. {
  2494. WARN_BAD_FILE_NUMBER;
  2495. return (Line);
  2496. }
  2497. if (My->CurrentFile->cfp == NULL)
  2498. {
  2499. WARN_BAD_FILE_NUMBER;
  2500. return (Line);
  2501. }
  2502. }
  2503. /* check for comma */
  2504. if (line_skip_seperator (Line))
  2505. {
  2506. /* optional */
  2507. }
  2508. }
  2509. /* check for quotation mark indicating prompt */
  2510. if (line_peek_QuoteChar (Line))
  2511. {
  2512. /* get prompt string */
  2513. if (line_read_string_expression (Line, &Prompt) == FALSE)
  2514. {
  2515. WARN_SYNTAX_ERROR;
  2516. return (Line);
  2517. }
  2518. /* check for comma */
  2519. if (line_skip_seperator (Line))
  2520. {
  2521. /* optional */
  2522. }
  2523. }
  2524. /* read the variable for assignment */
  2525. if ((v = line_read_scalar (Line)) == NULL)
  2526. {
  2527. WARN_SYNTAX_ERROR;
  2528. return (Line);
  2529. }
  2530. if (VAR_IS_STRING (v))
  2531. {
  2532. /* OK */
  2533. }
  2534. else
  2535. {
  2536. /* ERROR */
  2537. WARN_TYPE_MISMATCH;
  2538. return (Line);
  2539. }
  2540. /* read a line of text into the bufffer */
  2541. if (My->CurrentFile == My->SYSIN)
  2542. {
  2543. /* LINE INPUT never displays a '?' regardless of the ',' or ';' */
  2544. bwx_input (Prompt, FALSE, tbuf, tlen);
  2545. }
  2546. else
  2547. {
  2548. if (fgets (tbuf, tlen, My->CurrentFile->cfp)) /* bwb_LINE_INPUT */
  2549. {
  2550. tbuf[tlen] = NulChar;
  2551. CleanTextInput (tbuf);
  2552. }
  2553. else
  2554. {
  2555. return file_if_end (Line);
  2556. }
  2557. }
  2558. /* if( TRUE ) */
  2559. {
  2560. VariantType variant;
  2561. variant.VariantTypeCode = StringTypeCode;
  2562. variant.Buffer = tbuf;
  2563. variant.Length = bwb_strlen (variant.Buffer);
  2564. if (var_set (v, &variant) == FALSE)
  2565. {
  2566. WARN_VARIABLE_NOT_DECLARED;
  2567. return (Line);
  2568. }
  2569. }
  2570. if (Prompt != NULL)
  2571. {
  2572. free (Prompt);
  2573. Prompt = NULL;
  2574. }
  2575. return (Line);
  2576. }
  2577. static LineType *
  2578. file_read_matrix (LineType * Line)
  2579. {
  2580. /* MAT GET filename$ , matrix [, ...] */
  2581. /* MAT READ arrayname [;|,] */
  2582. /* Array must be 1, 2 or 3 dimensions */
  2583. /* Array may be either NUMBER or STRING */
  2584. VariableType *v;
  2585. assert (Line != NULL);
  2586. assert(My != NULL);
  2587. assert(My->CurrentVersion != NULL);
  2588. assert(My->SYSIN != NULL);
  2589. assert(My->SYSIN->cfp != NULL);
  2590. assert(My->ConsoleInput != NULL);
  2591. assert(MAX_LINE_LENGTH > 1);
  2592. assert(My->CurrentFile != NULL);
  2593. My->LastInputCount = 0;
  2594. do
  2595. {
  2596. char *tbuf;
  2597. int tlen;
  2598. tbuf = My->ConsoleInput;
  2599. tlen = MAX_LINE_LENGTH;
  2600. if (My->CurrentFile->width > 0 && My->CurrentFile->buffer != NULL)
  2601. {
  2602. tlen = My->CurrentFile->width;
  2603. tbuf = My->CurrentFile->buffer;
  2604. }
  2605. tbuf[0] = NulChar;
  2606. My->LastInputCount = 0;
  2607. if ((v = line_read_matrix (Line)) == NULL)
  2608. {
  2609. WARN_SUBSCRIPT_OUT_OF_RANGE;
  2610. return (Line);
  2611. }
  2612. /* variable MUST be an array of 1, 2 or 3 dimensions */
  2613. if (v->dimensions < 1)
  2614. {
  2615. WARN_SUBSCRIPT_OUT_OF_RANGE;
  2616. return (Line);
  2617. }
  2618. if (v->dimensions > 3)
  2619. {
  2620. WARN_SUBSCRIPT_OUT_OF_RANGE;
  2621. return (Line);
  2622. }
  2623. /* READ array */
  2624. switch (v->dimensions)
  2625. {
  2626. case 1:
  2627. {
  2628. /*
  2629. OPTION BASE 0
  2630. DIM A(5)
  2631. ...
  2632. MAT READ A
  2633. ...
  2634. FOR I = 0 TO 5
  2635. READ A(I)
  2636. NEXT I
  2637. ...
  2638. */
  2639. for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
  2640. v->VINDEX[0]++)
  2641. {
  2642. if (My->CurrentFile == My->SYSIN)
  2643. {
  2644. if (read_data (v) != RESULT_SUCCESS)
  2645. {
  2646. return data_if_end (Line);
  2647. }
  2648. }
  2649. else
  2650. {
  2651. if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
  2652. {
  2653. return file_if_end (Line);
  2654. }
  2655. }
  2656. /* OK */
  2657. My->LastInputCount++;
  2658. }
  2659. }
  2660. break;
  2661. case 2:
  2662. {
  2663. /*
  2664. OPTION BASE 0
  2665. DIM B(2,3)
  2666. ...
  2667. MAT READ B
  2668. ...
  2669. FOR I = 0 TO 2
  2670. FOR J = 0 TO 3
  2671. READ B(I,J)
  2672. NEXT J
  2673. PRINT
  2674. NEXT I
  2675. ...
  2676. */
  2677. for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
  2678. v->VINDEX[0]++)
  2679. {
  2680. for (v->VINDEX[1] = v->LBOUND[1]; v->VINDEX[1] <= v->UBOUND[1];
  2681. v->VINDEX[1]++)
  2682. {
  2683. if (My->CurrentFile == My->SYSIN)
  2684. {
  2685. if (read_data (v) != RESULT_SUCCESS)
  2686. {
  2687. return data_if_end (Line);
  2688. }
  2689. }
  2690. else
  2691. {
  2692. if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
  2693. {
  2694. return file_if_end (Line);
  2695. }
  2696. }
  2697. /* OK */
  2698. My->LastInputCount++;
  2699. }
  2700. }
  2701. }
  2702. break;
  2703. case 3:
  2704. {
  2705. /*
  2706. OPTION BASE 0
  2707. DIM C(2,3,4)
  2708. ...
  2709. MAT READ C
  2710. ...
  2711. FOR I = 0 TO 2
  2712. FOR J = 0 TO 3
  2713. FOR K = 0 TO 4
  2714. READ C(I,J,K)
  2715. NEXT K
  2716. PRINT
  2717. NEXT J
  2718. PRINT
  2719. NEXT I
  2720. ...
  2721. */
  2722. for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
  2723. v->VINDEX[0]++)
  2724. {
  2725. for (v->VINDEX[1] = v->LBOUND[1]; v->VINDEX[1] <= v->UBOUND[1];
  2726. v->VINDEX[1]++)
  2727. {
  2728. for (v->VINDEX[2] = v->LBOUND[2]; v->VINDEX[2] <= v->UBOUND[2];
  2729. v->VINDEX[2]++)
  2730. {
  2731. if (My->CurrentFile == My->SYSIN)
  2732. {
  2733. if (read_data (v) != RESULT_SUCCESS)
  2734. {
  2735. return data_if_end (Line);
  2736. }
  2737. }
  2738. else
  2739. {
  2740. if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
  2741. {
  2742. return file_if_end (Line);
  2743. }
  2744. }
  2745. /* OK */
  2746. My->LastInputCount++;
  2747. }
  2748. }
  2749. }
  2750. }
  2751. break;
  2752. }
  2753. /* process the next variable, if any */
  2754. }
  2755. while (line_skip_seperator (Line));
  2756. return (Line);
  2757. }
  2758. extern LineType *
  2759. bwb_MAT_GET (LineType * Line)
  2760. {
  2761. /* MAT GET filename$ , matrix [, ...] */
  2762. VariantType E;
  2763. VariantType *e;
  2764. assert (Line != NULL);
  2765. assert(My != NULL);
  2766. assert(My->SYSIN != NULL);
  2767. assert(My->SYSIN->cfp != NULL);
  2768. e = &E;
  2769. My->CurrentFile = My->SYSIN;
  2770. if (line_read_expression (Line, e) == FALSE) /* bwb_MAT_GET */
  2771. {
  2772. WARN_SYNTAX_ERROR;
  2773. return (Line);
  2774. }
  2775. if (e->VariantTypeCode == StringTypeCode)
  2776. {
  2777. /* STRING */
  2778. /* MAT GET filename$ ... */
  2779. if (is_empty_string (e->Buffer))
  2780. {
  2781. /* MAT GET "" ... is an error */
  2782. WARN_BAD_FILE_NAME;
  2783. return (Line);
  2784. }
  2785. My->CurrentFile = find_file_by_name (e->Buffer);
  2786. if (My->CurrentFile == NULL)
  2787. {
  2788. /* implicitly OPEN for reading */
  2789. My->CurrentFile = file_new ();
  2790. My->CurrentFile->cfp = fopen (e->Buffer, "r");
  2791. if (My->CurrentFile->cfp == NULL)
  2792. {
  2793. WARN_BAD_FILE_NAME;
  2794. return (Line);
  2795. }
  2796. My->CurrentFile->FileNumber = file_next_number ();
  2797. My->CurrentFile->DevMode = DEVMODE_INPUT;
  2798. My->CurrentFile->width = 0;
  2799. /* WIDTH == RECLEN */
  2800. My->CurrentFile->col = 1;
  2801. My->CurrentFile->row = 1;
  2802. My->CurrentFile->delimit = ',';
  2803. My->CurrentFile->buffer = NULL;
  2804. if (My->CurrentFile->FileName != NULL)
  2805. {
  2806. free (My->CurrentFile->FileName);
  2807. My->CurrentFile->FileName = NULL;
  2808. }
  2809. My->CurrentFile->FileName = e->Buffer;
  2810. e->Buffer = NULL;
  2811. }
  2812. }
  2813. else
  2814. {
  2815. /* NUMBER -- file must already be OPEN */
  2816. /* GET filenumber ... */
  2817. if (e->Number < 0)
  2818. {
  2819. /* "MAT GET # -1" is an error */
  2820. WARN_BAD_FILE_NUMBER;
  2821. return (Line);
  2822. }
  2823. if (e->Number == 0)
  2824. {
  2825. /* "MAT GET # 0" is an error */
  2826. WARN_BAD_FILE_NUMBER;
  2827. return (Line);
  2828. }
  2829. /* normal file */
  2830. My->CurrentFile = find_file_by_number ((int) bwb_rint (e->Number));
  2831. if (My->CurrentFile == NULL)
  2832. {
  2833. /* file not OPEN */
  2834. WARN_BAD_FILE_NUMBER;
  2835. return (Line);
  2836. }
  2837. }
  2838. if (My->CurrentFile == NULL)
  2839. {
  2840. WARN_BAD_FILE_NUMBER;
  2841. return (Line);
  2842. }
  2843. if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
  2844. {
  2845. WARN_BAD_FILE_NUMBER;
  2846. return (Line);
  2847. }
  2848. if (line_skip_seperator (Line))
  2849. {
  2850. /* OK */
  2851. }
  2852. else
  2853. {
  2854. WARN_SYNTAX_ERROR;
  2855. return (Line);
  2856. }
  2857. return file_read_matrix (Line);
  2858. }
  2859. extern LineType *
  2860. bwb_MAT_READ (LineType * Line)
  2861. {
  2862. /* MAT READ arrayname [;|,] */
  2863. /* Array must be 1, 2 or 3 dimensions */
  2864. /* Array may be either NUMBER or STRING */
  2865. assert (Line != NULL);
  2866. assert(My != NULL);
  2867. assert(My->CurrentVersion != NULL);
  2868. assert(My->SYSIN != NULL);
  2869. assert(My->SYSIN->cfp != NULL);
  2870. My->CurrentFile = My->SYSIN;
  2871. My->LastInputCount = 0;
  2872. if (line_skip_FilenumChar (Line))
  2873. {
  2874. /* MAT READ # filenum, varlist */
  2875. int FileNumber;
  2876. if (line_read_integer_expression (Line, &FileNumber) == FALSE)
  2877. {
  2878. WARN_SYNTAX_ERROR;
  2879. return (Line);
  2880. }
  2881. if (line_skip_seperator (Line))
  2882. {
  2883. /* OK */
  2884. }
  2885. else
  2886. {
  2887. WARN_SYNTAX_ERROR;
  2888. return (Line);
  2889. }
  2890. My->CurrentFile = find_file_by_number (FileNumber);
  2891. if (My->CurrentFile == NULL)
  2892. {
  2893. WARN_BAD_FILE_NUMBER;
  2894. return (Line);
  2895. }
  2896. if (My->CurrentFile != My->SYSIN)
  2897. {
  2898. if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
  2899. {
  2900. WARN_BAD_FILE_NUMBER;
  2901. return (Line);
  2902. }
  2903. if (My->CurrentFile->cfp == NULL)
  2904. {
  2905. WARN_BAD_FILE_NUMBER;
  2906. return (Line);
  2907. }
  2908. }
  2909. /* "MAT READ # 0, varlist" is the same as "MAT READ varlist" */
  2910. }
  2911. return file_read_matrix (Line);
  2912. }
  2913. static ResultType
  2914. input_data (VariableType * Variable, char *tbuf, int tlen)
  2915. {
  2916. /*
  2917. **
  2918. ** read one INPUT item
  2919. **
  2920. */
  2921. int p;
  2922. ResultType Result;
  2923. VariantType Variant;
  2924. VariantType *X;
  2925. assert (Variable != NULL);
  2926. assert (tbuf != NULL);
  2927. assert(My != NULL);
  2928. assert(My->CurrentVersion != NULL);
  2929. assert(My->SYSIN != NULL);
  2930. assert(My->SYSIN->cfp != NULL);
  2931. assert(My->CurrentFile != NULL);
  2932. assert (My->CurrentFile == My->SYSIN);
  2933. Result = RESULT_UNPARSED;
  2934. X = &Variant;
  2935. CLEAR_VARIANT (X);
  2936. if (tbuf[0] == NulChar)
  2937. {
  2938. /* Get more data */
  2939. bwx_input ("?", FALSE, tbuf, tlen);
  2940. if (tbuf[0] == NulChar)
  2941. {
  2942. return RESULT_UNPARSED;
  2943. }
  2944. /*
  2945. **
  2946. ** make sure we can parse everything in tbuf
  2947. **
  2948. */
  2949. p = 0;
  2950. do
  2951. {
  2952. do
  2953. {
  2954. if (VAR_IS_STRING (Variable))
  2955. {
  2956. Result = parse_string (tbuf, &p, X);
  2957. }
  2958. else
  2959. {
  2960. Result = parse_number (tbuf, &p, X, FALSE);
  2961. }
  2962. }
  2963. while (buff_skip_seperator (tbuf, &p) && Result == RESULT_SUCCESS);
  2964. /* verify we consumed all user values */
  2965. if (buff_is_eol (tbuf, &p))
  2966. {
  2967. /* we reached the end of the user's input */
  2968. }
  2969. else
  2970. {
  2971. /* garbage in user's input */
  2972. Result = RESULT_UNPARSED;
  2973. }
  2974. if (Result != RESULT_SUCCESS)
  2975. {
  2976. tbuf[0] = NulChar;
  2977. bwx_input ("?Redo", FALSE, tbuf, tlen);
  2978. if (tbuf[0] == NulChar)
  2979. {
  2980. return RESULT_UNPARSED;
  2981. }
  2982. p = 0;
  2983. }
  2984. }
  2985. while (Result != RESULT_SUCCESS);
  2986. /*
  2987. **
  2988. ** so, we can parse all of the user's input (everything in tbuf)
  2989. **
  2990. */
  2991. }
  2992. /* process one value */
  2993. p = 0;
  2994. if (VAR_IS_STRING (Variable))
  2995. {
  2996. Result = parse_string (tbuf, &p, X);
  2997. }
  2998. else
  2999. {
  3000. Result = parse_number (tbuf, &p, X, FALSE);
  3001. }
  3002. if (Result != RESULT_SUCCESS)
  3003. {
  3004. WARN_INTERNAL_ERROR;
  3005. return RESULT_UNPARSED;
  3006. }
  3007. if (X->VariantTypeCode == StringTypeCode
  3008. && My->CurrentVersion->
  3009. OptionFlags & OPTION_BUGS_ON /* DATA allows embedded quote pairs */ )
  3010. {
  3011. int i;
  3012. int n;
  3013. n = X->Length;
  3014. for (i = 0; i < n; i++)
  3015. {
  3016. if (X->Buffer[i + 0] == My->CurrentVersion->OptionQuoteChar
  3017. && X->Buffer[i + 1] == My->CurrentVersion->OptionQuoteChar)
  3018. {
  3019. bwb_strncpy (&X->Buffer[i + 0], &X->Buffer[i + 1], n - i);
  3020. n--;
  3021. }
  3022. }
  3023. X->Length = n;
  3024. }
  3025. if (var_set (Variable, X) == FALSE)
  3026. {
  3027. WARN_VARIABLE_NOT_DECLARED;
  3028. return RESULT_UNPARSED;
  3029. }
  3030. /* determine whether all user input was consumed */
  3031. if (buff_is_eol (tbuf, &p))
  3032. {
  3033. /* we have consumed the entire buffer */
  3034. tbuf[0] = NulChar;
  3035. return RESULT_SUCCESS;
  3036. }
  3037. if (buff_skip_char (tbuf, &p, My->CurrentFile->delimit)) /* buff_skip_comma */
  3038. {
  3039. /* shift the buffer left, just past the comma (,) */
  3040. bwb_strcpy (tbuf, &tbuf[p]);
  3041. return RESULT_SUCCESS;
  3042. }
  3043. /* garbage after the value we just READ */
  3044. WARN_BAD_DATA;
  3045. return RESULT_UNPARSED;
  3046. }
  3047. extern LineType *
  3048. bwb_MAT_INPUT (LineType * Line)
  3049. {
  3050. /* MAT INPUT arrayname [;|,] */
  3051. /* Array must be 1, 2 or 3 dimensions */
  3052. /* Array may be either NUMBER or STRING */
  3053. VariableType *v;
  3054. assert (Line != NULL);
  3055. assert(My != NULL);
  3056. assert(My->CurrentVersion != NULL);
  3057. assert(My->SYSIN != NULL);
  3058. assert(My->SYSIN->cfp != NULL);
  3059. assert(My->ConsoleInput != NULL);
  3060. assert(MAX_LINE_LENGTH > 1);
  3061. My->CurrentFile = My->SYSIN;
  3062. My->LastInputCount = 0;
  3063. if (line_skip_FilenumChar (Line))
  3064. {
  3065. /* MAT INPUT # filenum, varlist */
  3066. int FileNumber;
  3067. if (line_read_integer_expression (Line, &FileNumber) == FALSE)
  3068. {
  3069. WARN_SYNTAX_ERROR;
  3070. return (Line);
  3071. }
  3072. if (line_skip_seperator (Line))
  3073. {
  3074. /* OK */
  3075. }
  3076. else
  3077. {
  3078. WARN_SYNTAX_ERROR;
  3079. return (Line);
  3080. }
  3081. My->CurrentFile = find_file_by_number (FileNumber);
  3082. if (My->CurrentFile == NULL)
  3083. {
  3084. WARN_BAD_FILE_NUMBER;
  3085. return (Line);
  3086. }
  3087. if (My->CurrentFile != My->SYSIN)
  3088. {
  3089. if ((My->CurrentFile->DevMode & DEVMODE_READ) == 0)
  3090. {
  3091. WARN_BAD_FILE_NUMBER;
  3092. return (Line);
  3093. }
  3094. if (My->CurrentFile->cfp == NULL)
  3095. {
  3096. WARN_BAD_FILE_NUMBER;
  3097. return (Line);
  3098. }
  3099. }
  3100. /* "MAT INPUT # 0, varlist" is the same as "MAT INPUT varlist" */
  3101. }
  3102. do
  3103. {
  3104. char *tbuf;
  3105. int tlen;
  3106. tbuf = My->ConsoleInput;
  3107. tlen = MAX_LINE_LENGTH;
  3108. if (My->CurrentFile->width > 0 && My->CurrentFile->buffer != NULL)
  3109. {
  3110. tlen = My->CurrentFile->width;
  3111. tbuf = My->CurrentFile->buffer;
  3112. }
  3113. tbuf[0] = NulChar;
  3114. My->LastInputCount = 0;
  3115. if ((v = line_read_matrix (Line)) == NULL)
  3116. {
  3117. WARN_SUBSCRIPT_OUT_OF_RANGE;
  3118. return (Line);
  3119. }
  3120. /* variable MUST be an array of 1, 2 or 3 dimensions */
  3121. if (v->dimensions < 1)
  3122. {
  3123. WARN_SUBSCRIPT_OUT_OF_RANGE;
  3124. return (Line);
  3125. }
  3126. if (v->dimensions > 3)
  3127. {
  3128. WARN_SUBSCRIPT_OUT_OF_RANGE;
  3129. return (Line);
  3130. }
  3131. /* INPUT array */
  3132. switch (v->dimensions)
  3133. {
  3134. case 1:
  3135. {
  3136. /*
  3137. OPTION BASE 0
  3138. DIM A(5)
  3139. ...
  3140. MAT INPUT A
  3141. ...
  3142. FOR I = 0 TO 5
  3143. INPUT A(I)
  3144. NEXT I
  3145. ...
  3146. */
  3147. My->LastInputCount = 0;
  3148. for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
  3149. v->VINDEX[0]++)
  3150. {
  3151. if (My->CurrentFile == My->SYSIN)
  3152. {
  3153. if (input_data (v, tbuf, tlen) != RESULT_SUCCESS)
  3154. {
  3155. /*
  3156. WARN_INPUT_PAST_END;
  3157. */
  3158. return (Line);
  3159. }
  3160. }
  3161. else
  3162. {
  3163. if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
  3164. {
  3165. return file_if_end (Line);
  3166. }
  3167. }
  3168. /* OK */
  3169. My->LastInputCount++;
  3170. }
  3171. }
  3172. break;
  3173. case 2:
  3174. {
  3175. /*
  3176. OPTION BASE 0
  3177. DIM B(2,3)
  3178. ...
  3179. MAT INPUT B
  3180. ...
  3181. FOR I = 0 TO 2
  3182. FOR J = 0 TO 3
  3183. INPUT B(I,J)
  3184. NEXT J
  3185. PRINT
  3186. NEXT I
  3187. ...
  3188. */
  3189. My->LastInputCount = 0;
  3190. for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
  3191. v->VINDEX[0]++)
  3192. {
  3193. for (v->VINDEX[1] = v->LBOUND[1]; v->VINDEX[1] <= v->UBOUND[1];
  3194. v->VINDEX[1]++)
  3195. {
  3196. if (My->CurrentFile == My->SYSIN)
  3197. {
  3198. if (input_data (v, tbuf, tlen) != RESULT_SUCCESS)
  3199. {
  3200. /*
  3201. WARN_INPUT_PAST_END;
  3202. */
  3203. return (Line);
  3204. }
  3205. }
  3206. else
  3207. {
  3208. if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
  3209. {
  3210. return file_if_end (Line);
  3211. }
  3212. }
  3213. /* OK */
  3214. My->LastInputCount++;
  3215. }
  3216. }
  3217. }
  3218. break;
  3219. case 3:
  3220. {
  3221. /*
  3222. OPTION BASE 0
  3223. DIM C(2,3,4)
  3224. ...
  3225. MAT INPUT C
  3226. ...
  3227. FOR I = 0 TO 2
  3228. FOR J = 0 TO 3
  3229. FOR K = 0 TO 4
  3230. INPUT C(I,J,K)
  3231. NEXT K
  3232. PRINT
  3233. NEXT J
  3234. PRINT
  3235. NEXT I
  3236. ...
  3237. */
  3238. My->LastInputCount = 0;
  3239. for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0];
  3240. v->VINDEX[0]++)
  3241. {
  3242. for (v->VINDEX[1] = v->LBOUND[1]; v->VINDEX[1] <= v->UBOUND[1];
  3243. v->VINDEX[1]++)
  3244. {
  3245. for (v->VINDEX[2] = v->LBOUND[2]; v->VINDEX[2] <= v->UBOUND[2];
  3246. v->VINDEX[2]++)
  3247. {
  3248. if (My->CurrentFile == My->SYSIN)
  3249. {
  3250. if (input_data (v, tbuf, tlen) != RESULT_SUCCESS)
  3251. {
  3252. /*
  3253. WARN_INPUT_PAST_END;
  3254. */
  3255. return (Line);
  3256. }
  3257. }
  3258. else
  3259. {
  3260. if (file_data (v, tbuf, tlen) != RESULT_SUCCESS)
  3261. {
  3262. return file_if_end (Line);
  3263. }
  3264. }
  3265. /* OK */
  3266. My->LastInputCount++;
  3267. }
  3268. }
  3269. }
  3270. }
  3271. break;
  3272. }
  3273. /* process the next variable, if any */
  3274. }
  3275. while (line_skip_seperator (Line));
  3276. return (Line);
  3277. }
  3278. /* EOF */