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.
 
 
 
 
 
 

10220 lines
216 KiB

  1. /***************************************************************
  2. bwb_cmd.c Miscellaneous Commands
  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. /* Version 3.20A by Ken Martin Mainly corrected fprint issues */
  31. /* */
  32. /*---------------------------------------------------------------*/
  33. #include "bwbasic.h"
  34. static void bwb_copy_file (char *Source, char *Target);
  35. static LineType *bwb_delete (LineType * l);
  36. static void bwb_display_file (char *Source);
  37. static LineType *bwb_load (LineType * Line, char *Prompt, int IsNew);
  38. static void bwb_new (void);
  39. static LineType *bwb_run_filename_or_linenumber (LineType * L);
  40. static LineType *bwb_save (LineType * Line, char *Prompt);
  41. static LineType *bwb_system (LineType * l);
  42. static LineType *bwb_xlist (LineType * l, FILE * file);
  43. static LineType *bwx_run (LineType * Line, char *ProgramName);
  44. static void CommandOptionVersion (int n, char *OutputLine);
  45. static void CommandUniqueID (int i, char *UniqueID);
  46. static void CommandVector (int i, char *Vector);
  47. static VariableType *find_variable_by_type (char *name, int dimensions,
  48. char VariableTypeCode);
  49. static void FixUp (char *Name);
  50. static LineType *H14_RENAME (LineType * l);
  51. static int line_read_matrix_redim (LineType * l, VariableType * v);
  52. static void ProcessEscapeChars (const char *Input, char *Output);
  53. static int xl_line (FILE * file, LineType * l);
  54. /*
  55. fprintf( file, "------------------------------------------------------------\n");
  56. 123456789012345678901234567890123456789012345678901234567890
  57. fprintf( file, " SYNTAX: %s\n", IntrinsicCommandTable[n].Syntax);
  58. sprintf( tbuf, "DESCRIPTION: %s\n", IntrinsicCommandTable[n].Description);
  59. fprintf( file, " " );
  60. fprintf( file, " [%c] %s\n", X, bwb_vertable[i].Name);
  61. 1234567890123
  62. */
  63. #define LEFT_LENGTH 13
  64. #define RIGHT_LENGTH 47
  65. #define TOTAL_LENGTH ( LEFT_LENGTH + RIGHT_LENGTH )
  66. /*
  67. --------------------------------------------------------------------------------------------
  68. EDIT, RENUM, RENUMBER
  69. --------------------------------------------------------------------------------------------
  70. */
  71. static LineType *
  72. bwx_run (LineType * Line, char *ProgramName)
  73. {
  74. size_t n;
  75. char *tbuf;
  76. assert (Line != NULL);
  77. assert( My != NULL );
  78. if (is_empty_string (ProgramName))
  79. {
  80. WARN_BAD_FILE_NAME;
  81. return (Line);
  82. }
  83. if (is_empty_string (My->ProgramFilename))
  84. {
  85. WARN_BAD_FILE_NAME;
  86. return (Line);
  87. }
  88. n = bwb_strlen (ProgramName) + 1 + bwb_strlen (My->ProgramFilename);
  89. if ((tbuf = (char *) calloc (n + 1 /* NulChar */ , sizeof (char))) == NULL)
  90. {
  91. WARN_OUT_OF_MEMORY;
  92. return (Line);
  93. }
  94. bwb_strcpy (tbuf, ProgramName);
  95. bwb_strcat (tbuf, " ");
  96. bwb_strcat (tbuf, My->ProgramFilename);
  97. system (tbuf);
  98. free (tbuf);
  99. tbuf = NULL;
  100. /* open edited file for read */
  101. bwb_NEW (Line); /* Relocated by JBV (bug found by DD) */
  102. if (bwb_fload (NULL) == FALSE)
  103. {
  104. WARN_BAD_FILE_NAME;
  105. return (Line);
  106. }
  107. return (Line);
  108. }
  109. /***************************************************************
  110. FUNCTION: bwb_edit()
  111. DESCRIPTION: This function implements the BASIC EDIT
  112. program by shelling out to a default editor
  113. specified by the variable BWB.EDITOR$.
  114. SYNTAX: EDIT
  115. ***************************************************************/
  116. LineType *
  117. bwb_EDIT (LineType * Line)
  118. {
  119. /*
  120. SYNTAX: EDIT
  121. */
  122. assert (Line != NULL);
  123. assert( My != NULL );
  124. return bwx_run (Line, My->OptionEditString);
  125. }
  126. /***************************************************************
  127. FUNCTION: bwb_renum()
  128. DESCRIPTION: This function implements the BASIC RENUM
  129. command by shelling out to a default
  130. renumbering program called "renum".
  131. Added by JBV 10/95
  132. SYNTAX: RENUM
  133. ***************************************************************/
  134. LineType *
  135. bwb_RENUM (LineType * Line)
  136. {
  137. /*
  138. SYNTAX: RENUM
  139. */
  140. assert (Line != NULL);
  141. assert( My != NULL );
  142. return bwx_run (Line, My->OptionRenumString);
  143. }
  144. LineType *
  145. bwb_RENUMBER (LineType * Line)
  146. {
  147. /*
  148. SYNTAX: RENUMBER
  149. */
  150. assert (Line != NULL);
  151. assert( My != NULL );
  152. return bwx_run (Line, My->OptionRenumString);
  153. }
  154. /*
  155. --------------------------------------------------------------------------------------------
  156. REM
  157. --------------------------------------------------------------------------------------------
  158. */
  159. LineType *
  160. bwb_REM (LineType * L)
  161. {
  162. /*
  163. SYNTAX: REM comment
  164. */
  165. /*
  166. This line holds BASIC comments.
  167. */
  168. assert (L != NULL);
  169. line_skip_eol (L);
  170. return L;
  171. }
  172. /*
  173. --------------------------------------------------------------------------------------------
  174. IMAGE
  175. --------------------------------------------------------------------------------------------
  176. */
  177. LineType *
  178. bwb_IMAGE (LineType * L)
  179. {
  180. /*
  181. SYNTAX: IMAGE print-using-format
  182. */
  183. assert (L != NULL);
  184. line_skip_eol (L);
  185. return L;
  186. }
  187. /*
  188. --------------------------------------------------------------------------------------------
  189. LET
  190. --------------------------------------------------------------------------------------------
  191. */
  192. LineType *
  193. bwb_LET (LineType * L)
  194. {
  195. /*
  196. SYNTAX: LET variable [,...] = expression
  197. */
  198. VariableType *v;
  199. VariantType x;
  200. VariantType *X;
  201. assert (L != NULL);
  202. X = &x;
  203. CLEAR_VARIANT (X);
  204. /* read the list of variables */
  205. do
  206. {
  207. if ((v = line_read_scalar (L)) == NULL)
  208. {
  209. WARN_VARIABLE_NOT_DECLARED;
  210. goto EXIT;
  211. }
  212. }
  213. while (line_skip_seperator (L));
  214. /* skip the equal sign */
  215. if (line_skip_EqualChar (L))
  216. {
  217. /* OK */
  218. }
  219. else if (line_skip_word (L, "EQ"))
  220. {
  221. /* OK */
  222. }
  223. else if (line_skip_word (L, ".EQ."))
  224. {
  225. /* OK */
  226. }
  227. else
  228. {
  229. WARN_SYNTAX_ERROR;
  230. goto EXIT;
  231. }
  232. /* evaluate the expression */
  233. if (line_read_expression (L, X)) /* bwb_LET */
  234. {
  235. /* save the value */
  236. if (line_is_eol (L) == FALSE)
  237. {
  238. WARN_SYNTAX_ERROR;
  239. goto EXIT;
  240. }
  241. L->position = L->Startpos;
  242. /* for each variable, assign the value */
  243. do
  244. {
  245. /* read a variable */
  246. if ((v = line_read_scalar (L)) == NULL)
  247. {
  248. WARN_VARIABLE_NOT_DECLARED;
  249. goto EXIT;
  250. }
  251. assert (v != NULL);
  252. assert (X != NULL);
  253. if (var_set (v, X) == FALSE)
  254. {
  255. WARN_TYPE_MISMATCH;
  256. goto EXIT;
  257. }
  258. }
  259. while (line_skip_seperator (L));
  260. /* we are now at the equals sign */
  261. line_skip_eol (L);
  262. }
  263. else
  264. {
  265. WARN_SYNTAX_ERROR;
  266. }
  267. EXIT:
  268. RELEASE_VARIANT (X);
  269. return L;
  270. }
  271. LineType *
  272. bwb_CONST (LineType * L)
  273. {
  274. /*
  275. SYNTAX: CONST variable [,...] = expression
  276. */
  277. VariableType *v;
  278. VariantType x;
  279. VariantType *X;
  280. assert (L != NULL);
  281. X = &x;
  282. CLEAR_VARIANT (X);
  283. /* read the list of variables */
  284. do
  285. {
  286. if ((v = line_read_scalar (L)) == NULL)
  287. {
  288. WARN_VARIABLE_NOT_DECLARED;
  289. goto EXIT;
  290. }
  291. }
  292. while (line_skip_seperator (L));
  293. /* we are now at the equals sign */
  294. /* skip the equal sign */
  295. if (line_skip_EqualChar (L))
  296. {
  297. /* OK */
  298. }
  299. else if (line_skip_word (L, "EQ"))
  300. {
  301. /* OK */
  302. }
  303. else if (line_skip_word (L, ".EQ."))
  304. {
  305. /* OK */
  306. }
  307. else
  308. {
  309. WARN_SYNTAX_ERROR;
  310. goto EXIT;
  311. }
  312. /* evaluate the expression */
  313. if (line_read_expression (L, X)) /* bwb_LET */
  314. {
  315. /* save the value */
  316. if (line_is_eol (L) == FALSE)
  317. {
  318. WARN_SYNTAX_ERROR;
  319. goto EXIT;
  320. }
  321. /* for each variable, assign the value */
  322. L->position = L->Startpos;
  323. do
  324. {
  325. /* read a variable */
  326. if ((v = line_read_scalar (L)) == NULL)
  327. {
  328. WARN_VARIABLE_NOT_DECLARED;
  329. goto EXIT;
  330. }
  331. assert (v != NULL);
  332. assert (X != NULL);
  333. if (var_set (v, X) == FALSE)
  334. {
  335. WARN_TYPE_MISMATCH;
  336. goto EXIT;
  337. }
  338. }
  339. while (line_skip_seperator (L));
  340. /* we are now at the equals sign */
  341. /* for each variable, mark as constant */
  342. L->position = L->Startpos;
  343. do
  344. {
  345. /* read a variable */
  346. if ((v = line_read_scalar (L)) == NULL)
  347. {
  348. WARN_VARIABLE_NOT_DECLARED;
  349. goto EXIT;
  350. }
  351. assert (v != NULL);
  352. v->VariableFlags |= VARIABLE_CONSTANT;
  353. }
  354. while (line_skip_seperator (L));
  355. /* we are now at the equals sign */
  356. line_skip_eol (L);
  357. }
  358. else
  359. {
  360. WARN_SYNTAX_ERROR;
  361. }
  362. EXIT:
  363. RELEASE_VARIANT (X);
  364. return L;
  365. }
  366. LineType *
  367. bwb_DEC (LineType * L)
  368. {
  369. /*
  370. SYNTAX: DEC variable [,...]
  371. */
  372. VariableType *v;
  373. VariantType x;
  374. VariantType *X;
  375. assert (L != NULL);
  376. X = &x;
  377. CLEAR_VARIANT (X);
  378. /* read the list of variables */
  379. do
  380. {
  381. if ((v = line_read_scalar (L)) == NULL)
  382. {
  383. WARN_VARIABLE_NOT_DECLARED;
  384. goto EXIT;
  385. }
  386. if (v->VariableTypeCode == StringTypeCode)
  387. {
  388. WARN_TYPE_MISMATCH;
  389. goto EXIT;
  390. }
  391. }
  392. while (line_skip_seperator (L));
  393. /* we are now at the end of the line */
  394. if (line_is_eol (L) == FALSE)
  395. {
  396. WARN_SYNTAX_ERROR;
  397. goto EXIT;
  398. }
  399. L->position = L->Startpos;
  400. /* for each variable, assign the value */
  401. do
  402. {
  403. /* read a variable */
  404. if ((v = line_read_scalar (L)) == NULL)
  405. {
  406. WARN_VARIABLE_NOT_DECLARED;
  407. goto EXIT;
  408. }
  409. assert (v != NULL);
  410. assert (X != NULL);
  411. if (var_get (v, X) == FALSE)
  412. {
  413. WARN_VARIABLE_NOT_DECLARED;
  414. goto EXIT;
  415. }
  416. X->Number--;
  417. if (var_set (v, X) == FALSE)
  418. {
  419. WARN_VARIABLE_NOT_DECLARED;
  420. goto EXIT;
  421. }
  422. }
  423. while (line_skip_seperator (L));
  424. /* we are now at the end of the line */
  425. EXIT:
  426. RELEASE_VARIANT (X);
  427. return L;
  428. }
  429. LineType *
  430. bwb_INC (LineType * L)
  431. {
  432. /*
  433. SYNTAX: INC variable [,...]
  434. */
  435. VariableType *v;
  436. VariantType x;
  437. VariantType *X;
  438. assert (L != NULL);
  439. X = &x;
  440. CLEAR_VARIANT (X);
  441. /* read the list of variables */
  442. do
  443. {
  444. if ((v = line_read_scalar (L)) == NULL)
  445. {
  446. WARN_VARIABLE_NOT_DECLARED;
  447. goto EXIT;
  448. }
  449. if (v->VariableTypeCode == StringTypeCode)
  450. {
  451. WARN_TYPE_MISMATCH;
  452. goto EXIT;
  453. }
  454. }
  455. while (line_skip_seperator (L));
  456. /* we are now at the end of the line */
  457. if (line_is_eol (L) == FALSE)
  458. {
  459. WARN_SYNTAX_ERROR;
  460. goto EXIT;
  461. }
  462. L->position = L->Startpos;
  463. /* for each variable, assign the value */
  464. do
  465. {
  466. /* read a variable */
  467. if ((v = line_read_scalar (L)) == NULL)
  468. {
  469. WARN_VARIABLE_NOT_DECLARED;
  470. goto EXIT;
  471. }
  472. assert (v != NULL);
  473. assert (X != NULL);
  474. if (var_get (v, X) == FALSE)
  475. {
  476. WARN_VARIABLE_NOT_DECLARED;
  477. goto EXIT;
  478. }
  479. X->Number++;
  480. if (var_set (v, X) == FALSE)
  481. {
  482. WARN_VARIABLE_NOT_DECLARED;
  483. goto EXIT;
  484. }
  485. }
  486. while (line_skip_seperator (L));
  487. /* we are now at the end of the line */
  488. EXIT:
  489. RELEASE_VARIANT (X);
  490. return L;
  491. }
  492. /*
  493. --------------------------------------------------------------------------------------------
  494. GO
  495. --------------------------------------------------------------------------------------------
  496. */
  497. LineType *
  498. bwb_GO (LineType * L)
  499. {
  500. assert (L != NULL);
  501. WARN_SYNTAX_ERROR;
  502. return L;
  503. }
  504. LineType *
  505. bwb_THEN (LineType * L)
  506. {
  507. assert (L != NULL);
  508. WARN_SYNTAX_ERROR;
  509. return L;
  510. }
  511. LineType *
  512. bwb_TO (LineType * L)
  513. {
  514. assert (L != NULL);
  515. WARN_SYNTAX_ERROR;
  516. return L;
  517. }
  518. LineType *
  519. bwb_STEP (LineType * L)
  520. {
  521. assert (L != NULL);
  522. WARN_SYNTAX_ERROR;
  523. return L;
  524. }
  525. LineType *
  526. bwb_OF (LineType * L)
  527. {
  528. assert (L != NULL);
  529. WARN_SYNTAX_ERROR;
  530. return L;
  531. }
  532. LineType *
  533. bwb_AS (LineType * L)
  534. {
  535. assert (L != NULL);
  536. WARN_SYNTAX_ERROR;
  537. return L;
  538. }
  539. /*
  540. --------------------------------------------------------------------------------------------
  541. AUTO
  542. --------------------------------------------------------------------------------------------
  543. */
  544. LineType *
  545. bwb_BUILD (LineType * L)
  546. {
  547. /*
  548. SYNTAX: BUILD
  549. SYNTAX: BUILD start
  550. SYNTAX: BUILD start, increment
  551. */
  552. assert (L != NULL);
  553. return bwb_AUTO (L);
  554. }
  555. LineType *
  556. bwb_AUTO (LineType * L)
  557. {
  558. /*
  559. SYNTAX: AUTO
  560. SYNTAX: AUTO start
  561. SYNTAX: AUTO start , increment
  562. */
  563. assert (L != NULL);
  564. assert( My != NULL );
  565. My->AutomaticLineNumber = 0;
  566. My->AutomaticLineIncrement = 0;
  567. if (line_is_eol (L))
  568. {
  569. /* AUTO */
  570. My->AutomaticLineNumber = 10;
  571. My->AutomaticLineIncrement = 10;
  572. return L;
  573. }
  574. if (line_read_line_number (L, &My->AutomaticLineNumber))
  575. {
  576. /* AUTO ### ... */
  577. if (My->AutomaticLineNumber < MINLIN || My->AutomaticLineNumber > MAXLIN)
  578. {
  579. WARN_UNDEFINED_LINE;
  580. return L;
  581. }
  582. if (line_is_eol (L))
  583. {
  584. /* AUTO start */
  585. My->AutomaticLineIncrement = 10;
  586. return L;
  587. }
  588. else if (line_skip_seperator (L))
  589. {
  590. /* AUTO ### , ... */
  591. if (line_read_line_number (L, &My->AutomaticLineIncrement))
  592. {
  593. /* AUTO start , increment */
  594. if (My->AutomaticLineIncrement < MINLIN
  595. || My->AutomaticLineIncrement > MAXLIN)
  596. {
  597. WARN_UNDEFINED_LINE;
  598. return L;
  599. }
  600. return L;
  601. }
  602. }
  603. }
  604. My->AutomaticLineNumber = 0;
  605. My->AutomaticLineIncrement = 0;
  606. WARN_SYNTAX_ERROR;
  607. return L;
  608. }
  609. /*
  610. --------------------------------------------------------------------------------------------
  611. BREAK
  612. --------------------------------------------------------------------------------------------
  613. */
  614. LineType *
  615. bwb_BREAK (LineType * l)
  616. {
  617. /*
  618. SYNTAX: BREAK
  619. SYNTAX: BREAK line [,...]
  620. SYNTAX: BREAK line - line
  621. */
  622. assert (l != NULL);
  623. assert( My != NULL );
  624. assert( My->StartMarker != NULL );
  625. assert( My->EndMarker != NULL );
  626. if (line_is_eol (l))
  627. {
  628. /* BREAK */
  629. /* remove all line breaks */
  630. LineType *x;
  631. for (x = My->StartMarker->next; x != My->EndMarker; x = x->next)
  632. {
  633. x->LineFlags &= ~LINE_BREAK;
  634. }
  635. return (l);
  636. }
  637. else
  638. {
  639. do
  640. {
  641. int head;
  642. int tail;
  643. if (line_read_line_sequence (l, &head, &tail))
  644. {
  645. /* BREAK 's' - 'e' */
  646. LineType *x;
  647. if (head < MINLIN || head > MAXLIN)
  648. {
  649. WARN_UNDEFINED_LINE;
  650. return (l);
  651. }
  652. if (tail < MINLIN || tail > MAXLIN)
  653. {
  654. WARN_UNDEFINED_LINE;
  655. return (l);
  656. }
  657. if (head > tail)
  658. {
  659. WARN_SYNTAX_ERROR;
  660. return (l);
  661. }
  662. /* valid range */
  663. /* now go through and list appropriate lines */
  664. for (x = My->StartMarker->next; x != My->EndMarker; x = x->next)
  665. {
  666. if (head <= x->number && x->number <= tail)
  667. {
  668. if (x->LineFlags & LINE_NUMBERED)
  669. {
  670. x->LineFlags |= LINE_BREAK;
  671. }
  672. }
  673. }
  674. }
  675. else
  676. {
  677. WARN_SYNTAX_ERROR;
  678. return (l);
  679. }
  680. }
  681. while (line_skip_seperator (l));
  682. }
  683. return (l);
  684. }
  685. /*
  686. --------------------------------------------------------------------------------------------
  687. DSP
  688. --------------------------------------------------------------------------------------------
  689. */
  690. LineType *
  691. bwb_DSP (LineType * l)
  692. {
  693. /*
  694. SYNTAX: DSP
  695. SYNTAX: DSP variablename [,...]
  696. */
  697. VariableType *v;
  698. assert (l != NULL);
  699. assert( My != NULL );
  700. if (line_is_eol (l))
  701. {
  702. /* DSP */
  703. /* remove all variable displays */
  704. for (v = My->VariableHead; v != NULL; v = v->next)
  705. {
  706. v->VariableFlags &= ~VARIABLE_DISPLAY; /* bwb_DSP() */
  707. }
  708. return (l);
  709. }
  710. /* DSP variablename [,...] */
  711. do
  712. {
  713. char varname[NameLengthMax + 1];
  714. if (line_read_varname (l, varname))
  715. {
  716. /* mark the variable */
  717. for (v = My->VariableHead; v != NULL; v = v->next)
  718. {
  719. if (bwb_stricmp (v->name, varname) == 0)
  720. {
  721. v->VariableFlags |= VARIABLE_DISPLAY; /* bwb_DSP() */
  722. }
  723. }
  724. }
  725. }
  726. while (line_skip_seperator (l));
  727. return (l);
  728. }
  729. /*
  730. --------------------------------------------------------------------------------------------
  731. GOTO
  732. --------------------------------------------------------------------------------------------
  733. */
  734. LineType *
  735. bwb_GO_TO (LineType * l)
  736. {
  737. assert (l != NULL);
  738. return bwb_GOTO (l);
  739. }
  740. LineType *
  741. bwb_GOTO (LineType * l)
  742. {
  743. /*
  744. SYNTAX: GOTO line ' standard GOTO
  745. SYNTAX: GOTO expression ' calculated GOTO
  746. SYNTAX: GOTO expression OF line,... ' indexed GOTO, same as ON expression GOTO line,...
  747. SYNTAX: GOTO line [,...] ON expression ' indexed GOTO, same as ON expression GOTO line,...
  748. */
  749. int Value;
  750. int LineNumber;
  751. LineType *x;
  752. assert (l != NULL);
  753. assert( My != NULL );
  754. assert( My->CurrentVersion != NULL );
  755. Value = 0;
  756. LineNumber = 0;
  757. if (l->LineFlags & (LINE_USER))
  758. {
  759. WARN_ILLEGAL_DIRECT;
  760. return (l);
  761. }
  762. if (line_is_eol (l))
  763. {
  764. WARN_SYNTAX_ERROR;
  765. return (l);
  766. }
  767. if (line_read_integer_expression (l, &Value) == FALSE)
  768. {
  769. WARN_SYNTAX_ERROR;
  770. return (l);
  771. }
  772. if (line_is_eol (l))
  773. {
  774. /* GOTO linenumber */
  775. /* 'Value' is the line number */
  776. LineNumber = Value;
  777. }
  778. else if (line_skip_word (l, "OF"))
  779. {
  780. /* GOTO expression OF line, ... */
  781. /* 'Value' is an index into a list of line numbers */
  782. if (line_read_index_item (l, Value, &LineNumber))
  783. {
  784. /* found 'LineNumber' */
  785. }
  786. else if (My->CurrentVersion->OptionFlags & (OPTION_BUGS_ON) ) /* GOTO X OF ... */
  787. {
  788. /* silently fall-thru to the following line */
  789. line_skip_eol (l);
  790. return (l);
  791. }
  792. else
  793. {
  794. /* ERROR */
  795. WARN_UNDEFINED_LINE;
  796. return (l);
  797. }
  798. }
  799. else if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
  800. {
  801. /* GOTO line [,...] ON expression */
  802. while (line_skip_seperator (l))
  803. {
  804. if (line_read_integer_expression (l, &Value) == FALSE)
  805. {
  806. WARN_SYNTAX_ERROR;
  807. return (l);
  808. }
  809. }
  810. if (line_skip_word (l, "ON") == FALSE)
  811. {
  812. WARN_SYNTAX_ERROR;
  813. return (l);
  814. }
  815. if (line_read_integer_expression (l, &Value) == FALSE)
  816. {
  817. WARN_SYNTAX_ERROR;
  818. return (l);
  819. }
  820. /* 'Value' is an index into a list of line numbers */
  821. l->position = l->Startpos;
  822. if (line_read_index_item (l, Value, &LineNumber))
  823. {
  824. /* found 'LineNumber' */
  825. }
  826. else
  827. {
  828. /* silently fall-thru to the following line */
  829. line_skip_eol (l);
  830. return (l);
  831. }
  832. line_skip_eol (l);
  833. }
  834. else
  835. {
  836. WARN_SYNTAX_ERROR;
  837. return (l);
  838. }
  839. if (LineNumber < MINLIN || LineNumber > MAXLIN)
  840. {
  841. WARN_UNDEFINED_LINE;
  842. return (l);
  843. }
  844. /* valid range */
  845. x = NULL;
  846. #if THE_PRICE_IS_RIGHT
  847. if (l->OtherLine != NULL)
  848. {
  849. /* look in the cache */
  850. if (l->OtherLine->number == LineNumber)
  851. {
  852. x = l->OtherLine; /* found in cache */
  853. }
  854. }
  855. #endif /* THE_PRICE_IS_RIGHT */
  856. if (x == NULL)
  857. {
  858. x = find_line_number (LineNumber); /* not found in the cache */
  859. }
  860. if (x != NULL)
  861. {
  862. /* FOUND */
  863. line_skip_eol (l);
  864. x->position = 0;
  865. #if THE_PRICE_IS_RIGHT
  866. l->OtherLine = x; /* save in cache */
  867. #endif /* THE_PRICE_IS_RIGHT */
  868. return x;
  869. }
  870. /* NOT FOUND */
  871. WARN_UNDEFINED_LINE;
  872. return (l);
  873. }
  874. /*
  875. --------------------------------------------------------------------------------------------
  876. GOSUB
  877. --------------------------------------------------------------------------------------------
  878. */
  879. LineType *
  880. bwb_GO_SUB (LineType * l)
  881. {
  882. assert (l != NULL);
  883. return bwb_GOSUB (l);
  884. }
  885. LineType *
  886. bwb_GOSUB (LineType * l)
  887. {
  888. /*
  889. SYNTAX: GOSUB line ' standard GOSUB
  890. SYNTAX: GOSUB expression ' calculated GOSUB
  891. SYNTAX: GOSUB expression OF line,... ' indexed GOSUB, same as ON expression GOSUB line,...
  892. SYNTAX: GOSUB line [,...] ON expression ' indexed GOSUB, same as ON expression GOSUB line,...
  893. */
  894. int Value;
  895. int LineNumber;
  896. LineType *x;
  897. assert (l != NULL);
  898. assert( My != NULL );
  899. assert( My->CurrentVersion != NULL );
  900. Value = 0;
  901. LineNumber = 0;
  902. x = NULL;
  903. if (l->LineFlags & (LINE_USER))
  904. {
  905. WARN_ILLEGAL_DIRECT;
  906. return (l);
  907. }
  908. if (line_is_eol (l))
  909. {
  910. WARN_SYNTAX_ERROR;
  911. return (l);
  912. }
  913. if (line_read_integer_expression (l, &Value) == FALSE)
  914. {
  915. WARN_SYNTAX_ERROR;
  916. return (l);
  917. }
  918. if (line_is_eol (l))
  919. {
  920. /* GOSUB linenumber */
  921. /* 'Value' is the line number */
  922. LineNumber = Value;
  923. }
  924. else if (line_skip_word (l, "OF"))
  925. {
  926. /* GOSUB linenumber [,...] OF expression */
  927. /* 'Value' is an index into a list of line numbers */
  928. if (line_read_index_item (l, Value, &LineNumber))
  929. {
  930. /* found 'LineNumber' */
  931. }
  932. else if (My->CurrentVersion->OptionFlags & (OPTION_BUGS_ON) ) /* GOSUB X OF ... */
  933. {
  934. /* silently fall-thru to the following line */
  935. line_skip_eol (l);
  936. return (l);
  937. }
  938. else
  939. {
  940. /* ERROR */
  941. WARN_UNDEFINED_LINE;
  942. return (l);
  943. }
  944. }
  945. else if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
  946. {
  947. /* GOSUB line [,...] ON expression */
  948. while (line_skip_seperator (l))
  949. {
  950. if (line_read_integer_expression (l, &Value) == FALSE)
  951. {
  952. WARN_SYNTAX_ERROR;
  953. return (l);
  954. }
  955. }
  956. if (line_skip_word (l, "ON") == FALSE)
  957. {
  958. WARN_SYNTAX_ERROR;
  959. return (l);
  960. }
  961. if (line_read_integer_expression (l, &Value) == FALSE)
  962. {
  963. WARN_SYNTAX_ERROR;
  964. return (l);
  965. }
  966. /* 'Value' is an index into a list of line numbers */
  967. l->position = l->Startpos;
  968. if (line_read_index_item (l, Value, &LineNumber))
  969. {
  970. /* found 'LineNumber' */
  971. }
  972. else
  973. {
  974. /* silently fall-thru to the following line */
  975. line_skip_eol (l);
  976. return (l);
  977. }
  978. line_skip_eol (l);
  979. }
  980. else
  981. {
  982. WARN_SYNTAX_ERROR;
  983. return (l);
  984. }
  985. if (LineNumber < MINLIN || LineNumber > MAXLIN)
  986. {
  987. WARN_UNDEFINED_LINE;
  988. return (l);
  989. }
  990. /* valid range */
  991. x = NULL;
  992. #if THE_PRICE_IS_RIGHT
  993. if (l->OtherLine != NULL)
  994. {
  995. /* look in the cache */
  996. if (l->OtherLine->number == LineNumber)
  997. {
  998. x = l->OtherLine; /* found in cache */
  999. }
  1000. }
  1001. #endif /* THE_PRICE_IS_RIGHT */
  1002. if (x == NULL)
  1003. {
  1004. x = find_line_number (LineNumber); /* not found in the cache */
  1005. }
  1006. if (x != NULL)
  1007. {
  1008. /* FOUND */
  1009. line_skip_eol (l);
  1010. /* save current stack level */
  1011. My->StackHead->line = l;
  1012. /* increment exec stack */
  1013. if (bwb_incexec ())
  1014. {
  1015. /* set the new position to x and return x */
  1016. x->position = 0;
  1017. My->StackHead->line = x;
  1018. My->StackHead->ExecCode = EXEC_GOSUB;
  1019. #if THE_PRICE_IS_RIGHT
  1020. l->OtherLine = x; /* save in cache */
  1021. #endif /* THE_PRICE_IS_RIGHT */
  1022. return x;
  1023. }
  1024. else
  1025. {
  1026. /* ERROR */
  1027. WARN_OUT_OF_MEMORY;
  1028. return My->EndMarker;
  1029. }
  1030. }
  1031. /* NOT FOUND */
  1032. WARN_UNDEFINED_LINE;
  1033. return (l);
  1034. }
  1035. /*
  1036. --------------------------------------------------------------------------------------------
  1037. RETURN
  1038. --------------------------------------------------------------------------------------------
  1039. */
  1040. LineType *
  1041. bwb_RETURN (LineType * l)
  1042. {
  1043. /*
  1044. SYNTAX: RETURN
  1045. */
  1046. assert (l != NULL);
  1047. assert (My != NULL);
  1048. assert (My->CurrentVersion != NULL);
  1049. assert (My->StackHead != NULL);
  1050. if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
  1051. {
  1052. /* RETURN [comment] */
  1053. line_skip_eol (l);
  1054. }
  1055. if (My->CurrentVersion->OptionVersionValue & (C77))
  1056. {
  1057. /* CBASIC-II: RETURN exits the first FUNCTION or GOSUB */
  1058. while (My->StackHead->ExecCode != EXEC_GOSUB
  1059. && My->StackHead->ExecCode != EXEC_FUNCTION)
  1060. {
  1061. bwb_decexec ();
  1062. if (My->StackHead == NULL)
  1063. {
  1064. WARN_RETURN_WITHOUT_GOSUB;
  1065. return (l);
  1066. }
  1067. if (My->StackHead->ExecCode == EXEC_NORM) /* End of the line? */
  1068. {
  1069. WARN_RETURN_WITHOUT_GOSUB;
  1070. return (l);
  1071. }
  1072. }
  1073. }
  1074. else
  1075. {
  1076. /* RETURN exits the first GOSUB */
  1077. while (My->StackHead->ExecCode != EXEC_GOSUB)
  1078. {
  1079. bwb_decexec ();
  1080. if (My->StackHead == NULL)
  1081. {
  1082. WARN_RETURN_WITHOUT_GOSUB;
  1083. return (l);
  1084. }
  1085. if (My->StackHead->ExecCode == EXEC_NORM) /* End of the line? */
  1086. {
  1087. WARN_RETURN_WITHOUT_GOSUB;
  1088. return (l);
  1089. }
  1090. }
  1091. }
  1092. /* decrement the EXEC stack counter */
  1093. bwb_decexec ();
  1094. assert (My->StackHead != NULL);
  1095. return My->StackHead->line;
  1096. }
  1097. /*
  1098. --------------------------------------------------------------------------------------------
  1099. POP
  1100. --------------------------------------------------------------------------------------------
  1101. */
  1102. LineType *
  1103. bwb_POP (LineType * l)
  1104. {
  1105. /*
  1106. SYNTAX: POP
  1107. */
  1108. StackType *StackItem;
  1109. assert (l != NULL);
  1110. assert (My != NULL);
  1111. assert (My->CurrentVersion != NULL);
  1112. assert (My->StackHead != NULL);
  1113. StackItem = My->StackHead;
  1114. while (StackItem->ExecCode != EXEC_GOSUB)
  1115. {
  1116. StackItem = StackItem->next;
  1117. if (StackItem == NULL)
  1118. {
  1119. WARN_RETURN_WITHOUT_GOSUB;
  1120. return (l);
  1121. }
  1122. if (StackItem->ExecCode == EXEC_NORM)
  1123. {
  1124. /* End of the line */
  1125. WARN_RETURN_WITHOUT_GOSUB;
  1126. return (l);
  1127. }
  1128. }
  1129. /* hide the GOSUB */
  1130. StackItem->ExecCode = EXEC_POPPED;
  1131. return (l);
  1132. }
  1133. /*
  1134. --------------------------------------------------------------------------------------------
  1135. ON
  1136. --------------------------------------------------------------------------------------------
  1137. */
  1138. LineType *
  1139. bwb_ON (LineType * l)
  1140. {
  1141. /*
  1142. SYNTAX: ON expression GOTO line,... ' expression evaluates to an index
  1143. SYNTAX: ON expression GOSUB line,... ' expression evaluates to an index
  1144. */
  1145. int Value;
  1146. int command;
  1147. int LineNumber;
  1148. LineType *x;
  1149. assert (l != NULL);
  1150. assert (My != NULL);
  1151. assert (My->CurrentVersion != NULL);
  1152. Value = 0;
  1153. command = 0;
  1154. LineNumber = 0;
  1155. x = NULL;
  1156. if (l->LineFlags & (LINE_USER))
  1157. {
  1158. WARN_ILLEGAL_DIRECT;
  1159. return (l);
  1160. }
  1161. if (line_is_eol (l))
  1162. {
  1163. WARN_SYNTAX_ERROR;
  1164. return (l);
  1165. }
  1166. if (line_read_integer_expression (l, &Value) == FALSE)
  1167. {
  1168. WARN_UNDEFINED_LINE;
  1169. return (l);
  1170. }
  1171. if (line_skip_word (l, "GO"))
  1172. {
  1173. if (line_skip_word (l, "TO"))
  1174. {
  1175. command = C_GOTO;
  1176. }
  1177. else if (line_skip_word (l, "SUB"))
  1178. {
  1179. command = C_GOSUB;
  1180. }
  1181. else
  1182. {
  1183. WARN_SYNTAX_ERROR;
  1184. return (l);
  1185. }
  1186. }
  1187. else if (line_skip_word (l, "GOTO"))
  1188. {
  1189. command = C_GOTO;
  1190. }
  1191. else if (line_skip_word (l, "GOSUB"))
  1192. {
  1193. command = C_GOSUB;
  1194. }
  1195. else
  1196. {
  1197. WARN_SYNTAX_ERROR;
  1198. return (l);
  1199. }
  1200. /* 'Value' is an index into a list of line numbers */
  1201. if (line_read_index_item (l, Value, &LineNumber))
  1202. {
  1203. /* found 'LineNumber' */
  1204. }
  1205. else if (My->CurrentVersion->OptionFlags & (OPTION_BUGS_ON) ) /* ON X GOTO|GOSUB ... */
  1206. {
  1207. /* silently fall-thru to the following line */
  1208. line_skip_eol (l);
  1209. return (l);
  1210. }
  1211. else
  1212. {
  1213. /* ERROR */
  1214. WARN_UNDEFINED_LINE;
  1215. return (l);
  1216. }
  1217. if (LineNumber < MINLIN || LineNumber > MAXLIN)
  1218. {
  1219. WARN_UNDEFINED_LINE;
  1220. return (l);
  1221. }
  1222. /* valid range */
  1223. x = NULL;
  1224. #if THE_PRICE_IS_RIGHT
  1225. if (l->OtherLine != NULL)
  1226. {
  1227. /* look in the cache */
  1228. if (l->OtherLine->number == LineNumber)
  1229. {
  1230. x = l->OtherLine; /* found in cache */
  1231. }
  1232. }
  1233. #endif /* THE_PRICE_IS_RIGHT */
  1234. if (x == NULL)
  1235. {
  1236. x = find_line_number (LineNumber); /* not found in the cache */
  1237. }
  1238. if (x != NULL)
  1239. {
  1240. /* FOUND */
  1241. if (command == C_GOTO)
  1242. {
  1243. /* ON ... GOTO ... */
  1244. line_skip_eol (l);
  1245. x->position = 0;
  1246. #if THE_PRICE_IS_RIGHT
  1247. l->OtherLine = x; /* save in cache */
  1248. #endif /* THE_PRICE_IS_RIGHT */
  1249. return x;
  1250. }
  1251. else if (command == C_GOSUB)
  1252. {
  1253. /* ON ... GOSUB ... */
  1254. line_skip_eol (l);
  1255. /* save current stack level */
  1256. My->StackHead->line = l;
  1257. /* increment exec stack */
  1258. if (bwb_incexec ())
  1259. {
  1260. /* set the new position to x and return x */
  1261. x->position = 0;
  1262. My->StackHead->line = x;
  1263. My->StackHead->ExecCode = EXEC_GOSUB;
  1264. #if THE_PRICE_IS_RIGHT
  1265. l->OtherLine = x; /* save in cache */
  1266. #endif /* THE_PRICE_IS_RIGHT */
  1267. return x;
  1268. }
  1269. else
  1270. {
  1271. /* ERROR */
  1272. WARN_OUT_OF_MEMORY;
  1273. return My->EndMarker;
  1274. }
  1275. }
  1276. else
  1277. {
  1278. /* ERROR */
  1279. WARN_SYNTAX_ERROR;
  1280. return (l);
  1281. }
  1282. }
  1283. /* NOT FOUND */
  1284. WARN_UNDEFINED_LINE;
  1285. return (l);
  1286. }
  1287. /*
  1288. --------------------------------------------------------------------------------------------
  1289. PAUSE
  1290. --------------------------------------------------------------------------------------------
  1291. */
  1292. LineType *
  1293. bwb_PAUSE (LineType * l)
  1294. {
  1295. /*
  1296. SYNTAX: PAUSE
  1297. */
  1298. char *pstring;
  1299. char *tbuf;
  1300. int tlen;
  1301. assert (l != NULL);
  1302. assert (My != NULL);
  1303. assert (My->CurrentVersion != NULL);
  1304. assert (My->ConsoleOutput != NULL);
  1305. assert (My->ConsoleInput != NULL);
  1306. pstring = My->ConsoleOutput;
  1307. tbuf = My->ConsoleInput;
  1308. tlen = MAX_LINE_LENGTH;
  1309. if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
  1310. {
  1311. /* PAUSE [comment] */
  1312. line_skip_eol (l);
  1313. }
  1314. sprintf (pstring, "PAUSE AT %d\n", l->number);
  1315. bwx_input (pstring, FALSE, tbuf, tlen);
  1316. return (l);
  1317. }
  1318. /*
  1319. --------------------------------------------------------------------------------------------
  1320. STOP
  1321. --------------------------------------------------------------------------------------------
  1322. */
  1323. LineType *
  1324. bwb_STOP (LineType * l)
  1325. {
  1326. /*
  1327. SYNTAX: STOP
  1328. */
  1329. assert (l != NULL);
  1330. assert (My != NULL);
  1331. assert (My->CurrentVersion != NULL);
  1332. if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
  1333. {
  1334. /* STOP [comment] */
  1335. line_skip_eol (l);
  1336. }
  1337. My->ContinueLine = l->next;
  1338. bwx_STOP (TRUE);
  1339. return bwb_END (l);
  1340. }
  1341. /*
  1342. --------------------------------------------------------------------------------------------
  1343. END
  1344. --------------------------------------------------------------------------------------------
  1345. */
  1346. LineType *
  1347. bwb_END (LineType * l)
  1348. {
  1349. /*
  1350. SYNTAX: END
  1351. */
  1352. assert (l != NULL);
  1353. assert (My != NULL);
  1354. assert (My->CurrentVersion != NULL);
  1355. if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
  1356. {
  1357. /* END [comment] */
  1358. line_skip_eol (l);
  1359. }
  1360. My->ContinueLine = l->next;
  1361. bwx_STOP (FALSE);
  1362. return My->EndMarker;
  1363. }
  1364. /*
  1365. --------------------------------------------------------------------------------------------
  1366. RUN
  1367. --------------------------------------------------------------------------------------------
  1368. */
  1369. static LineType *
  1370. bwb_run_filename_or_linenumber (LineType * L)
  1371. {
  1372. LineType *current = NULL;
  1373. VariantType x;
  1374. VariantType *X;
  1375. assert (L != NULL);
  1376. assert (My != NULL);
  1377. assert (My->StartMarker != NULL);
  1378. X = &x;
  1379. CLEAR_VARIANT (X);
  1380. if (line_read_expression (L, X) == FALSE) /* bwb_run_filename_or_linenumber */
  1381. {
  1382. WARN_SYNTAX_ERROR;
  1383. return L;
  1384. }
  1385. if (X->VariantTypeCode == StringTypeCode)
  1386. {
  1387. /* RUN "filename" */
  1388. /* RUN A$ */
  1389. if (is_empty_string (X->Buffer))
  1390. {
  1391. WARN_BAD_FILE_NAME;
  1392. return L;
  1393. }
  1394. /* open the file and execute it */
  1395. bwb_new (); /* clear memory */
  1396. if (My->ProgramFilename != NULL)
  1397. {
  1398. free (My->ProgramFilename);
  1399. My->ProgramFilename = NULL;
  1400. }
  1401. My->ProgramFilename = bwb_strdup (X->Buffer);
  1402. if (bwb_fload (NULL) == FALSE)
  1403. {
  1404. WARN_BAD_FILE_NAME;
  1405. return L;
  1406. }
  1407. /*
  1408. **
  1409. ** FORCE SCAN
  1410. **
  1411. */
  1412. if (bwb_scan () == FALSE)
  1413. {
  1414. WARN_CANT_CONTINUE;
  1415. return L;
  1416. }
  1417. current = My->StartMarker->next;
  1418. }
  1419. else
  1420. {
  1421. /* RUN 100 */
  1422. /* RUN N */
  1423. /* execute the line */
  1424. int LineNumber;
  1425. LineNumber = (int) bwb_rint (X->Number);
  1426. /*
  1427. **
  1428. ** FORCE SCAN
  1429. **
  1430. */
  1431. if (bwb_scan () == FALSE)
  1432. {
  1433. WARN_CANT_CONTINUE;
  1434. goto EXIT;
  1435. }
  1436. current = find_line_number (LineNumber); /* RUN 100 */
  1437. if (current == NULL)
  1438. {
  1439. WARN_CANT_CONTINUE;
  1440. return L;
  1441. }
  1442. }
  1443. EXIT:
  1444. RELEASE_VARIANT (X);
  1445. return current;
  1446. }
  1447. LineType *
  1448. bwb_RUNNH (LineType * L)
  1449. {
  1450. assert (L != NULL);
  1451. return bwb_RUN (L);
  1452. }
  1453. LineType *
  1454. bwb_RUN (LineType * L)
  1455. {
  1456. /*
  1457. SYNTAX: RUN
  1458. SYNTAX: RUN filename$
  1459. SYNTAX: RUN linenumber
  1460. */
  1461. LineType *current;
  1462. assert (L != NULL);
  1463. assert (My != NULL);
  1464. assert (My->EndMarker != NULL);
  1465. assert (My->DefaultVariableType != NULL);
  1466. /* clear the STACK */
  1467. bwb_clrexec ();
  1468. if (bwb_incexec ())
  1469. {
  1470. /* OK */
  1471. }
  1472. else
  1473. {
  1474. /* ERROR */
  1475. WARN_OUT_OF_MEMORY;
  1476. return My->EndMarker;
  1477. }
  1478. if (line_is_eol (L))
  1479. {
  1480. /* RUN */
  1481. var_CLEAR ();
  1482. /* if( TRUE ) */
  1483. {
  1484. int n;
  1485. for (n = 0; n < 26; n++)
  1486. {
  1487. My->DefaultVariableType[n] = DoubleTypeCode;
  1488. }
  1489. }
  1490. /*
  1491. **
  1492. ** FORCE SCAN
  1493. **
  1494. */
  1495. if (bwb_scan () == FALSE)
  1496. {
  1497. WARN_CANT_CONTINUE;
  1498. return My->EndMarker;
  1499. }
  1500. current = My->StartMarker->next;
  1501. }
  1502. else
  1503. {
  1504. /* RUN 100 : RUN filename$ */
  1505. current = bwb_run_filename_or_linenumber (L);
  1506. if (current == NULL)
  1507. {
  1508. WARN_UNDEFINED_LINE;
  1509. return My->EndMarker;
  1510. }
  1511. }
  1512. current->position = 0;
  1513. assert (My->StackHead != NULL);
  1514. My->StackHead->line = current;
  1515. My->StackHead->ExecCode = EXEC_NORM;
  1516. /* RUN */
  1517. WARN_CLEAR; /* bwb_RUN */
  1518. My->ContinueLine = NULL;
  1519. SetOnError (0);
  1520. /* if( TRUE ) */
  1521. {
  1522. time_t t;
  1523. struct tm *lt;
  1524. time (&t);
  1525. lt = localtime (&t);
  1526. My->StartTimeInteger = lt->tm_hour;
  1527. My->StartTimeInteger *= 60;
  1528. My->StartTimeInteger += lt->tm_min;
  1529. My->StartTimeInteger *= 60;
  1530. My->StartTimeInteger += lt->tm_sec;
  1531. /* number of seconds since midnight */
  1532. }
  1533. return current;
  1534. }
  1535. /*
  1536. --------------------------------------------------------------------------------------------
  1537. CONT
  1538. --------------------------------------------------------------------------------------------
  1539. */
  1540. LineType *
  1541. bwb_CONTINUE (LineType * l)
  1542. {
  1543. /*
  1544. SYNTAX: CONTINUE
  1545. */
  1546. assert (l != NULL);
  1547. return bwb_CONT (l);
  1548. }
  1549. LineType *
  1550. bwb_CONT (LineType * l)
  1551. {
  1552. /*
  1553. SYNTAX: CONT
  1554. */
  1555. LineType *current;
  1556. assert (l != NULL);
  1557. assert (My != NULL);
  1558. assert (My->EndMarker != NULL);
  1559. assert (My->StartMarker != NULL);
  1560. current = NULL;
  1561. /* see if there is an element */
  1562. if (line_is_eol (l))
  1563. {
  1564. /* CONT */
  1565. current = My->ContinueLine;
  1566. }
  1567. else
  1568. {
  1569. /* CONT 100 */
  1570. int LineNumber;
  1571. LineNumber = 0;
  1572. if (line_read_line_number (l, &LineNumber))
  1573. {
  1574. current = find_line_number (LineNumber); /* CONT 100 */
  1575. }
  1576. }
  1577. if (current == NULL || current == My->EndMarker)
  1578. {
  1579. /* same as RUN */
  1580. current = My->StartMarker->next;
  1581. }
  1582. /*
  1583. **
  1584. ** FORCE SCAN
  1585. **
  1586. */
  1587. if (bwb_scan () == FALSE)
  1588. {
  1589. WARN_CANT_CONTINUE;
  1590. return (l);
  1591. }
  1592. current->position = 0;
  1593. bwb_clrexec ();
  1594. if (bwb_incexec ())
  1595. {
  1596. /* OK */
  1597. My->StackHead->line = current;
  1598. My->StackHead->ExecCode = EXEC_NORM;
  1599. }
  1600. else
  1601. {
  1602. /* ERROR */
  1603. WARN_OUT_OF_MEMORY;
  1604. return My->EndMarker;
  1605. }
  1606. /* CONT */
  1607. My->ContinueLine = NULL;
  1608. return current;
  1609. }
  1610. /*
  1611. --------------------------------------------------------------------------------------------
  1612. NEW
  1613. --------------------------------------------------------------------------------------------
  1614. */
  1615. void
  1616. bwb_xnew (LineType * l)
  1617. {
  1618. LineType *current;
  1619. LineType *previous;
  1620. int wait;
  1621. assert (l != NULL);
  1622. assert (My != NULL);
  1623. assert (My->EndMarker != NULL);
  1624. previous = NULL; /* JBV */
  1625. wait = TRUE;
  1626. for (current = l->next; current != My->EndMarker; current = current->next)
  1627. {
  1628. assert (current != NULL);
  1629. if (wait == FALSE)
  1630. {
  1631. free (previous);
  1632. previous = NULL;
  1633. }
  1634. wait = FALSE;
  1635. previous = current;
  1636. }
  1637. l->next = My->EndMarker;
  1638. }
  1639. static void
  1640. bwb_new ()
  1641. {
  1642. assert (My != NULL);
  1643. assert (My->StartMarker != NULL);
  1644. assert (My->DefaultVariableType != NULL);
  1645. /* clear program in memory */
  1646. bwb_xnew (My->StartMarker);
  1647. /* clear all variables */
  1648. var_CLEAR ();
  1649. /* if( TRUE ) */
  1650. {
  1651. int n;
  1652. for (n = 0; n < 26; n++)
  1653. {
  1654. My->DefaultVariableType[n] = DoubleTypeCode;
  1655. }
  1656. }
  1657. /* NEW */
  1658. WARN_CLEAR; /* bwb_new */
  1659. My->ContinueLine = NULL;
  1660. SetOnError (0);
  1661. }
  1662. LineType *
  1663. bwb_NEW (LineType * l)
  1664. {
  1665. /*
  1666. SYNTAX: NEW
  1667. */
  1668. assert (l != NULL);
  1669. assert (My != NULL);
  1670. assert (My->CurrentVersion != NULL);
  1671. bwb_new ();
  1672. if (My->CurrentVersion->OptionVersionValue & (D64 | G65 | G67 | G74))
  1673. {
  1674. if (line_is_eol (l))
  1675. {
  1676. /* NEW */
  1677. char *tbuf;
  1678. int tlen;
  1679. tbuf = My->ConsoleInput;
  1680. tlen = MAX_LINE_LENGTH;
  1681. /* prompt for the program name */
  1682. bwx_input ("NEW PROBLEM NAME:", FALSE, tbuf, tlen);
  1683. if (is_empty_string (tbuf))
  1684. {
  1685. WARN_BAD_FILE_NAME;
  1686. return l;
  1687. }
  1688. if (My->ProgramFilename != NULL)
  1689. {
  1690. free (My->ProgramFilename);
  1691. My->ProgramFilename = NULL;
  1692. }
  1693. My->ProgramFilename = bwb_strdup (tbuf);
  1694. }
  1695. else
  1696. {
  1697. /* NEW filename$ */
  1698. /* the parameter is the program name */
  1699. char *Value;
  1700. Value = NULL;
  1701. if (line_read_string_expression (l, &Value) == FALSE)
  1702. {
  1703. WARN_SYNTAX_ERROR;
  1704. return (l);
  1705. }
  1706. if (is_empty_string (Value))
  1707. {
  1708. WARN_BAD_FILE_NAME;
  1709. return l;
  1710. }
  1711. if (My->ProgramFilename != NULL)
  1712. {
  1713. free (My->ProgramFilename);
  1714. My->ProgramFilename = NULL;
  1715. }
  1716. My->ProgramFilename = Value;
  1717. }
  1718. }
  1719. else
  1720. {
  1721. /* ignore any parameters */
  1722. line_skip_eol (l);
  1723. }
  1724. return (l);
  1725. }
  1726. /*
  1727. --------------------------------------------------------------------------------------------
  1728. SCRATCH
  1729. --------------------------------------------------------------------------------------------
  1730. */
  1731. LineType *
  1732. bwb_SCRATCH (LineType * l)
  1733. {
  1734. /*
  1735. SYNTAX: SCRATCH -- same as NEW
  1736. SYNTAX: SCRATCH # filenumber -- close file and re-open for output
  1737. */
  1738. assert (l != NULL);
  1739. if (line_is_eol (l))
  1740. {
  1741. /* SCRATCH */
  1742. bwb_new ();
  1743. return (l);
  1744. }
  1745. if (line_skip_FilenumChar (l))
  1746. {
  1747. /* SCRATCH # X */
  1748. int FileNumber;
  1749. if (line_read_integer_expression (l, &FileNumber) == FALSE)
  1750. {
  1751. WARN_BAD_FILE_NUMBER;
  1752. return (l);
  1753. }
  1754. if (FileNumber < 0)
  1755. {
  1756. /* SCRATCH # -1 is silently ignored */
  1757. return (l);
  1758. }
  1759. if (FileNumber == 0)
  1760. {
  1761. /* SCRATCH # 0 is silently ignored */
  1762. return (l);
  1763. }
  1764. My->CurrentFile = find_file_by_number (FileNumber);
  1765. if (My->CurrentFile == NULL)
  1766. {
  1767. WARN_BAD_FILE_NUMBER;
  1768. return (l);
  1769. }
  1770. if (My->CurrentFile->DevMode != DEVMODE_CLOSED)
  1771. {
  1772. My->CurrentFile->DevMode = DEVMODE_CLOSED;
  1773. }
  1774. if (My->CurrentFile->cfp != NULL)
  1775. {
  1776. bwb_fclose (My->CurrentFile->cfp);
  1777. My->CurrentFile->cfp = NULL;
  1778. }
  1779. if (My->CurrentFile->buffer != NULL)
  1780. {
  1781. free (My->CurrentFile->buffer);
  1782. My->CurrentFile->buffer = NULL;
  1783. }
  1784. My->CurrentFile->width = 0;
  1785. My->CurrentFile->col = 1;
  1786. My->CurrentFile->row = 1;
  1787. My->CurrentFile->delimit = ',';
  1788. if (is_empty_string (My->CurrentFile->FileName))
  1789. {
  1790. WARN_BAD_FILE_NAME;
  1791. return (l);
  1792. }
  1793. if (bwb_strcmp (My->CurrentFile->FileName, "*") != 0)
  1794. {
  1795. if ((My->CurrentFile->cfp =
  1796. fopen (My->CurrentFile->FileName, "w")) == NULL)
  1797. {
  1798. WARN_BAD_FILE_NAME;
  1799. return (l);
  1800. }
  1801. My->CurrentFile->DevMode = DEVMODE_OUTPUT;
  1802. }
  1803. /* OK */
  1804. return (l);
  1805. }
  1806. WARN_SYNTAX_ERROR;
  1807. return (l);
  1808. }
  1809. /*
  1810. ============================================================================================
  1811. SYSTEM and so on
  1812. ============================================================================================
  1813. */
  1814. static LineType *
  1815. bwb_system (LineType * l)
  1816. {
  1817. /*
  1818. SYNTAX: SYSTEM
  1819. */
  1820. assert (l != NULL);
  1821. assert (My != NULL);
  1822. assert (My->SYSOUT != NULL);
  1823. assert (My->SYSOUT->cfp != NULL);
  1824. fprintf (My->SYSOUT->cfp, "\n");
  1825. fflush (My->SYSOUT->cfp);
  1826. bwx_terminate ();
  1827. return (l); /* never reached */
  1828. }
  1829. /*
  1830. --------------------------------------------------------------------------------------------
  1831. BYE
  1832. --------------------------------------------------------------------------------------------
  1833. */
  1834. LineType *
  1835. bwb_BYE (LineType * l)
  1836. {
  1837. /*
  1838. SYNTAX: BYE
  1839. */
  1840. assert (l != NULL);
  1841. return bwb_system (l);
  1842. }
  1843. /*
  1844. --------------------------------------------------------------------------------------------
  1845. DOS
  1846. --------------------------------------------------------------------------------------------
  1847. */
  1848. LineType *
  1849. bwb_DOS (LineType * l)
  1850. {
  1851. /*
  1852. SYNTAX: DOS
  1853. */
  1854. assert (l != NULL);
  1855. return bwb_system (l);
  1856. }
  1857. /*
  1858. --------------------------------------------------------------------------------------------
  1859. FLEX
  1860. --------------------------------------------------------------------------------------------
  1861. */
  1862. LineType *
  1863. bwb_FLEX (LineType * l)
  1864. {
  1865. /*
  1866. SYNTAX: FLEX
  1867. */
  1868. assert (l != NULL);
  1869. return bwb_system (l);
  1870. }
  1871. /*
  1872. --------------------------------------------------------------------------------------------
  1873. GOODBYE
  1874. --------------------------------------------------------------------------------------------
  1875. */
  1876. LineType *
  1877. bwb_GOODBYE (LineType * l)
  1878. {
  1879. /*
  1880. SYNTAX: GOODBYE
  1881. */
  1882. assert (l != NULL);
  1883. return bwb_system (l);
  1884. }
  1885. /*
  1886. --------------------------------------------------------------------------------------------
  1887. MON
  1888. --------------------------------------------------------------------------------------------
  1889. */
  1890. LineType *
  1891. bwb_MON (LineType * l)
  1892. {
  1893. /*
  1894. SYNTAX: MON
  1895. */
  1896. assert (l != NULL);
  1897. return bwb_system (l);
  1898. }
  1899. /*
  1900. --------------------------------------------------------------------------------------------
  1901. QUIT
  1902. --------------------------------------------------------------------------------------------
  1903. */
  1904. LineType *
  1905. bwb_QUIT (LineType * l)
  1906. {
  1907. /*
  1908. SYNTAX: QUIT
  1909. */
  1910. assert (l != NULL);
  1911. return bwb_system (l);
  1912. }
  1913. /*
  1914. --------------------------------------------------------------------------------------------
  1915. SYSTEM
  1916. --------------------------------------------------------------------------------------------
  1917. */
  1918. LineType *
  1919. bwb_SYSTEM (LineType * l)
  1920. {
  1921. /*
  1922. SYNTAX: SYSTEM
  1923. */
  1924. assert (l != NULL);
  1925. return bwb_system (l);
  1926. }
  1927. /*
  1928. ============================================================================================
  1929. LOAD and so on
  1930. ============================================================================================
  1931. */
  1932. static LineType *
  1933. bwb_load (LineType * Line, char *Prompt, int IsNew)
  1934. {
  1935. /*
  1936. **
  1937. ** load a BASIC program from a file
  1938. **
  1939. */
  1940. /*
  1941. SYNTAX: ... [filename$]
  1942. */
  1943. assert (Line != NULL);
  1944. assert (Prompt != NULL);
  1945. assert (My != NULL);
  1946. assert (My->CurrentVersion != NULL);
  1947. if (IsNew)
  1948. {
  1949. /* TRUE == LOAD */
  1950. bwb_new ();
  1951. }
  1952. else
  1953. {
  1954. /* FALSE == MERGE */
  1955. if (My->ProgramFilename != NULL)
  1956. {
  1957. free (My->ProgramFilename);
  1958. My->ProgramFilename = NULL;
  1959. }
  1960. }
  1961. if (line_is_eol (Line))
  1962. {
  1963. /* default is the last filename used by LOAD or SAVE */
  1964. /* if( My->CurrentVersion->OptionVersionValue & (D64 | G65 | G67 | G74) ) */
  1965. if (is_empty_string (My->ProgramFilename))
  1966. {
  1967. /* prompt for the program name */
  1968. char *tbuf;
  1969. int tlen;
  1970. tbuf = My->ConsoleInput;
  1971. tlen = MAX_LINE_LENGTH;
  1972. bwx_input (Prompt, FALSE, tbuf, tlen);
  1973. if (is_empty_string (tbuf))
  1974. {
  1975. WARN_BAD_FILE_NAME;
  1976. return (Line);
  1977. }
  1978. if (My->ProgramFilename != NULL)
  1979. {
  1980. free (My->ProgramFilename);
  1981. My->ProgramFilename = NULL;
  1982. }
  1983. My->ProgramFilename = bwb_strdup (tbuf);
  1984. }
  1985. fprintf (My->SYSOUT->cfp, "Loading %s\n", My->ProgramFilename);
  1986. ResetConsoleColumn ();
  1987. }
  1988. else
  1989. {
  1990. /* Get an argument for filename */
  1991. char *Value;
  1992. Value = NULL;
  1993. if (line_read_string_expression (Line, &Value) == FALSE)
  1994. {
  1995. WARN_SYNTAX_ERROR;
  1996. return (Line);
  1997. }
  1998. if (is_empty_string (Value))
  1999. {
  2000. WARN_BAD_FILE_NAME;
  2001. return (Line);
  2002. }
  2003. if (My->ProgramFilename != NULL)
  2004. {
  2005. free (My->ProgramFilename);
  2006. My->ProgramFilename = NULL;
  2007. }
  2008. My->ProgramFilename = Value;
  2009. }
  2010. if (bwb_fload (NULL) == FALSE)
  2011. {
  2012. WARN_BAD_FILE_NAME;
  2013. return (Line);
  2014. }
  2015. if (IsNew)
  2016. {
  2017. /* TRUE == LOAD */
  2018. }
  2019. else
  2020. {
  2021. /* FALSE == MERGE */
  2022. if (My->ProgramFilename != NULL)
  2023. {
  2024. free (My->ProgramFilename);
  2025. My->ProgramFilename = NULL;
  2026. }
  2027. }
  2028. /*
  2029. **
  2030. ** FORCE SCAN
  2031. **
  2032. */
  2033. if (bwb_scan () == FALSE)
  2034. {
  2035. WARN_CANT_CONTINUE;
  2036. }
  2037. return (Line);
  2038. }
  2039. /*
  2040. --------------------------------------------------------------------------------------------
  2041. CLOAD
  2042. --------------------------------------------------------------------------------------------
  2043. */
  2044. LineType *
  2045. bwb_CLOAD (LineType * Line)
  2046. {
  2047. /*
  2048. SYNTAX: CLOAD [filename$]
  2049. */
  2050. assert (Line != NULL);
  2051. return bwb_load (Line, "CLOAD FILE NAME:", TRUE);
  2052. }
  2053. /*
  2054. --------------------------------------------------------------------------------------------
  2055. LOAD
  2056. --------------------------------------------------------------------------------------------
  2057. */
  2058. LineType *
  2059. bwb_LOAD (LineType * Line)
  2060. {
  2061. /*
  2062. SYNTAX: LOAD [filename$]
  2063. */
  2064. assert (Line != NULL);
  2065. return bwb_load (Line, "LOAD FILE NAME:", TRUE);
  2066. }
  2067. /*
  2068. --------------------------------------------------------------------------------------------
  2069. MERGE
  2070. --------------------------------------------------------------------------------------------
  2071. */
  2072. LineType *
  2073. bwb_MERGE (LineType * l)
  2074. {
  2075. /*
  2076. SYNTAX: MERGE [filename$]
  2077. */
  2078. assert (l != NULL);
  2079. return bwb_load (l, "MERGE FILE NAME:", FALSE);
  2080. }
  2081. /*
  2082. --------------------------------------------------------------------------------------------
  2083. OLD
  2084. --------------------------------------------------------------------------------------------
  2085. */
  2086. LineType *
  2087. bwb_OLD (LineType * Line)
  2088. {
  2089. /*
  2090. SYNTAX: OLD [filename$]
  2091. */
  2092. assert (Line != NULL);
  2093. return bwb_load (Line, "OLD PROBLEM NAME:", TRUE);
  2094. }
  2095. /*
  2096. --------------------------------------------------------------------------------------------
  2097. TLOAD
  2098. --------------------------------------------------------------------------------------------
  2099. */
  2100. LineType *
  2101. bwb_TLOAD (LineType * Line)
  2102. {
  2103. /*
  2104. SYNTAX: TLOAD [filename$]
  2105. */
  2106. assert (Line != NULL);
  2107. return bwb_load (Line, "TLOAD FILE NAME:", TRUE);
  2108. }
  2109. /*
  2110. --------------------------------------------------------------------------------------------
  2111. RENAME
  2112. --------------------------------------------------------------------------------------------
  2113. */
  2114. static LineType *
  2115. H14_RENAME (LineType * l)
  2116. {
  2117. /*
  2118. SYNTAX: RENAME from$ TO to$
  2119. */
  2120. char *From;
  2121. char *To;
  2122. assert (l != NULL);
  2123. From = NULL;
  2124. To = NULL;
  2125. if (line_read_string_expression (l, &From) == FALSE)
  2126. {
  2127. WARN_SYNTAX_ERROR;
  2128. return (l);
  2129. }
  2130. if (is_empty_string (From))
  2131. {
  2132. WARN_BAD_FILE_NAME;
  2133. return (l);
  2134. }
  2135. if (line_skip_word (l, "TO") == FALSE)
  2136. {
  2137. WARN_SYNTAX_ERROR;
  2138. return (l);
  2139. }
  2140. if (line_read_string_expression (l, &To) == FALSE)
  2141. {
  2142. WARN_SYNTAX_ERROR;
  2143. return (l);
  2144. }
  2145. if (is_empty_string (To))
  2146. {
  2147. WARN_BAD_FILE_NAME;
  2148. return (l);
  2149. }
  2150. if (rename (From, To))
  2151. {
  2152. WARN_BAD_FILE_NAME;
  2153. return (l);
  2154. }
  2155. return (l);
  2156. }
  2157. LineType *
  2158. bwb_RENAME (LineType * l)
  2159. {
  2160. /*
  2161. SYNTAX: RENAME filename$
  2162. */
  2163. assert (l != NULL);
  2164. assert( My != NULL );
  2165. assert( My->CurrentVersion != NULL );
  2166. assert( My->ConsoleInput != NULL );
  2167. if (My->CurrentVersion->OptionVersionValue & (H14))
  2168. {
  2169. /* RENAME == change an exisiting file's name */
  2170. return H14_RENAME (l);
  2171. }
  2172. /* RENAME == change the BASIC program's name for a later SAVE */
  2173. if (line_is_eol (l))
  2174. {
  2175. /* RENAME */
  2176. if (My->CurrentVersion->OptionVersionValue & (D64 | G65 | G67 | G74))
  2177. {
  2178. /* prompt for the program name */
  2179. char *tbuf;
  2180. int tlen;
  2181. tbuf = My->ConsoleInput;
  2182. tlen = MAX_LINE_LENGTH;
  2183. bwx_input ("RENAME PROBLEM NAME:", FALSE, tbuf, tlen);
  2184. if (is_empty_string (tbuf))
  2185. {
  2186. WARN_BAD_FILE_NAME;
  2187. return (l);
  2188. }
  2189. if (My->ProgramFilename != NULL)
  2190. {
  2191. free (My->ProgramFilename);
  2192. My->ProgramFilename = NULL;
  2193. }
  2194. My->ProgramFilename = bwb_strdup (tbuf);
  2195. }
  2196. else
  2197. {
  2198. WARN_SYNTAX_ERROR;
  2199. return (l);
  2200. }
  2201. }
  2202. else
  2203. {
  2204. /* RENAME value$ */
  2205. char *Value;
  2206. Value = NULL;
  2207. if (line_read_string_expression (l, &Value) == FALSE)
  2208. {
  2209. WARN_SYNTAX_ERROR;
  2210. return (l);
  2211. }
  2212. if (is_empty_string (Value))
  2213. {
  2214. WARN_BAD_FILE_NAME;
  2215. return (l);
  2216. }
  2217. if (My->ProgramFilename != NULL)
  2218. {
  2219. free (My->ProgramFilename);
  2220. My->ProgramFilename = NULL;
  2221. }
  2222. My->ProgramFilename = Value;
  2223. }
  2224. return (l);
  2225. }
  2226. /*
  2227. --------------------------------------------------------------------------------------------
  2228. MAT
  2229. --------------------------------------------------------------------------------------------
  2230. */
  2231. extern void
  2232. Determinant (VariableType * v)
  2233. {
  2234. /* http://easy-learn-c-language.blogspot.com/search/label/Numerical%20Methods */
  2235. /* Numerical Methods: Determinant of nxn matrix using C */
  2236. DoubleType **matrix;
  2237. DoubleType ratio;
  2238. int i;
  2239. int j;
  2240. int k;
  2241. int n;
  2242. assert (v != NULL);
  2243. assert( My != NULL );
  2244. My->LastDeterminant = 0; /* default */
  2245. n = v->UBOUND[0] - v->LBOUND[0] + 1;
  2246. if ((matrix = (DoubleType **) calloc (n, sizeof (DoubleType *))) == NULL)
  2247. {
  2248. goto EXIT;
  2249. }
  2250. assert( matrix != NULL );
  2251. for (i = 0; i < n; i++)
  2252. {
  2253. if ((matrix[i] = (DoubleType *) calloc (n, sizeof (DoubleType))) == NULL)
  2254. {
  2255. goto EXIT;
  2256. }
  2257. assert( matrix[i] != NULL );
  2258. }
  2259. for (i = 0; i < n; i++)
  2260. {
  2261. for (j = 0; j < n; j++)
  2262. {
  2263. VariantType variant;
  2264. CLEAR_VARIANT (&variant);
  2265. v->VINDEX[0] = v->LBOUND[0] + i;
  2266. v->VINDEX[1] = v->LBOUND[1] + j;
  2267. if (var_get (v, &variant) == FALSE)
  2268. {
  2269. WARN_VARIABLE_NOT_DECLARED;
  2270. goto EXIT;
  2271. }
  2272. if (variant.VariantTypeCode == StringTypeCode)
  2273. {
  2274. WARN_TYPE_MISMATCH;
  2275. goto EXIT;
  2276. }
  2277. matrix[i][j] = variant.Number;
  2278. }
  2279. }
  2280. /* Conversion of matrix to upper triangular */
  2281. for (i = 0; i < n; i++)
  2282. {
  2283. for (j = 0; j < n; j++)
  2284. {
  2285. if (j > i)
  2286. {
  2287. if (matrix[i][i] == 0)
  2288. {
  2289. /* - Evaluation of an expression results in division
  2290. * by zero (nonfatal, the recommended recovery
  2291. * procedure is to supply machine infinity with the
  2292. * sign of the numerator and continue)
  2293. */
  2294. if (WARN_DIVISION_BY_ZERO)
  2295. {
  2296. /* ERROR */
  2297. goto EXIT;
  2298. }
  2299. /* CONTINUE */
  2300. if (matrix[j][i] < 0)
  2301. {
  2302. ratio = MINDBL;
  2303. }
  2304. else
  2305. {
  2306. ratio = MAXDBL;
  2307. }
  2308. }
  2309. else
  2310. {
  2311. ratio = matrix[j][i] / matrix[i][i];
  2312. }
  2313. for (k = 0; k < n; k++)
  2314. {
  2315. matrix[j][k] -= ratio * matrix[i][k];
  2316. }
  2317. }
  2318. }
  2319. }
  2320. My->LastDeterminant = 1; /* storage for determinant */
  2321. for (i = 0; i < n; i++)
  2322. {
  2323. DoubleType Value;
  2324. Value = matrix[i][i];
  2325. My->LastDeterminant *= Value;
  2326. }
  2327. EXIT:
  2328. if( matrix != NULL )
  2329. {
  2330. for (i = 0; i < n; i++)
  2331. {
  2332. if( matrix[i] != NULL )
  2333. {
  2334. free (matrix[i]);
  2335. /* matrix[i] = NULL; */
  2336. }
  2337. }
  2338. free (matrix);
  2339. /* matrix = NULL; */
  2340. }
  2341. }
  2342. int
  2343. InvertMatrix (VariableType * vOut, VariableType * vIn)
  2344. {
  2345. /* http://easy-learn-c-language.blogspot.com/search/label/Numerical%20Methods */
  2346. /* Numerical Methods: Inverse of nxn matrix using C */
  2347. int Result;
  2348. DoubleType **matrix;
  2349. DoubleType ratio;
  2350. int i;
  2351. int j;
  2352. int k;
  2353. int n;
  2354. assert (vOut != NULL);
  2355. assert (vIn != NULL);
  2356. Result = FALSE;
  2357. n = vIn->UBOUND[0] - vIn->LBOUND[0] + 1;
  2358. if ((matrix = (DoubleType **) calloc (n, sizeof (DoubleType *))) == NULL)
  2359. {
  2360. goto EXIT;
  2361. }
  2362. assert( matrix != NULL );
  2363. for (i = 0; i < n; i++)
  2364. {
  2365. if ((matrix[i] =
  2366. (DoubleType *) calloc (n + n, sizeof (DoubleType))) == NULL)
  2367. {
  2368. goto EXIT;
  2369. }
  2370. assert( matrix[i] != NULL );
  2371. }
  2372. for (i = 0; i < n; i++)
  2373. {
  2374. for (j = 0; j < n; j++)
  2375. {
  2376. VariantType variant;
  2377. CLEAR_VARIANT (&variant);
  2378. vIn->VINDEX[0] = vIn->LBOUND[0] + i;
  2379. vIn->VINDEX[1] = vIn->LBOUND[1] + j;
  2380. if (var_get (vIn, &variant) == FALSE)
  2381. {
  2382. WARN_VARIABLE_NOT_DECLARED;
  2383. goto EXIT;
  2384. }
  2385. if (variant.VariantTypeCode == StringTypeCode)
  2386. {
  2387. WARN_TYPE_MISMATCH;
  2388. goto EXIT;
  2389. }
  2390. matrix[i][j] = variant.Number;
  2391. }
  2392. }
  2393. for (i = 0; i < n; i++)
  2394. {
  2395. for (j = n; j < 2 * n; j++)
  2396. {
  2397. if (i == (j - n))
  2398. {
  2399. matrix[i][j] = 1.0;
  2400. }
  2401. else
  2402. {
  2403. matrix[i][j] = 0.0;
  2404. }
  2405. }
  2406. }
  2407. for (i = 0; i < n; i++)
  2408. {
  2409. for (j = 0; j < n; j++)
  2410. {
  2411. if (i != j)
  2412. {
  2413. if (matrix[i][i] == 0)
  2414. {
  2415. /* - Evaluation of an expression results in division
  2416. * by zero (nonfatal, the recommended recovery
  2417. * procedure is to supply machine infinity with the
  2418. * sign of the numerator and continue)
  2419. */
  2420. if (WARN_DIVISION_BY_ZERO)
  2421. {
  2422. /* ERROR */
  2423. goto EXIT;
  2424. }
  2425. /* CONTINUE */
  2426. if (matrix[j][i] < 0)
  2427. {
  2428. ratio = MINDBL;
  2429. }
  2430. else
  2431. {
  2432. ratio = MAXDBL;
  2433. }
  2434. }
  2435. else
  2436. {
  2437. ratio = matrix[j][i] / matrix[i][i];
  2438. }
  2439. for (k = 0; k < 2 * n; k++)
  2440. {
  2441. matrix[j][k] -= ratio * matrix[i][k];
  2442. }
  2443. }
  2444. }
  2445. }
  2446. for (i = 0; i < n; i++)
  2447. {
  2448. DoubleType a;
  2449. a = matrix[i][i];
  2450. if (a == 0)
  2451. {
  2452. /* - Evaluation of an expression results in division
  2453. * by zero (nonfatal, the recommended recovery
  2454. * procedure is to supply machine infinity with the
  2455. * sign of the numerator and continue)
  2456. */
  2457. if (WARN_DIVISION_BY_ZERO)
  2458. {
  2459. /* ERROR */
  2460. goto EXIT;
  2461. }
  2462. /* CONTINUE */
  2463. for (j = 0; j < 2 * n; j++)
  2464. {
  2465. if (matrix[i][j] < 0)
  2466. {
  2467. matrix[i][j] = MINDBL;
  2468. }
  2469. else
  2470. {
  2471. matrix[i][j] = MAXDBL;
  2472. }
  2473. }
  2474. }
  2475. else
  2476. {
  2477. for (j = 0; j < 2 * n; j++)
  2478. {
  2479. matrix[i][j] /= a;
  2480. }
  2481. }
  2482. }
  2483. for (i = 0; i < n; i++)
  2484. {
  2485. for (j = 0; j < n; j++)
  2486. {
  2487. VariantType variant;
  2488. CLEAR_VARIANT (&variant);
  2489. vOut->VINDEX[0] = vOut->LBOUND[0] + i;
  2490. vOut->VINDEX[1] = vOut->LBOUND[0] + j;
  2491. variant.VariantTypeCode = vOut->VariableTypeCode;
  2492. variant.Number = matrix[i][j + n];
  2493. if (var_set (vOut, &variant) == FALSE)
  2494. {
  2495. WARN_VARIABLE_NOT_DECLARED;
  2496. goto EXIT;
  2497. }
  2498. }
  2499. }
  2500. /*
  2501. **
  2502. ** Everything is OK
  2503. **
  2504. */
  2505. Result = TRUE;
  2506. EXIT:
  2507. if (matrix != NULL)
  2508. {
  2509. for (i = 0; i < n; i++)
  2510. {
  2511. if (matrix[i] != NULL)
  2512. {
  2513. free (matrix[i]);
  2514. /* matrix[i] = NULL; */
  2515. }
  2516. }
  2517. free (matrix);
  2518. /* matrix = NULL; */
  2519. }
  2520. return Result;
  2521. }
  2522. static int
  2523. line_read_matrix_redim (LineType * l, VariableType * v)
  2524. {
  2525. /* get OPTIONAL parameters if the variable is dimensioned */
  2526. assert (l != NULL);
  2527. assert (v != NULL);
  2528. if (line_peek_LparenChar (l))
  2529. {
  2530. /* get requested size, which is <= original array size */
  2531. size_t array_units;
  2532. int n;
  2533. int dimensions;
  2534. int LBOUND[MAX_DIMS];
  2535. int UBOUND[MAX_DIMS];
  2536. if (line_read_array_redim (l, &dimensions, LBOUND, UBOUND) == FALSE)
  2537. {
  2538. WARN_SYNTAX_ERROR;
  2539. return FALSE;
  2540. }
  2541. /* update array dimensions */
  2542. array_units = 1;
  2543. for (n = 0; n < dimensions; n++)
  2544. {
  2545. if (UBOUND[n] < LBOUND[n])
  2546. {
  2547. WARN_SUBSCRIPT_OUT_OF_RANGE;
  2548. return FALSE;
  2549. }
  2550. array_units *= UBOUND[n] - LBOUND[n] + 1;
  2551. }
  2552. if (array_units > v->array_units)
  2553. {
  2554. WARN_SUBSCRIPT_OUT_OF_RANGE;
  2555. return FALSE;
  2556. }
  2557. v->dimensions = dimensions;
  2558. for (n = 0; n < dimensions; n++)
  2559. {
  2560. v->LBOUND[n] = LBOUND[n];
  2561. v->UBOUND[n] = UBOUND[n];
  2562. }
  2563. }
  2564. return TRUE;
  2565. }
  2566. LineType *
  2567. bwb_MAT (LineType * l)
  2568. {
  2569. /*
  2570. SYNTAX: MAT A = CON
  2571. SYNTAX: MAT A = IDN
  2572. SYNTAX: MAT A = ZER
  2573. SYNTAX: MAT A = INV B
  2574. SYNTAX: MAT A = TRN B
  2575. SYNTAX: MAT A = (k) * B
  2576. SYNTAX: MAT A = B
  2577. SYNTAX: MAT A = B + C
  2578. SYNTAX: MAT A = B - C
  2579. SYNTAX: MAT A = B * C
  2580. */
  2581. VariableType *v_A;
  2582. char varname_A[NameLengthMax + 1];
  2583. assert (l != NULL);
  2584. /* just a placeholder for now. this will grow. */
  2585. if (line_read_varname (l, varname_A) == FALSE)
  2586. {
  2587. WARN_SYNTAX_ERROR;
  2588. return (l);
  2589. }
  2590. v_A = mat_find (varname_A);
  2591. if (v_A == NULL)
  2592. {
  2593. WARN_VARIABLE_NOT_DECLARED;
  2594. return (l);
  2595. }
  2596. /* variable MUST be numeric */
  2597. if (VAR_IS_STRING (v_A))
  2598. {
  2599. WARN_SYNTAX_ERROR;
  2600. return (l);
  2601. }
  2602. if (line_read_matrix_redim (l, v_A) == FALSE)
  2603. {
  2604. WARN_SYNTAX_ERROR;
  2605. return (l);
  2606. }
  2607. if (line_skip_EqualChar (l) == FALSE)
  2608. {
  2609. WARN_SYNTAX_ERROR;
  2610. return (l);
  2611. }
  2612. /* MAT A = ... */
  2613. if (line_skip_word (l, "CON"))
  2614. {
  2615. /* MAT A = CON */
  2616. /* MAT A = CON(I) */
  2617. /* MAT A = CON(I,J) */
  2618. /* MAT A = CON(I,J,K) */
  2619. /* OK */
  2620. int i;
  2621. int j;
  2622. int k;
  2623. if (line_read_matrix_redim (l, v_A) == FALSE)
  2624. {
  2625. WARN_SYNTAX_ERROR;
  2626. return (l);
  2627. }
  2628. /* both arrays are of the same size */
  2629. switch (v_A->dimensions)
  2630. {
  2631. case 1:
  2632. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  2633. {
  2634. VariantType variant;
  2635. CLEAR_VARIANT (&variant);
  2636. variant.VariantTypeCode = v_A->VariableTypeCode;
  2637. variant.Number = 1;
  2638. v_A->VINDEX[0] = i;
  2639. if (var_set (v_A, &variant) == FALSE)
  2640. {
  2641. WARN_VARIABLE_NOT_DECLARED;
  2642. return (l);
  2643. }
  2644. }
  2645. break;
  2646. case 2:
  2647. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  2648. {
  2649. for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
  2650. {
  2651. VariantType variant;
  2652. CLEAR_VARIANT (&variant);
  2653. variant.VariantTypeCode = v_A->VariableTypeCode;
  2654. variant.Number = 1;
  2655. v_A->VINDEX[0] = i;
  2656. v_A->VINDEX[1] = j;
  2657. if (var_set (v_A, &variant) == FALSE)
  2658. {
  2659. WARN_VARIABLE_NOT_DECLARED;
  2660. return (l);
  2661. }
  2662. }
  2663. }
  2664. break;
  2665. case 3:
  2666. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  2667. {
  2668. for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
  2669. {
  2670. for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++)
  2671. {
  2672. VariantType variant;
  2673. CLEAR_VARIANT (&variant);
  2674. variant.VariantTypeCode = v_A->VariableTypeCode;
  2675. variant.Number = 1;
  2676. v_A->VINDEX[0] = i;
  2677. v_A->VINDEX[1] = j;
  2678. v_A->VINDEX[2] = k;
  2679. if (var_set (v_A, &variant) == FALSE)
  2680. {
  2681. WARN_VARIABLE_NOT_DECLARED;
  2682. return (l);
  2683. }
  2684. }
  2685. }
  2686. }
  2687. break;
  2688. default:
  2689. WARN_SYNTAX_ERROR;
  2690. return (l);
  2691. }
  2692. }
  2693. else if (line_skip_word (l, "IDN"))
  2694. {
  2695. /* MAT A = IDN */
  2696. /* MAT A = IDN(I,J) */
  2697. /* OK */
  2698. int i;
  2699. int j;
  2700. if (line_read_matrix_redim (l, v_A) == FALSE)
  2701. {
  2702. WARN_SYNTAX_ERROR;
  2703. return (l);
  2704. }
  2705. if (v_A->dimensions != 2)
  2706. {
  2707. WARN_SUBSCRIPT_OUT_OF_RANGE;
  2708. return (l);
  2709. }
  2710. if (v_A->LBOUND[0] != v_A->LBOUND[1])
  2711. {
  2712. WARN_SUBSCRIPT_OUT_OF_RANGE;
  2713. return (l);
  2714. }
  2715. if (v_A->UBOUND[0] != v_A->UBOUND[1])
  2716. {
  2717. WARN_SUBSCRIPT_OUT_OF_RANGE;
  2718. return (l);
  2719. }
  2720. /* square matrix */
  2721. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  2722. {
  2723. for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
  2724. {
  2725. VariantType variant;
  2726. CLEAR_VARIANT (&variant);
  2727. variant.VariantTypeCode = v_A->VariableTypeCode;
  2728. if (i == j)
  2729. {
  2730. variant.Number = 1;
  2731. }
  2732. else
  2733. {
  2734. variant.Number = 0;
  2735. }
  2736. v_A->VINDEX[0] = i;
  2737. v_A->VINDEX[1] = j;
  2738. if (var_set (v_A, &variant) == FALSE)
  2739. {
  2740. WARN_VARIABLE_NOT_DECLARED;
  2741. return (l);
  2742. }
  2743. }
  2744. }
  2745. }
  2746. else if (line_skip_word (l, "ZER"))
  2747. {
  2748. /* MAT A = ZER */
  2749. /* MAT A = ZER(I) */
  2750. /* MAT A = ZER(I,J) */
  2751. /* MAT A = ZER(I,J,K) */
  2752. /* OK */
  2753. int i;
  2754. int j;
  2755. int k;
  2756. if (line_read_matrix_redim (l, v_A) == FALSE)
  2757. {
  2758. WARN_SYNTAX_ERROR;
  2759. return (l);
  2760. }
  2761. /* both arrays are of the same size */
  2762. switch (v_A->dimensions)
  2763. {
  2764. case 1:
  2765. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  2766. {
  2767. VariantType variant;
  2768. CLEAR_VARIANT (&variant);
  2769. variant.VariantTypeCode = v_A->VariableTypeCode;
  2770. variant.Number = 0;
  2771. v_A->VINDEX[0] = i;
  2772. if (var_set (v_A, &variant) == FALSE)
  2773. {
  2774. WARN_VARIABLE_NOT_DECLARED;
  2775. return (l);
  2776. }
  2777. }
  2778. break;
  2779. case 2:
  2780. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  2781. {
  2782. for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
  2783. {
  2784. VariantType variant;
  2785. CLEAR_VARIANT (&variant);
  2786. variant.VariantTypeCode = v_A->VariableTypeCode;
  2787. variant.Number = 0;
  2788. v_A->VINDEX[0] = i;
  2789. v_A->VINDEX[1] = j;
  2790. if (var_set (v_A, &variant) == FALSE)
  2791. {
  2792. WARN_VARIABLE_NOT_DECLARED;
  2793. return (l);
  2794. }
  2795. }
  2796. }
  2797. break;
  2798. case 3:
  2799. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  2800. {
  2801. for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
  2802. {
  2803. for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++)
  2804. {
  2805. VariantType variant;
  2806. CLEAR_VARIANT (&variant);
  2807. variant.VariantTypeCode = v_A->VariableTypeCode;
  2808. variant.Number = 0;
  2809. v_A->VINDEX[0] = i;
  2810. v_A->VINDEX[1] = j;
  2811. v_A->VINDEX[2] = k;
  2812. if (var_set (v_A, &variant) == FALSE)
  2813. {
  2814. WARN_VARIABLE_NOT_DECLARED;
  2815. return (l);
  2816. }
  2817. }
  2818. }
  2819. }
  2820. break;
  2821. default:
  2822. WARN_SYNTAX_ERROR;
  2823. return (l);
  2824. }
  2825. }
  2826. else if (line_skip_word (l, "INV"))
  2827. {
  2828. /* MAT A = INV B */
  2829. /* MAT A = INV( B ) */
  2830. /* OK */
  2831. VariableType *v_B;
  2832. char varname_B[NameLengthMax + 1];
  2833. if (v_A->dimensions != 2)
  2834. {
  2835. WARN_SYNTAX_ERROR;
  2836. return (l);
  2837. }
  2838. if (v_A->LBOUND[0] != v_A->LBOUND[1] || v_A->UBOUND[0] != v_A->UBOUND[1])
  2839. {
  2840. WARN_SUBSCRIPT_OUT_OF_RANGE;
  2841. return (l);
  2842. }
  2843. if (line_skip_LparenChar (l))
  2844. {
  2845. /* optional */
  2846. }
  2847. if (line_read_varname (l, varname_B) == FALSE)
  2848. {
  2849. WARN_SYNTAX_ERROR;
  2850. return (l);
  2851. }
  2852. if ((v_B = mat_find (varname_B)) == NULL)
  2853. {
  2854. WARN_VARIABLE_NOT_DECLARED;
  2855. return (l);
  2856. }
  2857. /* variable MUST be numeric */
  2858. if (VAR_IS_STRING (v_B))
  2859. {
  2860. WARN_SYNTAX_ERROR;
  2861. return (l);
  2862. }
  2863. if (line_read_matrix_redim (l, v_B) == FALSE)
  2864. {
  2865. WARN_SYNTAX_ERROR;
  2866. return (l);
  2867. }
  2868. if (line_skip_RparenChar (l))
  2869. {
  2870. /* optional */
  2871. }
  2872. if (v_B->dimensions != 2)
  2873. {
  2874. WARN_SYNTAX_ERROR;
  2875. return (l);
  2876. }
  2877. if (v_B->LBOUND[0] != v_B->LBOUND[1] || v_B->UBOUND[0] != v_B->UBOUND[1])
  2878. {
  2879. WARN_SUBSCRIPT_OUT_OF_RANGE;
  2880. return (l);
  2881. }
  2882. if (v_A->LBOUND[0] != v_B->LBOUND[0] || v_A->UBOUND[0] != v_B->UBOUND[0])
  2883. {
  2884. WARN_SUBSCRIPT_OUT_OF_RANGE;
  2885. return (l);
  2886. }
  2887. /* square matrix */
  2888. Determinant (v_B);
  2889. if (My->LastDeterminant == 0)
  2890. {
  2891. WARN_ILLEGAL_FUNCTION_CALL;
  2892. return (l);
  2893. }
  2894. if (InvertMatrix (v_A, v_B) == FALSE)
  2895. {
  2896. WARN_ILLEGAL_FUNCTION_CALL;
  2897. return (l);
  2898. }
  2899. }
  2900. else if (line_skip_word (l, "TRN"))
  2901. {
  2902. /* MAT A = TRN B */
  2903. /* MAT A = TRN( B ) */
  2904. /* OK */
  2905. int i;
  2906. int j;
  2907. VariableType *v_B;
  2908. char varname_B[NameLengthMax + 1];
  2909. if (v_A->dimensions != 2)
  2910. {
  2911. WARN_SYNTAX_ERROR;
  2912. return (l);
  2913. }
  2914. if (line_skip_LparenChar (l))
  2915. {
  2916. /* optional */
  2917. }
  2918. if (line_read_varname (l, varname_B) == FALSE)
  2919. {
  2920. WARN_SYNTAX_ERROR;
  2921. return (l);
  2922. }
  2923. if ((v_B = mat_find (varname_B)) == NULL)
  2924. {
  2925. WARN_VARIABLE_NOT_DECLARED;
  2926. return (l);
  2927. }
  2928. /* variable MUST be numeric */
  2929. if (VAR_IS_STRING (v_B))
  2930. {
  2931. WARN_SYNTAX_ERROR;
  2932. return (l);
  2933. }
  2934. if (line_read_matrix_redim (l, v_B) == FALSE)
  2935. {
  2936. WARN_SYNTAX_ERROR;
  2937. return (l);
  2938. }
  2939. if (line_skip_RparenChar (l))
  2940. {
  2941. /* optional */
  2942. }
  2943. if (v_B->dimensions != 2)
  2944. {
  2945. WARN_SYNTAX_ERROR;
  2946. return (l);
  2947. }
  2948. /* MxN */
  2949. if (v_A->LBOUND[0] != v_B->LBOUND[1] || v_A->UBOUND[0] != v_B->UBOUND[1])
  2950. {
  2951. WARN_SYNTAX_ERROR;
  2952. return (l);
  2953. }
  2954. if (v_A->LBOUND[1] != v_B->LBOUND[0] || v_A->UBOUND[1] != v_B->UBOUND[0])
  2955. {
  2956. WARN_SYNTAX_ERROR;
  2957. return (l);
  2958. }
  2959. /* transpose matrix */
  2960. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  2961. {
  2962. for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
  2963. {
  2964. VariantType variant;
  2965. CLEAR_VARIANT (&variant);
  2966. v_B->VINDEX[1] = i;
  2967. v_B->VINDEX[0] = j;
  2968. if (var_get (v_B, &variant) == FALSE)
  2969. {
  2970. WARN_VARIABLE_NOT_DECLARED;
  2971. return (l);
  2972. }
  2973. v_A->VINDEX[0] = i;
  2974. v_A->VINDEX[1] = j;
  2975. if (var_set (v_A, &variant) == FALSE)
  2976. {
  2977. WARN_VARIABLE_NOT_DECLARED;
  2978. return (l);
  2979. }
  2980. }
  2981. }
  2982. }
  2983. else if (line_peek_LparenChar (l))
  2984. {
  2985. /* MAT A = (k) * B */
  2986. DoubleType Multiplier;
  2987. VariableType *v_B;
  2988. int i;
  2989. int j;
  2990. int k;
  2991. char *E;
  2992. int p;
  2993. char varname_B[NameLengthMax + 1];
  2994. char *tbuf;
  2995. tbuf = My->ConsoleInput;
  2996. bwb_strcpy (tbuf, &(l->buffer[l->position]));
  2997. E = bwb_strrchr (tbuf, '*');
  2998. if (E == NULL)
  2999. {
  3000. WARN_SYNTAX_ERROR;
  3001. return (l);
  3002. }
  3003. *E = NulChar;
  3004. p = 0;
  3005. if (buff_read_numeric_expression (tbuf, &p, &Multiplier) == FALSE)
  3006. {
  3007. WARN_SYNTAX_ERROR;
  3008. return (l);
  3009. }
  3010. l->position += p;
  3011. if (line_skip_StarChar (l) == FALSE)
  3012. {
  3013. WARN_SYNTAX_ERROR;
  3014. return (l);
  3015. }
  3016. if (line_read_varname (l, varname_B) == FALSE)
  3017. {
  3018. WARN_SYNTAX_ERROR;
  3019. return (l);
  3020. }
  3021. if ((v_B = mat_find (varname_B)) == NULL)
  3022. {
  3023. WARN_VARIABLE_NOT_DECLARED;
  3024. return (l);
  3025. }
  3026. /* variable MUST be numeric */
  3027. if (VAR_IS_STRING (v_B))
  3028. {
  3029. WARN_SYNTAX_ERROR;
  3030. return (l);
  3031. }
  3032. if (line_read_matrix_redim (l, v_B) == FALSE)
  3033. {
  3034. WARN_SYNTAX_ERROR;
  3035. return (l);
  3036. }
  3037. if (v_A->dimensions != v_B->dimensions)
  3038. {
  3039. WARN_SYNTAX_ERROR;
  3040. return (l);
  3041. }
  3042. /* both arrays are of the same size */
  3043. switch (v_A->dimensions)
  3044. {
  3045. case 1:
  3046. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  3047. {
  3048. VariantType variant;
  3049. CLEAR_VARIANT (&variant);
  3050. v_B->VINDEX[0] = i;
  3051. if (var_get (v_B, &variant) == FALSE)
  3052. {
  3053. WARN_VARIABLE_NOT_DECLARED;
  3054. return (l);
  3055. }
  3056. variant.Number *= Multiplier;
  3057. v_A->VINDEX[0] = i;
  3058. if (var_set (v_A, &variant) == FALSE)
  3059. {
  3060. WARN_VARIABLE_NOT_DECLARED;
  3061. return (l);
  3062. }
  3063. }
  3064. break;
  3065. case 2:
  3066. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  3067. {
  3068. for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
  3069. {
  3070. VariantType variant;
  3071. CLEAR_VARIANT (&variant);
  3072. v_B->VINDEX[0] = i;
  3073. v_B->VINDEX[1] = j;
  3074. if (var_get (v_B, &variant) == FALSE)
  3075. {
  3076. WARN_VARIABLE_NOT_DECLARED;
  3077. return (l);
  3078. }
  3079. variant.Number *= Multiplier;
  3080. v_A->VINDEX[0] = i;
  3081. v_A->VINDEX[1] = j;
  3082. if (var_set (v_A, &variant) == FALSE)
  3083. {
  3084. WARN_VARIABLE_NOT_DECLARED;
  3085. return (l);
  3086. }
  3087. }
  3088. }
  3089. break;
  3090. case 3:
  3091. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  3092. {
  3093. for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
  3094. {
  3095. for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++)
  3096. {
  3097. VariantType variant;
  3098. CLEAR_VARIANT (&variant);
  3099. v_B->VINDEX[0] = i;
  3100. v_B->VINDEX[1] = j;
  3101. v_B->VINDEX[2] = k;
  3102. if (var_get (v_B, &variant) == FALSE)
  3103. {
  3104. WARN_VARIABLE_NOT_DECLARED;
  3105. return (l);
  3106. }
  3107. variant.Number *= Multiplier;
  3108. v_A->VINDEX[0] = i;
  3109. v_A->VINDEX[1] = j;
  3110. v_A->VINDEX[2] = k;
  3111. if (var_set (v_A, &variant) == FALSE)
  3112. {
  3113. WARN_VARIABLE_NOT_DECLARED;
  3114. return (l);
  3115. }
  3116. }
  3117. }
  3118. }
  3119. break;
  3120. default:
  3121. WARN_SYNTAX_ERROR;
  3122. return (l);
  3123. }
  3124. }
  3125. else
  3126. {
  3127. /* MAT A = B */
  3128. /* MAT A = B + C */
  3129. /* MAT A = B - C */
  3130. /* MAT A = B * C */
  3131. VariableType *v_B;
  3132. char varname_B[NameLengthMax + 1];
  3133. if (line_read_varname (l, varname_B) == FALSE)
  3134. {
  3135. WARN_SYNTAX_ERROR;
  3136. return (l);
  3137. }
  3138. if ((v_B = mat_find (varname_B)) == NULL)
  3139. {
  3140. WARN_VARIABLE_NOT_DECLARED;
  3141. return (l);
  3142. }
  3143. /* variable MUST be numeric */
  3144. if (VAR_IS_STRING (v_B))
  3145. {
  3146. WARN_SYNTAX_ERROR;
  3147. return (l);
  3148. }
  3149. if (line_read_matrix_redim (l, v_B) == FALSE)
  3150. {
  3151. WARN_SYNTAX_ERROR;
  3152. return (l);
  3153. }
  3154. if (line_is_eol (l))
  3155. {
  3156. /* MAT A = B */
  3157. /* OK */
  3158. int i;
  3159. int j;
  3160. int k;
  3161. if (v_A->dimensions != v_B->dimensions)
  3162. {
  3163. WARN_SYNTAX_ERROR;
  3164. return (l);
  3165. }
  3166. /* both arrays are of the same size */
  3167. switch (v_A->dimensions)
  3168. {
  3169. case 1:
  3170. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  3171. {
  3172. VariantType variant;
  3173. CLEAR_VARIANT (&variant);
  3174. v_B->VINDEX[0] = i;
  3175. if (var_get (v_B, &variant) == FALSE)
  3176. {
  3177. WARN_VARIABLE_NOT_DECLARED;
  3178. return (l);
  3179. }
  3180. v_A->VINDEX[0] = i;
  3181. if (var_set (v_A, &variant) == FALSE)
  3182. {
  3183. WARN_VARIABLE_NOT_DECLARED;
  3184. return (l);
  3185. }
  3186. }
  3187. break;
  3188. case 2:
  3189. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  3190. {
  3191. for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
  3192. {
  3193. VariantType variant;
  3194. CLEAR_VARIANT (&variant);
  3195. v_B->VINDEX[0] = i;
  3196. v_B->VINDEX[1] = j;
  3197. if (var_get (v_B, &variant) == FALSE)
  3198. {
  3199. WARN_VARIABLE_NOT_DECLARED;
  3200. return (l);
  3201. }
  3202. v_A->VINDEX[0] = i;
  3203. v_A->VINDEX[1] = j;
  3204. if (var_set (v_A, &variant) == FALSE)
  3205. {
  3206. WARN_VARIABLE_NOT_DECLARED;
  3207. return (l);
  3208. }
  3209. }
  3210. }
  3211. break;
  3212. case 3:
  3213. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  3214. {
  3215. for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
  3216. {
  3217. for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++)
  3218. {
  3219. VariantType variant;
  3220. CLEAR_VARIANT (&variant);
  3221. v_B->VINDEX[0] = i;
  3222. v_B->VINDEX[1] = j;
  3223. v_B->VINDEX[2] = k;
  3224. if (var_get (v_B, &variant) == FALSE)
  3225. {
  3226. WARN_VARIABLE_NOT_DECLARED;
  3227. return (l);
  3228. }
  3229. v_A->VINDEX[0] = i;
  3230. v_A->VINDEX[1] = j;
  3231. v_A->VINDEX[2] = k;
  3232. if (var_set (v_A, &variant) == FALSE)
  3233. {
  3234. WARN_VARIABLE_NOT_DECLARED;
  3235. return (l);
  3236. }
  3237. }
  3238. }
  3239. }
  3240. break;
  3241. default:
  3242. WARN_SYNTAX_ERROR;
  3243. return (l);
  3244. }
  3245. }
  3246. else if (line_skip_PlusChar (l))
  3247. {
  3248. /* MAT A = B + C */
  3249. /* OK */
  3250. int i;
  3251. int j;
  3252. int k;
  3253. VariableType *v_C;
  3254. char varname_C[NameLengthMax + 1];
  3255. if (v_A->dimensions != v_B->dimensions)
  3256. {
  3257. WARN_SYNTAX_ERROR;
  3258. return (l);
  3259. }
  3260. /* both arrays are of the same size */
  3261. if (line_read_varname (l, varname_C) == FALSE)
  3262. {
  3263. WARN_SYNTAX_ERROR;
  3264. return (l);
  3265. }
  3266. if ((v_C = mat_find (varname_C)) == NULL)
  3267. {
  3268. WARN_VARIABLE_NOT_DECLARED;
  3269. return (l);
  3270. }
  3271. /* variable MUST be numeric */
  3272. if (VAR_IS_STRING (v_C))
  3273. {
  3274. WARN_SYNTAX_ERROR;
  3275. return (l);
  3276. }
  3277. if (line_read_matrix_redim (l, v_C) == FALSE)
  3278. {
  3279. WARN_SYNTAX_ERROR;
  3280. return (l);
  3281. }
  3282. if (v_B->dimensions != v_C->dimensions)
  3283. {
  3284. WARN_SYNTAX_ERROR;
  3285. return (l);
  3286. }
  3287. /* both arrays are of the same size */
  3288. switch (v_A->dimensions)
  3289. {
  3290. case 1:
  3291. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  3292. {
  3293. VariantType variant_L;
  3294. VariantType variant_R;
  3295. CLEAR_VARIANT (&variant_L);
  3296. CLEAR_VARIANT (&variant_R);
  3297. v_B->VINDEX[0] = i;
  3298. if (var_get (v_B, &variant_L) == FALSE)
  3299. {
  3300. WARN_VARIABLE_NOT_DECLARED;
  3301. return (l);
  3302. }
  3303. v_C->VINDEX[0] = i;
  3304. if (var_get (v_C, &variant_R) == FALSE)
  3305. {
  3306. WARN_VARIABLE_NOT_DECLARED;
  3307. return (l);
  3308. }
  3309. variant_L.Number += variant_R.Number;
  3310. v_A->VINDEX[0] = i;
  3311. if (var_set (v_A, &variant_L) == FALSE)
  3312. {
  3313. WARN_VARIABLE_NOT_DECLARED;
  3314. return (l);
  3315. }
  3316. }
  3317. break;
  3318. case 2:
  3319. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  3320. {
  3321. for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
  3322. {
  3323. VariantType variant_L;
  3324. VariantType variant_R;
  3325. CLEAR_VARIANT (&variant_L);
  3326. CLEAR_VARIANT (&variant_R);
  3327. v_B->VINDEX[0] = i;
  3328. v_B->VINDEX[1] = j;
  3329. if (var_get (v_B, &variant_L) == FALSE)
  3330. {
  3331. WARN_VARIABLE_NOT_DECLARED;
  3332. return (l);
  3333. }
  3334. v_C->VINDEX[0] = i;
  3335. v_C->VINDEX[1] = j;
  3336. if (var_get (v_C, &variant_R) == FALSE)
  3337. {
  3338. WARN_VARIABLE_NOT_DECLARED;
  3339. return (l);
  3340. }
  3341. variant_L.Number += variant_R.Number;
  3342. v_A->VINDEX[0] = i;
  3343. v_A->VINDEX[1] = j;
  3344. if (var_set (v_A, &variant_L) == FALSE)
  3345. {
  3346. WARN_VARIABLE_NOT_DECLARED;
  3347. return (l);
  3348. }
  3349. }
  3350. }
  3351. break;
  3352. case 3:
  3353. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  3354. {
  3355. for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
  3356. {
  3357. for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++)
  3358. {
  3359. VariantType variant_L;
  3360. VariantType variant_R;
  3361. CLEAR_VARIANT (&variant_L);
  3362. CLEAR_VARIANT (&variant_R);
  3363. v_B->VINDEX[0] = i;
  3364. v_B->VINDEX[1] = j;
  3365. v_B->VINDEX[2] = k;
  3366. if (var_get (v_B, &variant_L) == FALSE)
  3367. {
  3368. WARN_VARIABLE_NOT_DECLARED;
  3369. return (l);
  3370. }
  3371. v_C->VINDEX[0] = i;
  3372. v_C->VINDEX[1] = j;
  3373. v_C->VINDEX[2] = k;
  3374. if (var_get (v_C, &variant_R) == FALSE)
  3375. {
  3376. WARN_VARIABLE_NOT_DECLARED;
  3377. return (l);
  3378. }
  3379. variant_L.Number += variant_R.Number;
  3380. v_A->VINDEX[0] = i;
  3381. v_A->VINDEX[1] = j;
  3382. v_A->VINDEX[2] = k;
  3383. if (var_set (v_A, &variant_L) == FALSE)
  3384. {
  3385. WARN_VARIABLE_NOT_DECLARED;
  3386. return (l);
  3387. }
  3388. }
  3389. }
  3390. }
  3391. break;
  3392. default:
  3393. WARN_SYNTAX_ERROR;
  3394. return (l);
  3395. }
  3396. }
  3397. else if (line_skip_MinusChar (l))
  3398. {
  3399. /* MAT A = B - C */
  3400. /* OK */
  3401. int i;
  3402. int j;
  3403. int k;
  3404. VariableType *v_C;
  3405. char varname_C[NameLengthMax + 1];
  3406. if (v_A->dimensions != v_B->dimensions)
  3407. {
  3408. WARN_SYNTAX_ERROR;
  3409. return (l);
  3410. }
  3411. /* both arrays are of the same size */
  3412. if (line_read_varname (l, varname_C) == FALSE)
  3413. {
  3414. WARN_SYNTAX_ERROR;
  3415. return (l);
  3416. }
  3417. if ((v_C = mat_find (varname_C)) == NULL)
  3418. {
  3419. WARN_VARIABLE_NOT_DECLARED;
  3420. return (l);
  3421. }
  3422. /* variable MUST be numeric */
  3423. if (VAR_IS_STRING (v_C))
  3424. {
  3425. WARN_SYNTAX_ERROR;
  3426. return (l);
  3427. }
  3428. if (line_read_matrix_redim (l, v_C) == FALSE)
  3429. {
  3430. WARN_SYNTAX_ERROR;
  3431. return (l);
  3432. }
  3433. if (v_B->dimensions != v_C->dimensions)
  3434. {
  3435. WARN_SYNTAX_ERROR;
  3436. return (l);
  3437. }
  3438. /* both arrays are of the same dimension */
  3439. switch (v_A->dimensions)
  3440. {
  3441. case 1:
  3442. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  3443. {
  3444. VariantType variant_L;
  3445. VariantType variant_R;
  3446. CLEAR_VARIANT (&variant_L);
  3447. CLEAR_VARIANT (&variant_R);
  3448. v_B->VINDEX[0] = i;
  3449. if (var_get (v_B, &variant_L) == FALSE)
  3450. {
  3451. WARN_VARIABLE_NOT_DECLARED;
  3452. return (l);
  3453. }
  3454. v_C->VINDEX[0] = i;
  3455. if (var_get (v_C, &variant_R) == FALSE)
  3456. {
  3457. WARN_VARIABLE_NOT_DECLARED;
  3458. return (l);
  3459. }
  3460. variant_L.Number -= variant_R.Number;
  3461. v_A->VINDEX[0] = i;
  3462. if (var_set (v_A, &variant_L) == FALSE)
  3463. {
  3464. WARN_VARIABLE_NOT_DECLARED;
  3465. return (l);
  3466. }
  3467. }
  3468. break;
  3469. case 2:
  3470. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  3471. {
  3472. for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
  3473. {
  3474. VariantType variant_L;
  3475. VariantType variant_R;
  3476. CLEAR_VARIANT (&variant_L);
  3477. CLEAR_VARIANT (&variant_R);
  3478. v_B->VINDEX[0] = i;
  3479. v_B->VINDEX[1] = j;
  3480. if (var_get (v_B, &variant_L) == FALSE)
  3481. {
  3482. WARN_VARIABLE_NOT_DECLARED;
  3483. return (l);
  3484. }
  3485. v_C->VINDEX[0] = i;
  3486. v_C->VINDEX[1] = j;
  3487. if (var_get (v_C, &variant_R) == FALSE)
  3488. {
  3489. WARN_VARIABLE_NOT_DECLARED;
  3490. return (l);
  3491. }
  3492. variant_L.Number -= variant_R.Number;
  3493. v_A->VINDEX[0] = i;
  3494. v_A->VINDEX[1] = j;
  3495. if (var_set (v_A, &variant_L) == FALSE)
  3496. {
  3497. WARN_VARIABLE_NOT_DECLARED;
  3498. return (l);
  3499. }
  3500. }
  3501. }
  3502. break;
  3503. case 3:
  3504. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  3505. {
  3506. for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
  3507. {
  3508. for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++)
  3509. {
  3510. VariantType variant_L;
  3511. VariantType variant_R;
  3512. CLEAR_VARIANT (&variant_L);
  3513. CLEAR_VARIANT (&variant_R);
  3514. v_B->VINDEX[0] = i;
  3515. v_B->VINDEX[1] = j;
  3516. v_B->VINDEX[2] = k;
  3517. if (var_get (v_B, &variant_L) == FALSE)
  3518. {
  3519. WARN_VARIABLE_NOT_DECLARED;
  3520. return (l);
  3521. }
  3522. v_C->VINDEX[0] = i;
  3523. v_C->VINDEX[1] = j;
  3524. v_C->VINDEX[2] = k;
  3525. if (var_get (v_C, &variant_R) == FALSE)
  3526. {
  3527. WARN_VARIABLE_NOT_DECLARED;
  3528. return (l);
  3529. }
  3530. variant_L.Number -= variant_R.Number;
  3531. v_A->VINDEX[0] = i;
  3532. v_A->VINDEX[1] = j;
  3533. v_A->VINDEX[2] = k;
  3534. if (var_set (v_A, &variant_L) == FALSE)
  3535. {
  3536. WARN_VARIABLE_NOT_DECLARED;
  3537. return (l);
  3538. }
  3539. }
  3540. }
  3541. }
  3542. break;
  3543. default:
  3544. WARN_SYNTAX_ERROR;
  3545. return (l);
  3546. }
  3547. }
  3548. else if (line_skip_StarChar (l))
  3549. {
  3550. /* MAT A = B * C */
  3551. int i;
  3552. int j;
  3553. int k;
  3554. VariableType *v_C;
  3555. char varname_C[NameLengthMax + 1];
  3556. if (v_A->dimensions != 2)
  3557. {
  3558. WARN_SUBSCRIPT_OUT_OF_RANGE;
  3559. return (l);
  3560. }
  3561. if (v_B->dimensions != 2)
  3562. {
  3563. WARN_SUBSCRIPT_OUT_OF_RANGE;
  3564. return (l);
  3565. }
  3566. if (line_read_varname (l, varname_C) == FALSE)
  3567. {
  3568. WARN_SYNTAX_ERROR;
  3569. return (l);
  3570. }
  3571. if ((v_C = mat_find (varname_C)) == NULL)
  3572. {
  3573. WARN_VARIABLE_NOT_DECLARED;
  3574. return (l);
  3575. }
  3576. /* variable MUST be numeric */
  3577. if (VAR_IS_STRING (v_C))
  3578. {
  3579. WARN_TYPE_MISMATCH;
  3580. return (l);
  3581. }
  3582. if (line_read_matrix_redim (l, v_C) == FALSE)
  3583. {
  3584. WARN_SYNTAX_ERROR;
  3585. return (l);
  3586. }
  3587. if (v_C->dimensions != 2)
  3588. {
  3589. WARN_SUBSCRIPT_OUT_OF_RANGE;
  3590. return (l);
  3591. }
  3592. if (v_A->LBOUND[0] != v_B->LBOUND[0])
  3593. {
  3594. WARN_SUBSCRIPT_OUT_OF_RANGE;
  3595. return (l);
  3596. }
  3597. if (v_A->UBOUND[0] != v_B->UBOUND[0])
  3598. {
  3599. WARN_SUBSCRIPT_OUT_OF_RANGE;
  3600. return (l);
  3601. }
  3602. if (v_A->LBOUND[1] != v_C->LBOUND[1])
  3603. {
  3604. WARN_SUBSCRIPT_OUT_OF_RANGE;
  3605. return (l);
  3606. }
  3607. if (v_A->UBOUND[1] != v_C->UBOUND[1])
  3608. {
  3609. WARN_SUBSCRIPT_OUT_OF_RANGE;
  3610. return (l);
  3611. }
  3612. if (v_B->LBOUND[1] != v_C->LBOUND[0])
  3613. {
  3614. WARN_SUBSCRIPT_OUT_OF_RANGE;
  3615. return (l);
  3616. }
  3617. if (v_B->UBOUND[1] != v_C->UBOUND[0])
  3618. {
  3619. WARN_SUBSCRIPT_OUT_OF_RANGE;
  3620. return (l);
  3621. }
  3622. for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
  3623. {
  3624. for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
  3625. {
  3626. VariantType variant_A;
  3627. CLEAR_VARIANT (&variant_A);
  3628. variant_A.VariantTypeCode = v_A->VariableTypeCode;
  3629. variant_A.Number = 0;
  3630. v_A->VINDEX[0] = i;
  3631. v_A->VINDEX[1] = j;
  3632. if (var_set (v_A, &variant_A) == FALSE)
  3633. {
  3634. WARN_VARIABLE_NOT_DECLARED;
  3635. return (l);
  3636. }
  3637. for (k = v_C->LBOUND[0]; k <= v_C->UBOUND[0]; k++)
  3638. {
  3639. VariantType variant_B;
  3640. VariantType variant_C;
  3641. CLEAR_VARIANT (&variant_B);
  3642. CLEAR_VARIANT (&variant_C);
  3643. v_A->VINDEX[0] = i;
  3644. v_A->VINDEX[1] = j;
  3645. if (var_get (v_A, &variant_A) == FALSE)
  3646. {
  3647. WARN_VARIABLE_NOT_DECLARED;
  3648. return (l);
  3649. }
  3650. v_B->VINDEX[0] = i;
  3651. v_B->VINDEX[1] = k;
  3652. if (var_get (v_B, &variant_B) == FALSE)
  3653. {
  3654. WARN_VARIABLE_NOT_DECLARED;
  3655. return (l);
  3656. }
  3657. v_C->VINDEX[0] = k;
  3658. v_C->VINDEX[1] = j;
  3659. if (var_get (v_C, &variant_C) == FALSE)
  3660. {
  3661. WARN_VARIABLE_NOT_DECLARED;
  3662. return (l);
  3663. }
  3664. variant_A.Number += variant_B.Number * variant_C.Number;
  3665. v_A->VINDEX[0] = i;
  3666. v_A->VINDEX[1] = j;
  3667. if (var_set (v_A, &variant_A) == FALSE)
  3668. {
  3669. WARN_VARIABLE_NOT_DECLARED;
  3670. return (l);
  3671. }
  3672. }
  3673. }
  3674. }
  3675. }
  3676. else
  3677. {
  3678. WARN_SYNTAX_ERROR;
  3679. return (l);
  3680. }
  3681. }
  3682. return (l);
  3683. }
  3684. /*
  3685. --------------------------------------------------------------------------------------------
  3686. STORE
  3687. --------------------------------------------------------------------------------------------
  3688. */
  3689. LineType *
  3690. bwb_STORE (LineType * l)
  3691. {
  3692. /*
  3693. SYNTAX: STORE NumericArrayName
  3694. */
  3695. assert (l != NULL);
  3696. return bwb_CSAVE8 (l);
  3697. }
  3698. /*
  3699. --------------------------------------------------------------------------------------------
  3700. CSAVE*
  3701. --------------------------------------------------------------------------------------------
  3702. */
  3703. #define CSAVE_VERSION_1 0x20150218L
  3704. LineType *
  3705. bwb_CSAVE8 (LineType * l)
  3706. {
  3707. /*
  3708. SYNTAX: CSAVE* NumericArrayName
  3709. */
  3710. VariableType *v = NULL;
  3711. FILE *f;
  3712. unsigned long n;
  3713. size_t t;
  3714. char varname[NameLengthMax + 1];
  3715. assert (l != NULL);
  3716. if (line_read_varname (l, varname) == FALSE)
  3717. {
  3718. WARN_SYNTAX_ERROR;
  3719. return (l);
  3720. }
  3721. v = mat_find (varname);
  3722. if (v == NULL)
  3723. {
  3724. WARN_VARIABLE_NOT_DECLARED;
  3725. return (l);
  3726. }
  3727. /* variable MUST be numeric */
  3728. if (VAR_IS_STRING (v))
  3729. {
  3730. WARN_SYNTAX_ERROR;
  3731. return (l);
  3732. }
  3733. /* variable MUST be an array */
  3734. if (v->dimensions == 0)
  3735. {
  3736. WARN_SYNTAX_ERROR;
  3737. return (l);
  3738. }
  3739. if (line_read_matrix_redim (l, v) == FALSE)
  3740. {
  3741. WARN_SYNTAX_ERROR;
  3742. return (l);
  3743. }
  3744. /* variable storage is a mess, we bypass that tradition here. */
  3745. t = v->array_units;
  3746. if (t <= 1)
  3747. {
  3748. WARN_SYNTAX_ERROR;
  3749. return (l);
  3750. }
  3751. /* open file */
  3752. f = fopen (v->name, "w");
  3753. if (f == NULL)
  3754. {
  3755. WARN_SYNTAX_ERROR;
  3756. return (l);
  3757. }
  3758. /* write version number */
  3759. n = CSAVE_VERSION_1;
  3760. fwrite (&n, sizeof (long), 1, f);
  3761. /* write total number of elements */
  3762. fwrite (&t, sizeof (long), 1, f);
  3763. /* write data */
  3764. fwrite (v->Value.Number, sizeof (DoubleType), t, f);
  3765. /* OK */
  3766. bwb_fclose (f);
  3767. return (l);
  3768. }
  3769. /*
  3770. --------------------------------------------------------------------------------------------
  3771. RECALL
  3772. --------------------------------------------------------------------------------------------
  3773. */
  3774. LineType *
  3775. bwb_RECALL (LineType * l)
  3776. {
  3777. /*
  3778. SYNTAX: RECALL NumericArrayName
  3779. */
  3780. assert (l != NULL);
  3781. return bwb_CLOAD8 (l);
  3782. }
  3783. /*
  3784. --------------------------------------------------------------------------------------------
  3785. CLOAD*
  3786. --------------------------------------------------------------------------------------------
  3787. */
  3788. LineType *
  3789. bwb_CLOAD8 (LineType * l)
  3790. {
  3791. /*
  3792. SYNTAX: CLOAD* NumericArrayName
  3793. */
  3794. VariableType *v = NULL;
  3795. FILE *f;
  3796. unsigned long n;
  3797. size_t t;
  3798. char varname[NameLengthMax + 1];
  3799. assert (l != NULL);
  3800. if (line_read_varname (l, varname) == FALSE)
  3801. {
  3802. WARN_SYNTAX_ERROR;
  3803. return (l);
  3804. }
  3805. v = mat_find (varname);
  3806. if (v == NULL)
  3807. {
  3808. WARN_VARIABLE_NOT_DECLARED;
  3809. return (l);
  3810. }
  3811. /* variable MUST be numeric */
  3812. if (VAR_IS_STRING (v))
  3813. {
  3814. WARN_SYNTAX_ERROR;
  3815. return (l);
  3816. }
  3817. /* variable MUST be an array */
  3818. if (v->dimensions == 0)
  3819. {
  3820. WARN_SYNTAX_ERROR;
  3821. return (l);
  3822. }
  3823. if (line_read_matrix_redim (l, v) == FALSE)
  3824. {
  3825. WARN_SYNTAX_ERROR;
  3826. return (l);
  3827. }
  3828. /* variable storage is a mess, we bypass that tradition here. */
  3829. t = v->array_units;
  3830. if (t <= 1)
  3831. {
  3832. WARN_SYNTAX_ERROR;
  3833. return (l);
  3834. }
  3835. /* open file */
  3836. f = fopen (v->name, "r");
  3837. if (f == NULL)
  3838. {
  3839. WARN_BAD_FILE_NAME;
  3840. return (l);
  3841. }
  3842. /* read version number */
  3843. n = 0;
  3844. fread (&n, sizeof (long), 1, f);
  3845. if (n != CSAVE_VERSION_1)
  3846. {
  3847. bwb_fclose (f);
  3848. WARN_BAD_FILE_NAME;
  3849. return (l);
  3850. }
  3851. /* read total number of elements */
  3852. n = 0;
  3853. fread (&n, sizeof (long), 1, f);
  3854. if (n != t)
  3855. {
  3856. bwb_fclose (f);
  3857. WARN_BAD_FILE_NAME;
  3858. return (l);
  3859. }
  3860. /* read data */
  3861. fread (v->Value.Number, sizeof (DoubleType), t, f);
  3862. /* OK */
  3863. bwb_fclose (f);
  3864. return (l);
  3865. }
  3866. /*
  3867. ============================================================================================
  3868. SAVE and so on
  3869. ============================================================================================
  3870. */
  3871. static LineType *
  3872. bwb_save (LineType * Line, char *Prompt)
  3873. {
  3874. /*
  3875. SYNTAX: SAVE [filename$]
  3876. */
  3877. FILE *outfile;
  3878. assert (Line != NULL);
  3879. assert (Prompt != NULL);
  3880. assert( My != NULL );
  3881. assert( My->ConsoleInput != NULL );
  3882. assert( My->SYSOUT != NULL );
  3883. assert( My->SYSOUT->cfp != NULL );
  3884. /* Get an argument for filename */
  3885. if (line_is_eol (Line))
  3886. {
  3887. /* default is the last filename used by LOAD or SAVE */
  3888. if (is_empty_string (My->ProgramFilename) && Prompt != NULL)
  3889. {
  3890. /* prompt for the program name */
  3891. char *tbuf;
  3892. int tlen;
  3893. tbuf = My->ConsoleInput;
  3894. tlen = MAX_LINE_LENGTH;
  3895. bwx_input (Prompt, FALSE, tbuf, tlen);
  3896. if (is_empty_string (tbuf))
  3897. {
  3898. WARN_BAD_FILE_NAME;
  3899. return (Line);
  3900. }
  3901. if (My->ProgramFilename != NULL)
  3902. {
  3903. free (My->ProgramFilename);
  3904. My->ProgramFilename = NULL;
  3905. }
  3906. My->ProgramFilename = bwb_strdup (tbuf);
  3907. }
  3908. assert( My->ProgramFilename != NULL );
  3909. fprintf (My->SYSOUT->cfp, "Saving %s\n", My->ProgramFilename);
  3910. ResetConsoleColumn ();
  3911. }
  3912. else
  3913. {
  3914. char *Value;
  3915. Value = NULL;
  3916. if (line_read_string_expression (Line, &Value) == FALSE)
  3917. {
  3918. WARN_SYNTAX_ERROR;
  3919. return (Line);
  3920. }
  3921. if (is_empty_string (Value))
  3922. {
  3923. WARN_BAD_FILE_NAME;
  3924. return (Line);
  3925. }
  3926. if (My->ProgramFilename != NULL)
  3927. {
  3928. free (My->ProgramFilename);
  3929. }
  3930. My->ProgramFilename = Value;
  3931. }
  3932. assert( My->ProgramFilename != NULL );
  3933. if ((outfile = fopen (My->ProgramFilename, "w")) == NULL)
  3934. {
  3935. WARN_BAD_FILE_NAME;
  3936. return (Line);
  3937. }
  3938. bwb_xlist (Line, outfile);
  3939. bwb_fclose (outfile);
  3940. return (Line);
  3941. }
  3942. /*
  3943. --------------------------------------------------------------------------------------------
  3944. CSAVE
  3945. --------------------------------------------------------------------------------------------
  3946. */
  3947. LineType *
  3948. bwb_CSAVE (LineType * Line)
  3949. {
  3950. /*
  3951. SYNTAX: CSAVE [filename$]
  3952. */
  3953. assert (Line != NULL);
  3954. return bwb_save (Line, "CSAVE FILE NAME:");
  3955. }
  3956. /*
  3957. --------------------------------------------------------------------------------------------
  3958. REPLACE
  3959. --------------------------------------------------------------------------------------------
  3960. */
  3961. LineType *
  3962. bwb_REPLACE (LineType * Line)
  3963. {
  3964. /*
  3965. SYNTAX: REPLACE [filename$]
  3966. */
  3967. assert (Line != NULL);
  3968. return bwb_save (Line, "REPLACE FILE NAME:");
  3969. }
  3970. /*
  3971. --------------------------------------------------------------------------------------------
  3972. SAVE
  3973. --------------------------------------------------------------------------------------------
  3974. */
  3975. LineType *
  3976. bwb_SAVE (LineType * l)
  3977. {
  3978. /*
  3979. SYNTAX: SAVE [filename$]
  3980. */
  3981. assert (l != NULL);
  3982. return bwb_save (l, "SAVE FILE NAME:");
  3983. }
  3984. /*
  3985. --------------------------------------------------------------------------------------------
  3986. TSAVE
  3987. --------------------------------------------------------------------------------------------
  3988. */
  3989. LineType *
  3990. bwb_TSAVE (LineType * Line)
  3991. {
  3992. /*
  3993. SYNTAX: TSAVE [filename$]
  3994. */
  3995. assert (Line != NULL);
  3996. return bwb_save (Line, "TSAVE FILE NAME:");
  3997. }
  3998. /*
  3999. ============================================================================================
  4000. LIST and so on
  4001. ============================================================================================
  4002. */
  4003. static int
  4004. xl_line (FILE * file, LineType * l)
  4005. {
  4006. char LineExecuted;
  4007. char *C; /* start of comment text */
  4008. char *buffer; /* 0...99999 */
  4009. assert (file != NULL);
  4010. assert (l != NULL);
  4011. assert( My != NULL );
  4012. assert( My->NumLenBuffer != NULL );
  4013. assert( My->CurrentVersion != NULL );
  4014. assert( My->SYSOUT != NULL );
  4015. assert( My->SYSOUT->cfp != NULL );
  4016. assert( My->SYSPRN != NULL );
  4017. assert( My->SYSPRN->cfp != NULL );
  4018. /*
  4019. ** The only difference between LIST, LLIST and SAVE is:
  4020. ** LIST and LLIST display an '*'
  4021. ** when a line has been executed
  4022. ** and OPTION COVERAGE ON is enabled.
  4023. */
  4024. buffer = My->NumLenBuffer;
  4025. LineExecuted = ' ';
  4026. if (My->CurrentVersion->OptionFlags & (OPTION_COVERAGE_ON))
  4027. {
  4028. if (l->LineFlags & LINE_EXECUTED)
  4029. {
  4030. if (file == My->SYSOUT->cfp || file == My->SYSPRN->cfp)
  4031. {
  4032. /* LIST */
  4033. /* LLIST */
  4034. LineExecuted = '*';
  4035. }
  4036. else
  4037. {
  4038. /* SAVE */
  4039. /* EDIT implies SAVE */
  4040. }
  4041. }
  4042. }
  4043. C = l->buffer;
  4044. if (l->LineFlags & LINE_NUMBERED)
  4045. {
  4046. /* explicitly numbered */
  4047. sprintf (buffer, "%*d", LineNumberDigits, l->number);
  4048. /* ##### xxx */
  4049. }
  4050. else
  4051. {
  4052. /* implicitly numbered */
  4053. if (My->LastLineNumber == l->number)
  4054. {
  4055. /* multi-statement line */
  4056. if (l->cmdnum == C_REM
  4057. && IS_CHAR (l->buffer[0], My->CurrentVersion->OptionCommentChar))
  4058. {
  4059. /* trailing comment */
  4060. sprintf (buffer, "%*s%c", LineNumberDigits - 1, "",
  4061. My->CurrentVersion->OptionCommentChar);
  4062. C++; /* skip comment char */
  4063. while (*C == ' ')
  4064. {
  4065. /* skip spaces */
  4066. C++;
  4067. }
  4068. /* ____' xxx */
  4069. }
  4070. else if (My->CurrentVersion->OptionStatementChar)
  4071. {
  4072. /* all other commands, add a colon */
  4073. sprintf (buffer, "%*s%c", LineNumberDigits - 1, "",
  4074. My->CurrentVersion->OptionStatementChar);
  4075. /* ____: xxx */
  4076. }
  4077. else
  4078. {
  4079. /*
  4080. The user is trying to list a multi-line statement
  4081. in a dialect that does NOT support multi-line statements.
  4082. This could occur when LOADing in one dialect and then SAVEing as another dialect, such as:
  4083. OPTION VERSION BASIC-80
  4084. LOAD "TEST1.BAS"
  4085. 100 REM TEST
  4086. 110 PRINT:PRINT:PRINT
  4087. OPTION VERSION MARK-I
  4088. EDIT
  4089. 100 REM TEST
  4090. 110 PRINT
  4091. PRINT
  4092. PRINT
  4093. The only thing we can reasonably do is put spaces for the line number,
  4094. since the user will have to edit the results manually anyways.
  4095. */
  4096. sprintf (buffer, "%*s", LineNumberDigits, "");
  4097. /* _____ xxx */
  4098. }
  4099. }
  4100. else
  4101. {
  4102. /* single-statement line */
  4103. sprintf (buffer, "%*s", LineNumberDigits, "");
  4104. /* _____ xxx */
  4105. }
  4106. }
  4107. fprintf (file, "%s", buffer);
  4108. fprintf (file, "%c", LineExecuted);
  4109. /* if( TRUE ) */
  4110. {
  4111. /* %INCLUDE */
  4112. int i;
  4113. for (i = 0; i < l->IncludeLevel; i++)
  4114. {
  4115. fputc (' ', file);
  4116. }
  4117. }
  4118. if (My->OptionIndentInteger > 0)
  4119. {
  4120. int i;
  4121. for (i = 0; i < l->Indention; i++)
  4122. {
  4123. int j;
  4124. for (j = 0; j < My->OptionIndentInteger; j++)
  4125. {
  4126. fputc (' ', file);
  4127. }
  4128. }
  4129. }
  4130. fprintf (file, "%s\n", C);
  4131. My->LastLineNumber = l->number;
  4132. return TRUE;
  4133. }
  4134. static LineType *
  4135. bwb_xlist (LineType * l, FILE * file)
  4136. {
  4137. assert (l != NULL);
  4138. assert (file != NULL);
  4139. assert( My != NULL );
  4140. assert( My->StartMarker != NULL );
  4141. assert( My->EndMarker != NULL );
  4142. /*
  4143. **
  4144. ** FORCE SCAN
  4145. **
  4146. */
  4147. if (bwb_scan () == FALSE)
  4148. {
  4149. /*
  4150. **
  4151. ** we are used by bwb_SAVE and bwb_EDIT
  4152. **
  4153. WARN_CANT_CONTINUE;
  4154. return (l);
  4155. */
  4156. }
  4157. if (line_is_eol (l))
  4158. {
  4159. /* LIST */
  4160. LineType *x;
  4161. /* now go through and list appropriate lines */
  4162. My->LastLineNumber = -1;
  4163. for (x = My->StartMarker->next; x != My->EndMarker; x = x->next)
  4164. {
  4165. xl_line (file, x);
  4166. }
  4167. fprintf (file, "\n");
  4168. }
  4169. else
  4170. {
  4171. do
  4172. {
  4173. int head;
  4174. int tail;
  4175. if (line_read_line_sequence (l, &head, &tail))
  4176. {
  4177. /* LIST 's' - 'e' */
  4178. LineType *x;
  4179. if (head < MINLIN || head > MAXLIN)
  4180. {
  4181. WARN_UNDEFINED_LINE;
  4182. return (l);
  4183. }
  4184. if (tail < MINLIN || tail > MAXLIN)
  4185. {
  4186. WARN_UNDEFINED_LINE;
  4187. return (l);
  4188. }
  4189. if (head > tail)
  4190. {
  4191. WARN_UNDEFINED_LINE;
  4192. return (l);
  4193. }
  4194. /* valid range */
  4195. /* now go through and list appropriate lines */
  4196. My->LastLineNumber = -1;
  4197. for (x = My->StartMarker->next; x != My->EndMarker; x = x->next)
  4198. {
  4199. if (head <= x->number && x->number <= tail)
  4200. {
  4201. xl_line (file, x);
  4202. }
  4203. }
  4204. fprintf (file, "\n");
  4205. }
  4206. else
  4207. {
  4208. WARN_SYNTAX_ERROR;
  4209. return (l);
  4210. }
  4211. }
  4212. while (line_skip_seperator (l));
  4213. }
  4214. if (file == My->SYSOUT->cfp)
  4215. {
  4216. ResetConsoleColumn ();
  4217. }
  4218. return (l);
  4219. }
  4220. /*
  4221. --------------------------------------------------------------------------------------------
  4222. LIST
  4223. --------------------------------------------------------------------------------------------
  4224. */
  4225. LineType *
  4226. bwb_LIST (LineType * l)
  4227. {
  4228. /*
  4229. SYNTAX: LIST
  4230. SYNTAX: LIST line [,...]
  4231. SYNTAX: LIST line - line
  4232. */
  4233. assert (l != NULL);
  4234. return bwb_xlist (l, My->SYSOUT->cfp);
  4235. }
  4236. /*
  4237. --------------------------------------------------------------------------------------------
  4238. LISTNH
  4239. --------------------------------------------------------------------------------------------
  4240. */
  4241. LineType *
  4242. bwb_LISTNH (LineType * l)
  4243. {
  4244. /*
  4245. SYNTAX: LISTNH
  4246. SYNTAX: LISTNH line [,...]
  4247. SYNTAX: LISTNH line - line
  4248. */
  4249. assert (l != NULL);
  4250. return bwb_xlist (l, My->SYSOUT->cfp);
  4251. }
  4252. /*
  4253. --------------------------------------------------------------------------------------------
  4254. LLIST
  4255. --------------------------------------------------------------------------------------------
  4256. */
  4257. LineType *
  4258. bwb_LLIST (LineType * l)
  4259. {
  4260. /*
  4261. SYNTAX: LLIST
  4262. SYNTAX: LLIST line [,...]
  4263. SYNTAX: LLIST line - line
  4264. */
  4265. assert (l != NULL);
  4266. return bwb_xlist (l, My->SYSPRN->cfp);
  4267. }
  4268. /*
  4269. ============================================================================================
  4270. DELETE and so on
  4271. ============================================================================================
  4272. */
  4273. static LineType *
  4274. bwb_delete (LineType * l)
  4275. {
  4276. assert (l != NULL);
  4277. assert( My != NULL );
  4278. assert( My->CurrentVersion != NULL );
  4279. assert( My->StartMarker != NULL );
  4280. assert( My->EndMarker != NULL );
  4281. if (line_is_eol (l))
  4282. {
  4283. /* DELETE */
  4284. WARN_SYNTAX_ERROR;
  4285. return (l);
  4286. }
  4287. else if (My->CurrentVersion->OptionVersionValue & (C77))
  4288. {
  4289. /*
  4290. SYNTAX: DELETE filenum [,...]
  4291. */
  4292. do
  4293. {
  4294. int FileNumber;
  4295. FileNumber = 0;
  4296. if (line_read_integer_expression (l, &FileNumber) == FALSE)
  4297. {
  4298. WARN_BAD_FILE_NUMBER;
  4299. return (l);
  4300. }
  4301. if (FileNumber <= 0)
  4302. {
  4303. WARN_BAD_FILE_NUMBER;
  4304. return (l);
  4305. }
  4306. My->CurrentFile = find_file_by_number (FileNumber);
  4307. if (My->CurrentFile == NULL)
  4308. {
  4309. WARN_BAD_FILE_NUMBER;
  4310. return (l);
  4311. }
  4312. if (My->CurrentFile->DevMode == DEVMODE_CLOSED)
  4313. {
  4314. WARN_BAD_FILE_NUMBER;
  4315. return (l);
  4316. }
  4317. if (My->CurrentFile->cfp != NULL)
  4318. {
  4319. bwb_fclose (My->CurrentFile->cfp);
  4320. My->CurrentFile->cfp = NULL;
  4321. }
  4322. if (My->CurrentFile->buffer != NULL)
  4323. {
  4324. free (My->CurrentFile->buffer);
  4325. My->CurrentFile->buffer = NULL;
  4326. }
  4327. My->CurrentFile->width = 0;
  4328. My->CurrentFile->col = 1;
  4329. My->CurrentFile->row = 1;
  4330. My->CurrentFile->delimit = ',';
  4331. My->CurrentFile->DevMode = DEVMODE_CLOSED;
  4332. if (My->CurrentFile->FileName == NULL)
  4333. {
  4334. WARN_BAD_FILE_NAME;
  4335. return (l);
  4336. }
  4337. remove (My->CurrentFile->FileName);
  4338. free (My->CurrentFile->FileName);
  4339. My->CurrentFile->FileName = NULL;
  4340. }
  4341. while (line_skip_seperator (l));
  4342. /* OK */
  4343. return (l);
  4344. }
  4345. else
  4346. {
  4347. /*
  4348. SYNTAX: DELETE line [,...]
  4349. SYNTAX: DELETE line - line
  4350. */
  4351. do
  4352. {
  4353. int head;
  4354. int tail;
  4355. if (line_read_line_sequence (l, &head, &tail))
  4356. {
  4357. /* DELETE 's' - 'e' */
  4358. LineType *x;
  4359. LineType *previous;
  4360. if (head < MINLIN || head > MAXLIN)
  4361. {
  4362. WARN_UNDEFINED_LINE;
  4363. return (l);
  4364. }
  4365. if (tail < MINLIN || tail > MAXLIN)
  4366. {
  4367. WARN_UNDEFINED_LINE;
  4368. return (l);
  4369. }
  4370. if (head > tail)
  4371. {
  4372. WARN_UNDEFINED_LINE;
  4373. return (l);
  4374. }
  4375. /* valid range */
  4376. /* avoid deleting ourself */
  4377. if (l->LineFlags & (LINE_USER))
  4378. {
  4379. /* console line (immediate mode) */
  4380. }
  4381. else if (head <= l->number && l->number <= tail)
  4382. {
  4383. /* 100 DELETE 100 */
  4384. WARN_CANT_CONTINUE;
  4385. return (l);
  4386. }
  4387. /* now go through and list appropriate lines */
  4388. previous = My->StartMarker;
  4389. for (x = My->StartMarker->next; x != My->EndMarker;)
  4390. {
  4391. LineType *next;
  4392. next = x->next;
  4393. if (x->number < head)
  4394. {
  4395. previous = x;
  4396. }
  4397. else if (head <= x->number && x->number <= tail)
  4398. {
  4399. if (x == l)
  4400. {
  4401. /* 100 DELETE 100 */
  4402. WARN_CANT_CONTINUE;
  4403. return (l);
  4404. }
  4405. bwb_freeline (x);
  4406. previous->next = next;
  4407. }
  4408. x = next;
  4409. }
  4410. }
  4411. else
  4412. {
  4413. WARN_SYNTAX_ERROR;
  4414. return (l);
  4415. }
  4416. }
  4417. while (line_skip_seperator (l));
  4418. /*
  4419. **
  4420. ** FORCE SCAN
  4421. **
  4422. */
  4423. if (bwb_scan () == FALSE)
  4424. {
  4425. WARN_CANT_CONTINUE;
  4426. return (l);
  4427. }
  4428. }
  4429. return (l);
  4430. }
  4431. /*
  4432. --------------------------------------------------------------------------------------------
  4433. DELETE
  4434. --------------------------------------------------------------------------------------------
  4435. */
  4436. LineType *
  4437. bwb_DELETE (LineType * l)
  4438. {
  4439. assert (l != NULL);
  4440. return bwb_delete (l);
  4441. }
  4442. /*
  4443. --------------------------------------------------------------------------------------------
  4444. PDEL
  4445. --------------------------------------------------------------------------------------------
  4446. */
  4447. LineType *
  4448. bwb_PDEL (LineType * l)
  4449. {
  4450. assert (l != NULL);
  4451. return bwb_delete (l);
  4452. }
  4453. #if FALSE /* keep the source to DONUM and DOUNNUM */
  4454. /*
  4455. --------------------------------------------------------------------------------------------
  4456. DONUM
  4457. --------------------------------------------------------------------------------------------
  4458. */
  4459. LineType *
  4460. bwb_donum (LineType * l)
  4461. {
  4462. /*
  4463. SYNTAX: DONUM
  4464. */
  4465. LineType *current;
  4466. int lnumber;
  4467. assert (l != NULL);
  4468. assert( My != NULL );
  4469. assert( My->StartMarker != NULL );
  4470. assert( My->EndMarker != NULL );
  4471. lnumber = 10;
  4472. for (current = My->StartMarker->next; current != My->EndMarker;
  4473. current = current->next)
  4474. {
  4475. current->number = lnumber;
  4476. lnumber += 10;
  4477. if (lnumber > MAXLIN)
  4478. {
  4479. return (l);
  4480. }
  4481. }
  4482. return (l);
  4483. }
  4484. /*
  4485. --------------------------------------------------------------------------------------------
  4486. DOUNUM
  4487. --------------------------------------------------------------------------------------------
  4488. */
  4489. LineType *
  4490. bwb_dounnum (LineType * l)
  4491. {
  4492. /*
  4493. SYNTAX: DOUNNUM
  4494. */
  4495. LineType *current;
  4496. assert (l != NULL);
  4497. assert( My != NULL );
  4498. assert( My->StartMarker != NULL );
  4499. assert( My->EndMarker != NULL );
  4500. for (current = My->StartMarker->next; current != My->EndMarker;
  4501. current = current->next)
  4502. {
  4503. current->number = 0;
  4504. }
  4505. return (l);
  4506. }
  4507. #endif /* FALSE */
  4508. /*
  4509. --------------------------------------------------------------------------------------------
  4510. FILES
  4511. --------------------------------------------------------------------------------------------
  4512. */
  4513. LineType *
  4514. bwb_FILES (LineType * l)
  4515. {
  4516. /*
  4517. SYNTAX: FILES A$ [, ...]
  4518. */
  4519. /* open a list of files in READ mode */
  4520. assert (l != NULL);
  4521. assert( My != NULL );
  4522. do
  4523. {
  4524. int FileNumber;
  4525. FileNumber = My->LastFileNumber;
  4526. FileNumber++;
  4527. if (FileNumber < 0)
  4528. {
  4529. WARN_BAD_FILE_NUMBER;
  4530. return (l);
  4531. }
  4532. if (FileNumber == 0)
  4533. {
  4534. WARN_BAD_FILE_NUMBER;
  4535. return (l);
  4536. }
  4537. My->CurrentFile = find_file_by_number (FileNumber);
  4538. if (My->CurrentFile == NULL)
  4539. {
  4540. My->CurrentFile = file_new ();
  4541. My->CurrentFile->FileNumber = FileNumber;
  4542. }
  4543. {
  4544. char *Value;
  4545. Value = NULL;
  4546. if (line_read_string_expression (l, &Value) == FALSE)
  4547. {
  4548. WARN_SYNTAX_ERROR;
  4549. return (l);
  4550. }
  4551. if (Value == NULL)
  4552. {
  4553. WARN_SYNTAX_ERROR;
  4554. return (l);
  4555. }
  4556. if (My->CurrentFile->FileName != NULL)
  4557. {
  4558. free (My->CurrentFile->FileName);
  4559. My->CurrentFile->FileName = NULL;
  4560. }
  4561. My->CurrentFile->FileName = Value;
  4562. Value = NULL;
  4563. }
  4564. if (My->CurrentFile->DevMode != DEVMODE_CLOSED)
  4565. {
  4566. My->CurrentFile->DevMode = DEVMODE_CLOSED;
  4567. }
  4568. if (My->CurrentFile->cfp != NULL)
  4569. {
  4570. bwb_fclose (My->CurrentFile->cfp);
  4571. My->CurrentFile->cfp = NULL;
  4572. }
  4573. if (My->CurrentFile->buffer != NULL)
  4574. {
  4575. free (My->CurrentFile->buffer);
  4576. My->CurrentFile->buffer = NULL;
  4577. }
  4578. My->CurrentFile->width = 0;
  4579. My->CurrentFile->col = 1;
  4580. My->CurrentFile->row = 1;
  4581. My->CurrentFile->delimit = ',';
  4582. if (is_empty_string (My->CurrentFile->FileName))
  4583. {
  4584. WARN_BAD_FILE_NAME;
  4585. return (l);
  4586. }
  4587. if (bwb_strcmp (My->CurrentFile->FileName, "*") != 0)
  4588. {
  4589. if ((My->CurrentFile->cfp =
  4590. fopen (My->CurrentFile->FileName, "r")) == NULL)
  4591. {
  4592. WARN_BAD_FILE_NAME;
  4593. return (l);
  4594. }
  4595. My->CurrentFile->DevMode = DEVMODE_INPUT;
  4596. }
  4597. My->LastFileNumber = FileNumber;
  4598. /* OK */
  4599. }
  4600. while (line_skip_seperator (l));
  4601. return (l);
  4602. }
  4603. /*
  4604. --------------------------------------------------------------------------------------------
  4605. FILE
  4606. --------------------------------------------------------------------------------------------
  4607. */
  4608. LineType *
  4609. bwb_FILE (LineType * l)
  4610. {
  4611. assert (l != NULL);
  4612. assert( My != NULL );
  4613. assert( My->CurrentVersion != NULL );
  4614. if (My->CurrentVersion->OptionVersionValue & (C77))
  4615. {
  4616. /*
  4617. CBASIC-II:
  4618. FILE file_name$ ' filename$ must be a simple string scalar (no arrays)
  4619. FILE file_name$ ( record_length% ) ' filename$ must be a simple string scalar (no arrays)
  4620. -- if the file exists,
  4621. then it is used,
  4622. else it is created.
  4623. -- Does not trigger IF END #
  4624. */
  4625. do
  4626. {
  4627. int FileNumber;
  4628. VariableType *v;
  4629. char varname[NameLengthMax + 1];
  4630. if (line_read_varname (l, varname) == FALSE)
  4631. {
  4632. WARN_BAD_FILE_NAME;
  4633. return (l);
  4634. }
  4635. if (is_empty_string (varname))
  4636. {
  4637. WARN_BAD_FILE_NAME;
  4638. return (l);
  4639. }
  4640. v = find_variable_by_type (varname, 0, StringTypeCode);
  4641. if (v == NULL)
  4642. {
  4643. WARN_VARIABLE_NOT_DECLARED;
  4644. return (l);
  4645. }
  4646. if (VAR_IS_STRING (v))
  4647. {
  4648. /* OK */
  4649. }
  4650. else
  4651. {
  4652. WARN_TYPE_MISMATCH;
  4653. return (l);
  4654. }
  4655. FileNumber = My->LastFileNumber;
  4656. FileNumber++;
  4657. if (FileNumber < 0)
  4658. {
  4659. WARN_BAD_FILE_NUMBER;
  4660. return (l);
  4661. }
  4662. if (FileNumber == 0)
  4663. {
  4664. WARN_BAD_FILE_NUMBER;
  4665. return (l);
  4666. }
  4667. My->CurrentFile = find_file_by_number (FileNumber);
  4668. if (My->CurrentFile == NULL)
  4669. {
  4670. My->CurrentFile = file_new ();
  4671. My->CurrentFile->FileNumber = FileNumber;
  4672. }
  4673. if (My->CurrentFile->DevMode != DEVMODE_CLOSED)
  4674. {
  4675. My->CurrentFile->DevMode = DEVMODE_CLOSED;
  4676. }
  4677. if (My->CurrentFile->cfp != NULL)
  4678. {
  4679. bwb_fclose (My->CurrentFile->cfp);
  4680. My->CurrentFile->cfp = NULL;
  4681. }
  4682. if (My->CurrentFile->buffer != NULL)
  4683. {
  4684. free (My->CurrentFile->buffer);
  4685. My->CurrentFile->buffer = NULL;
  4686. }
  4687. My->CurrentFile->width = 0;
  4688. My->CurrentFile->col = 1;
  4689. My->CurrentFile->row = 1;
  4690. My->CurrentFile->delimit = ',';
  4691. /* OK */
  4692. if (line_skip_LparenChar (l))
  4693. {
  4694. /* RANDOM file */
  4695. int RecLen;
  4696. if (line_read_integer_expression (l, &RecLen) == FALSE)
  4697. {
  4698. WARN_FIELD_OVERFLOW;
  4699. return (l);
  4700. }
  4701. if (RecLen <= 0)
  4702. {
  4703. WARN_FIELD_OVERFLOW;
  4704. return (l);
  4705. }
  4706. if (line_skip_RparenChar (l) == FALSE)
  4707. {
  4708. WARN_SYNTAX_ERROR;
  4709. return (l);
  4710. }
  4711. if ((My->CurrentFile->buffer =
  4712. (char *) calloc (RecLen + 1 /* NulChar */ ,
  4713. sizeof (char))) == NULL)
  4714. {
  4715. WARN_OUT_OF_MEMORY;
  4716. return (l);
  4717. }
  4718. My->CurrentFile->width = RecLen;
  4719. }
  4720. /* if( TRUE ) */
  4721. {
  4722. VariantType variant;
  4723. CLEAR_VARIANT (&variant);
  4724. if (var_get (v, &variant) == FALSE)
  4725. {
  4726. WARN_VARIABLE_NOT_DECLARED;
  4727. return (l);
  4728. }
  4729. if (variant.VariantTypeCode == StringTypeCode)
  4730. {
  4731. if (My->CurrentFile->FileName != NULL)
  4732. {
  4733. free (My->CurrentFile->FileName);
  4734. My->CurrentFile->FileName = NULL;
  4735. }
  4736. My->CurrentFile->FileName = variant.Buffer;
  4737. variant.Buffer = NULL;
  4738. }
  4739. else
  4740. {
  4741. WARN_TYPE_MISMATCH;
  4742. return (l);
  4743. }
  4744. }
  4745. if (is_empty_string (My->CurrentFile->FileName))
  4746. {
  4747. WARN_BAD_FILE_NAME;
  4748. return (l);
  4749. }
  4750. My->CurrentFile->cfp = fopen (My->CurrentFile->FileName, "r+");
  4751. if (My->CurrentFile->cfp == NULL)
  4752. {
  4753. My->CurrentFile->cfp = fopen (My->CurrentFile->FileName, "w");
  4754. if (My->CurrentFile->cfp != NULL)
  4755. {
  4756. bwb_fclose (My->CurrentFile->cfp);
  4757. My->CurrentFile->cfp = fopen (My->CurrentFile->FileName, "r+");
  4758. }
  4759. }
  4760. if (My->CurrentFile->cfp == NULL)
  4761. {
  4762. WARN_BAD_FILE_NAME;
  4763. return (l);
  4764. }
  4765. if (My->CurrentFile->width > 0)
  4766. {
  4767. /* RANDOM file */
  4768. My->CurrentFile->DevMode = DEVMODE_RANDOM;
  4769. }
  4770. else
  4771. {
  4772. /* SERIAL file */
  4773. My->CurrentFile->DevMode = DEVMODE_INPUT | DEVMODE_OUTPUT;
  4774. }
  4775. /* OK */
  4776. My->LastFileNumber = FileNumber;
  4777. }
  4778. while (line_skip_seperator (l));
  4779. /* OK */
  4780. return (l);
  4781. }
  4782. if (line_skip_FilenumChar (l))
  4783. {
  4784. /*
  4785. SYNTAX: FILE # X, A$
  4786. */
  4787. int FileNumber;
  4788. if (line_read_integer_expression (l, &FileNumber) == FALSE)
  4789. {
  4790. WARN_BAD_FILE_NUMBER;
  4791. return (l);
  4792. }
  4793. if (line_skip_seperator (l))
  4794. {
  4795. /* OK */
  4796. }
  4797. else
  4798. {
  4799. WARN_SYNTAX_ERROR;
  4800. return (l);
  4801. }
  4802. if (FileNumber < 0)
  4803. {
  4804. /* "FILE # -1" is an ERROR */
  4805. WARN_BAD_FILE_NUMBER;
  4806. return (l);
  4807. }
  4808. if (FileNumber == 0)
  4809. {
  4810. /* "FILE # 0" is an ERROR */
  4811. WARN_BAD_FILE_NUMBER;
  4812. return (l);
  4813. }
  4814. My->CurrentFile = find_file_by_number (FileNumber);
  4815. if (My->CurrentFile == NULL)
  4816. {
  4817. My->CurrentFile = file_new ();
  4818. My->CurrentFile->FileNumber = FileNumber;
  4819. }
  4820. {
  4821. char *Value;
  4822. Value = NULL;
  4823. if (line_read_string_expression (l, &Value) == FALSE)
  4824. {
  4825. WARN_SYNTAX_ERROR;
  4826. return (l);
  4827. }
  4828. if (Value == NULL)
  4829. {
  4830. WARN_SYNTAX_ERROR;
  4831. return (l);
  4832. }
  4833. if (My->CurrentFile->FileName != NULL)
  4834. {
  4835. free (My->CurrentFile->FileName);
  4836. My->CurrentFile->FileName = NULL;
  4837. }
  4838. My->CurrentFile->FileName = Value;
  4839. Value = NULL;
  4840. }
  4841. if (My->CurrentFile->DevMode != DEVMODE_CLOSED)
  4842. {
  4843. My->CurrentFile->DevMode = DEVMODE_CLOSED;
  4844. }
  4845. if (My->CurrentFile->cfp != NULL)
  4846. {
  4847. bwb_fclose (My->CurrentFile->cfp);
  4848. My->CurrentFile->cfp = NULL;
  4849. }
  4850. if (My->CurrentFile->buffer != NULL)
  4851. {
  4852. free (My->CurrentFile->buffer);
  4853. My->CurrentFile->buffer = NULL;
  4854. }
  4855. My->CurrentFile->width = 0;
  4856. My->CurrentFile->col = 1;
  4857. My->CurrentFile->row = 1;
  4858. My->CurrentFile->delimit = ',';
  4859. if (is_empty_string (My->CurrentFile->FileName))
  4860. {
  4861. WARN_BAD_FILE_NAME;
  4862. return (l);
  4863. }
  4864. if (bwb_strcmp (My->CurrentFile->FileName, "*") != 0)
  4865. {
  4866. if ((My->CurrentFile->cfp =
  4867. fopen (My->CurrentFile->FileName, "r")) == NULL)
  4868. {
  4869. WARN_BAD_FILE_NAME;
  4870. return (l);
  4871. }
  4872. My->CurrentFile->DevMode = DEVMODE_INPUT;
  4873. }
  4874. /* OK */
  4875. return (l);
  4876. }
  4877. WARN_SYNTAX_ERROR;
  4878. return (l);
  4879. }
  4880. /*
  4881. --------------------------------------------------------------------------------------------
  4882. DELIMIT
  4883. --------------------------------------------------------------------------------------------
  4884. */
  4885. LineType *
  4886. bwb_DELIMIT (LineType * l)
  4887. {
  4888. /*
  4889. SYNTAX: DELIMIT # X, A$
  4890. */
  4891. assert (l != NULL);
  4892. assert( My != NULL );
  4893. assert( My->SYSIN != NULL );
  4894. if (line_skip_FilenumChar (l))
  4895. {
  4896. /* DELIMIT # */
  4897. int FileNumber;
  4898. char delimit;
  4899. My->CurrentFile = My->SYSIN;
  4900. if (line_read_integer_expression (l, &FileNumber) == FALSE)
  4901. {
  4902. WARN_BAD_FILE_NUMBER;
  4903. return (l);
  4904. }
  4905. if (line_skip_seperator (l))
  4906. {
  4907. /* OK */
  4908. }
  4909. else
  4910. {
  4911. WARN_SYNTAX_ERROR;
  4912. return (l);
  4913. }
  4914. {
  4915. char *Value;
  4916. Value = NULL;
  4917. if (line_read_string_expression (l, &Value) == FALSE)
  4918. {
  4919. WARN_SYNTAX_ERROR;
  4920. return (l);
  4921. }
  4922. if (Value == NULL)
  4923. {
  4924. WARN_SYNTAX_ERROR;
  4925. return (l);
  4926. }
  4927. delimit = Value[0];
  4928. free (Value);
  4929. Value = NULL;
  4930. if (bwb_ispunct (delimit))
  4931. {
  4932. /* OK */
  4933. }
  4934. else
  4935. {
  4936. WARN_ILLEGAL_FUNCTION_CALL;
  4937. return (l);
  4938. }
  4939. }
  4940. if (FileNumber < 0)
  4941. {
  4942. /* "DELIMIT # -1" is SYSPRN */
  4943. My->SYSPRN->delimit = delimit;
  4944. return (l);
  4945. }
  4946. if (FileNumber == 0)
  4947. {
  4948. /* "DELIMIT # 0" is SYSOUT */
  4949. My->SYSOUT->delimit = delimit;
  4950. return (l);
  4951. }
  4952. /* normal file */
  4953. My->CurrentFile = find_file_by_number (FileNumber);
  4954. if (My->CurrentFile == NULL)
  4955. {
  4956. WARN_BAD_FILE_NUMBER;
  4957. return (l);
  4958. }
  4959. My->CurrentFile->delimit = delimit;
  4960. /* OK */
  4961. return (l);
  4962. }
  4963. WARN_SYNTAX_ERROR;
  4964. return (l);
  4965. }
  4966. /*
  4967. --------------------------------------------------------------------------------------------
  4968. MARGIN
  4969. --------------------------------------------------------------------------------------------
  4970. */
  4971. LineType *
  4972. bwb_MARGIN (LineType * l)
  4973. {
  4974. /*
  4975. SYNTAX: MARGIN # X, Y
  4976. */
  4977. /* set width for OUTPUT */
  4978. int FileNumber;
  4979. int Value;
  4980. assert (l != NULL);
  4981. assert( My != NULL );
  4982. assert( My->SYSIN != NULL );
  4983. if (line_skip_FilenumChar (l))
  4984. {
  4985. /* MARGIN # */
  4986. My->CurrentFile = My->SYSIN;
  4987. if (line_read_integer_expression (l, &FileNumber) == FALSE)
  4988. {
  4989. WARN_BAD_FILE_NUMBER;
  4990. return (l);
  4991. }
  4992. if (line_skip_seperator (l))
  4993. {
  4994. /* OK */
  4995. }
  4996. else
  4997. {
  4998. WARN_SYNTAX_ERROR;
  4999. return (l);
  5000. }
  5001. if (line_read_integer_expression (l, &Value) == FALSE)
  5002. {
  5003. WARN_SYNTAX_ERROR;
  5004. return (l);
  5005. }
  5006. if (Value < 0)
  5007. {
  5008. WARN_ILLEGAL_FUNCTION_CALL;
  5009. return (l);
  5010. }
  5011. if (FileNumber < 0)
  5012. {
  5013. /* "MARGIN # -1" is SYSPRN */
  5014. My->SYSPRN->width = Value;
  5015. return (l);
  5016. }
  5017. if (FileNumber == 0)
  5018. {
  5019. /* "MARGIN # 0" is SYSOUT */
  5020. My->SYSOUT->width = Value;
  5021. return (l);
  5022. }
  5023. /* normal file */
  5024. My->CurrentFile = find_file_by_number (FileNumber);
  5025. if (My->CurrentFile == NULL)
  5026. {
  5027. WARN_BAD_FILE_NUMBER;
  5028. return (l);
  5029. }
  5030. if ((My->CurrentFile->DevMode & DEVMODE_WRITE) == 0)
  5031. {
  5032. WARN_BAD_FILE_NUMBER;
  5033. return (l);
  5034. }
  5035. My->CurrentFile->width = Value;
  5036. /* OK */
  5037. return (l);
  5038. }
  5039. WARN_SYNTAX_ERROR;
  5040. return (l);
  5041. }
  5042. /*
  5043. --------------------------------------------------------------------------------------------
  5044. USE
  5045. --------------------------------------------------------------------------------------------
  5046. */
  5047. LineType *
  5048. bwb_USE (LineType * l)
  5049. {
  5050. /*
  5051. SYNTAX: USE parameter$ ' CALL/360, System/360, System/370
  5052. */
  5053. VariableType *v;
  5054. assert (l != NULL);
  5055. assert( My != NULL );
  5056. if ((v = line_read_scalar (l)) == NULL)
  5057. {
  5058. WARN_SYNTAX_ERROR;
  5059. return (l);
  5060. }
  5061. if (v->VariableTypeCode != StringTypeCode)
  5062. {
  5063. WARN_SYNTAX_ERROR;
  5064. return (l);
  5065. }
  5066. /* OK */
  5067. if (My->UseParameterString)
  5068. {
  5069. VariantType variant;
  5070. CLEAR_VARIANT (&variant);
  5071. variant.VariantTypeCode = StringTypeCode;
  5072. variant.Buffer = My->UseParameterString;
  5073. variant.Length = bwb_strlen (My->UseParameterString);
  5074. var_set (v, &variant);
  5075. }
  5076. return (l);
  5077. }
  5078. /*
  5079. --------------------------------------------------------------------------------------------
  5080. CHAIN
  5081. --------------------------------------------------------------------------------------------
  5082. */
  5083. LineType *
  5084. bwb_CHAIN (LineType * l)
  5085. {
  5086. /*
  5087. SYNTAX: CHAIN file-name$ [, linenumber] ' most dialects
  5088. SYNTAX: CHAIN file-name$ [, parameter$] ' CALL/360, System/360, System/370
  5089. */
  5090. /* originally based upon bwb_load() */
  5091. int LineNumber;
  5092. LineType *x;
  5093. assert (l != NULL);
  5094. assert( My != NULL );
  5095. assert( My->CurrentVersion != NULL );
  5096. assert( My->StartMarker != NULL );
  5097. assert( My->EndMarker != NULL );
  5098. /* Get an argument for filename */
  5099. if (line_is_eol (l))
  5100. {
  5101. WARN_BAD_FILE_NAME;
  5102. return (l);
  5103. }
  5104. else
  5105. {
  5106. char *Value;
  5107. Value = NULL;
  5108. if (line_read_string_expression (l, &Value) == FALSE)
  5109. {
  5110. WARN_SYNTAX_ERROR;
  5111. return (l);
  5112. }
  5113. if (is_empty_string (Value))
  5114. {
  5115. WARN_BAD_FILE_NAME;
  5116. return (l);
  5117. }
  5118. if (My->ProgramFilename != NULL)
  5119. {
  5120. free (My->ProgramFilename);
  5121. My->ProgramFilename = NULL;
  5122. }
  5123. My->ProgramFilename = Value;
  5124. }
  5125. /* optional linenumber */
  5126. LineNumber = 0;
  5127. if (line_skip_seperator (l))
  5128. {
  5129. if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
  5130. {
  5131. /* CHAIN filename$, parameter$ */
  5132. {
  5133. char *Value;
  5134. Value = NULL;
  5135. if (line_read_string_expression (l, &Value) == FALSE)
  5136. {
  5137. WARN_SYNTAX_ERROR;
  5138. return (l);
  5139. }
  5140. if (Value == NULL)
  5141. {
  5142. WARN_SYNTAX_ERROR;
  5143. return (l);
  5144. }
  5145. if (My->UseParameterString)
  5146. {
  5147. free (My->UseParameterString);
  5148. My->UseParameterString = NULL;
  5149. }
  5150. My->UseParameterString = Value;
  5151. }
  5152. }
  5153. else
  5154. {
  5155. /* CHAIN filename$, linenumber */
  5156. if (line_read_integer_expression (l, &LineNumber) == FALSE)
  5157. {
  5158. WARN_SYNTAX_ERROR;
  5159. return (l);
  5160. }
  5161. if (LineNumber < MINLIN || LineNumber > MAXLIN)
  5162. {
  5163. WARN_UNDEFINED_LINE;
  5164. return (l);
  5165. }
  5166. }
  5167. }
  5168. /* deallocate all variables except common ones */
  5169. var_delcvars ();
  5170. /* remove old program from memory */
  5171. bwb_xnew (My->StartMarker);
  5172. /* load new program in memory */
  5173. if (bwb_fload (NULL) == FALSE)
  5174. {
  5175. WARN_BAD_FILE_NAME;
  5176. return (l);
  5177. }
  5178. /* FIXME */
  5179. x = My->StartMarker;
  5180. if (MINLIN <= LineNumber && LineNumber <= MAXLIN)
  5181. {
  5182. /* search for a matching line number */
  5183. while (x->number != LineNumber && x != My->EndMarker)
  5184. {
  5185. x = x->next;
  5186. }
  5187. if (x == My->EndMarker)
  5188. {
  5189. /* NOT FOUND */
  5190. x = My->StartMarker;
  5191. }
  5192. }
  5193. x->position = 0;
  5194. /*
  5195. **
  5196. ** FORCE SCAN
  5197. **
  5198. */
  5199. if (bwb_scan () == FALSE)
  5200. {
  5201. WARN_CANT_CONTINUE;
  5202. return (l);
  5203. }
  5204. /* reset all stack counters */
  5205. bwb_clrexec ();
  5206. if (bwb_incexec ())
  5207. {
  5208. /* OK */
  5209. My->StackHead->line = x;
  5210. My->StackHead->ExecCode = EXEC_NORM;
  5211. }
  5212. else
  5213. {
  5214. /* ERROR */
  5215. WARN_OUT_OF_MEMORY;
  5216. return My->EndMarker;
  5217. }
  5218. /* run the program */
  5219. /* CHAIN */
  5220. WARN_CLEAR; /* bwb_CHAIN */
  5221. My->ContinueLine = NULL;
  5222. SetOnError (0);
  5223. return x;
  5224. }
  5225. /*
  5226. --------------------------------------------------------------------------------------------
  5227. APPEND
  5228. --------------------------------------------------------------------------------------------
  5229. */
  5230. LineType *
  5231. bwb_APPEND (LineType * l)
  5232. {
  5233. /*
  5234. SYNTAX: APPEND # filenumber ' Dartmouth, Mark-I, Mark-II, GCOS
  5235. SYNTAX: APPEND [filename$] ' all others
  5236. */
  5237. assert (l != NULL);
  5238. assert( My != NULL );
  5239. assert( My->CurrentVersion != NULL );
  5240. if (My->CurrentVersion->OptionVersionValue & (D64 | G65 | G67 | G74))
  5241. {
  5242. if (line_skip_FilenumChar (l))
  5243. {
  5244. /* APPEND # filenumber */
  5245. int FileNumber;
  5246. if (line_read_integer_expression (l, &FileNumber) == FALSE)
  5247. {
  5248. WARN_SYNTAX_ERROR;
  5249. return (l);
  5250. }
  5251. if (FileNumber < 0)
  5252. {
  5253. /* "APPEND # -1" is silently ignored */
  5254. return (l);
  5255. }
  5256. if (FileNumber == 0)
  5257. {
  5258. /* "APPEND # 0" is silently ignored */
  5259. return (l);
  5260. }
  5261. My->CurrentFile = find_file_by_number (FileNumber);
  5262. if (My->CurrentFile == NULL)
  5263. {
  5264. WARN_BAD_FILE_NUMBER;
  5265. return (l);
  5266. }
  5267. /* normal file */
  5268. fseek (My->CurrentFile->cfp, 0, SEEK_END);
  5269. My->CurrentFile->DevMode = DEVMODE_APPEND;
  5270. /* OK */
  5271. return (l);
  5272. }
  5273. }
  5274. /* APPEND filename$ */
  5275. return bwb_load (l, "APPEND FILE NAME:", FALSE);
  5276. }
  5277. /*
  5278. --------------------------------------------------------------------------------------------
  5279. ON ERROR and so on
  5280. --------------------------------------------------------------------------------------------
  5281. */
  5282. extern void
  5283. SetOnError (int LineNumber)
  5284. {
  5285. /* scan the stack looking for a FUNCTION/SUB */
  5286. StackType *StackItem;
  5287. assert( My != NULL );
  5288. if (My->StackHead == NULL)
  5289. {
  5290. return;
  5291. }
  5292. for (StackItem = My->StackHead; StackItem->next != NULL;
  5293. StackItem = StackItem->next)
  5294. {
  5295. LineType *current;
  5296. current = StackItem->LoopTopLine;
  5297. if (current != NULL)
  5298. {
  5299. switch (current->cmdnum)
  5300. {
  5301. case C_FUNCTION:
  5302. case C_SUB:
  5303. /* FOUND */
  5304. /* we are in a FUNCTION/SUB, so this is LOCAL */
  5305. StackItem->OnErrorGoto = LineNumber;
  5306. return;
  5307. /* break; */
  5308. }
  5309. }
  5310. }
  5311. /* StackItem->next == NULL */
  5312. /* NOT FOUND */
  5313. /* we are NOT in a FUNCTION/SUB */
  5314. assert (StackItem != NULL);
  5315. StackItem->OnErrorGoto = LineNumber;
  5316. }
  5317. extern int
  5318. GetOnError (void)
  5319. {
  5320. /* scan the stack looking for an active "ON ERROR GOTO linenumber" */
  5321. StackType *StackItem;
  5322. assert( My != NULL );
  5323. for (StackItem = My->StackHead; StackItem != NULL;
  5324. StackItem = StackItem->next)
  5325. {
  5326. if (StackItem->OnErrorGoto != 0)
  5327. {
  5328. /* FOUND */
  5329. return StackItem->OnErrorGoto;
  5330. }
  5331. }
  5332. /* NOT FOUND */
  5333. return 0;
  5334. }
  5335. /*
  5336. --------------------------------------------------------------------------------------------
  5337. ON ERROR
  5338. --------------------------------------------------------------------------------------------
  5339. */
  5340. LineType *
  5341. bwb_ON_ERROR (LineType * l)
  5342. {
  5343. assert (l != NULL);
  5344. WARN_SYNTAX_ERROR;
  5345. return (l);
  5346. }
  5347. /*
  5348. --------------------------------------------------------------------------------------------
  5349. ON ERROR GOTO
  5350. --------------------------------------------------------------------------------------------
  5351. */
  5352. LineType *
  5353. bwb_ON_ERROR_GOTO (LineType * l)
  5354. {
  5355. /* ON ERROR GOTO line */
  5356. int LineNumber;
  5357. assert (l != NULL);
  5358. WARN_CLEAR; /* bwb_ON_ERROR_GOTO */
  5359. /* get the line number */
  5360. LineNumber = 0;
  5361. if (line_is_eol (l))
  5362. {
  5363. /* ON ERROR GOTO */
  5364. SetOnError (0);
  5365. return (l);
  5366. }
  5367. if (line_read_integer_expression (l, &LineNumber) == FALSE)
  5368. {
  5369. WARN_SYNTAX_ERROR;
  5370. return (l);
  5371. }
  5372. /* ON ERORR GOTO linenumber */
  5373. if (LineNumber == 0)
  5374. {
  5375. /* ON ERROR GOTO 0 */
  5376. SetOnError (0);
  5377. return (l);
  5378. }
  5379. if (LineNumber < MINLIN || LineNumber > MAXLIN)
  5380. {
  5381. /* ERROR */
  5382. WARN_UNDEFINED_LINE;
  5383. return (l);
  5384. }
  5385. /* OK */
  5386. SetOnError (LineNumber);
  5387. return (l);
  5388. }
  5389. /*
  5390. --------------------------------------------------------------------------------------------
  5391. ON ERROR GOSUB
  5392. --------------------------------------------------------------------------------------------
  5393. */
  5394. LineType *
  5395. bwb_ON_ERROR_GOSUB (LineType * l)
  5396. {
  5397. /* ON ERROR GOSUB line */
  5398. assert (l != NULL);
  5399. return bwb_ON_ERROR_GOTO (l);
  5400. }
  5401. /*
  5402. --------------------------------------------------------------------------------------------
  5403. ON ERROR RESUME
  5404. --------------------------------------------------------------------------------------------
  5405. */
  5406. LineType *
  5407. bwb_ON_ERROR_RESUME (LineType * l)
  5408. {
  5409. assert (l != NULL);
  5410. WARN_SYNTAX_ERROR;
  5411. return (l);
  5412. }
  5413. /*
  5414. --------------------------------------------------------------------------------------------
  5415. ON ERROR RESUME NEXT
  5416. --------------------------------------------------------------------------------------------
  5417. */
  5418. LineType *
  5419. bwb_ON_ERROR_RESUME_NEXT (LineType * l)
  5420. {
  5421. assert (l != NULL);
  5422. WARN_CLEAR; /* bwb_ON_ERROR_RESUME_NEXT */
  5423. SetOnError (-1);
  5424. return (l);
  5425. }
  5426. /*
  5427. --------------------------------------------------------------------------------------------
  5428. ON ERROR RETURN
  5429. --------------------------------------------------------------------------------------------
  5430. */
  5431. LineType *
  5432. bwb_ON_ERROR_RETURN (LineType * l)
  5433. {
  5434. assert (l != NULL);
  5435. WARN_SYNTAX_ERROR;
  5436. return (l);
  5437. }
  5438. /*
  5439. --------------------------------------------------------------------------------------------
  5440. ON ERROR RETURN NEXT
  5441. --------------------------------------------------------------------------------------------
  5442. */
  5443. LineType *
  5444. bwb_ON_ERROR_RETURN_NEXT (LineType * l)
  5445. {
  5446. assert (l != NULL);
  5447. return bwb_ON_ERROR_RESUME_NEXT (l);
  5448. }
  5449. /*
  5450. --------------------------------------------------------------------------------------------
  5451. ON TIMER
  5452. --------------------------------------------------------------------------------------------
  5453. */
  5454. LineType *
  5455. bwb_ON_TIMER (LineType * l)
  5456. {
  5457. /* ON TIMER(...) GOSUB ... */
  5458. DoubleType v;
  5459. DoubleType minv;
  5460. int LineNumber;
  5461. assert (l != NULL);
  5462. assert( My != NULL );
  5463. My->IsTimerOn = FALSE; /* bwb_ON_TIMER */
  5464. My->OnTimerLineNumber = 0;
  5465. My->OnTimerCount = 0;
  5466. /* get the SECOMDS parameter */
  5467. if (line_read_numeric_expression (l, &v) == FALSE)
  5468. {
  5469. WARN_SYNTAX_ERROR;
  5470. return (l);
  5471. }
  5472. minv = 1;
  5473. assert (CLOCKS_PER_SEC > 0);
  5474. minv /= CLOCKS_PER_SEC;
  5475. if (v < minv)
  5476. {
  5477. /* ERROR */
  5478. WARN_ILLEGAL_FUNCTION_CALL;
  5479. return (l);
  5480. }
  5481. /* get the GOSUB keyword */
  5482. if (line_skip_word (l, "GOSUB") == FALSE)
  5483. {
  5484. WARN_SYNTAX_ERROR;
  5485. return (l);
  5486. }
  5487. /* ON TIMER(X) GOSUB line */
  5488. if (line_read_integer_expression (l, &LineNumber) == FALSE)
  5489. {
  5490. WARN_SYNTAX_ERROR;
  5491. return (l);
  5492. }
  5493. if (LineNumber < MINLIN || LineNumber > MAXLIN)
  5494. {
  5495. /* ERROR */
  5496. WARN_UNDEFINED_LINE;
  5497. return (l);
  5498. }
  5499. /* OK */
  5500. My->OnTimerLineNumber = LineNumber;
  5501. My->OnTimerCount = v;
  5502. return (l);
  5503. }
  5504. /*
  5505. --------------------------------------------------------------------------------------------
  5506. TIMER
  5507. --------------------------------------------------------------------------------------------
  5508. */
  5509. LineType *
  5510. bwb_TIMER (LineType * l)
  5511. {
  5512. assert (l != NULL);
  5513. assert( My != NULL );
  5514. My->IsTimerOn = FALSE; /* bwb_TIMER */
  5515. WARN_SYNTAX_ERROR;
  5516. return (l);
  5517. }
  5518. /*
  5519. --------------------------------------------------------------------------------------------
  5520. TIMER OFF
  5521. --------------------------------------------------------------------------------------------
  5522. */
  5523. LineType *
  5524. bwb_TIMER_OFF (LineType * l)
  5525. {
  5526. assert (l != NULL);
  5527. assert( My != NULL );
  5528. /* TIMER OFF */
  5529. My->IsTimerOn = FALSE; /* bwb_TIMER_OFF */
  5530. My->OnTimerLineNumber = 0;
  5531. My->OnTimerCount = 0;
  5532. return (l);
  5533. }
  5534. /*
  5535. --------------------------------------------------------------------------------------------
  5536. TIMER ON
  5537. --------------------------------------------------------------------------------------------
  5538. */
  5539. LineType *
  5540. bwb_TIMER_ON (LineType * l)
  5541. {
  5542. assert (l != NULL);
  5543. assert( My != NULL );
  5544. My->IsTimerOn = FALSE; /* bwb_TIMER_ON */
  5545. /* TIMER ON */
  5546. if (My->OnTimerCount > 0 && My->OnTimerLineNumber > 0)
  5547. {
  5548. My->OnTimerExpires = bwx_TIMER (My->OnTimerCount);
  5549. My->IsTimerOn = TRUE; /* bwb_TIMER_ON */
  5550. }
  5551. return (l);
  5552. }
  5553. /*
  5554. --------------------------------------------------------------------------------------------
  5555. TIMER STOP
  5556. --------------------------------------------------------------------------------------------
  5557. */
  5558. LineType *
  5559. bwb_TIMER_STOP (LineType * l)
  5560. {
  5561. assert (l != NULL);
  5562. assert( My != NULL );
  5563. My->IsTimerOn = FALSE; /* bwb_TIMER_STOP */
  5564. return (l);
  5565. }
  5566. /*
  5567. --------------------------------------------------------------------------------------------
  5568. RESUME
  5569. --------------------------------------------------------------------------------------------
  5570. */
  5571. LineType *
  5572. bwb_RESUME (LineType * l)
  5573. {
  5574. int LineNumber;
  5575. LineType *x;
  5576. assert (l != NULL);
  5577. assert( My != NULL );
  5578. LineNumber = 0;
  5579. x = My->ERL; /* bwb_RESUME */
  5580. WARN_CLEAR; /* bwb_RESUME */
  5581. if (l->LineFlags & (LINE_USER))
  5582. {
  5583. WARN_ILLEGAL_DIRECT;
  5584. return (l);
  5585. }
  5586. if (x == NULL)
  5587. {
  5588. WARN_RESUME_WITHOUT_ERROR;
  5589. return (l);
  5590. }
  5591. /* Get optional argument for RESUME */
  5592. if (line_is_eol (l))
  5593. {
  5594. /* RESUME */
  5595. /*
  5596. Execution resumes at the statement which caused the error
  5597. For structured commands, this is the top line of the structure.
  5598. */
  5599. x->position = 0;
  5600. return x;
  5601. }
  5602. if (line_skip_word (l, "NEXT"))
  5603. {
  5604. /* RESUME NEXT */
  5605. /*
  5606. Execution resumes at the statement immediately following the one which caused the error.
  5607. For structured commands, this is the bottom line of the structure.
  5608. */
  5609. switch (x->cmdnum)
  5610. {
  5611. case C_IF8THEN:
  5612. /* skip to END_IF */
  5613. assert (x->OtherLine != NULL);
  5614. for (x = x->OtherLine; x->cmdnum != C_END_IF; x = x->OtherLine);
  5615. break;
  5616. case C_SELECT_CASE:
  5617. /* skip to END_SELECT */
  5618. assert (x->OtherLine != NULL);
  5619. for (x = x->OtherLine; x->cmdnum != C_END_SELECT; x = x->OtherLine);
  5620. break;
  5621. default:
  5622. x = x->next;
  5623. }
  5624. x->position = 0;
  5625. return x;
  5626. }
  5627. /* RESUME ### */
  5628. if (line_read_integer_expression (l, &LineNumber) == FALSE)
  5629. {
  5630. WARN_SYNTAX_ERROR;
  5631. return (l);
  5632. }
  5633. if (LineNumber == 0)
  5634. {
  5635. /* SPECIAL CASE */
  5636. /* RESUME 0 */
  5637. /* Execution resumes at the statement which caused the error */
  5638. x->position = 0;
  5639. return x;
  5640. }
  5641. /* VERIFY LINE EXISTS */
  5642. x = find_line_number (LineNumber); /* RESUME 100 */
  5643. if (x != NULL)
  5644. {
  5645. /* FOUND */
  5646. x->position = 0;
  5647. return x;
  5648. }
  5649. /* NOT FOUND */
  5650. WARN_UNDEFINED_LINE;
  5651. return (l);
  5652. }
  5653. /*
  5654. --------------------------------------------------------------------------------------------
  5655. CMDS
  5656. --------------------------------------------------------------------------------------------
  5657. */
  5658. LineType *
  5659. bwb_CMDS (LineType * l)
  5660. {
  5661. int n;
  5662. int t;
  5663. assert (l != NULL);
  5664. assert( My != NULL );
  5665. assert( My->SYSOUT != NULL );
  5666. assert( My->SYSOUT->cfp != NULL );
  5667. My->CurrentFile = My->SYSOUT;
  5668. fprintf (My->SYSOUT->cfp, "BWBASIC COMMANDS AVAILABLE:\n");
  5669. /* run through the command table and print comand names */
  5670. t = 0;
  5671. for (n = 0; n < NUM_COMMANDS; n++)
  5672. {
  5673. fprintf (My->SYSOUT->cfp, "%s", IntrinsicCommandTable[n].name);
  5674. if (t < 4)
  5675. {
  5676. fprintf (My->SYSOUT->cfp, "\t");
  5677. t++;
  5678. }
  5679. else
  5680. {
  5681. fprintf (My->SYSOUT->cfp, "\n");
  5682. t = 0;
  5683. }
  5684. }
  5685. if (t > 0)
  5686. {
  5687. fprintf (My->SYSOUT->cfp, "\n");
  5688. }
  5689. ResetConsoleColumn ();
  5690. return (l);
  5691. }
  5692. static void
  5693. FixUp (char *Name)
  5694. {
  5695. char *C;
  5696. assert (Name != NULL);
  5697. C = Name;
  5698. while (*C)
  5699. {
  5700. if (bwb_isalnum (*C))
  5701. {
  5702. /* OK */
  5703. }
  5704. else
  5705. {
  5706. /* FIX */
  5707. switch (*C)
  5708. {
  5709. case '!':
  5710. *C = '1';
  5711. break;
  5712. case '@':
  5713. *C = '2';
  5714. break;
  5715. case '#':
  5716. *C = '3';
  5717. break;
  5718. case '$':
  5719. *C = '4';
  5720. break;
  5721. case '%':
  5722. *C = '5';
  5723. break;
  5724. case '^':
  5725. *C = '6';
  5726. break;
  5727. case '&':
  5728. *C = '7';
  5729. break;
  5730. case '*':
  5731. *C = '8';
  5732. break;
  5733. case '(':
  5734. *C = '9';
  5735. break;
  5736. case ')':
  5737. *C = '0';
  5738. break;
  5739. default:
  5740. *C = '_';
  5741. }
  5742. }
  5743. C++;
  5744. }
  5745. }
  5746. static void
  5747. CommandUniqueID (int i, char *UniqueID)
  5748. {
  5749. assert (UniqueID != NULL);
  5750. bwb_strcpy (UniqueID, "C_");
  5751. bwb_strcat (UniqueID, IntrinsicCommandTable[i].name);
  5752. FixUp (UniqueID);
  5753. }
  5754. static void
  5755. CommandVector (int i, char *Vector)
  5756. {
  5757. assert (Vector != NULL);
  5758. bwb_strcpy (Vector, "bwb_");
  5759. bwb_strcat (Vector, IntrinsicCommandTable[i].name);
  5760. FixUp (Vector);
  5761. }
  5762. static void
  5763. CommandOptionVersion (int n, char *OutputLine)
  5764. {
  5765. int i;
  5766. int j;
  5767. assert (OutputLine != NULL);
  5768. bwb_strcpy (OutputLine, "");
  5769. j = 0;
  5770. for (i = 0; i < NUM_VERSIONS; i++)
  5771. {
  5772. if (IntrinsicCommandTable[n].OptionVersionBitmask & bwb_vertable[i].
  5773. OptionVersionValue)
  5774. {
  5775. if (j > 0)
  5776. {
  5777. bwb_strcat (OutputLine, " | ");
  5778. }
  5779. bwb_strcat (OutputLine, bwb_vertable[i].ID);
  5780. j++;
  5781. }
  5782. }
  5783. }
  5784. void
  5785. SortAllCommands (void)
  5786. {
  5787. /* sort by name */
  5788. int i;
  5789. assert( My != NULL );
  5790. for (i = 0; i < NUM_COMMANDS - 1; i++)
  5791. {
  5792. int j;
  5793. int k;
  5794. k = i;
  5795. for (j = i + 1; j < NUM_COMMANDS; j++)
  5796. {
  5797. if (bwb_stricmp
  5798. (IntrinsicCommandTable[j].name, IntrinsicCommandTable[k].name) < 0)
  5799. {
  5800. k = j;
  5801. }
  5802. }
  5803. if (k > i)
  5804. {
  5805. CommandType t;
  5806. bwb_memcpy (&t, &(IntrinsicCommandTable[i]), sizeof (CommandType));
  5807. bwb_memcpy (&(IntrinsicCommandTable[i]), &(IntrinsicCommandTable[k]),
  5808. sizeof (CommandType));
  5809. bwb_memcpy (&(IntrinsicCommandTable[k]), &t, sizeof (CommandType));
  5810. }
  5811. }
  5812. #if THE_PRICE_IS_RIGHT
  5813. for (i = 0; i < 26; i++)
  5814. {
  5815. My->CommandStart[i] = -1;
  5816. }
  5817. for (i = 0; i < NUM_COMMANDS; i++)
  5818. {
  5819. int j;
  5820. j = VarTypeIndex (IntrinsicCommandTable[i].name[0]);
  5821. if (j < 0)
  5822. {
  5823. /* non-alpha */
  5824. }
  5825. else if (My->CommandStart[j] < 0)
  5826. {
  5827. /* this is the first command starting with this letter */
  5828. My->CommandStart[j] = i;
  5829. }
  5830. }
  5831. #endif /* THE_PRICE_IS_RIGHT */
  5832. }
  5833. void
  5834. SortAllFunctions (void)
  5835. {
  5836. /* sort by name then number of parameters */
  5837. int i;
  5838. assert( My != NULL );
  5839. for (i = 0; i < NUM_FUNCTIONS - 1; i++)
  5840. {
  5841. int j;
  5842. int k;
  5843. k = i;
  5844. for (j = i + 1; j < NUM_FUNCTIONS; j++)
  5845. {
  5846. int n;
  5847. n =
  5848. bwb_stricmp (IntrinsicFunctionTable[j].Name,
  5849. IntrinsicFunctionTable[k].Name);
  5850. if (n < 0)
  5851. {
  5852. k = j;
  5853. }
  5854. else if (n == 0)
  5855. {
  5856. if (IntrinsicFunctionTable[j].ParameterCount <
  5857. IntrinsicFunctionTable[k].ParameterCount)
  5858. {
  5859. k = j;
  5860. }
  5861. }
  5862. }
  5863. if (k > i)
  5864. {
  5865. IntrinsicFunctionType t;
  5866. bwb_memcpy (&t, &(IntrinsicFunctionTable[i]),
  5867. sizeof (IntrinsicFunctionType));
  5868. bwb_memcpy (&(IntrinsicFunctionTable[i]), &(IntrinsicFunctionTable[k]),
  5869. sizeof (IntrinsicFunctionType));
  5870. bwb_memcpy (&(IntrinsicFunctionTable[k]), &t,
  5871. sizeof (IntrinsicFunctionType));
  5872. }
  5873. }
  5874. #if THE_PRICE_IS_RIGHT
  5875. for (i = 0; i < 26; i++)
  5876. {
  5877. My->IntrinsicFunctionStart[i] = -1;
  5878. }
  5879. for (i = 0; i < NUM_FUNCTIONS; i++)
  5880. {
  5881. int j;
  5882. j = VarTypeIndex (IntrinsicFunctionTable[i].Name[0]);
  5883. if (j < 0)
  5884. {
  5885. /* non-alpha */
  5886. }
  5887. else if (My->IntrinsicFunctionStart[j] < 0)
  5888. {
  5889. /* this is the first command starting with this letter */
  5890. My->IntrinsicFunctionStart[j] = i;
  5891. }
  5892. }
  5893. #endif /* THE_PRICE_IS_RIGHT */
  5894. }
  5895. void
  5896. DumpAllCommandUniqueID (FILE * file)
  5897. {
  5898. int i;
  5899. int j;
  5900. char LastUniqueID[NameLengthMax + 1];
  5901. assert (file != NULL);
  5902. j = 0;
  5903. LastUniqueID[0] = NulChar;
  5904. fprintf (file, "/* COMMANDS */\n");
  5905. /* run through the command table and print comand #define */
  5906. for (i = 0; i < NUM_COMMANDS; i++)
  5907. {
  5908. char UniqueID[NameLengthMax + 1];
  5909. CommandUniqueID (i, UniqueID);
  5910. if (bwb_stricmp (LastUniqueID, UniqueID) != 0)
  5911. {
  5912. /* not a duplicate */
  5913. bwb_strcpy (LastUniqueID, UniqueID);
  5914. j = j + 1;
  5915. fprintf (file, "#define %-30s %3d /* %-30s */\n", UniqueID, j,
  5916. IntrinsicCommandTable[i].name);
  5917. }
  5918. }
  5919. fprintf (file, "#define NUM_COMMANDS %d\n", j);
  5920. fflush (file);
  5921. }
  5922. static void
  5923. ProcessEscapeChars (const char *Input, char *Output)
  5924. {
  5925. int n;
  5926. assert (Input != NULL);
  5927. assert (Output != NULL);
  5928. n = 0;
  5929. while (*Input)
  5930. {
  5931. /* \a \b \f \n \r \t \v \" \\ */
  5932. switch (*Input)
  5933. {
  5934. case '\a':
  5935. *Output = '\\';
  5936. Output++;
  5937. *Output = 'a';
  5938. Output++;
  5939. break;
  5940. case '\b':
  5941. *Output = '\\';
  5942. Output++;
  5943. *Output = 'b';
  5944. Output++;
  5945. break;
  5946. case '\f':
  5947. *Output = '\\';
  5948. Output++;
  5949. *Output = 'f';
  5950. Output++;
  5951. break;
  5952. case '\n':
  5953. *Output = '\\';
  5954. Output++;
  5955. *Output = 'n';
  5956. Output++;
  5957. break;
  5958. case '\r':
  5959. *Output = '\\';
  5960. Output++;
  5961. *Output = 'r';
  5962. Output++;
  5963. break;
  5964. case '\t':
  5965. *Output = '\\';
  5966. Output++;
  5967. *Output = 't';
  5968. Output++;
  5969. break;
  5970. case '\v':
  5971. *Output = '\\';
  5972. Output++;
  5973. *Output = 'n';
  5974. Output++;
  5975. break;
  5976. case '\"':
  5977. *Output = '\\';
  5978. Output++;
  5979. *Output = '"';
  5980. Output++;
  5981. break;
  5982. case '\\':
  5983. *Output = '\\';
  5984. Output++;
  5985. *Output = '\\';
  5986. Output++;
  5987. break;
  5988. default:
  5989. *Output = *Input;
  5990. Output++;
  5991. break;
  5992. }
  5993. *Output = NulChar;
  5994. n++;
  5995. if (n > 60 && *Input == ' ')
  5996. {
  5997. *Output = '\"';
  5998. Output++;
  5999. *Output = '\n';
  6000. Output++;
  6001. *Output = ' ';
  6002. Output++;
  6003. *Output = ' ';
  6004. Output++;
  6005. *Output = '\"';
  6006. Output++;
  6007. *Output = NulChar;
  6008. n = 0;
  6009. }
  6010. Input++;
  6011. }
  6012. }
  6013. void
  6014. DumpAllCommandTableDefinitions (FILE * file)
  6015. {
  6016. /* generate bwd_cmd.c */
  6017. int i;
  6018. assert (file != NULL);
  6019. fprintf (file, "/* COMMAND TABLE */\n\n");
  6020. fprintf (file, "#include \"bwbasic.h\"\n\n");
  6021. fprintf (file,
  6022. "CommandType IntrinsicCommandTable[ /* NUM_COMMANDS */ ] =\n");
  6023. fprintf (file, "{\n");
  6024. /* run through the command table and print comand #define */
  6025. for (i = 0; i < NUM_COMMANDS; i++)
  6026. {
  6027. char tbuf[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpAllCommandTableDefinitions */
  6028. fprintf (file, "{\n");
  6029. fprintf (file, " ");
  6030. CommandUniqueID (i, tbuf);
  6031. fprintf (file, "%s", tbuf);
  6032. fprintf (file, ", /* UniqueID */\n");
  6033. fprintf (file, " ");
  6034. fprintf (file, "\"");
  6035. ProcessEscapeChars (IntrinsicCommandTable[i].Syntax, tbuf);
  6036. fprintf (file, "%s", tbuf);
  6037. fprintf (file, "\"");
  6038. fprintf (file, ", /* Syntax */\n");
  6039. fprintf (file, " ");
  6040. fprintf (file, "\"");
  6041. ProcessEscapeChars (IntrinsicCommandTable[i].Description, tbuf);
  6042. fprintf (file, "%s", tbuf);
  6043. fprintf (file, "\"");
  6044. fprintf (file, ", /* Description */\n");
  6045. fprintf (file, " ");
  6046. fprintf (file, "\"");
  6047. fprintf (file, "%s", IntrinsicCommandTable[i].name);
  6048. fprintf (file, "\"");
  6049. fprintf (file, ", /* Name */\n");
  6050. fprintf (file, " ");
  6051. CommandOptionVersion (i, tbuf);
  6052. fprintf (file, "%s", tbuf);
  6053. fprintf (file, " /* OptionVersionBitmask */\n");
  6054. fprintf (file, "},\n");
  6055. }
  6056. fprintf (file, "};\n");
  6057. fprintf (file, "\n");
  6058. fprintf (file,
  6059. "const size_t NUM_COMMANDS = sizeof( IntrinsicCommandTable ) / sizeof( CommandType );\n");
  6060. fprintf (file, "\n");
  6061. fflush (file);
  6062. }
  6063. void
  6064. DumpAllCommandSwitchStatement (FILE * file)
  6065. {
  6066. int i;
  6067. char LastUniqueID[NameLengthMax + 1];
  6068. assert (file != NULL);
  6069. LastUniqueID[0] = NulChar;
  6070. /* run through the command table and print comand #define */
  6071. fprintf (file, "/* SWITCH */\n");
  6072. fprintf (file, "LineType *bwb_vector( LineType *l )\n");
  6073. fprintf (file, "{\n");
  6074. fprintf (file, " ");
  6075. fprintf (file, "LineType *r;\n");
  6076. fprintf (file, " ");
  6077. fprintf (file, "switch( l->cmdnum )\n");
  6078. fprintf (file, " ");
  6079. fprintf (file, "{\n");
  6080. for (i = 0; i < NUM_COMMANDS; i++)
  6081. {
  6082. char tbuf[NameLengthMax + 1];
  6083. CommandUniqueID (i, tbuf);
  6084. if (bwb_stricmp (LastUniqueID, tbuf) != 0)
  6085. {
  6086. /* not a duplicate */
  6087. bwb_strcpy (LastUniqueID, tbuf);
  6088. fprintf (file, " ");
  6089. fprintf (file, "case ");
  6090. CommandUniqueID (i, tbuf);
  6091. fprintf (file, "%s", tbuf);
  6092. fprintf (file, ":\n");
  6093. fprintf (file, " ");
  6094. fprintf (file, " ");
  6095. fprintf (file, "r = ");
  6096. CommandVector (i, tbuf);
  6097. fprintf (file, "%s", tbuf);
  6098. fprintf (file, "( l );\n");
  6099. fprintf (file, " ");
  6100. fprintf (file, " ");
  6101. fprintf (file, "break;\n");
  6102. }
  6103. }
  6104. fprintf (file, " ");
  6105. fprintf (file, "default:\n");
  6106. fprintf (file, " ");
  6107. fprintf (file, " ");
  6108. fprintf (file, "WARN_INTERNAL_ERROR;\n");
  6109. fprintf (file, " ");
  6110. fprintf (file, " ");
  6111. fprintf (file, "r = l;\n");
  6112. fprintf (file, " ");
  6113. fprintf (file, " ");
  6114. fprintf (file, "break;\n");
  6115. fprintf (file, " ");
  6116. fprintf (file, "}\n");
  6117. fprintf (file, " ");
  6118. fprintf (file, "return r;\n");
  6119. fprintf (file, "}\n");
  6120. fflush (file);
  6121. }
  6122. void
  6123. FixDescription (FILE * file, const char *left, const char *right)
  6124. {
  6125. char buffer[MAINTAINER_BUFFER_LENGTH + 1]; /* FixDescription */
  6126. int l; /* length of left side */
  6127. int p; /* current position */
  6128. int n; /* position of the last space character, zero means none yet seen */
  6129. int i; /* number of characters since last '\n' */
  6130. assert (left != NULL);
  6131. assert (right != NULL);
  6132. l = bwb_strlen (left);
  6133. p = 0;
  6134. n = 0;
  6135. i = 0;
  6136. bwb_strcpy (buffer, right);
  6137. while (buffer[p])
  6138. {
  6139. if (buffer[p] == '\n')
  6140. {
  6141. n = p;
  6142. i = 0;
  6143. }
  6144. if (buffer[p] == ' ')
  6145. {
  6146. n = p;
  6147. }
  6148. if (i > 45 && n > 0)
  6149. {
  6150. buffer[n] = '\n';
  6151. i = p - n;
  6152. }
  6153. p++;
  6154. i++;
  6155. }
  6156. fputs (left, file);
  6157. p = 0;
  6158. while (buffer[p])
  6159. {
  6160. if (buffer[p] == '\n')
  6161. {
  6162. fputc (buffer[p], file);
  6163. p++;
  6164. while (buffer[p] == ' ')
  6165. {
  6166. p++;
  6167. }
  6168. for (i = 0; i < l; i++)
  6169. {
  6170. fputc (' ', file);
  6171. }
  6172. }
  6173. else
  6174. {
  6175. fputc (buffer[p], file);
  6176. p++;
  6177. }
  6178. }
  6179. fputc ('\n', file);
  6180. }
  6181. void
  6182. DumpOneCommandSyntax (FILE * file, int IsXref, int n)
  6183. {
  6184. assert (file != NULL);
  6185. if (n < 0 || n >= NUM_COMMANDS)
  6186. {
  6187. return;
  6188. }
  6189. /* NAME */
  6190. {
  6191. FixDescription (file, " SYNTAX: ", IntrinsicCommandTable[n].Syntax);
  6192. }
  6193. /* DESCRIPTION */
  6194. {
  6195. FixDescription (file, "DESCRIPTION: ",
  6196. IntrinsicCommandTable[n].Description);
  6197. }
  6198. /* COMPATIBILITY */
  6199. if (IsXref)
  6200. {
  6201. int i;
  6202. fprintf (file, " VERSIONS:\n");
  6203. for (i = 0; i < NUM_VERSIONS; i++)
  6204. {
  6205. char X;
  6206. if (IntrinsicCommandTable[n].OptionVersionBitmask & bwb_vertable[i].
  6207. OptionVersionValue)
  6208. {
  6209. /* SUPPORTED */
  6210. X = 'X';
  6211. }
  6212. else
  6213. {
  6214. /* NOT SUPPORTED */
  6215. X = '_';
  6216. }
  6217. fprintf (file, " [%c] %s\n", X, bwb_vertable[i].Name);
  6218. }
  6219. }
  6220. fflush (file);
  6221. }
  6222. void
  6223. DumpAllCommandSyntax (FILE * file, int IsXref,
  6224. OptionVersionType OptionVersionValue)
  6225. {
  6226. /* for the C maintainer */
  6227. int i;
  6228. assert (file != NULL);
  6229. fprintf (file,
  6230. "============================================================\n");
  6231. fprintf (file,
  6232. " COMMANDS \n");
  6233. fprintf (file,
  6234. "============================================================\n");
  6235. fprintf (file, "\n");
  6236. fprintf (file, "\n");
  6237. for (i = 0; i < NUM_COMMANDS; i++)
  6238. {
  6239. if (IntrinsicCommandTable[i].OptionVersionBitmask & OptionVersionValue)
  6240. {
  6241. fprintf (file,
  6242. "------------------------------------------------------------\n");
  6243. DumpOneCommandSyntax (file, IsXref, i);
  6244. }
  6245. }
  6246. fprintf (file,
  6247. "------------------------------------------------------------\n");
  6248. fprintf (file, "\n");
  6249. fprintf (file, "\n");
  6250. fflush (file);
  6251. }
  6252. void
  6253. DumpAllCommandHtmlTable (FILE * file)
  6254. {
  6255. /* generate bwd_cmd.htm */
  6256. int i;
  6257. int j;
  6258. assert (file != NULL);
  6259. /* LEGEND */
  6260. fprintf (file, "<html><head><title>CMDS</title></head><body>\n");
  6261. fprintf (file, "<h1>LEGEND</h1><br>\n");
  6262. fprintf (file, "<table>\n");
  6263. fprintf (file, "<tr>");
  6264. fprintf (file, "<td>");
  6265. fprintf (file, "<b>");
  6266. fprintf (file, "ID");
  6267. fprintf (file, "</b>");
  6268. fprintf (file, "</td>");
  6269. fprintf (file, "<td>");
  6270. fprintf (file, "<b>");
  6271. fprintf (file, "NAME");
  6272. fprintf (file, "</b>");
  6273. fprintf (file, "</td>");
  6274. fprintf (file, "<td>");
  6275. fprintf (file, "<b>");
  6276. fprintf (file, "DESCRIPTION");
  6277. fprintf (file, "</b>");
  6278. fprintf (file, "</td>");
  6279. fprintf (file, "</tr>\n");
  6280. for (j = 0; j < NUM_VERSIONS; j++)
  6281. {
  6282. fprintf (file, "<tr>");
  6283. fprintf (file, "<td>");
  6284. fprintf (file, "%s", bwb_vertable[j].ID);
  6285. fprintf (file, "</td>");
  6286. fprintf (file, "<td>");
  6287. fprintf (file, "%s", bwb_vertable[j].Name);
  6288. fprintf (file, "</td>");
  6289. fprintf (file, "<td>");
  6290. fprintf (file, "%s", bwb_vertable[j].Description);
  6291. fprintf (file, "</td>");
  6292. fprintf (file, "</tr>\n");
  6293. }
  6294. fprintf (file, "</table>\n");
  6295. fprintf (file, "<hr>\n");
  6296. /* DETAILS */
  6297. fprintf (file, "<h1>DETAILS</h1><br>\n");
  6298. fprintf (file, "<table>\n");
  6299. fprintf (file, "<tr>");
  6300. fprintf (file, "<td>");
  6301. fprintf (file, "<b>");
  6302. fprintf (file, "COMMAND");
  6303. fprintf (file, "</b>");
  6304. fprintf (file, "</td>");
  6305. for (j = 0; j < NUM_VERSIONS; j++)
  6306. {
  6307. fprintf (file, "<td>");
  6308. fprintf (file, "<b>");
  6309. fprintf (file, "%s", bwb_vertable[j].ID);
  6310. fprintf (file, "</b>");
  6311. fprintf (file, "</td>");
  6312. }
  6313. fprintf (file, "</tr>\n");
  6314. /* run through the command table and print comand -vs- OPTION VERSION */
  6315. for (i = 0; i < NUM_COMMANDS; i++)
  6316. {
  6317. fprintf (file, "<tr>");
  6318. fprintf (file, "<td>");
  6319. fprintf (file, "%s", (char *) IntrinsicCommandTable[i].Syntax);
  6320. fprintf (file, "</td>");
  6321. for (j = 0; j < NUM_VERSIONS; j++)
  6322. {
  6323. fprintf (file, "<td>");
  6324. if (IntrinsicCommandTable[i].OptionVersionBitmask & bwb_vertable[j].
  6325. OptionVersionValue)
  6326. {
  6327. fprintf (file, "X");
  6328. }
  6329. else
  6330. {
  6331. fprintf (file, " ");
  6332. }
  6333. fprintf (file, "</td>");
  6334. }
  6335. fprintf (file, "</tr>\n");
  6336. }
  6337. fprintf (file, "</table>\n");
  6338. fprintf (file, "</body></html>\n");
  6339. fprintf (file, "\n");
  6340. fflush (file);
  6341. }
  6342. /*
  6343. --------------------------------------------------------------------------------------------
  6344. HELP
  6345. --------------------------------------------------------------------------------------------
  6346. */
  6347. LineType *
  6348. bwb_HELP (LineType * l)
  6349. {
  6350. /* HELP ... */
  6351. int n;
  6352. int Found;
  6353. char *C;
  6354. char *tbuf;
  6355. assert (l != NULL);
  6356. assert( My != NULL );
  6357. assert( My->ConsoleInput != NULL );
  6358. assert( My->SYSOUT != NULL );
  6359. assert( My->SYSOUT->cfp != NULL );
  6360. tbuf = My->ConsoleInput;
  6361. Found = FALSE;
  6362. C = l->buffer;
  6363. C += l->position;
  6364. bwb_strcpy (tbuf, C);
  6365. /* RTRIM$ */
  6366. C = tbuf;
  6367. if (*C != 0)
  6368. {
  6369. /* not an empty line, so remove one (or more) trailing spaces */
  6370. char *E;
  6371. E = bwb_strchr (tbuf, 0);
  6372. E--;
  6373. while (E >= tbuf && *E == ' ')
  6374. {
  6375. *E = 0;
  6376. E--;
  6377. }
  6378. }
  6379. /* EXACT match */
  6380. for (n = 0; n < NUM_COMMANDS; n++)
  6381. {
  6382. if (bwb_stricmp (IntrinsicCommandTable[n].name, tbuf) == 0)
  6383. {
  6384. fprintf (My->SYSOUT->cfp,
  6385. "------------------------------------------------------------\n");
  6386. DumpOneCommandSyntax (My->SYSOUT->cfp, FALSE, n);
  6387. Found = TRUE;
  6388. }
  6389. }
  6390. for (n = 0; n < NUM_FUNCTIONS; n++)
  6391. {
  6392. if (bwb_stricmp (IntrinsicFunctionTable[n].Name, tbuf) == 0)
  6393. {
  6394. fprintf (My->SYSOUT->cfp,
  6395. "------------------------------------------------------------\n");
  6396. DumpOneFunctionSyntax (My->SYSOUT->cfp, FALSE, n);
  6397. Found = TRUE;
  6398. }
  6399. }
  6400. if (Found == FALSE)
  6401. {
  6402. /* PARTIAL match */
  6403. int Length;
  6404. Length = bwb_strlen (tbuf);
  6405. for (n = 0; n < NUM_COMMANDS; n++)
  6406. {
  6407. if (bwb_strnicmp (IntrinsicCommandTable[n].name, tbuf, Length) == 0)
  6408. {
  6409. if (Found == FALSE)
  6410. {
  6411. fprintf (My->SYSOUT->cfp,
  6412. "The following topics are a partial match:\n");
  6413. }
  6414. fprintf (My->SYSOUT->cfp, "%s", IntrinsicCommandTable[n].name);
  6415. fprintf (My->SYSOUT->cfp, "\t");
  6416. Found = TRUE;
  6417. }
  6418. }
  6419. for (n = 0; n < NUM_FUNCTIONS; n++)
  6420. {
  6421. if (bwb_strnicmp (IntrinsicFunctionTable[n].Name, tbuf, Length) == 0)
  6422. {
  6423. if (Found == FALSE)
  6424. {
  6425. fprintf (My->SYSOUT->cfp,
  6426. "The following topics are a partial match:\n");
  6427. }
  6428. fprintf (My->SYSOUT->cfp, "%s", IntrinsicFunctionTable[n].Name);
  6429. fprintf (My->SYSOUT->cfp, "\t");
  6430. Found = TRUE;
  6431. }
  6432. }
  6433. if (Found == TRUE)
  6434. {
  6435. /* match */
  6436. fprintf (My->SYSOUT->cfp, "\n");
  6437. }
  6438. }
  6439. if (Found == FALSE)
  6440. {
  6441. /* NO match */
  6442. fprintf (My->SYSOUT->cfp, "No help found.\n");
  6443. }
  6444. ResetConsoleColumn ();
  6445. line_skip_eol (l);
  6446. return (l);
  6447. }
  6448. int
  6449. NumberValueCheck (ParamTestType ParameterTests, DoubleType X)
  6450. {
  6451. DoubleType XR; /* rounded value */
  6452. unsigned char TestNibble;
  6453. /* VerifyNumeric */
  6454. if (isnan (X))
  6455. {
  6456. /* INTERNAL ERROR */
  6457. return -1;
  6458. }
  6459. if (isinf (X))
  6460. {
  6461. /* - Evaluation of an expression results in an overflow
  6462. * (nonfatal, the recommended recovery procedure is to supply
  6463. * machine in- finity with the algebraically correct sign and
  6464. * continue). */
  6465. if (X < 0)
  6466. {
  6467. X = MINDBL;
  6468. }
  6469. else
  6470. {
  6471. X = MAXDBL;
  6472. }
  6473. if (WARN_OVERFLOW)
  6474. {
  6475. /* ERROR */
  6476. return -1;
  6477. }
  6478. /* CONTINUE */
  6479. }
  6480. /* OK */
  6481. /* VALID NUMERIC VALUE */
  6482. XR = bwb_rint (X);
  6483. ParameterTests &= 0x0000000F;
  6484. TestNibble = (unsigned char) ParameterTests;
  6485. switch (TestNibble)
  6486. {
  6487. case P1ERR:
  6488. /* INTERNAL ERROR */
  6489. return -1;
  6490. /* break; */
  6491. case P1ANY:
  6492. if (X < MINDBL || X > MAXDBL)
  6493. {
  6494. /* ERROR */
  6495. return -1;
  6496. }
  6497. /* OK */
  6498. return 0;
  6499. /* break; */
  6500. case P1BYT:
  6501. if (XR < MINBYT || XR > MAXBYT)
  6502. {
  6503. /* ERROR */
  6504. return -1;
  6505. }
  6506. /* OK */
  6507. return 0;
  6508. /* break; */
  6509. case P1INT:
  6510. if (XR < MININT || XR > MAXINT)
  6511. {
  6512. /* ERROR */
  6513. return -1;
  6514. }
  6515. /* OK */
  6516. return 0;
  6517. /* break; */
  6518. case P1LNG:
  6519. if (XR < MINLNG || XR > MAXLNG)
  6520. {
  6521. /* ERROR */
  6522. return -1;
  6523. }
  6524. /* OK */
  6525. return 0;
  6526. /* break; */
  6527. case P1CUR:
  6528. if (XR < MINCUR || XR > MAXCUR)
  6529. {
  6530. /* ERROR */
  6531. return -1;
  6532. }
  6533. /* OK */
  6534. return 0;
  6535. /* break; */
  6536. case P1FLT:
  6537. if (X < MINSNG || X > MAXSNG)
  6538. {
  6539. /* ERROR */
  6540. return -1;
  6541. }
  6542. /* OK */
  6543. return 0;
  6544. /* break; */
  6545. case P1DBL:
  6546. if (X < MINDBL || X > MAXDBL)
  6547. {
  6548. /* ERROR */
  6549. return -1;
  6550. }
  6551. /* OK */
  6552. return 0;
  6553. /* break; */
  6554. case P1DEV:
  6555. /* ERROR */
  6556. return -1;
  6557. /* break; */
  6558. case P1LEN:
  6559. if (XR < MINLEN || XR > MAXLEN)
  6560. {
  6561. /* ERROR */
  6562. return -1;
  6563. }
  6564. /* OK */
  6565. return 0;
  6566. /* break; */
  6567. case P1POS:
  6568. if (XR < 1 || XR > MAXLEN)
  6569. {
  6570. /* ERROR */
  6571. return -1;
  6572. }
  6573. /* OK */
  6574. return 0;
  6575. /* break; */
  6576. case P1COM:
  6577. /* ERROR */
  6578. return -1;
  6579. /* break; */
  6580. case P1LPT:
  6581. /* ERROR */
  6582. return -1;
  6583. /* break; */
  6584. case P1GTZ:
  6585. if (X > 0)
  6586. {
  6587. /* OK */
  6588. return 0;
  6589. }
  6590. break;
  6591. case P1GEZ:
  6592. if (X >= 0)
  6593. {
  6594. /* OK */
  6595. return 0;
  6596. }
  6597. break;
  6598. case P1NEZ:
  6599. if (X != 0)
  6600. {
  6601. /* OK */
  6602. return 0;
  6603. }
  6604. break;
  6605. }
  6606. /* ERROR */
  6607. return -1;
  6608. }
  6609. int
  6610. StringLengthCheck (ParamTestType ParameterTests, int s)
  6611. {
  6612. unsigned char TestNibble;
  6613. /* check for invalid string length */
  6614. if (s < 0 || s > MAXLEN)
  6615. {
  6616. /* INTERNAL ERROR */
  6617. return -1;
  6618. }
  6619. /* VALID STRING LENGTH */
  6620. ParameterTests &= 0x0000000F;
  6621. TestNibble = (unsigned char) ParameterTests;
  6622. switch (TestNibble)
  6623. {
  6624. case P1ERR:
  6625. /* INTERNAL ERROR */
  6626. return -1;
  6627. /* break; */
  6628. case P1ANY:
  6629. /* OK */
  6630. return 0;
  6631. /* break; */
  6632. case P1BYT:
  6633. if (s >= sizeof (ByteType))
  6634. {
  6635. /* OK */
  6636. return 0;
  6637. }
  6638. break;
  6639. case P1INT:
  6640. if (s >= sizeof (IntegerType))
  6641. {
  6642. /* OK */
  6643. return 0;
  6644. }
  6645. break;
  6646. case P1LNG:
  6647. if (s >= sizeof (LongType))
  6648. {
  6649. /* OK */
  6650. return 0;
  6651. }
  6652. break;
  6653. case P1CUR:
  6654. if (s >= sizeof (CurrencyType))
  6655. {
  6656. /* OK */
  6657. return 0;
  6658. }
  6659. break;
  6660. case P1FLT:
  6661. if (s >= sizeof (SingleType))
  6662. {
  6663. /* OK */
  6664. return 0;
  6665. }
  6666. break;
  6667. case P1DBL:
  6668. if (s >= sizeof (DoubleType))
  6669. {
  6670. /* OK */
  6671. return 0;
  6672. }
  6673. break;
  6674. case P1DEV:
  6675. /* ERROR */
  6676. return -1;
  6677. /* break; */
  6678. case P1LEN:
  6679. /* ERROR */
  6680. return -1;
  6681. /* break; */
  6682. case P1POS:
  6683. /* ERROR */
  6684. return -1;
  6685. /* break; */
  6686. case P1GEZ:
  6687. /* ERROR */
  6688. return -1;
  6689. /* break; */
  6690. case P1GTZ:
  6691. /* ERROR */
  6692. return -1;
  6693. /* break; */
  6694. case P1NEZ:
  6695. /* ERROR */
  6696. return -1;
  6697. /* break; */
  6698. }
  6699. /* ERROR */
  6700. return -1;
  6701. }
  6702. void
  6703. IntrinsicFunctionDefinitionCheck (IntrinsicFunctionType * f)
  6704. {
  6705. /* function definition check -- look for obvious errors */
  6706. assert (f != NULL);
  6707. assert( My != NULL );
  6708. assert( My->SYSOUT != NULL );
  6709. assert( My->SYSOUT->cfp != NULL );
  6710. /* sanity check */
  6711. if (f->ParameterCount == PNONE || f->ParameterCount == 0xFF)
  6712. {
  6713. /* function has NO explicit parameters */
  6714. if (f->ParameterTypes == PNONE)
  6715. {
  6716. /* OK */
  6717. }
  6718. else
  6719. {
  6720. /* oops */
  6721. fprintf (My->SYSOUT->cfp, "invalid ParameterTypes <%s>\n", f->Name);
  6722. }
  6723. if (f->ParameterTests == PNONE)
  6724. {
  6725. /* OK */
  6726. }
  6727. else
  6728. {
  6729. /* oops */
  6730. fprintf (My->SYSOUT->cfp, "invalid ParameterTests <%s>\n", f->Name);
  6731. }
  6732. }
  6733. else
  6734. {
  6735. /* function HAS an explicit number of parameters */
  6736. int i;
  6737. ParamTestType ParameterTests;
  6738. ParameterTests = f->ParameterTests;
  6739. for (i = 0; i < f->ParameterCount; i++)
  6740. {
  6741. /* sanity check this parameter */
  6742. ParamTestType thischeck;
  6743. thischeck = ParameterTests & 0x0000000F;
  6744. /* verify parameter check */
  6745. if (f->ParameterTypes & (1 << i))
  6746. {
  6747. /* STRING */
  6748. if (thischeck >= P1ANY && thischeck <= P1DBL)
  6749. {
  6750. /* OK */
  6751. }
  6752. else
  6753. {
  6754. /* oops */
  6755. fprintf (My->SYSOUT->cfp,
  6756. "invalid ParameterTests <%s> parameter %d\n", f->Name,
  6757. i + 1);
  6758. }
  6759. }
  6760. else
  6761. {
  6762. /* NUMBER */
  6763. if (thischeck >= P1ANY && thischeck <= P1NEZ)
  6764. {
  6765. /* OK */
  6766. }
  6767. else
  6768. {
  6769. /* oops */
  6770. fprintf (My->SYSOUT->cfp,
  6771. "invalid ParameterTests <%s> parameter %d\n", f->Name,
  6772. i + 1);
  6773. }
  6774. }
  6775. ParameterTests = ParameterTests >> 4;
  6776. }
  6777. if (ParameterTests != 0)
  6778. {
  6779. /* oops */
  6780. fprintf (My->SYSOUT->cfp, "invalid ParameterTests <%s> parameter %d\n",
  6781. f->Name, i + 1);
  6782. }
  6783. }
  6784. }
  6785. void
  6786. IntrinsicFunctionUniqueID (IntrinsicFunctionType * f, char *UniqueID)
  6787. {
  6788. /* generate the function's UniqueID */
  6789. /* manual fixup required for duplicates */
  6790. char NumVar;
  6791. char StrVar;
  6792. assert (f != NULL);
  6793. assert (UniqueID != NULL);
  6794. NumVar = 'X';
  6795. StrVar = 'A';
  6796. /* F_ */
  6797. bwb_strcpy (UniqueID, "F_");
  6798. /* NAME */
  6799. bwb_strcat (UniqueID, f->Name);
  6800. /* PARAMETERS */
  6801. if (f->ParameterCount == PNONE || f->ParameterCount == 0xFF)
  6802. {
  6803. /* function has NO explicit parameters */
  6804. }
  6805. else
  6806. {
  6807. /* function HAS explicit parameters */
  6808. int i;
  6809. ParamBitsType ParameterTypes;
  6810. ParameterTypes = f->ParameterTypes;
  6811. for (i = 0; i < f->ParameterCount; i++)
  6812. {
  6813. char VarName[NameLengthMax + 1];
  6814. if (ParameterTypes & 1)
  6815. {
  6816. /* STRING */
  6817. sprintf (VarName, "_%c", StrVar);
  6818. StrVar++;
  6819. }
  6820. else
  6821. {
  6822. /* NUMBER */
  6823. sprintf (VarName, "_%c", NumVar);
  6824. NumVar++;
  6825. }
  6826. bwb_strcat (UniqueID, VarName);
  6827. ParameterTypes = ParameterTypes >> 1;
  6828. }
  6829. }
  6830. /* RETURN TYPE */
  6831. if (f->ReturnTypeCode == StringTypeCode)
  6832. {
  6833. bwb_strcat (UniqueID, "_S");
  6834. }
  6835. else
  6836. {
  6837. bwb_strcat (UniqueID, "_N");
  6838. }
  6839. /* fixup illegal characters, "DEF FN" "BLOAD:", "CLOAD*" */
  6840. FixUp (UniqueID);
  6841. }
  6842. void
  6843. IntrinsicFunctionSyntax (IntrinsicFunctionType * f, char *Syntax)
  6844. {
  6845. /* generate the function's Syntax */
  6846. char NumVar;
  6847. char StrVar;
  6848. assert (f != NULL);
  6849. assert (Syntax != NULL);
  6850. NumVar = 'X';
  6851. StrVar = 'A';
  6852. /* RETURN TYPE */
  6853. if (f->ReturnTypeCode == StringTypeCode)
  6854. {
  6855. bwb_strcpy (Syntax, "S$ = ");
  6856. }
  6857. else
  6858. {
  6859. bwb_strcpy (Syntax, "N = ");
  6860. }
  6861. /* NAME */
  6862. bwb_strcat (Syntax, f->Name);
  6863. /* PARAMETERS */
  6864. if (f->ParameterCount == PNONE)
  6865. {
  6866. /* function has NO explicit parameters */
  6867. }
  6868. else if (f->ParameterCount == 0xFF)
  6869. {
  6870. /* function has a variable number of parameters */
  6871. bwb_strcat (Syntax, "( ... )");
  6872. }
  6873. else
  6874. {
  6875. /* function HAS explicit parameters */
  6876. int i;
  6877. ParamBitsType ParameterTypes;
  6878. ParameterTypes = f->ParameterTypes;
  6879. if (f->ReturnTypeCode == StringTypeCode)
  6880. {
  6881. bwb_strcat (Syntax, "( ");
  6882. }
  6883. else
  6884. {
  6885. bwb_strcat (Syntax, "( ");
  6886. }
  6887. for (i = 0; i < f->ParameterCount; i++)
  6888. {
  6889. char VarName[NameLengthMax + 1];
  6890. if (i > 0)
  6891. {
  6892. bwb_strcat (Syntax, ", ");
  6893. }
  6894. /* verify parameter check */
  6895. if (ParameterTypes & 1)
  6896. {
  6897. /* STRING */
  6898. sprintf (VarName, "%c$", StrVar);
  6899. StrVar++;
  6900. }
  6901. else
  6902. {
  6903. /* NUMBER */
  6904. sprintf (VarName, "%c", NumVar);
  6905. NumVar++;
  6906. }
  6907. bwb_strcat (Syntax, VarName);
  6908. ParameterTypes = ParameterTypes >> 1;
  6909. }
  6910. if (f->ReturnTypeCode == StringTypeCode)
  6911. {
  6912. bwb_strcat (Syntax, " )");
  6913. }
  6914. else
  6915. {
  6916. bwb_strcat (Syntax, " )");
  6917. }
  6918. }
  6919. }
  6920. void
  6921. DumpAllFunctionUniqueID (FILE * file)
  6922. {
  6923. /* for the C maintainer */
  6924. int i;
  6925. int j;
  6926. char LastUniqueID[NameLengthMax + 1];
  6927. assert (file != NULL);
  6928. j = 0;
  6929. LastUniqueID[0] = NulChar;
  6930. fprintf (file, "/* FUNCTIONS */\n");
  6931. for (i = 0; i < NUM_FUNCTIONS; i++)
  6932. {
  6933. char UniqueID[NameLengthMax + 1];
  6934. IntrinsicFunctionUniqueID (&(IntrinsicFunctionTable[i]), UniqueID);
  6935. if (bwb_stricmp (LastUniqueID, UniqueID) != 0)
  6936. {
  6937. /* not a duplicate */
  6938. char Syntax[NameLengthMax + 1];
  6939. bwb_strcpy (LastUniqueID, UniqueID);
  6940. j = j + 1;
  6941. IntrinsicFunctionSyntax (&(IntrinsicFunctionTable[i]), Syntax);
  6942. fprintf (file, "#define %-30s %3d /* %-30s */\n", UniqueID, j, Syntax);
  6943. }
  6944. }
  6945. fprintf (file, "#define NUM_FUNCTIONS %d\n", j);
  6946. fflush (file);
  6947. }
  6948. void
  6949. DumpAllFunctionSwitch (FILE * file)
  6950. {
  6951. /* for the C maintainer */
  6952. int i;
  6953. assert (file != NULL);
  6954. fprintf (file, "/* SWITCH */\n");
  6955. fprintf (file, "switch( UniqueID )\n");
  6956. fprintf (file, "{\n");
  6957. for (i = 0; i < NUM_FUNCTIONS; i++)
  6958. {
  6959. char tbuf[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpAllFunctionSwitch */
  6960. fprintf (file, "case ");
  6961. IntrinsicFunctionUniqueID (&(IntrinsicFunctionTable[i]), tbuf);
  6962. fprintf (file, "%s", tbuf);
  6963. fprintf (file, ":\n");
  6964. fprintf (file, " break;\n");
  6965. }
  6966. fprintf (file, "}\n");
  6967. fflush (file);
  6968. }
  6969. static const char *ParameterRangeID[16] = {
  6970. "P%dERR",
  6971. "P%dANY",
  6972. "P%dBYT",
  6973. "P%dINT",
  6974. "P%dLNG",
  6975. "P%dCUR",
  6976. "P%dFLT",
  6977. "P%dDBL",
  6978. "P%dDEV",
  6979. "P%dLEN",
  6980. "P%dPOS",
  6981. "P%dCOM",
  6982. "P%dLPT",
  6983. "P%dGTZ",
  6984. "P%dGEZ",
  6985. "P%dNEZ",
  6986. };
  6987. static const char *NumberVariableRange[16] = {
  6988. /* P1ERR */ " PARAMETER: %c is a number, INTERNAL ERROR",
  6989. /* P1ANY */ " PARAMETER: %c is a number",
  6990. /* P1BYT */ " PARAMETER: %c is a number, [0,255]",
  6991. /* P1INT */ " PARAMETER: %c is a number, [MININT,MAXINT]",
  6992. /* P1LNG */ " PARAMETER: %c is a number, [MINLNG,MAXLNG]",
  6993. /* P1CUR */ " PARAMETER: %c is a number, [MINCUR,MAXCUR]",
  6994. /* P1FLT */ " PARAMETER: %c is a number, [MINFLT,MAXFLT]",
  6995. /* P1DBL */ " PARAMETER: %c is a number, [MINDBL,MAXDBL]",
  6996. /* P1DEV */ " PARAMETER: %c is a number, RESERVED",
  6997. /* P1LEN */ " PARAMETER: %c is a number, [0,MAXLEN]",
  6998. /* P1POS */ " PARAMETER: %c is a number, [1,MAXLEN]",
  6999. /* P1COM */ " PARAMETER: %c is a number, RESERVED",
  7000. /* P1LPT */ " PARAMETER: %c is a number, RESERVED",
  7001. /* P1GTZ */ " PARAMETER: %c is a number, > 0",
  7002. /* P1GEZ */ " PARAMETER: %c is a number, >= 0",
  7003. /* P1NEZ */ " PARAMETER: %c is a number, <> 0",
  7004. };
  7005. static const char *StringVariableRange[16] = {
  7006. /* P1ERR */ " PARAMETER: %c$ is a string, INTERNAL ERROR",
  7007. /* P1ANY */ " PARAMETER: %c$ is a string, LEN >= 0",
  7008. /* P1BYT */ " PARAMETER: %c$ is a string, LEN >= 1",
  7009. /* P1INT */ " PARAMETER: %c$ is a string, LEN >= sizeof(INT)",
  7010. /* P1LNG */ " PARAMETER: %c$ is a string, LEN >= sizeof(LNG)",
  7011. /* P1CUR */ " PARAMETER: %c$ is a string, LEN >= sizeof(CUR)",
  7012. /* P1FLT */ " PARAMETER: %c$ is a string, LEN >= sizeof(FLT)",
  7013. /* P1DBL */ " PARAMETER: %c$ is a string, LEN >= sizeof(DBL)",
  7014. /* P1DEV */ " PARAMETER: %c$ is a string, RESERVED",
  7015. /* P1LEN */ " PARAMETER: %c$ is a string, RESERVED",
  7016. /* P1POS */ " PARAMETER: %c$ is a string, RESERVED",
  7017. /* P1COM */ " PARAMETER: %c$ is a string, RESERVED",
  7018. /* P1LPT */ " PARAMETER: %c$ is a string, RESERVED",
  7019. /* P1GTZ */ " PARAMETER: %c$ is a string, RESERVED",
  7020. /* P1GEZ */ " PARAMETER: %c$ is a string, RESERVED",
  7021. /* P1NEZ */ " PARAMETER: %c$ is a string, RESERVED",
  7022. };
  7023. void
  7024. DumpAllFuctionTableDefinitions (FILE * file)
  7025. {
  7026. /* generate bwd_fun.c */
  7027. int n;
  7028. assert (file != NULL);
  7029. fprintf (file, "/* FUNCTION TABLE */\n");
  7030. fprintf (file, "\n");
  7031. fprintf (file, "#include \"bwbasic.h\"\n");
  7032. fprintf (file, "\n");
  7033. fprintf (file,
  7034. "IntrinsicFunctionType IntrinsicFunctionTable[ /* NUM_FUNCTIONS */ ] =\n");
  7035. fprintf (file, "{\n");
  7036. for (n = 0; n < NUM_FUNCTIONS; n++)
  7037. {
  7038. int i;
  7039. int j;
  7040. char tbuf[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpAllFuctionTableDefinitions */
  7041. char UniqueID[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpAllFuctionTableDefinitions */
  7042. char Syntax[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpAllFuctionTableDefinitions */
  7043. IntrinsicFunctionType *f;
  7044. f = &(IntrinsicFunctionTable[n]);
  7045. IntrinsicFunctionUniqueID (f, UniqueID);
  7046. IntrinsicFunctionSyntax (f, Syntax);
  7047. fprintf (file, "{\n");
  7048. fprintf (file, " %s, /* UniqueID */\n", UniqueID);
  7049. fprintf (file, " \"%s\", /* Syntax */\n", Syntax);
  7050. fprintf (file, " ");
  7051. fprintf (file, "\"");
  7052. ProcessEscapeChars (f->Description, tbuf);
  7053. fprintf (file, "%s", tbuf);
  7054. fprintf (file, "\"");
  7055. fprintf (file, ", /* Description */\n");
  7056. fprintf (file, " \"%s\", /* Name */\n", f->Name);
  7057. switch (f->ReturnTypeCode)
  7058. {
  7059. case ByteTypeCode:
  7060. fprintf (file, " %s, /* ReturnTypeCode */\n", "ByteTypeCode");
  7061. break;
  7062. case IntegerTypeCode:
  7063. fprintf (file, " %s, /* ReturnTypeCode */\n", "IntegerTypeCode");
  7064. break;
  7065. case LongTypeCode:
  7066. fprintf (file, " %s, /* ReturnTypeCode */\n", "LongTypeCode");
  7067. break;
  7068. case CurrencyTypeCode:
  7069. fprintf (file, " %s, /* ReturnTypeCode */\n", "CurrencyTypeCode");
  7070. break;
  7071. case SingleTypeCode:
  7072. fprintf (file, " %s, /* ReturnTypeCode */\n", "SingleTypeCode");
  7073. break;
  7074. case DoubleTypeCode:
  7075. fprintf (file, " %s, /* ReturnTypeCode */\n", "DoubleTypeCode");
  7076. break;
  7077. case StringTypeCode:
  7078. fprintf (file, " %s, /* ReturnTypeCode */\n", "StringTypeCode");
  7079. break;
  7080. default:
  7081. fprintf (file, " %s, /* ReturnTypeCode */\n", "INTERNAL ERROR");
  7082. break;
  7083. }
  7084. fprintf (file, " %d, /* ParameterCount */\n", f->ParameterCount);
  7085. if (f->ParameterCount == 0 || f->ParameterCount == 0xFF)
  7086. {
  7087. /* function has NO explicit parameters */
  7088. fprintf (file, " %s, /* ParameterTypes */\n", "PNONE");
  7089. fprintf (file, " %s, /* ParameterTests */\n", "PNONE");
  7090. }
  7091. else
  7092. {
  7093. /* function has explicit parameters */
  7094. bwb_strcpy (tbuf, " ");
  7095. for (i = 0; i < f->ParameterCount; i++)
  7096. {
  7097. ParamBitsType ParameterTypes;
  7098. ParameterTypes = f->ParameterTypes >> i;
  7099. ParameterTypes &= 0x1;
  7100. if (i > 0)
  7101. {
  7102. bwb_strcat (tbuf, " | ");
  7103. }
  7104. if (ParameterTypes)
  7105. {
  7106. sprintf (bwb_strchr (tbuf, NulChar), "P%dSTR", i + 1);
  7107. }
  7108. else
  7109. {
  7110. sprintf (bwb_strchr (tbuf, NulChar), "P%dNUM", i + 1);
  7111. }
  7112. }
  7113. bwb_strcat (tbuf, ", /* ParameterTypes */\n");
  7114. fprintf (file, "%s", tbuf);
  7115. bwb_strcpy (tbuf, " ");
  7116. for (i = 0; i < f->ParameterCount; i++)
  7117. {
  7118. ParamTestType ParameterTests;
  7119. ParameterTests = f->ParameterTests >> (i * 4);
  7120. ParameterTests &= 0xF;
  7121. if (i > 0)
  7122. {
  7123. bwb_strcat (tbuf, " | ");
  7124. }
  7125. sprintf (bwb_strchr (tbuf, 0), ParameterRangeID[ParameterTests],
  7126. i + 1);
  7127. /* Conversion may lose significant digits */
  7128. }
  7129. bwb_strcat (tbuf, ", /* ParameterTests */\n");
  7130. fprintf (file, "%s", tbuf);
  7131. }
  7132. bwb_strcpy (tbuf, " ");
  7133. j = 0;
  7134. for (i = 0; i < NUM_VERSIONS; i++)
  7135. {
  7136. if (f->OptionVersionBitmask & bwb_vertable[i].OptionVersionValue)
  7137. {
  7138. if (j > 0)
  7139. {
  7140. bwb_strcat (tbuf, " | ");
  7141. }
  7142. bwb_strcat (tbuf, bwb_vertable[i].ID);
  7143. j++;
  7144. }
  7145. }
  7146. bwb_strcat (tbuf, " /* OptionVersionBitmask */\n");
  7147. fprintf (file, "%s", tbuf);
  7148. fprintf (file, "},\n");
  7149. }
  7150. fprintf (file, "};\n");
  7151. fprintf (file, "\n");
  7152. fprintf (file,
  7153. "const size_t NUM_FUNCTIONS = sizeof( IntrinsicFunctionTable ) / sizeof( IntrinsicFunctionType );\n");
  7154. fprintf (file, "\n");
  7155. fflush (file);
  7156. }
  7157. void
  7158. DumpOneFunctionSyntax (FILE * file, int IsXref, int n)
  7159. {
  7160. IntrinsicFunctionType *f;
  7161. assert (file != NULL);
  7162. if (n < 0 || n >= NUM_FUNCTIONS)
  7163. {
  7164. return;
  7165. }
  7166. f = &(IntrinsicFunctionTable[n]);
  7167. /* NAME */
  7168. {
  7169. char UniqueID[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpOneFunctionSyntax */
  7170. char Syntax[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpOneFunctionSyntax */
  7171. IntrinsicFunctionUniqueID (f, UniqueID);
  7172. IntrinsicFunctionSyntax (f, Syntax);
  7173. fprintf (file, " SYNTAX: %s\n", Syntax);
  7174. }
  7175. /* PARAMETERS */
  7176. if (f->ParameterCount == PNONE || f->ParameterCount == 0xFF)
  7177. {
  7178. /* function has NO explicit parameters */
  7179. }
  7180. else
  7181. {
  7182. /* function HAS explicit parameters */
  7183. int i;
  7184. ParamBitsType ParameterTypes;
  7185. ParamTestType ParameterTests;
  7186. char NumVar;
  7187. char StrVar;
  7188. ParameterTypes = f->ParameterTypes;
  7189. ParameterTests = f->ParameterTests;
  7190. NumVar = 'X';
  7191. StrVar = 'A';
  7192. for (i = 0; i < f->ParameterCount; i++)
  7193. {
  7194. /* sanity check this parameter */
  7195. unsigned long thischeck;
  7196. char tbuf[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpOneFunctionSyntax */
  7197. thischeck = ParameterTests & 0x0000000F;
  7198. /* verify parameter check */
  7199. if (ParameterTypes & 1)
  7200. {
  7201. /* STRING */
  7202. sprintf (tbuf, StringVariableRange[thischeck], StrVar);
  7203. /* Conversion may lose significant digits */
  7204. StrVar++;
  7205. }
  7206. else
  7207. {
  7208. /* NUMBER */
  7209. sprintf (tbuf, NumberVariableRange[thischeck], NumVar);
  7210. /* Conversion may lose significant digits */
  7211. NumVar++;
  7212. }
  7213. fprintf (file, "%s", tbuf);
  7214. fprintf (file, "\n");
  7215. ParameterTypes = ParameterTypes >> 1;
  7216. ParameterTests = ParameterTests >> 4;
  7217. }
  7218. }
  7219. /* DESCRIPTION */
  7220. {
  7221. FixDescription (file, "DESCRIPTION: ", f->Description);
  7222. }
  7223. /* COMPATIBILITY */
  7224. if (IsXref)
  7225. {
  7226. int i;
  7227. fprintf (file, " VERSIONS:\n");
  7228. for (i = 0; i < NUM_VERSIONS; i++)
  7229. {
  7230. char X;
  7231. if (f->OptionVersionBitmask & bwb_vertable[i].OptionVersionValue)
  7232. {
  7233. /* SUPPORTED */
  7234. X = 'X';
  7235. }
  7236. else
  7237. {
  7238. /* NOT SUPPORTED */
  7239. X = '_';
  7240. }
  7241. fprintf (file, " [%c] %s\n", X, bwb_vertable[i].Name);
  7242. }
  7243. }
  7244. fflush (file);
  7245. }
  7246. void
  7247. DumpAllFunctionSyntax (FILE * file, int IsXref,
  7248. OptionVersionType OptionVersionValue)
  7249. {
  7250. /* for the C maintainer */
  7251. int i;
  7252. assert (file != NULL);
  7253. fprintf (file,
  7254. "============================================================\n");
  7255. fprintf (file,
  7256. " FUNCTIONS \n");
  7257. fprintf (file,
  7258. "============================================================\n");
  7259. fprintf (file, "\n");
  7260. fprintf (file, "\n");
  7261. for (i = 0; i < NUM_FUNCTIONS; i++)
  7262. {
  7263. if (IntrinsicFunctionTable[i].OptionVersionBitmask & OptionVersionValue)
  7264. {
  7265. fprintf (file,
  7266. "------------------------------------------------------------\n");
  7267. DumpOneFunctionSyntax (file, IsXref, i);
  7268. }
  7269. }
  7270. fprintf (file,
  7271. "------------------------------------------------------------\n");
  7272. fprintf (file, "\n");
  7273. fprintf (file, "\n");
  7274. fflush (file);
  7275. }
  7276. void
  7277. DumpAllFunctionHtmlTable (FILE * file)
  7278. {
  7279. /* generate bwd_cmd.htm */
  7280. int i;
  7281. int j;
  7282. assert (file != NULL);
  7283. /* LEGEND */
  7284. fprintf (file, "<html><head><title>FNCS</title></head><body>\n");
  7285. fprintf (file, "<h1>LEGEND</h1><br>\n");
  7286. fprintf (file, "<table>\n");
  7287. fprintf (file, "<tr>");
  7288. fprintf (file, "<td>");
  7289. fprintf (file, "<b>");
  7290. fprintf (file, "ID");
  7291. fprintf (file, "</b>");
  7292. fprintf (file, "</td>");
  7293. fprintf (file, "<td>");
  7294. fprintf (file, "<b>");
  7295. fprintf (file, "NAME");
  7296. fprintf (file, "</b>");
  7297. fprintf (file, "</td>");
  7298. fprintf (file, "<td>");
  7299. fprintf (file, "<b>");
  7300. fprintf (file, "DESCRIPTION");
  7301. fprintf (file, "</b>");
  7302. fprintf (file, "</td>");
  7303. fprintf (file, "</tr>\n");
  7304. for (j = 0; j < NUM_VERSIONS; j++)
  7305. {
  7306. fprintf (file, "<tr>");
  7307. fprintf (file, "<td>");
  7308. fprintf (file, "%s", bwb_vertable[j].ID);
  7309. fprintf (file, "</td>");
  7310. fprintf (file, "<td>");
  7311. fprintf (file, "%s", bwb_vertable[j].Name);
  7312. fprintf (file, "</td>");
  7313. fprintf (file, "<td>");
  7314. fprintf (file, "%s", bwb_vertable[j].Description);
  7315. fprintf (file, "</td>");
  7316. fprintf (file, "</tr>\n");
  7317. }
  7318. fprintf (file, "</table>\n");
  7319. fprintf (file, "<hr>\n");
  7320. /* DETAILS */
  7321. fprintf (file, "<h1>DETAILS</h1><br>\n");
  7322. fprintf (file, "<table>\n");
  7323. fprintf (file, "<tr>");
  7324. fprintf (file, "<td>");
  7325. fprintf (file, "<b>");
  7326. fprintf (file, "FUNCTION");
  7327. fprintf (file, "</b>");
  7328. fprintf (file, "</td>");
  7329. for (j = 0; j < NUM_VERSIONS; j++)
  7330. {
  7331. fprintf (file, "<td>");
  7332. fprintf (file, "<b>");
  7333. fprintf (file, "%s", bwb_vertable[j].ID);
  7334. fprintf (file, "</b>");
  7335. fprintf (file, "</td>");
  7336. }
  7337. fprintf (file, "</tr>\n");
  7338. /* run through the command table and print comand -vs- OPTION VERSION */
  7339. for (i = 0; i < NUM_FUNCTIONS; i++)
  7340. {
  7341. fprintf (file, "<tr>");
  7342. fprintf (file, "<td>");
  7343. fprintf (file, "%s", (char *) IntrinsicFunctionTable[i].Syntax);
  7344. fprintf (file, "</td>");
  7345. for (j = 0; j < NUM_VERSIONS; j++)
  7346. {
  7347. fprintf (file, "<td>");
  7348. if (IntrinsicFunctionTable[i].OptionVersionBitmask & bwb_vertable[j].
  7349. OptionVersionValue)
  7350. {
  7351. fprintf (file, "X");
  7352. }
  7353. else
  7354. {
  7355. fprintf (file, " ");
  7356. }
  7357. fprintf (file, "</td>");
  7358. }
  7359. fprintf (file, "</tr>\n");
  7360. }
  7361. fprintf (file, "</table>\n");
  7362. fprintf (file, "</body></html>\n");
  7363. fprintf (file, "\n");
  7364. fflush (file);
  7365. }
  7366. /*
  7367. --------------------------------------------------------------------------------------------
  7368. FNCS
  7369. --------------------------------------------------------------------------------------------
  7370. */
  7371. LineType *
  7372. bwb_FNCS (LineType * l)
  7373. {
  7374. int n;
  7375. int t;
  7376. assert (l != NULL);
  7377. assert( My != NULL );
  7378. assert( My->SYSOUT != NULL );
  7379. assert( My->SYSOUT->cfp != NULL );
  7380. My->CurrentFile = My->SYSOUT;
  7381. fprintf (My->SYSOUT->cfp, "BWBASIC FUNCTIONS AVAILABLE:\n");
  7382. /* run through the command table and print comand names */
  7383. t = 0;
  7384. for (n = 0; n < NUM_FUNCTIONS; n++)
  7385. {
  7386. fprintf (My->SYSOUT->cfp, "%s", IntrinsicFunctionTable[n].Name);
  7387. if (t < 4)
  7388. {
  7389. fprintf (My->SYSOUT->cfp, "\t");
  7390. t++;
  7391. }
  7392. else
  7393. {
  7394. fprintf (My->SYSOUT->cfp, "\n");
  7395. t = 0;
  7396. }
  7397. }
  7398. if (t > 0)
  7399. {
  7400. fprintf (My->SYSOUT->cfp, "\n");
  7401. }
  7402. ResetConsoleColumn ();
  7403. return (l);
  7404. }
  7405. /*
  7406. --------------------------------------------------------------------------------------------
  7407. MAINTAINER
  7408. --------------------------------------------------------------------------------------------
  7409. */
  7410. LineType *
  7411. bwb_MAINTAINER (LineType * l)
  7412. {
  7413. assert (l != NULL);
  7414. WARN_SYNTAX_ERROR;
  7415. return (l);
  7416. }
  7417. LineType *
  7418. bwb_MAINTAINER_CMDS (LineType * l)
  7419. {
  7420. assert (l != NULL);
  7421. WARN_SYNTAX_ERROR;
  7422. return (l);
  7423. }
  7424. LineType *
  7425. bwb_MAINTAINER_CMDS_HTML (LineType * l)
  7426. {
  7427. assert (l != NULL);
  7428. assert(My != NULL);
  7429. assert(My->SYSPRN != NULL);
  7430. assert(My->SYSPRN->cfp != NULL);
  7431. DumpAllCommandHtmlTable (My->SYSPRN->cfp);
  7432. return (l);
  7433. }
  7434. LineType *
  7435. bwb_MAINTAINER_CMDS_ID (LineType * l)
  7436. {
  7437. assert (l != NULL);
  7438. assert(My != NULL);
  7439. assert(My->SYSPRN != NULL);
  7440. assert(My->SYSPRN->cfp != NULL);
  7441. DumpAllCommandUniqueID (My->SYSPRN->cfp);
  7442. return (l);
  7443. }
  7444. LineType *
  7445. bwb_MAINTAINER_CMDS_MANUAL (LineType * l)
  7446. {
  7447. assert (l != NULL);
  7448. assert(My != NULL);
  7449. assert(My->SYSPRN != NULL);
  7450. assert(My->SYSPRN->cfp != NULL);
  7451. DumpAllCommandSyntax (My->SYSPRN->cfp, TRUE, (OptionVersionType)(-1));
  7452. return (l);
  7453. }
  7454. LineType *
  7455. bwb_MAINTAINER_CMDS_SWITCH (LineType * l)
  7456. {
  7457. assert (l != NULL);
  7458. assert(My != NULL);
  7459. assert(My->SYSPRN != NULL);
  7460. assert(My->SYSPRN->cfp != NULL);
  7461. DumpAllCommandSwitchStatement (My->SYSPRN->cfp);
  7462. return (l);
  7463. }
  7464. LineType *
  7465. bwb_MAINTAINER_CMDS_TABLE (LineType * l)
  7466. {
  7467. assert (l != NULL);
  7468. assert(My != NULL);
  7469. assert(My->SYSPRN != NULL);
  7470. assert(My->SYSPRN->cfp != NULL);
  7471. DumpAllCommandTableDefinitions (My->SYSPRN->cfp);
  7472. return (l);
  7473. }
  7474. LineType *
  7475. bwb_MAINTAINER_DEBUG (LineType * l)
  7476. {
  7477. assert (l != NULL);
  7478. WARN_SYNTAX_ERROR;
  7479. return (l);
  7480. }
  7481. LineType *
  7482. bwb_MAINTAINER_DEBUG_ON (LineType * l)
  7483. {
  7484. assert (l != NULL);
  7485. return (l);
  7486. }
  7487. LineType *
  7488. bwb_MAINTAINER_DEBUG_OFF (LineType * l)
  7489. {
  7490. assert (l != NULL);
  7491. return (l);
  7492. }
  7493. LineType *
  7494. bwb_MAINTAINER_FNCS (LineType * l)
  7495. {
  7496. assert (l != NULL);
  7497. WARN_SYNTAX_ERROR;
  7498. return (l);
  7499. }
  7500. LineType *
  7501. bwb_MAINTAINER_FNCS_HTML (LineType * l)
  7502. {
  7503. assert (l != NULL);
  7504. assert(My != NULL);
  7505. assert(My->SYSPRN != NULL);
  7506. assert(My->SYSPRN->cfp != NULL);
  7507. DumpAllFunctionHtmlTable (My->SYSPRN->cfp);
  7508. return (l);
  7509. }
  7510. LineType *
  7511. bwb_MAINTAINER_FNCS_ID (LineType * l)
  7512. {
  7513. assert (l != NULL);
  7514. assert(My != NULL);
  7515. assert(My->SYSPRN != NULL);
  7516. assert(My->SYSPRN->cfp != NULL);
  7517. DumpAllFunctionUniqueID (My->SYSPRN->cfp);
  7518. return (l);
  7519. }
  7520. LineType *
  7521. bwb_MAINTAINER_FNCS_MANUAL (LineType * l)
  7522. {
  7523. assert (l != NULL);
  7524. assert(My != NULL);
  7525. assert(My->SYSPRN != NULL);
  7526. assert(My->SYSPRN->cfp != NULL);
  7527. DumpAllFunctionSyntax (My->SYSPRN->cfp, TRUE, (OptionVersionType)(-1));
  7528. DumpAllOperatorSyntax (My->SYSPRN->cfp, TRUE, (OptionVersionType)(-1));
  7529. return (l);
  7530. }
  7531. LineType *
  7532. bwb_MAINTAINER_FNCS_SWITCH (LineType * l)
  7533. {
  7534. assert (l != NULL);
  7535. assert(My != NULL);
  7536. assert(My->SYSPRN != NULL);
  7537. assert(My->SYSPRN->cfp != NULL);
  7538. DumpAllFunctionSwitch (My->SYSPRN->cfp);
  7539. return (l);
  7540. }
  7541. LineType *
  7542. bwb_MAINTAINER_FNCS_TABLE (LineType * l)
  7543. {
  7544. assert (l != NULL);
  7545. assert(My != NULL);
  7546. assert(My->SYSPRN != NULL);
  7547. assert(My->SYSPRN->cfp != NULL);
  7548. DumpAllFuctionTableDefinitions (My->SYSPRN->cfp);
  7549. return (l);
  7550. }
  7551. void
  7552. DumpHeader (FILE * file)
  7553. {
  7554. char c;
  7555. assert (file != NULL);
  7556. assert(My != NULL);
  7557. assert(My->CurrentVersion != NULL);
  7558. fprintf (file,
  7559. "============================================================\n");
  7560. fprintf (file,
  7561. " GENERAL \n");
  7562. fprintf (file,
  7563. "============================================================\n");
  7564. fprintf (file, "\n");
  7565. fprintf (file, "\n");
  7566. fprintf (file, "OPTION VERSION \"%s\"\n", My->CurrentVersion->Name);
  7567. fprintf (file, "REM INTERNAL ID: %s\n", My->CurrentVersion->ID);
  7568. fprintf (file, "REM DESCRIPTION: %s\n", My->CurrentVersion->Description);
  7569. fprintf (file, "REM REFERENCE: %s\n", My->CurrentVersion->ReferenceTitle);
  7570. fprintf (file, "REM %s\n",
  7571. My->CurrentVersion->ReferenceAuthor);
  7572. fprintf (file, "REM %s\n",
  7573. My->CurrentVersion->ReferenceCopyright);
  7574. fprintf (file, "REM %s\n", My->CurrentVersion->ReferenceURL1);
  7575. fprintf (file, "REM %s\n", My->CurrentVersion->ReferenceURL2);
  7576. fprintf (file, "REM\n");
  7577. if (My->CurrentVersion->OptionFlags & (OPTION_STRICT_ON))
  7578. {
  7579. fprintf (file, "OPTION STRICT ON\n");
  7580. }
  7581. else
  7582. {
  7583. fprintf (file, "OPTION STRICT OFF\n");
  7584. }
  7585. if (My->CurrentVersion->OptionFlags & (OPTION_ANGLE_DEGREES))
  7586. {
  7587. fprintf (file, "OPTION ANGLE DEGREES\n");
  7588. }
  7589. else if (My->CurrentVersion->OptionFlags & (OPTION_ANGLE_GRADIANS))
  7590. {
  7591. fprintf (file, "OPTION ANGLE GRADIANS\n");
  7592. }
  7593. else
  7594. {
  7595. fprintf (file, "OPTION ANGLE RADIANS\n");
  7596. }
  7597. if (My->CurrentVersion->OptionFlags & (OPTION_BUGS_ON))
  7598. {
  7599. fprintf (file, "OPTION BUGS ON\n");
  7600. }
  7601. else
  7602. {
  7603. fprintf (file, "OPTION BUGS OFF\n");
  7604. }
  7605. if (My->CurrentVersion->OptionFlags & (OPTION_LABELS_ON))
  7606. {
  7607. fprintf (file, "OPTION LABELS ON\n");
  7608. }
  7609. else
  7610. {
  7611. fprintf (file, "OPTION LABELS OFF\n");
  7612. }
  7613. if (My->CurrentVersion->OptionFlags & (OPTION_COMPARE_TEXT))
  7614. {
  7615. fprintf (file, "OPTION COMPARE TEXT\n");
  7616. }
  7617. else
  7618. {
  7619. fprintf (file, "OPTION COMPARE BINARY\n");
  7620. }
  7621. if (My->CurrentVersion->OptionFlags & (OPTION_COVERAGE_ON))
  7622. {
  7623. fprintf (file, "OPTION COVERAGE ON\n");
  7624. }
  7625. else
  7626. {
  7627. fprintf (file, "OPTION COVERAGE OFF\n");
  7628. }
  7629. if (My->CurrentVersion->OptionFlags & (OPTION_TRACE_ON))
  7630. {
  7631. fprintf (file, "OPTION TRACE ON\n");
  7632. }
  7633. else
  7634. {
  7635. fprintf (file, "OPTION TRACE OFF\n");
  7636. }
  7637. if (My->CurrentVersion->OptionFlags & (OPTION_ERROR_GOSUB))
  7638. {
  7639. fprintf (file, "OPTION ERROR GOSUB\n");
  7640. }
  7641. else
  7642. {
  7643. fprintf (file, "OPTION ERROR GOTO\n");
  7644. }
  7645. if (My->CurrentVersion->OptionFlags & (OPTION_EXPLICIT_ON))
  7646. {
  7647. fprintf (file, "OPTION EXPLICIT\n");
  7648. }
  7649. else
  7650. {
  7651. fprintf (file, "OPTION IMPLICIT\n");
  7652. }
  7653. fprintf (file, "OPTION BASE %d\n",
  7654. My->CurrentVersion->OptionBaseInteger);
  7655. fprintf (file, "OPTION RECLEN %d\n",
  7656. My->CurrentVersion->OptionReclenInteger);
  7657. fprintf (file, "OPTION DATE \"%s\"\n",
  7658. My->CurrentVersion->OptionDateFormat);
  7659. fprintf (file, "OPTION TIME \"%s\"\n",
  7660. My->CurrentVersion->OptionTimeFormat);
  7661. c = My->CurrentVersion->OptionStringChar;
  7662. if (!bwb_isgraph (c))
  7663. {
  7664. c = ' ';
  7665. };
  7666. fprintf (file, "OPTION PUNCT STRING \"%c\"\n", c);
  7667. c = My->CurrentVersion->OptionDoubleChar;
  7668. if (!bwb_isgraph (c))
  7669. {
  7670. c = ' ';
  7671. };
  7672. fprintf (file, "OPTION PUNCT DOUBLE \"%c\"\n", c);
  7673. c = My->CurrentVersion->OptionSingleChar;
  7674. if (!bwb_isgraph (c))
  7675. {
  7676. c = ' ';
  7677. };
  7678. fprintf (file, "OPTION PUNCT SINGLE \"%c\"\n", c);
  7679. c = My->CurrentVersion->OptionCurrencyChar;
  7680. if (!bwb_isgraph (c))
  7681. {
  7682. c = ' ';
  7683. };
  7684. fprintf (file, "OPTION PUNCT CURRENCY \"%c\"\n", c);
  7685. c = My->CurrentVersion->OptionLongChar;
  7686. if (!bwb_isgraph (c))
  7687. {
  7688. c = ' ';
  7689. };
  7690. fprintf (file, "OPTION PUNCT LONG \"%c\"\n", c);
  7691. c = My->CurrentVersion->OptionIntegerChar;
  7692. if (!bwb_isgraph (c))
  7693. {
  7694. c = ' ';
  7695. };
  7696. fprintf (file, "OPTION PUNCT INTEGER \"%c\"\n", c);
  7697. c = My->CurrentVersion->OptionByteChar;
  7698. if (!bwb_isgraph (c))
  7699. {
  7700. c = ' ';
  7701. };
  7702. fprintf (file, "OPTION PUNCT BYTE \"%c\"\n", c);
  7703. c = My->CurrentVersion->OptionQuoteChar;
  7704. if (!bwb_isgraph (c))
  7705. {
  7706. c = ' ';
  7707. };
  7708. fprintf (file, "OPTION PUNCT QUOTE \"%c\"\n", c);
  7709. c = My->CurrentVersion->OptionCommentChar;
  7710. if (!bwb_isgraph (c))
  7711. {
  7712. c = ' ';
  7713. };
  7714. fprintf (file, "OPTION PUNCT COMMENT \"%c\"\n", c);
  7715. c = My->CurrentVersion->OptionStatementChar;
  7716. if (!bwb_isgraph (c))
  7717. {
  7718. c = ' ';
  7719. };
  7720. fprintf (file, "OPTION PUNCT STATEMENT \"%c\"\n", c);
  7721. c = My->CurrentVersion->OptionPrintChar;
  7722. if (!bwb_isgraph (c))
  7723. {
  7724. c = ' ';
  7725. };
  7726. fprintf (file, "OPTION PUNCT PRINT \"%c\"\n", c);
  7727. c = My->CurrentVersion->OptionInputChar;
  7728. if (!bwb_isgraph (c))
  7729. {
  7730. c = ' ';
  7731. };
  7732. fprintf (file, "OPTION PUNCT INPUT \"%c\"\n", c);
  7733. c = My->CurrentVersion->OptionImageChar;
  7734. if (!bwb_isgraph (c))
  7735. {
  7736. c = ' ';
  7737. };
  7738. fprintf (file, "OPTION PUNCT IMAGE \"%c\"\n", c);
  7739. c = My->CurrentVersion->OptionLparenChar;
  7740. if (!bwb_isgraph (c))
  7741. {
  7742. c = ' ';
  7743. };
  7744. fprintf (file, "OPTION PUNCT LPAREN \"%c\"\n", c);
  7745. c = My->CurrentVersion->OptionRparenChar;
  7746. if (!bwb_isgraph (c))
  7747. {
  7748. c = ' ';
  7749. };
  7750. fprintf (file, "OPTION PUNCT RPAREN \"%c\"\n", c);
  7751. c = My->CurrentVersion->OptionFilenumChar;
  7752. if (!bwb_isgraph (c))
  7753. {
  7754. c = ' ';
  7755. };
  7756. fprintf (file, "OPTION PUNCT FILENUM \"%c\"\n", c);
  7757. c = My->CurrentVersion->OptionAtChar;
  7758. if (!bwb_isgraph (c))
  7759. {
  7760. c = ' ';
  7761. };
  7762. fprintf (file, "OPTION PUNCT AT \"%c\"\n", c);
  7763. c = My->CurrentVersion->OptionUsingDigit;
  7764. if (!bwb_isgraph (c))
  7765. {
  7766. c = ' ';
  7767. };
  7768. fprintf (file, "OPTION USING DIGIT \"%c\"\n", c);
  7769. c = My->CurrentVersion->OptionUsingComma;
  7770. if (!bwb_isgraph (c))
  7771. {
  7772. c = ' ';
  7773. };
  7774. fprintf (file, "OPTION USING COMMA \"%c\"\n", c);
  7775. c = My->CurrentVersion->OptionUsingPeriod;
  7776. if (!bwb_isgraph (c))
  7777. {
  7778. c = ' ';
  7779. };
  7780. fprintf (file, "OPTION USING PERIOD \"%c\"\n", c);
  7781. c = My->CurrentVersion->OptionUsingPlus;
  7782. if (!bwb_isgraph (c))
  7783. {
  7784. c = ' ';
  7785. };
  7786. fprintf (file, "OPTION USING PLUS \"%c\"\n", c);
  7787. c = My->CurrentVersion->OptionUsingMinus;
  7788. if (!bwb_isgraph (c))
  7789. {
  7790. c = ' ';
  7791. };
  7792. fprintf (file, "OPTION USING MINUS \"%c\"\n", c);
  7793. c = My->CurrentVersion->OptionUsingExrad;
  7794. if (!bwb_isgraph (c))
  7795. {
  7796. c = ' ';
  7797. };
  7798. fprintf (file, "OPTION USING EXRAD \"%c\"\n", c);
  7799. c = My->CurrentVersion->OptionUsingDollar;
  7800. if (!bwb_isgraph (c))
  7801. {
  7802. c = ' ';
  7803. };
  7804. fprintf (file, "OPTION USING DOLLAR \"%c\"\n", c);
  7805. c = My->CurrentVersion->OptionUsingFiller;
  7806. if (!bwb_isgraph (c))
  7807. {
  7808. c = ' ';
  7809. };
  7810. fprintf (file, "OPTION USING FILLER \"%c\"\n", c);
  7811. c = My->CurrentVersion->OptionUsingLiteral;
  7812. if (!bwb_isgraph (c))
  7813. {
  7814. c = ' ';
  7815. };
  7816. fprintf (file, "OPTION USING LITERAL \"%c\"\n", c);
  7817. c = My->CurrentVersion->OptionUsingFirst;
  7818. if (!bwb_isgraph (c))
  7819. {
  7820. c = ' ';
  7821. };
  7822. fprintf (file, "OPTION USING FIRST \"%c\"\n", c);
  7823. c = My->CurrentVersion->OptionUsingAll;
  7824. if (!bwb_isgraph (c))
  7825. {
  7826. c = ' ';
  7827. };
  7828. fprintf (file, "OPTION USING ALL \"%c\"\n", c);
  7829. c = My->CurrentVersion->OptionUsingLength;
  7830. if (!bwb_isgraph (c))
  7831. {
  7832. c = ' ';
  7833. };
  7834. fprintf (file, "OPTION USING LENGTH \"%c\"\n", c);
  7835. fprintf (file, "\n");
  7836. fprintf (file, "\n");
  7837. fflush (file);
  7838. }
  7839. LineType *
  7840. bwb_MAINTAINER_MANUAL (LineType * l)
  7841. {
  7842. assert (l != NULL);
  7843. DumpHeader (My->SYSPRN->cfp);
  7844. DumpAllCommandSyntax (My->SYSPRN->cfp, FALSE,
  7845. My->CurrentVersion->OptionVersionValue);
  7846. DumpAllFunctionSyntax (My->SYSPRN->cfp, FALSE,
  7847. My->CurrentVersion->OptionVersionValue);
  7848. DumpAllOperatorSyntax (My->SYSPRN->cfp, FALSE,
  7849. My->CurrentVersion->OptionVersionValue);
  7850. return (l);
  7851. }
  7852. LineType *
  7853. bwb_MAINTAINER_STACK (LineType * l)
  7854. {
  7855. /*
  7856. dump the current execution stack,
  7857. Leftmost is the top,
  7858. Rigthmost is the bottom.
  7859. */
  7860. StackType *StackItem;
  7861. assert (l != NULL);
  7862. for (StackItem = My->StackHead; StackItem != NULL;
  7863. StackItem = StackItem->next)
  7864. {
  7865. LineType *l;
  7866. l = StackItem->line;
  7867. if (l != NULL)
  7868. {
  7869. fprintf (My->SYSOUT->cfp, "%d:", l->number);
  7870. }
  7871. }
  7872. fprintf (My->SYSOUT->cfp, "\n");
  7873. ResetConsoleColumn ();
  7874. return (l);
  7875. }
  7876. /***************************************************************
  7877. FUNCTION: IntrinsicFunction_init()
  7878. DESCRIPTION: This command initializes the function
  7879. linked list, placing all predefined functions
  7880. in the list.
  7881. ***************************************************************/
  7882. int
  7883. IntrinsicFunction_init (void)
  7884. {
  7885. int n;
  7886. for (n = 0; n < NUM_FUNCTIONS; n++)
  7887. {
  7888. IntrinsicFunctionDefinitionCheck (&(IntrinsicFunctionTable[n]));
  7889. }
  7890. return TRUE;
  7891. }
  7892. VariableType *
  7893. IntrinsicFunction_deffn (int argc, VariableType * argv, UserFunctionType * f)
  7894. {
  7895. /*
  7896. The generic handler for user defined functions.
  7897. When called by exp_function(), f->id will be set to the line number of a specific DEF USR.
  7898. */
  7899. VariableType *v;
  7900. VariableType *argn;
  7901. int i;
  7902. LineType *call_line;
  7903. StackType *save_elevel;
  7904. assert (argc >= 0);
  7905. assert (argv != NULL);
  7906. assert (f != NULL);
  7907. assert(My != NULL);
  7908. /* initialize the variable if necessary */
  7909. /* these errors should not occur */
  7910. if (f == NULL)
  7911. {
  7912. WARN_INTERNAL_ERROR;
  7913. return NULL;
  7914. }
  7915. if (f->line == NULL)
  7916. {
  7917. WARN_INTERNAL_ERROR;
  7918. return NULL;
  7919. }
  7920. if (argv == NULL)
  7921. {
  7922. WARN_INTERNAL_ERROR;
  7923. return NULL;
  7924. }
  7925. if (f->ParameterCount == 0xFF)
  7926. {
  7927. /* VARIANT */
  7928. }
  7929. else if (argc != f->ParameterCount)
  7930. {
  7931. WARN_INTERNAL_ERROR;
  7932. return NULL;
  7933. }
  7934. if (f->ParameterCount == 0xFF)
  7935. {
  7936. /* VARIANT */
  7937. f->local_variable = argv;
  7938. }
  7939. else if (argc > 0)
  7940. {
  7941. v = f->local_variable;
  7942. argn = argv;
  7943. for (i = 0; i < argc; i++)
  7944. {
  7945. argn = argn->next;
  7946. if (v == NULL)
  7947. {
  7948. WARN_INTERNAL_ERROR;
  7949. return NULL;
  7950. }
  7951. if (argn == NULL)
  7952. {
  7953. WARN_INTERNAL_ERROR;
  7954. return NULL;
  7955. }
  7956. if (VAR_IS_STRING (v) != VAR_IS_STRING (argn))
  7957. {
  7958. WARN_INTERNAL_ERROR;
  7959. return NULL;
  7960. }
  7961. if (is_empty_string (v->name) == FALSE)
  7962. {
  7963. int IsError;
  7964. IsError = 0;
  7965. switch (v->VariableTypeCode)
  7966. {
  7967. case ByteTypeCode:
  7968. IsError = NumberValueCheck (P1BYT, PARAM_NUMBER);
  7969. break;
  7970. case IntegerTypeCode:
  7971. IsError = NumberValueCheck (P1INT, PARAM_NUMBER);
  7972. break;
  7973. case LongTypeCode:
  7974. IsError = NumberValueCheck (P1LNG, PARAM_NUMBER);
  7975. break;
  7976. case CurrencyTypeCode:
  7977. IsError = NumberValueCheck (P1CUR, PARAM_NUMBER);
  7978. break;
  7979. case SingleTypeCode:
  7980. IsError = NumberValueCheck (P1FLT, PARAM_NUMBER);
  7981. break;
  7982. case DoubleTypeCode:
  7983. IsError = NumberValueCheck (P1DBL, PARAM_NUMBER);
  7984. break;
  7985. case StringTypeCode:
  7986. IsError = StringLengthCheck (P1ANY, PARAM_LENGTH);
  7987. break;
  7988. default:
  7989. WARN_TYPE_MISMATCH;
  7990. return NULL;
  7991. }
  7992. if (IsError != 0)
  7993. {
  7994. WARN_ILLEGAL_FUNCTION_CALL;
  7995. return argv;
  7996. }
  7997. }
  7998. v = v->next;
  7999. }
  8000. }
  8001. /* OK */
  8002. call_line = f->line; /* line to call for function */
  8003. call_line->position = f->startpos;
  8004. if (call_line->cmdnum == C_DEF)
  8005. {
  8006. if (line_skip_EqualChar (call_line) == FALSE)
  8007. {
  8008. WARN_INTERNAL_ERROR;
  8009. return NULL;
  8010. }
  8011. }
  8012. /* PUSH STACK */
  8013. save_elevel = My->StackHead;
  8014. if (bwb_incexec ())
  8015. {
  8016. /* OK */
  8017. My->StackHead->line = call_line;
  8018. My->StackHead->ExecCode = EXEC_FUNCTION;
  8019. }
  8020. else
  8021. {
  8022. /* ERROR */
  8023. WARN_OUT_OF_MEMORY;
  8024. return NULL;
  8025. }
  8026. /* create variable chain */
  8027. if (f->ParameterCount == 0xFF)
  8028. {
  8029. /* VARIANT */
  8030. }
  8031. else if (argc > 0)
  8032. {
  8033. VariableType *source = NULL; /* source variable */
  8034. source = f->local_variable;
  8035. argn = argv;
  8036. for (i = 0; i < argc; i++)
  8037. {
  8038. argn = argn->next;
  8039. /* copy the name */
  8040. bwb_strcpy (argn->name, source->name);
  8041. if (VAR_IS_STRING (source))
  8042. {
  8043. }
  8044. else
  8045. {
  8046. int IsError;
  8047. double Value;
  8048. VariantType variant;
  8049. CLEAR_VARIANT (&variant);
  8050. if (var_get (argn, &variant) == FALSE)
  8051. {
  8052. WARN_VARIABLE_NOT_DECLARED;
  8053. return NULL;
  8054. }
  8055. if (variant.VariantTypeCode == StringTypeCode)
  8056. {
  8057. WARN_TYPE_MISMATCH;
  8058. return NULL;
  8059. }
  8060. Value = variant.Number;
  8061. IsError = 0;
  8062. switch (source->VariableTypeCode)
  8063. {
  8064. case ByteTypeCode:
  8065. IsError = NumberValueCheck (P1BYT, Value);
  8066. Value = bwb_rint (Value);
  8067. break;
  8068. case IntegerTypeCode:
  8069. IsError = NumberValueCheck (P1INT, Value);
  8070. Value = bwb_rint (Value);
  8071. break;
  8072. case LongTypeCode:
  8073. IsError = NumberValueCheck (P1LNG, Value);
  8074. Value = bwb_rint (Value);
  8075. break;
  8076. case CurrencyTypeCode:
  8077. IsError = NumberValueCheck (P1CUR, Value);
  8078. Value = bwb_rint (Value);
  8079. break;
  8080. case SingleTypeCode:
  8081. IsError = NumberValueCheck (P1FLT, Value);
  8082. break;
  8083. case DoubleTypeCode:
  8084. IsError = NumberValueCheck (P1DBL, Value);
  8085. break;
  8086. case StringTypeCode:
  8087. WARN_TYPE_MISMATCH;
  8088. return NULL;
  8089. /* break; */
  8090. default:
  8091. WARN_TYPE_MISMATCH;
  8092. return NULL;
  8093. }
  8094. if (IsError != 0)
  8095. {
  8096. WARN_ILLEGAL_FUNCTION_CALL;
  8097. return argv;
  8098. }
  8099. variant.Number = Value;
  8100. if (var_set (argn, &variant) == FALSE)
  8101. {
  8102. WARN_VARIABLE_NOT_DECLARED;
  8103. return NULL;
  8104. }
  8105. }
  8106. source = source->next;
  8107. }
  8108. }
  8109. if (call_line->cmdnum == C_DEF)
  8110. {
  8111. VariantType x;
  8112. VariantType *X;
  8113. X = &x;
  8114. CLEAR_VARIANT (X);
  8115. /* the function return variable is hidden */
  8116. My->StackHead->local_variable = argv->next;
  8117. /* var_islocal() uses the LoopTopLine to find local variables */
  8118. My->StackHead->LoopTopLine = call_line; /* FUNCTION, SUB */
  8119. /* evaluate the expression */
  8120. if (line_read_expression (call_line, X) == FALSE) /* IntrinsicFunction_deffn */
  8121. {
  8122. WARN_SYNTAX_ERROR;
  8123. goto EXIT;
  8124. }
  8125. /* save the value */
  8126. switch (X->VariantTypeCode)
  8127. {
  8128. case ByteTypeCode:
  8129. case IntegerTypeCode:
  8130. case LongTypeCode:
  8131. case CurrencyTypeCode:
  8132. case SingleTypeCode:
  8133. case DoubleTypeCode:
  8134. if (argv->VariableTypeCode == StringTypeCode)
  8135. {
  8136. WARN_TYPE_MISMATCH;
  8137. goto EXIT;
  8138. }
  8139. /* OK */
  8140. {
  8141. int IsError;
  8142. double Value;
  8143. IsError = 0;
  8144. Value = X->Number;
  8145. /* VerifyNumeric */
  8146. if (isnan (Value))
  8147. {
  8148. /*** FATAL - INTERNAL ERROR - SHOULD NEVER HAPPEN ***/
  8149. WARN_INTERNAL_ERROR;
  8150. return FALSE;
  8151. }
  8152. if (isinf (Value))
  8153. {
  8154. /* - Evaluation of an expression results in an overflow
  8155. * (nonfatal, the recommended recovery procedure is to supply
  8156. * machine in- finity with the algebraically correct sign and
  8157. * continue). */
  8158. if (Value < 0)
  8159. {
  8160. Value = MINDBL;
  8161. }
  8162. else
  8163. {
  8164. Value = MAXDBL;
  8165. }
  8166. if (WARN_OVERFLOW)
  8167. {
  8168. /* ERROR */
  8169. goto EXIT;
  8170. }
  8171. /* CONTINUE */
  8172. }
  8173. /* OK */
  8174. switch (argv->VariableTypeCode)
  8175. {
  8176. case ByteTypeCode:
  8177. IsError = NumberValueCheck (P1BYT, Value);
  8178. Value = bwb_rint (Value);
  8179. break;
  8180. case IntegerTypeCode:
  8181. IsError = NumberValueCheck (P1INT, Value);
  8182. Value = bwb_rint (Value);
  8183. break;
  8184. case LongTypeCode:
  8185. IsError = NumberValueCheck (P1LNG, Value);
  8186. Value = bwb_rint (Value);
  8187. break;
  8188. case CurrencyTypeCode:
  8189. IsError = NumberValueCheck (P1CUR, Value);
  8190. Value = bwb_rint (Value);
  8191. break;
  8192. case SingleTypeCode:
  8193. IsError = NumberValueCheck (P1FLT, Value);
  8194. break;
  8195. case DoubleTypeCode:
  8196. IsError = NumberValueCheck (P1DBL, Value);
  8197. break;
  8198. default:
  8199. WARN_TYPE_MISMATCH;
  8200. goto EXIT;
  8201. /* break; */
  8202. }
  8203. if (IsError != 0)
  8204. {
  8205. if (WARN_OVERFLOW)
  8206. {
  8207. /* ERROR */
  8208. goto EXIT;
  8209. }
  8210. /* CONTINUE */
  8211. }
  8212. /* assign Value */
  8213. RESULT_NUMBER = Value;
  8214. }
  8215. break;
  8216. case StringTypeCode:
  8217. if (argv->VariableTypeCode != StringTypeCode)
  8218. {
  8219. WARN_TYPE_MISMATCH;
  8220. goto EXIT;
  8221. }
  8222. /* OK */
  8223. if (RESULT_BUFFER != My->MaxLenBuffer)
  8224. {
  8225. WARN_INTERNAL_ERROR;
  8226. goto EXIT;
  8227. }
  8228. if (X->Length > MAXLEN)
  8229. {
  8230. WARN_STRING_TOO_LONG; /* IntrinsicFunction_deffn */
  8231. X->Length = MAXLEN;
  8232. }
  8233. bwb_memcpy (RESULT_BUFFER, X->Buffer, X->Length);
  8234. RESULT_LENGTH = X->Length;
  8235. break;
  8236. default:
  8237. WARN_TYPE_MISMATCH;
  8238. goto EXIT;
  8239. /* break; */
  8240. }
  8241. EXIT:
  8242. RELEASE_VARIANT (X);
  8243. /* break variable chain */
  8244. My->StackHead->local_variable = NULL;
  8245. /* POP STACK */
  8246. bwb_decexec ();
  8247. }
  8248. else
  8249. {
  8250. /* the function return variable is visible */
  8251. My->StackHead->local_variable = argv;
  8252. /* var_islocal() uses the LoopTopLine to find local variables */
  8253. My->StackHead->LoopTopLine = call_line; /* FUNCTION, SUB */
  8254. /* execute until function returns */
  8255. while (My->StackHead != save_elevel)
  8256. {
  8257. bwb_execline ();
  8258. }
  8259. }
  8260. if (f->ParameterCount == 0xFF)
  8261. {
  8262. /* VARIANT */
  8263. f->local_variable = NULL;
  8264. }
  8265. if (is_empty_string (argv->name) == FALSE)
  8266. {
  8267. int IsError;
  8268. IsError = 0;
  8269. switch (argv->VariableTypeCode)
  8270. {
  8271. case ByteTypeCode:
  8272. IsError = NumberValueCheck (P1BYT, RESULT_NUMBER);
  8273. break;
  8274. case IntegerTypeCode:
  8275. IsError = NumberValueCheck (P1INT, RESULT_NUMBER);
  8276. break;
  8277. case LongTypeCode:
  8278. IsError = NumberValueCheck (P1LNG, RESULT_NUMBER);
  8279. break;
  8280. case CurrencyTypeCode:
  8281. IsError = NumberValueCheck (P1CUR, RESULT_NUMBER);
  8282. break;
  8283. case SingleTypeCode:
  8284. IsError = NumberValueCheck (P1FLT, RESULT_NUMBER);
  8285. break;
  8286. case DoubleTypeCode:
  8287. IsError = NumberValueCheck (P1DBL, RESULT_NUMBER);
  8288. break;
  8289. case StringTypeCode:
  8290. IsError = StringLengthCheck (P1ANY, RESULT_LENGTH);
  8291. break;
  8292. default:
  8293. /* no check */
  8294. break;
  8295. }
  8296. if (IsError != 0)
  8297. {
  8298. if (WARN_OVERFLOW)
  8299. {
  8300. /* ERROR */
  8301. }
  8302. /* CONTINUE */
  8303. }
  8304. }
  8305. return argv;
  8306. }
  8307. /***************************************************************
  8308. FUNCTION: IntrinsicFunction_find()
  8309. DESCRIPTION: This C function attempts to locate
  8310. a BASIC function with the specified name.
  8311. If successful, it returns a pointer to
  8312. the C structure for the BASIC function,
  8313. if not successful, it returns NULL.
  8314. ***************************************************************/
  8315. extern int
  8316. IntrinsicFunction_name (char *name)
  8317. {
  8318. /* search INTRINSIC functions */
  8319. IntrinsicFunctionType *f;
  8320. int i;
  8321. assert (name != NULL);
  8322. assert(My != NULL);
  8323. assert(My->CurrentVersion != NULL);
  8324. #if THE_PRICE_IS_RIGHT
  8325. /* start with the closest function, without going over */
  8326. i = VarTypeIndex (name[0]);
  8327. if (i < 0)
  8328. {
  8329. /* non-alpha */
  8330. return FALSE;
  8331. }
  8332. i = My->IntrinsicFunctionStart[i]; /* first function starting with this letter */
  8333. if (i < 0)
  8334. {
  8335. /* NOT FOUND */
  8336. return FALSE;
  8337. }
  8338. #else /* THE_PRICE_IS_RIGHT */
  8339. i = 0;
  8340. #endif /* THE_PRICE_IS_RIGHT */
  8341. for (; i < NUM_FUNCTIONS; i++)
  8342. {
  8343. f = &IntrinsicFunctionTable[i];
  8344. if (My->CurrentVersion->OptionVersionValue & f->OptionVersionBitmask)
  8345. {
  8346. int result;
  8347. result = bwb_stricmp (f->Name, name);
  8348. if (result == 0)
  8349. {
  8350. /* FOUND */
  8351. return TRUE;
  8352. }
  8353. if (result > 0 /* found > searched */ )
  8354. {
  8355. /* NOT FOUND */
  8356. return FALSE;
  8357. }
  8358. }
  8359. }
  8360. /* NOT FOUND */
  8361. return FALSE;
  8362. }
  8363. IntrinsicFunctionType *
  8364. IntrinsicFunction_find_exact (char *name, int ParameterCount,
  8365. ParamBitsType ParameterTypes)
  8366. {
  8367. IntrinsicFunctionType *f;
  8368. int i;
  8369. assert (name != NULL);
  8370. assert(My != NULL);
  8371. assert(My->CurrentVersion != NULL);
  8372. /* search INTRINSIC functions */
  8373. #if THE_PRICE_IS_RIGHT
  8374. /* start with the closest function, without going over */
  8375. i = VarTypeIndex (name[0]);
  8376. if (i < 0)
  8377. {
  8378. /* non-alpha */
  8379. return NULL;
  8380. }
  8381. i = My->IntrinsicFunctionStart[i]; /* first function starting with this letter */
  8382. if (i < 0)
  8383. {
  8384. /* NOT FOUND */
  8385. return NULL;
  8386. }
  8387. #else /* THE_PRICE_IS_RIGHT */
  8388. i = 0;
  8389. #endif /* THE_PRICE_IS_RIGHT */
  8390. for (; i < NUM_FUNCTIONS; i++)
  8391. {
  8392. f = &IntrinsicFunctionTable[i];
  8393. if (My->CurrentVersion->OptionVersionValue & f->OptionVersionBitmask)
  8394. {
  8395. if (f->ParameterCount == ParameterCount)
  8396. {
  8397. if (f->ParameterTypes == ParameterTypes)
  8398. {
  8399. int result;
  8400. result = bwb_stricmp (f->Name, name);
  8401. if (result == 0)
  8402. {
  8403. /* FOUND */
  8404. return f;
  8405. }
  8406. if (result > 0 /* found > searched */ )
  8407. {
  8408. /* NOT FOUND */
  8409. return NULL;
  8410. }
  8411. }
  8412. }
  8413. }
  8414. }
  8415. /* NOT FOUND */
  8416. return NULL;
  8417. }
  8418. static VariableType *
  8419. find_variable_by_type (char *name, int dimensions, char VariableTypeCode)
  8420. {
  8421. VariableType *v = NULL;
  8422. assert (name != NULL);
  8423. v = var_find (name, dimensions, FALSE);
  8424. if (v)
  8425. {
  8426. if (VAR_IS_STRING (v))
  8427. {
  8428. if (VariableTypeCode == StringTypeCode)
  8429. {
  8430. /* found */
  8431. return v;
  8432. }
  8433. }
  8434. else
  8435. {
  8436. if (VariableTypeCode != StringTypeCode)
  8437. {
  8438. /* found */
  8439. return v;
  8440. }
  8441. }
  8442. }
  8443. /* not found */
  8444. return NULL;
  8445. }
  8446. /*
  8447. --------------------------------------------------------------------------------------------
  8448. CHANGE
  8449. --------------------------------------------------------------------------------------------
  8450. */
  8451. LineType *
  8452. bwb_CHANGE (LineType * l)
  8453. {
  8454. /* SYNTAX: CHANGE A$ TO X */
  8455. /* SYNTAX: CHANGE X TO A$ */
  8456. char varname[NameLengthMax + 1];
  8457. VariableType *v;
  8458. VariableType *A;
  8459. VariableType *X;
  8460. int IsStringToArray;
  8461. assert (l != NULL);
  8462. v = NULL;
  8463. A = NULL;
  8464. X = NULL;
  8465. IsStringToArray = FALSE;
  8466. /* get 1st variable */
  8467. if (line_read_varname (l, varname) == FALSE)
  8468. {
  8469. WARN_SYNTAX_ERROR;
  8470. return (l);
  8471. }
  8472. v = find_variable_by_type (varname, 0, StringTypeCode);
  8473. if (v)
  8474. {
  8475. /* STRING to ARRAY */
  8476. A = v;
  8477. IsStringToArray = TRUE;
  8478. }
  8479. else
  8480. {
  8481. /* ARRAY to STRING */
  8482. v = find_variable_by_type (varname, 1, DoubleTypeCode);
  8483. if (v)
  8484. {
  8485. X = v;
  8486. IsStringToArray = FALSE;
  8487. }
  8488. }
  8489. if (v == NULL)
  8490. {
  8491. WARN_VARIABLE_NOT_DECLARED;
  8492. return (l);
  8493. }
  8494. /* get "TO" */
  8495. if (line_skip_word (l, "TO") == FALSE)
  8496. {
  8497. WARN_SYNTAX_ERROR;
  8498. return (l);
  8499. }
  8500. /* get 2nd variable */
  8501. if (line_read_varname (l, varname) == FALSE)
  8502. {
  8503. WARN_SYNTAX_ERROR;
  8504. return (l);
  8505. }
  8506. if (IsStringToArray)
  8507. {
  8508. /* STRING to ARRAY */
  8509. v = find_variable_by_type (varname, 1, DoubleTypeCode);
  8510. if (v == NULL)
  8511. {
  8512. v = var_find (varname, 1, TRUE);
  8513. }
  8514. if (v)
  8515. {
  8516. X = v;
  8517. }
  8518. }
  8519. else
  8520. {
  8521. /* ARRAY to STRING */
  8522. v = find_variable_by_type (varname, 0, StringTypeCode);
  8523. if (v == NULL)
  8524. {
  8525. v = var_find (varname, 0, TRUE);
  8526. }
  8527. if (v)
  8528. {
  8529. A = v;
  8530. }
  8531. }
  8532. if (v == NULL)
  8533. {
  8534. WARN_VARIABLE_NOT_DECLARED;
  8535. return (l);
  8536. }
  8537. assert(A != NULL);
  8538. assert(X != NULL);
  8539. if (IsStringToArray)
  8540. {
  8541. /* CHANGE A$ TO X */
  8542. int i;
  8543. int n;
  8544. char *a;
  8545. DoubleType *x;
  8546. unsigned long t;
  8547. if (A->Value.String == NULL)
  8548. {
  8549. WARN_INTERNAL_ERROR;
  8550. return (l);
  8551. }
  8552. if (A->Value.String->sbuffer == NULL)
  8553. {
  8554. WARN_INTERNAL_ERROR;
  8555. return (l);
  8556. }
  8557. /* variable storage is a mess, we bypass that tradition here. */
  8558. t = 1;
  8559. for (n = 0; n < X->dimensions; n++)
  8560. {
  8561. t *= X->UBOUND[n] - X->LBOUND[n] + 1;
  8562. }
  8563. if (t <= A->Value.String->length)
  8564. {
  8565. WARN_SUBSCRIPT_OUT_OF_RANGE;
  8566. return (l);
  8567. }
  8568. n = A->Value.String->length;
  8569. a = A->Value.String->sbuffer;
  8570. x = X->Value.Number;
  8571. *x = n;
  8572. x++;
  8573. for (i = 0; i < n; i++)
  8574. {
  8575. char C;
  8576. DoubleType V;
  8577. C = *a;
  8578. V = C;
  8579. *x = V;
  8580. x++;
  8581. a++;
  8582. }
  8583. }
  8584. else
  8585. {
  8586. /* CHANGE X TO A$ */
  8587. int i;
  8588. int n;
  8589. char *a;
  8590. DoubleType *x;
  8591. unsigned long t;
  8592. /* variable storage is a mess, we bypass that tradition here. */
  8593. t = 1;
  8594. for (n = 0; n < X->dimensions; n++)
  8595. {
  8596. t *= X->UBOUND[n] - X->LBOUND[n] + 1;
  8597. }
  8598. if (t <= 1)
  8599. {
  8600. WARN_SUBSCRIPT_OUT_OF_RANGE;
  8601. return (l);
  8602. }
  8603. if (t > MAXLEN)
  8604. {
  8605. WARN_STRING_TOO_LONG; /* bwb_CHANGE */
  8606. t = MAXLEN;
  8607. }
  8608. if (A->Value.String == NULL)
  8609. {
  8610. if ((A->Value.String =
  8611. (StringType *) calloc (1, sizeof (StringType))) == NULL)
  8612. {
  8613. WARN_OUT_OF_MEMORY;
  8614. return (l);
  8615. }
  8616. A->Value.String->sbuffer = NULL;
  8617. A->Value.String->length = 0;
  8618. }
  8619. if (A->Value.String->sbuffer != NULL)
  8620. {
  8621. free (A->Value.String->sbuffer);
  8622. A->Value.String->sbuffer = NULL;
  8623. A->Value.String->length = 0;
  8624. }
  8625. if (A->Value.String->sbuffer == NULL)
  8626. {
  8627. A->Value.String->length = 0;
  8628. if ((A->Value.String->sbuffer =
  8629. (char *) calloc (t + 1 /* NulChar */ , sizeof (char))) == NULL)
  8630. {
  8631. WARN_OUT_OF_MEMORY;
  8632. return (l);
  8633. }
  8634. }
  8635. a = A->Value.String->sbuffer;
  8636. x = X->Value.Number;
  8637. n = (int) bwb_rint (*x);
  8638. if (n > MAXLEN)
  8639. {
  8640. WARN_STRING_TOO_LONG; /* bwb_CHANGE */
  8641. n = MAXLEN;
  8642. }
  8643. A->Value.String->length = n;
  8644. x++;
  8645. for (i = 0; i < n; i++)
  8646. {
  8647. char C;
  8648. DoubleType V;
  8649. V = *x;
  8650. C = V;
  8651. *a = C;
  8652. x++;
  8653. a++;
  8654. }
  8655. }
  8656. return (l);
  8657. }
  8658. /*
  8659. --------------------------------------------------------------------------------------------
  8660. CONSOLE
  8661. --------------------------------------------------------------------------------------------
  8662. */
  8663. LineType *
  8664. bwb_CONSOLE (LineType * l)
  8665. {
  8666. /* SYNTAX: CONSOLE */
  8667. /* SYNTAX: CONSOLE WIDTH width */
  8668. assert (l != NULL);
  8669. assert(My != NULL);
  8670. assert(My->SYSPRN != NULL);
  8671. assert(My->SYSPRN->cfp != NULL);
  8672. assert(My->SYSOUT != NULL);
  8673. assert(My->SYSOUT->cfp != NULL);
  8674. if (My->IsPrinter == TRUE)
  8675. {
  8676. /* reset printer column */
  8677. if (My->SYSPRN->col != 1)
  8678. {
  8679. fputc ('\n', My->SYSPRN->cfp);
  8680. My->SYSPRN->col = 1;
  8681. }
  8682. My->IsPrinter = FALSE;
  8683. }
  8684. if (line_skip_word (l, "WIDTH"))
  8685. {
  8686. int width;
  8687. width = 0;
  8688. if (line_read_integer_expression (l, &width) == FALSE)
  8689. {
  8690. WARN_ILLEGAL_FUNCTION_CALL;
  8691. return (l);
  8692. }
  8693. if (width < 0)
  8694. {
  8695. WARN_ILLEGAL_FUNCTION_CALL;
  8696. return (l);
  8697. }
  8698. My->SYSOUT->width = width;
  8699. }
  8700. return (l);
  8701. }
  8702. /*
  8703. --------------------------------------------------------------------------------------------
  8704. LPRINTER
  8705. --------------------------------------------------------------------------------------------
  8706. */
  8707. LineType *
  8708. bwb_LPRINTER (LineType * l)
  8709. {
  8710. /* SYNTAX: LPRINTER */
  8711. /* SYNTAX: LPRINTER WIDTH width */
  8712. assert (l != NULL);
  8713. assert(My != NULL);
  8714. assert(My->SYSPRN != NULL);
  8715. assert(My->SYSPRN->cfp != NULL);
  8716. assert(My->SYSOUT != NULL);
  8717. assert(My->SYSOUT->cfp != NULL);
  8718. if (My->IsPrinter == FALSE)
  8719. {
  8720. /* reset console column */
  8721. if (My->SYSOUT->col != 1)
  8722. {
  8723. fputc ('\n', My->SYSOUT->cfp);
  8724. My->SYSOUT->col = 1;
  8725. }
  8726. My->IsPrinter = TRUE;
  8727. }
  8728. if (line_skip_word (l, "WIDTH"))
  8729. {
  8730. int width;
  8731. width = 0;
  8732. if (line_read_integer_expression (l, &width) == FALSE)
  8733. {
  8734. WARN_ILLEGAL_FUNCTION_CALL;
  8735. return (l);
  8736. }
  8737. if (width < 0)
  8738. {
  8739. WARN_ILLEGAL_FUNCTION_CALL;
  8740. return (l);
  8741. }
  8742. My->SYSPRN->width = width;
  8743. }
  8744. return (l);
  8745. }
  8746. extern void
  8747. bwb_fclose (FILE * file)
  8748. {
  8749. if (file == NULL)
  8750. {
  8751. /* don't close */
  8752. }
  8753. else if (file == stdin)
  8754. {
  8755. /* don't close */
  8756. }
  8757. else if (file == stdout)
  8758. {
  8759. /* don't close */
  8760. }
  8761. else if (file == stderr)
  8762. {
  8763. /* don't close */
  8764. }
  8765. else
  8766. {
  8767. fclose (file);
  8768. }
  8769. }
  8770. LineType *
  8771. bwb_LPT (LineType * l)
  8772. {
  8773. /* SYNTAX: LPT */
  8774. /* SYNTAX: LPT filename$ */
  8775. FILE *file;
  8776. char *filename;
  8777. assert (l != NULL);
  8778. assert(My != NULL);
  8779. assert(My->SYSOUT != NULL);
  8780. assert(My->SYSOUT->cfp != NULL);
  8781. file = NULL;
  8782. filename = NULL;
  8783. if (line_is_eol (l))
  8784. {
  8785. /* OK */
  8786. file = stderr;
  8787. }
  8788. else if (line_read_string_expression (l, &filename))
  8789. {
  8790. /* OK */
  8791. if (is_empty_string (filename))
  8792. {
  8793. WARN_BAD_FILE_NAME;
  8794. return (l);
  8795. }
  8796. file = fopen (filename, "w");
  8797. free (filename);
  8798. }
  8799. else
  8800. {
  8801. WARN_SYNTAX_ERROR;
  8802. return (l);
  8803. }
  8804. if (file == NULL)
  8805. {
  8806. WARN_BAD_FILE_NAME;
  8807. return (l);
  8808. }
  8809. bwb_fclose (My->SYSOUT->cfp);
  8810. My->SYSOUT->cfp = file;
  8811. return (l);
  8812. }
  8813. LineType *
  8814. bwb_PTP (LineType * l)
  8815. {
  8816. /* SYNTAX: PTP */
  8817. /* SYNTAX: PTP filename$ */
  8818. FILE *file;
  8819. char *filename;
  8820. assert (l != NULL);
  8821. assert(My != NULL);
  8822. assert(My->SYSOUT != NULL);
  8823. assert(My->SYSOUT->cfp != NULL);
  8824. file = NULL;
  8825. filename = NULL;
  8826. if (line_is_eol (l))
  8827. {
  8828. /* OK */
  8829. file = fopen ("PTP", "w");
  8830. }
  8831. else if (line_read_string_expression (l, &filename))
  8832. {
  8833. /* OK */
  8834. if (is_empty_string (filename))
  8835. {
  8836. WARN_BAD_FILE_NAME;
  8837. return (l);
  8838. }
  8839. file = fopen (filename, "w");
  8840. free (filename);
  8841. }
  8842. else
  8843. {
  8844. WARN_SYNTAX_ERROR;
  8845. return (l);
  8846. }
  8847. if (file == NULL)
  8848. {
  8849. WARN_BAD_FILE_NAME;
  8850. return (l);
  8851. }
  8852. bwb_fclose (My->SYSOUT->cfp);
  8853. My->SYSOUT->cfp = file;
  8854. return (l);
  8855. }
  8856. LineType *
  8857. bwb_PTR (LineType * l)
  8858. {
  8859. /* SYNTAX: PTR */
  8860. /* SYNTAX: PTR filename$ */
  8861. FILE *file;
  8862. char *filename;
  8863. assert (l != NULL);
  8864. assert(My != NULL);
  8865. assert(My->SYSIN != NULL);
  8866. assert(My->SYSIN->cfp != NULL);
  8867. file = NULL;
  8868. filename = NULL;
  8869. if (line_is_eol (l))
  8870. {
  8871. /* OK */
  8872. file = fopen ("PTR", "r");
  8873. }
  8874. else if (line_read_string_expression (l, &filename))
  8875. {
  8876. /* OK */
  8877. if (is_empty_string (filename))
  8878. {
  8879. WARN_BAD_FILE_NAME;
  8880. return (l);
  8881. }
  8882. file = fopen (filename, "r");
  8883. free (filename);
  8884. }
  8885. else
  8886. {
  8887. WARN_SYNTAX_ERROR;
  8888. return (l);
  8889. }
  8890. if (file == NULL)
  8891. {
  8892. WARN_BAD_FILE_NAME;
  8893. return (l);
  8894. }
  8895. bwb_fclose (My->SYSIN->cfp);
  8896. My->SYSIN->cfp = file;
  8897. return (l);
  8898. }
  8899. LineType *
  8900. bwb_TTY (LineType * l)
  8901. {
  8902. /* SYNTAX: TTY */
  8903. assert (l != NULL);
  8904. bwb_TTY_IN (l);
  8905. bwb_TTY_OUT (l);
  8906. return (l);
  8907. }
  8908. LineType *
  8909. bwb_TTY_IN (LineType * l)
  8910. {
  8911. /* SYNTAX: TTY IN */
  8912. assert (l != NULL);
  8913. assert(My != NULL);
  8914. assert(My->SYSIN != NULL);
  8915. assert(My->SYSIN->cfp != NULL);
  8916. bwb_fclose (My->SYSIN->cfp);
  8917. My->SYSIN->cfp = stdin;
  8918. return (l);
  8919. }
  8920. LineType *
  8921. bwb_TTY_OUT (LineType * l)
  8922. {
  8923. /* SYNTAX: TTY OUT */
  8924. assert (l != NULL);
  8925. assert(My != NULL);
  8926. assert(My->SYSOUT != NULL);
  8927. assert(My->SYSOUT->cfp != NULL);
  8928. bwb_fclose (My->SYSOUT->cfp);
  8929. My->SYSOUT->cfp = stdout;
  8930. return (l);
  8931. }
  8932. /*
  8933. --------------------------------------------------------------------------------------------
  8934. CREATE
  8935. --------------------------------------------------------------------------------------------
  8936. */
  8937. LineType *
  8938. bwb_CREATE (LineType * l)
  8939. {
  8940. /* SYNTAX: CREATE filename$ [ RECL reclen ] AS filenum [ BUFF number ] [ RECS size ] */
  8941. int FileNumber;
  8942. int width;
  8943. int buffnum;
  8944. int recsnum;
  8945. char *filename;
  8946. assert (l != NULL);
  8947. assert(My != NULL);
  8948. FileNumber = 0;
  8949. width = 0;
  8950. buffnum = 0;
  8951. recsnum = 0;
  8952. filename = NULL;
  8953. if (line_read_string_expression (l, &filename) == FALSE)
  8954. {
  8955. WARN_SYNTAX_ERROR;
  8956. return (l);
  8957. }
  8958. if (is_empty_string (filename))
  8959. {
  8960. WARN_BAD_FILE_NAME;
  8961. return (l);
  8962. }
  8963. if (line_skip_word (l, "RECL"))
  8964. {
  8965. if (line_read_integer_expression (l, &width) == FALSE)
  8966. {
  8967. WARN_FIELD_OVERFLOW;
  8968. return (l);
  8969. }
  8970. if (width <= 0)
  8971. {
  8972. WARN_FIELD_OVERFLOW;
  8973. return (l);
  8974. }
  8975. }
  8976. if (line_skip_word (l, "AS") == FALSE)
  8977. {
  8978. WARN_SYNTAX_ERROR;
  8979. return (l);
  8980. }
  8981. if (line_read_integer_expression (l, &FileNumber) == FALSE)
  8982. {
  8983. WARN_BAD_FILE_NUMBER;
  8984. return (l);
  8985. }
  8986. if (FileNumber <= 0)
  8987. {
  8988. WARN_BAD_FILE_NUMBER;
  8989. return (l);
  8990. }
  8991. if (line_skip_word (l, "BUFF"))
  8992. {
  8993. if (line_read_integer_expression (l, &buffnum) == FALSE)
  8994. {
  8995. WARN_FIELD_OVERFLOW;
  8996. return (l);
  8997. }
  8998. if (buffnum <= 0)
  8999. {
  9000. WARN_FIELD_OVERFLOW;
  9001. return (l);
  9002. }
  9003. }
  9004. if (line_skip_word (l, "RECS"))
  9005. {
  9006. if (line_read_integer_expression (l, &recsnum) == FALSE)
  9007. {
  9008. WARN_FIELD_OVERFLOW;
  9009. return (l);
  9010. }
  9011. if (recsnum <= 0)
  9012. {
  9013. WARN_FIELD_OVERFLOW;
  9014. return (l);
  9015. }
  9016. }
  9017. /* now, we are ready to create the file */
  9018. My->CurrentFile = find_file_by_number (FileNumber);
  9019. if (My->CurrentFile == NULL)
  9020. {
  9021. My->CurrentFile = file_new ();
  9022. My->CurrentFile->FileNumber = FileNumber;
  9023. }
  9024. if (My->CurrentFile->FileName != NULL)
  9025. {
  9026. free (My->CurrentFile->FileName);
  9027. My->CurrentFile->FileName = NULL;
  9028. }
  9029. My->CurrentFile->FileName = filename;
  9030. filename = NULL;
  9031. if (My->CurrentFile->DevMode != DEVMODE_CLOSED)
  9032. {
  9033. My->CurrentFile->DevMode = DEVMODE_CLOSED;
  9034. }
  9035. if (My->CurrentFile->cfp != NULL)
  9036. {
  9037. bwb_fclose (My->CurrentFile->cfp);
  9038. My->CurrentFile->cfp = NULL;
  9039. }
  9040. if (My->CurrentFile->buffer != NULL)
  9041. {
  9042. free (My->CurrentFile->buffer);
  9043. My->CurrentFile->buffer = NULL;
  9044. }
  9045. My->CurrentFile->width = 0;
  9046. My->CurrentFile->col = 1;
  9047. My->CurrentFile->row = 1;
  9048. My->CurrentFile->delimit = ',';
  9049. /* truncate to zero length or create text file for update (reading and writing) */
  9050. if (is_empty_string (My->CurrentFile->FileName))
  9051. {
  9052. WARN_BAD_FILE_NAME;
  9053. return (l);
  9054. }
  9055. if ((My->CurrentFile->cfp =
  9056. fopen (My->CurrentFile->FileName, "w+")) == NULL)
  9057. {
  9058. WARN_BAD_FILE_NAME;
  9059. return (l);
  9060. }
  9061. if (width > 0)
  9062. {
  9063. My->CurrentFile->width = width;
  9064. My->CurrentFile->DevMode = DEVMODE_RANDOM;
  9065. }
  9066. else
  9067. {
  9068. My->CurrentFile->DevMode = DEVMODE_INPUT | DEVMODE_OUTPUT;
  9069. }
  9070. return (l);
  9071. }
  9072. /*
  9073. --------------------------------------------------------------------------------------------
  9074. COPY
  9075. --------------------------------------------------------------------------------------------
  9076. */
  9077. static void
  9078. bwb_copy_file (char *Source, char *Target)
  9079. {
  9080. FILE *source;
  9081. FILE *target;
  9082. source = NULL;
  9083. target = NULL;
  9084. if (is_empty_string (Source))
  9085. {
  9086. WARN_BAD_FILE_NAME;
  9087. goto EXIT;
  9088. }
  9089. if (is_empty_string (Target))
  9090. {
  9091. WARN_BAD_FILE_NAME;
  9092. goto EXIT;
  9093. }
  9094. source = fopen (Source, "rb");
  9095. if (source == NULL)
  9096. {
  9097. WARN_BAD_FILE_NAME;
  9098. goto EXIT;
  9099. }
  9100. target = fopen (Target, "wb");
  9101. if (target == NULL)
  9102. {
  9103. WARN_BAD_FILE_NAME;
  9104. goto EXIT;
  9105. }
  9106. /* OK */
  9107. while (TRUE)
  9108. {
  9109. int C;
  9110. C = fgetc (source);
  9111. if (C < 0 /* EOF */ || feof (source) || ferror (source))
  9112. {
  9113. break;
  9114. }
  9115. fputc (C, target);
  9116. if (ferror (target))
  9117. {
  9118. break;
  9119. }
  9120. }
  9121. /* DONE */
  9122. EXIT:
  9123. if (source)
  9124. {
  9125. fclose (source);
  9126. }
  9127. if (target)
  9128. {
  9129. fclose (target);
  9130. }
  9131. }
  9132. LineType *
  9133. bwb_COPY (LineType * Line)
  9134. {
  9135. /* SYNTAX: COPY source$ TO target$ */
  9136. char *Source;
  9137. char *Target;
  9138. assert (Line != NULL);
  9139. Source = NULL;
  9140. Target = NULL;
  9141. if (line_read_string_expression (Line, &Source) == FALSE)
  9142. {
  9143. WARN_SYNTAX_ERROR;
  9144. goto EXIT;
  9145. }
  9146. if (line_skip_word (Line, "TO") == FALSE)
  9147. {
  9148. WARN_SYNTAX_ERROR;
  9149. goto EXIT;
  9150. }
  9151. if (line_read_string_expression (Line, &Target) == FALSE)
  9152. {
  9153. WARN_SYNTAX_ERROR;
  9154. goto EXIT;
  9155. }
  9156. bwb_copy_file (Source, Target);
  9157. EXIT:
  9158. if (Source)
  9159. {
  9160. free (Source);
  9161. }
  9162. if (Target)
  9163. {
  9164. free (Target);
  9165. }
  9166. return (Line);
  9167. }
  9168. /*
  9169. --------------------------------------------------------------------------------------------
  9170. DISPLAY
  9171. --------------------------------------------------------------------------------------------
  9172. */
  9173. static void
  9174. bwb_display_file (char *Source)
  9175. {
  9176. FILE *source;
  9177. assert (My->SYSOUT != NULL);
  9178. assert (My->SYSOUT->cfp != NULL);
  9179. source = NULL;
  9180. if (is_empty_string (Source))
  9181. {
  9182. WARN_BAD_FILE_NAME;
  9183. goto EXIT;
  9184. }
  9185. source = fopen (Source, "rb");
  9186. if (source == NULL)
  9187. {
  9188. WARN_BAD_FILE_NAME;
  9189. goto EXIT;
  9190. }
  9191. /* OK */
  9192. while (TRUE)
  9193. {
  9194. int C;
  9195. C = fgetc (source);
  9196. if (C < 0 /* EOF */ || feof (source) || ferror (source))
  9197. {
  9198. break;
  9199. }
  9200. fputc (C, My->SYSOUT->cfp);
  9201. }
  9202. /* DONE */
  9203. EXIT:
  9204. if (source)
  9205. {
  9206. fclose (source);
  9207. }
  9208. }
  9209. LineType *
  9210. bwb_DISPLAY (LineType * Line)
  9211. {
  9212. /* SYNTAX: DISPLAY source$ */
  9213. char *Source;
  9214. assert (Line != NULL);
  9215. Source = NULL;
  9216. if (line_read_string_expression (Line, &Source) == FALSE)
  9217. {
  9218. WARN_SYNTAX_ERROR;
  9219. goto EXIT;
  9220. }
  9221. bwb_display_file (Source);
  9222. EXIT:
  9223. if (Source)
  9224. {
  9225. free (Source);
  9226. }
  9227. return (Line);
  9228. }
  9229. /*
  9230. --------------------------------------------------------------------------------------------
  9231. EOF
  9232. --------------------------------------------------------------------------------------------
  9233. */
  9234. /* EOF */