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.
 
 
 
 
 
 

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