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.
 
 
 
 
 
 

1601 lines
37 KiB

  1. /***************************************************************
  2. bwb_cnd.c Conditional Expressions and 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. /*---------------------------------------------------------------*/
  29. #include "bwbasic.h"
  30. /*
  31. --------------------------------------------------------------------------------------------
  32. STATIC UTILITY DECLARATIONS
  33. --------------------------------------------------------------------------------------------
  34. */
  35. static int FindTopLineOnStack(LineType * l);
  36. static LineType * bwb__if_file(LineType * l, int ThenValue );
  37. static LineType * bwb_then_else(LineType * l, int Value);
  38. static int IsTypeMismatch( char L, char R );
  39. static int for_limit_check( BasicNumberType Value, BasicNumberType Target, BasicNumberType Step );
  40. /*
  41. --------------------------------------------------------------------------------------------
  42. EXIT
  43. --------------------------------------------------------------------------------------------
  44. */
  45. LineType *
  46. bwb_EXIT(LineType * l)
  47. {
  48. bwx_DEBUG(__FUNCTION__);
  49. WARN_SYNTAX_ERROR;
  50. return bwb_zline(l);
  51. }
  52. /*
  53. --------------------------------------------------------------------------------------------
  54. SELECT
  55. --------------------------------------------------------------------------------------------
  56. */
  57. LineType *
  58. bwb_SELECT(LineType * l)
  59. {
  60. bwx_DEBUG(__FUNCTION__);
  61. WARN_SYNTAX_ERROR;
  62. return bwb_zline(l);
  63. }
  64. /*
  65. --------------------------------------------------------------------------------------------
  66. FUNCTION - END FUNCTION
  67. --------------------------------------------------------------------------------------------
  68. */
  69. /***************************************************************
  70. FUNCTION: bwb_FUNCTION()
  71. DESCRIPTION: This function implements the BASIC
  72. FUNCTION command, introducing a named
  73. function.
  74. SYNTAX: FUNCTION subroutine-name
  75. ...
  76. [ EXIT FUNCTION ]
  77. ...
  78. END FUNCTION
  79. ***************************************************************/
  80. LineType *
  81. bwb_FUNCTION(LineType * l)
  82. {
  83. bwx_DEBUG(__FUNCTION__);
  84. /* check current exec level */
  85. if (My->stack_head->next == NULL)
  86. {
  87. /* skip over the entire function definition */
  88. l = l->OtherLine; /* line of END SUB */
  89. l = l->next; /* line after END SUB */
  90. l->position = 0;
  91. return l;
  92. }
  93. /* we are being executed via fnc_deffn() */
  94. /* if this is the first time at this SUB statement, note it */
  95. if (My->stack_head->LoopTopLine != l)
  96. {
  97. if( bwb_incexec() )
  98. {
  99. /* OK */
  100. My->stack_head->LoopTopLine = l;
  101. }
  102. else
  103. {
  104. /* ERROR */
  105. WARN_OUT_OF_MEMORY;
  106. return &My->bwb_end;
  107. }
  108. }
  109. line_skip_eol(l);
  110. return bwb_zline(l);
  111. }
  112. LineType *
  113. bwb_EXIT_FUNCTION(LineType * l)
  114. {
  115. bwx_DEBUG(__FUNCTION__);
  116. /* check integrity of SUB commmand */
  117. if( FindTopLineOnStack(l->OtherLine) )
  118. {
  119. /* FOUND */
  120. LineType *r;
  121. bwb_decexec();
  122. r = l->OtherLine; /* line of FUNCTION */
  123. r = r->OtherLine; /* line of END FUNCTION */
  124. r = r->next; /* line after END FUNCTION */
  125. r->position = 0;
  126. return r;
  127. }
  128. /* NOT FOUND */
  129. WARN_EXIT_FUNCTION_WITHOUT_FUNCTION;
  130. return bwb_zline(l);
  131. }
  132. LineType *
  133. bwb_END_FUNCTION(LineType * l)
  134. {
  135. bwx_DEBUG(__FUNCTION__);
  136. /* check integrity of SUB commmand */
  137. if (FindTopLineOnStack(l->OtherLine) == FALSE)
  138. {
  139. /* NOT FOUND */
  140. WARN_END_FUNCTION_WITHOUT_FUNCTION;
  141. return bwb_zline(l);
  142. }
  143. /* decrement the stack */
  144. bwb_decexec();
  145. /* and return next from old line */
  146. My->stack_head->line->next->position = 0;
  147. return My->stack_head->line->next;
  148. }
  149. LineType *
  150. bwb_FNEND(LineType * l)
  151. {
  152. return bwb_END_FUNCTION( l );
  153. }
  154. LineType *
  155. bwb_FEND(LineType * l)
  156. {
  157. return bwb_END_FUNCTION( l );
  158. }
  159. /*
  160. --------------------------------------------------------------------------------------------
  161. SUB - END SUB
  162. --------------------------------------------------------------------------------------------
  163. */
  164. /***************************************************************
  165. FUNCTION: bwb_sub()
  166. DESCRIPTION: This function implements the BASIC
  167. SUB command, introducing a named
  168. subroutine.
  169. SYNTAX: SUB subroutine-name
  170. ...
  171. [ EXIT SUB ]
  172. ...
  173. END SUB
  174. ***************************************************************/
  175. LineType *
  176. bwb_SUB(LineType * l)
  177. {
  178. bwx_DEBUG(__FUNCTION__);
  179. /* check current exec level */
  180. if (My->stack_head->next == NULL)
  181. {
  182. /* skip over the entire function definition */
  183. l = l->OtherLine; /* line of END SUB */
  184. l = l->next; /* line after END SUB */
  185. l->position = 0;
  186. return l;
  187. }
  188. /* we are being executed via fnc_deffn() */
  189. /* if this is the first time at this SUB statement, note it */
  190. if (My->stack_head->LoopTopLine != l)
  191. {
  192. if( bwb_incexec() )
  193. {
  194. /* OK */
  195. My->stack_head->LoopTopLine = l;
  196. }
  197. else
  198. {
  199. /* ERROR */
  200. WARN_OUT_OF_MEMORY;
  201. return &My->bwb_end;
  202. }
  203. }
  204. line_skip_eol(l);
  205. return bwb_zline(l);
  206. }
  207. LineType *
  208. bwb_EXIT_SUB(LineType * l)
  209. {
  210. bwx_DEBUG(__FUNCTION__);
  211. /* check integrity of SUB commmand */
  212. if( FindTopLineOnStack(l->OtherLine) )
  213. {
  214. /* FOUND */
  215. LineType *r;
  216. bwb_decexec();
  217. r = l->OtherLine; /* line of FUNCTION */
  218. r = r->OtherLine; /* line of END FUNCTION */
  219. r = r->next; /* line after END FUNCTION */
  220. r->position = 0;
  221. return r;
  222. }
  223. /* NOT FOUND */
  224. WARN_EXIT_SUB_WITHOUT_SUB;
  225. return bwb_zline(l);
  226. }
  227. LineType *
  228. bwb_END_SUB(LineType * l)
  229. {
  230. bwx_DEBUG(__FUNCTION__);
  231. /* check integrity of SUB commmand */
  232. if (FindTopLineOnStack(l->OtherLine) == FALSE)
  233. {
  234. /* NOT FOUND */
  235. WARN_END_SUB_WITHOUT_SUB;
  236. return bwb_zline(l);
  237. }
  238. /* decrement the stack */
  239. bwb_decexec();
  240. /* and return next from old line */
  241. My->stack_head->line->next->position = 0;
  242. return My->stack_head->line->next;
  243. }
  244. LineType *
  245. bwb_SUBEND(LineType * l)
  246. {
  247. return bwb_END_SUB( l );
  248. }
  249. /*
  250. --------------------------------------------------------------------------------------------
  251. IF - END IF
  252. --------------------------------------------------------------------------------------------
  253. */
  254. /***************************************************************
  255. FUNCTION: bwb_IF()
  256. DESCRIPTION: This function handles the BASIC IF
  257. statement, standard flavor.
  258. standard
  259. SYNTAX: IF expression THEN line [ELSE line]
  260. IF END # file THEN line [ELSE line]
  261. IF MORE # file THEN line [ELSE line]
  262. ***************************************************************/
  263. LineType *
  264. bwb_IF(LineType * l)
  265. {
  266. /* classic IF */
  267. /* IF expression THEN 100 */
  268. /* IF expression THEN 100 ELSE 200 */
  269. int Value;
  270. bwx_DEBUG(__FUNCTION__);
  271. if( line_read_integer_expression(l, &Value) == FALSE )
  272. {
  273. WARN_SYNTAX_ERROR;
  274. return bwb_zline(l);
  275. }
  276. return bwb_then_else(l, Value);
  277. }
  278. LineType *
  279. bwb_IF_END(LineType * l)
  280. {
  281. /* IF END #1 THEN 100 */
  282. if( My->CurrentVersion->OptionVersionBitmask & ( C77 ) )
  283. {
  284. /* sets a linenumber to branch to on EOF */
  285. int FileNumber = 0;
  286. int LineNumber = 0;
  287. if( line_read_integer_expression( l, &FileNumber ) == FALSE )
  288. {
  289. WARN_BAD_FILE_NUMBER;
  290. return bwb_zline(l);
  291. }
  292. if( FileNumber <= 0 )
  293. {
  294. WARN_BAD_FILE_NUMBER;
  295. return bwb_zline(l);
  296. }
  297. if( line_skip_word( l, "THEN") == FALSE )
  298. {
  299. WARN_SYNTAX_ERROR;
  300. return bwb_zline(l);
  301. }
  302. if( line_read_integer_expression( l, &LineNumber ) == FALSE )
  303. {
  304. WARN_UNDEFINED_LINE;
  305. return bwb_zline(l);
  306. }
  307. if( LineNumber < 0 )
  308. {
  309. WARN_UNDEFINED_LINE;
  310. return bwb_zline(l);
  311. }
  312. /* now, we are ready to create the file */
  313. My->CurrentFile = find_file_by_number( FileNumber );
  314. if( My->CurrentFile == NULL )
  315. {
  316. My->CurrentFile = file_new();
  317. My->CurrentFile->FileNumber = FileNumber;
  318. }
  319. My->CurrentFile->EOF_LineNumber = LineNumber;
  320. return bwb_zline(l);
  321. }
  322. return bwb__if_file( l, TRUE );
  323. }
  324. LineType *
  325. bwb_IF_MORE(LineType * l)
  326. {
  327. /* IF MORE #1 THEN 100 */
  328. return bwb__if_file( l, FALSE );
  329. }
  330. /***************************************************************
  331. FUNCTION: bwb_IF_THEN()
  332. DESCRIPTION: This function handles the BASIC IF
  333. statement, structured flavor.
  334. SYNTAX: IF expression THEN
  335. ...
  336. ELSEIF expression
  337. ...
  338. ELSE
  339. ...
  340. END IF
  341. ***************************************************************/
  342. LineType *
  343. bwb_IF_THEN(LineType * l)
  344. {
  345. /* structured IF */
  346. LineType *else_line;
  347. int Value;
  348. bwx_DEBUG(__FUNCTION__);
  349. /* evaluate the expression */
  350. if( line_read_integer_expression(l, &Value) == FALSE )
  351. {
  352. WARN_SYNTAX_ERROR;
  353. return bwb_zline(l);
  354. }
  355. if (Value)
  356. {
  357. /* expression is TRUE */
  358. l->next->position = 0;
  359. return l->next;
  360. }
  361. /*
  362. RESUME knows we iterate thru the various ELSEIF commands, and restarts at the IF THEN command.
  363. RESUME NEXT knows we iterate thru the various ELSEIF commands, and restarts at the END IF command.
  364. */
  365. for( else_line = l->OtherLine; else_line->cmdnum == C_ELSEIF; else_line = else_line->OtherLine )
  366. {
  367. else_line->position = else_line->Startpos;
  368. /* evaluate the expression */
  369. if( line_read_integer_expression(else_line, &Value) == FALSE )
  370. {
  371. WARN_SYNTAX_ERROR;
  372. return bwb_zline(l);
  373. }
  374. if (Value)
  375. {
  376. /* expression is TRUE */
  377. else_line->next->position = 0;
  378. return else_line->next;
  379. }
  380. }
  381. /* ELSE or END IF */
  382. else_line->next->position = 0;
  383. return else_line->next;
  384. }
  385. LineType *
  386. bwb_ELSEIF(LineType * l)
  387. {
  388. bwx_DEBUG(__FUNCTION__);
  389. for( l = l->OtherLine; l->OtherLine != NULL; l = l->OtherLine );
  390. l = l->next; /* line after END IF */
  391. l->position = 0;
  392. return l;
  393. }
  394. LineType *
  395. bwb_ELSE(LineType * l)
  396. {
  397. bwx_DEBUG(__FUNCTION__);
  398. for( l = l->OtherLine; l->OtherLine != NULL; l = l->OtherLine );
  399. l = l->next; /* line after END IF */
  400. l->position = 0;
  401. return l;
  402. }
  403. LineType *
  404. bwb_END_IF(LineType * l)
  405. {
  406. bwx_DEBUG(__FUNCTION__);
  407. return bwb_zline(l);
  408. }
  409. /*
  410. --------------------------------------------------------------------------------------------
  411. SELECT CASE - END SELECT
  412. --------------------------------------------------------------------------------------------
  413. */
  414. /***************************************************************
  415. FUNCTION: bwb_select()
  416. DESCRIPTION: This C function handles the BASIC SELECT
  417. statement.
  418. SYNTAX: SELECT CASE expression ' examples:
  419. CASE value ' CASE 5
  420. CASE min TO max ' CASE 1 TO 10
  421. CASE IF relationaloperator value ' CASE IF > 5
  422. CASE IS relationaloperator value ' CASE IS > 5
  423. CASE ELSE
  424. END SELECT
  425. ***************************************************************/
  426. LineType *
  427. bwb_SELECT_CASE(LineType * l)
  428. {
  429. VariantType selectvalue;
  430. VariantType *e = &selectvalue;
  431. LineType *else_line;
  432. bwx_DEBUG(__FUNCTION__);
  433. /* evaluate the expression */
  434. if( line_read_expression( l, e ) == FALSE )
  435. {
  436. WARN_SYNTAX_ERROR;
  437. return bwb_zline(l);
  438. }
  439. /*
  440. RESUME knows we iterate thru the various CASE commands, and restarts at the SELECT CASE command.
  441. RESUME NEXT knows we iterate thru the various CASE commands, and restarts at the END SELECT command.
  442. */
  443. for( else_line = l->OtherLine; else_line->cmdnum == C_CASE; else_line = else_line->OtherLine )
  444. {
  445. else_line->position = else_line->Startpos;
  446. do
  447. {
  448. /* evaluate the expression */
  449. if( line_skip_word( else_line, "IF" ) || line_skip_word( else_line, "IS" ) )
  450. {
  451. /* CASE IS < 10 */
  452. /* CASE IF < "DEF" */
  453. /* CASE IS > 7 */
  454. /* CASE IS > "ABC" */
  455. char tbuf[BasicStringLengthMax + 1];
  456. int position;
  457. VariantType casevalue;
  458. VariantType *r = &casevalue;
  459. if( e->TypeChar == BasicStringSuffix )
  460. {
  461. /* STRING */
  462. bwb_strcpy( tbuf, e->Buffer );
  463. }
  464. else
  465. {
  466. /* NUMBER */
  467. sprintf(tbuf, BasicNumberPrintFormat, e->Number );
  468. }
  469. bwb_strcat( tbuf, " " );
  470. bwb_strcat( tbuf, &(else_line->buffer[else_line->position]));
  471. position = 0;
  472. if( buff_read_expression( tbuf, &position, r) == FALSE )
  473. {
  474. WARN_SYNTAX_ERROR;
  475. return bwb_zline(l);
  476. }
  477. if( r->TypeChar == BasicStringSuffix )
  478. {
  479. RELEASE( r );
  480. WARN_TYPE_MISMATCH;
  481. return bwb_zline(l);
  482. }
  483. if (r->Number)
  484. {
  485. /* expression is TRUE */
  486. else_line->next->position = 0;
  487. return else_line->next;
  488. }
  489. /* condition is FALSE */
  490. /* proceed to next CASE line if there is one */
  491. }
  492. else
  493. {
  494. /* CASE 7 */
  495. /* CASE 7 TO 10 */
  496. /* CASE "ABC" */
  497. /* CASE "ABC" TO "DEF" */
  498. VariantType minvalue;
  499. VariantType * minval = &minvalue;
  500. /* evaluate the MIN expression */
  501. if( line_read_expression( else_line, minval ) == FALSE )
  502. {
  503. WARN_SYNTAX_ERROR;
  504. return bwb_zline(l);
  505. }
  506. if( IsTypeMismatch(e->TypeChar, minval->TypeChar) )
  507. {
  508. RELEASE( minval );
  509. WARN_TYPE_MISMATCH;
  510. return bwb_zline(l);
  511. }
  512. if( line_skip_word( else_line, "TO" ) )
  513. {
  514. /* CASE 7 TO 10 */
  515. /* CASE "ABC" TO "DEF" */
  516. VariantType maxvalue;
  517. VariantType * maxval = &maxvalue;
  518. /* evaluate the MAX expression */
  519. if( line_read_expression( else_line, maxval ) == FALSE )
  520. {
  521. WARN_SYNTAX_ERROR;
  522. return bwb_zline(l);
  523. }
  524. if( IsTypeMismatch(e->TypeChar, maxval->TypeChar) )
  525. {
  526. RELEASE( maxval );
  527. WARN_TYPE_MISMATCH;
  528. return bwb_zline(l);
  529. }
  530. if (e->TypeChar == BasicStringSuffix)
  531. {
  532. /* STRING */
  533. if ( bwb_strcmp( e->Buffer, minval->Buffer ) >= 0
  534. && bwb_strcmp( e->Buffer, maxval->Buffer ) <= 0)
  535. {
  536. /* expression is TRUE */
  537. else_line->next->position = 0;
  538. return else_line->next;
  539. }
  540. }
  541. else
  542. {
  543. /* NUMBER */
  544. if( e->Number >= minval->Number
  545. && e->Number <= maxval->Number )
  546. {
  547. /* expression is TRUE */
  548. else_line->next->position = 0;
  549. return else_line->next;
  550. }
  551. }
  552. }
  553. else
  554. {
  555. /* CASE 7 */
  556. /* CASE "ABC" */
  557. if (e->TypeChar == BasicStringSuffix)
  558. {
  559. /* STRING */
  560. if (bwb_strcmp( e->Buffer, minval->Buffer ) == 0)
  561. {
  562. /* expression is TRUE */
  563. else_line->next->position = 0;
  564. return else_line->next;
  565. }
  566. }
  567. else
  568. {
  569. /* NUMBER */
  570. if( e->Number == minval->Number )
  571. {
  572. /* expression is TRUE */
  573. else_line->next->position = 0;
  574. return else_line->next;
  575. }
  576. }
  577. }
  578. /* condition is FALSE */
  579. /* proceed to next CASE line if there is one */
  580. }
  581. }
  582. while( line_skip_comma( else_line ) );
  583. }
  584. /* CASE_ELSE or END_SELECT */
  585. else_line->next->position = 0;
  586. return else_line->next;
  587. }
  588. LineType *
  589. bwb_CASE(LineType * l)
  590. {
  591. bwx_DEBUG(__FUNCTION__);
  592. for( l = l->OtherLine; l->OtherLine != NULL; l = l->OtherLine );
  593. l = l->next; /* line after END SELECT */
  594. l->position = 0;
  595. return l;
  596. }
  597. LineType *
  598. bwb_CASE_ELSE(LineType * l)
  599. {
  600. bwx_DEBUG(__FUNCTION__);
  601. for( l = l->OtherLine; l->OtherLine != NULL; l = l->OtherLine );
  602. l = l->next; /* line after END SELECT */
  603. l->position = 0;
  604. return l;
  605. }
  606. LineType *
  607. bwb_END_SELECT(LineType * l)
  608. {
  609. bwx_DEBUG(__FUNCTION__);
  610. return bwb_zline(l);
  611. }
  612. /*
  613. --------------------------------------------------------------------------------------------
  614. DO - LOOP
  615. --------------------------------------------------------------------------------------------
  616. */
  617. /***************************************************************
  618. FUNCTION: bwb_DO()
  619. DESCRIPTION: This C function implements the ANSI BASIC
  620. DO statement.
  621. SYNTAX: DO [UNTIL|WHILE condition]
  622. ...
  623. [EXIT DO]
  624. ...
  625. LOOP [UNTIL|WHILE condition]
  626. ***************************************************************/
  627. LineType *
  628. bwb_DO(LineType * l)
  629. {
  630. LineType *r;
  631. int Value;
  632. bwx_DEBUG(__FUNCTION__);
  633. /* DO ' forever */
  634. /* DO UNTIL ' exits when != 0 */
  635. /* DO WHILE ' exits when == 0 */
  636. do
  637. {
  638. /* evaluate the expression */
  639. if( line_is_eol( l ) )
  640. {
  641. break; /* exit 'do' */
  642. }
  643. else
  644. if( line_skip_word( l, "UNTIL" ) )
  645. {
  646. /* DO UNTIL */
  647. if( line_read_integer_expression(l, &Value) == FALSE )
  648. {
  649. WARN_SYNTAX_ERROR;
  650. return bwb_zline(l);
  651. }
  652. if (Value != 0)
  653. {
  654. /* EXIT DO */
  655. r = l->OtherLine; /* line of LOOP */
  656. r = r->next; /* line after LOOP */
  657. r->position = 0;
  658. return r;
  659. }
  660. }
  661. else
  662. if( line_skip_word( l, "WHILE" ) )
  663. {
  664. /* DO WHILE */
  665. if( line_read_integer_expression(l, &Value) == FALSE )
  666. {
  667. WARN_SYNTAX_ERROR;
  668. return bwb_zline(l);
  669. }
  670. if (Value == 0)
  671. {
  672. /* EXIT DO */
  673. r = l->OtherLine; /* line of LOOP */
  674. r = r->next; /* line after LOOP */
  675. r->position = 0;
  676. return r;
  677. }
  678. }
  679. }
  680. while( line_skip_comma( l ) );
  681. return bwb_zline(l);
  682. }
  683. LineType *
  684. bwb_EXIT_DO(LineType * l)
  685. {
  686. LineType *r;
  687. bwx_DEBUG(__FUNCTION__);
  688. /* EXIT DO */
  689. r = l->OtherLine; /* line of DO */
  690. r = r->OtherLine; /* line of LOOP */
  691. r = r->next; /* line after LOOP */
  692. r->position = 0;
  693. return r;
  694. }
  695. LineType *
  696. bwb_LOOP(LineType * l)
  697. {
  698. LineType *r;
  699. int Value;
  700. bwx_DEBUG(__FUNCTION__);
  701. /* LOOP ' forever */
  702. /* LOOP UNTIL ' exits when != 0 */
  703. /* LOOP WHILE ' exits when == 0 */
  704. do
  705. {
  706. /* evaluate the expression */
  707. if( line_is_eol( l ) )
  708. {
  709. break; /* exit 'do' */
  710. }
  711. else
  712. if( line_skip_word( l, "UNTIL" ) )
  713. {
  714. /* LOOP UNTIL */
  715. if( line_read_integer_expression(l, &Value) == FALSE )
  716. {
  717. WARN_SYNTAX_ERROR;
  718. return bwb_zline(l);
  719. }
  720. if (Value != 0)
  721. {
  722. /* EXIT DO */
  723. return bwb_zline(l);
  724. }
  725. }
  726. else
  727. if( line_skip_word( l, "WHILE" ) )
  728. {
  729. /* LOOP WHILE */
  730. if( line_read_integer_expression(l, &Value) == FALSE )
  731. {
  732. WARN_SYNTAX_ERROR;
  733. return bwb_zline(l);
  734. }
  735. if (Value == 0)
  736. {
  737. /* EXIT DO */
  738. return bwb_zline(l);
  739. }
  740. }
  741. }
  742. while( line_skip_comma( l ) );
  743. /* loop around to DO again */
  744. r = l->OtherLine; /* line of DO */
  745. r->position = 0;
  746. return r;
  747. }
  748. /*
  749. --------------------------------------------------------------------------------------------
  750. WHILE - WEND
  751. --------------------------------------------------------------------------------------------
  752. */
  753. /***************************************************************
  754. FUNCTION: bwb_WHILE()
  755. DESCRIPTION: This function handles the BASIC
  756. WHILE statement.
  757. SYNTAX: WHILE expression ' exits when == 0
  758. ...
  759. [EXIT WHILE]
  760. ...
  761. WEND
  762. ***************************************************************/
  763. LineType *
  764. bwb_WHILE(LineType * l)
  765. {
  766. int Value;
  767. LineType * r;
  768. bwx_DEBUG(__FUNCTION__);
  769. if( line_read_integer_expression(l, &Value) == FALSE )
  770. {
  771. WARN_SYNTAX_ERROR;
  772. return bwb_zline(l);
  773. }
  774. if ( Value == 0 )
  775. {
  776. /* EXIT WHILE */
  777. r = l->OtherLine; /* line of WEND */
  778. r = r->next; /* line after WEND */
  779. r->position = 0;
  780. return r;
  781. }
  782. return bwb_zline(l);
  783. }
  784. LineType *
  785. bwb_EXIT_WHILE(LineType * l)
  786. {
  787. LineType *r;
  788. bwx_DEBUG(__FUNCTION__);
  789. /* EXIT WHILE */
  790. r = l->OtherLine; /* line of WHILE */
  791. r = r->OtherLine; /* line of WEND */
  792. r = r->next; /* line after WEND */
  793. r->position = 0;
  794. return r;
  795. }
  796. LineType *
  797. bwb_WEND(LineType * l)
  798. {
  799. LineType *r;
  800. bwx_DEBUG(__FUNCTION__);
  801. r = l->OtherLine; /* line of WHILE */
  802. r->position = 0;
  803. return r;
  804. }
  805. /*
  806. --------------------------------------------------------------------------------------------
  807. UNTIL - UEND
  808. --------------------------------------------------------------------------------------------
  809. */
  810. /***************************************************************
  811. FUNCTION: bwb_UNTIL()
  812. DESCRIPTION: This function handles the BASIC
  813. UNTIL statement.
  814. SYNTAX: UNTIL expression ' exits when != 0
  815. ...
  816. [EXIT UNTIL]
  817. ...
  818. UEND
  819. ***************************************************************/
  820. LineType *
  821. bwb_UNTIL(LineType * l)
  822. {
  823. int Value;
  824. LineType * r;
  825. bwx_DEBUG(__FUNCTION__);
  826. if( line_read_integer_expression(l, &Value) == FALSE )
  827. {
  828. WARN_SYNTAX_ERROR;
  829. return bwb_zline(l);
  830. }
  831. if ( Value != 0 )
  832. {
  833. /* EXIT UNTIL */
  834. r = l->OtherLine; /* line of UEND */
  835. r = r->next; /* line after UEND */
  836. r->position = 0;
  837. return r;
  838. }
  839. return bwb_zline(l);
  840. }
  841. LineType *
  842. bwb_EXIT_UNTIL(LineType * l)
  843. {
  844. LineType *r;
  845. bwx_DEBUG(__FUNCTION__);
  846. /* EXIT UNTIL */
  847. r = l->OtherLine; /* line of UNTIL */
  848. r = r->OtherLine; /* line of UEND */
  849. r = r->next; /* line after UEND */
  850. r->position = 0;
  851. return r;
  852. }
  853. LineType *
  854. bwb_UEND(LineType * l)
  855. {
  856. LineType *r;
  857. bwx_DEBUG(__FUNCTION__);
  858. r = l->OtherLine; /* line of UNTIL */
  859. r->position = 0;
  860. return r;
  861. }
  862. /*
  863. --------------------------------------------------------------------------------------------
  864. FOR - NEXT
  865. --------------------------------------------------------------------------------------------
  866. */
  867. /***************************************************************
  868. FUNCTION: bwb_for()
  869. DESCRIPTION: This function handles the BASIC FOR
  870. statement.
  871. SYNTAX: FOR counter = start TO finish [STEP increment]
  872. ...
  873. [EXIT FOR]
  874. ...
  875. NEXT [counter]
  876. NOTE: This is controlled by the OptionVersion bitmask.
  877. The order of expression evaluation and variable creation varies.
  878. For example:
  879. FUNCTION FNA( Y )
  880. PRINT "Y="; Y
  881. FNA = Y
  882. END FUNCTION
  883. FOR X = FNA(3) TO FNA(1) STEP FNA(2)
  884. NEXT X
  885. ANSI/ECMA;
  886. Y= 1
  887. Y= 2
  888. Y= 3
  889. X is created (if it does not exist)
  890. X is assigned the value of 3
  891. MICROSOFT;
  892. X is created (if it does not exist)
  893. Y= 3
  894. X is assigned the value of 3
  895. Y= 1
  896. Y= 2
  897. ECMA-55: Section 13.4
  898. ...
  899. The action of the for-statement and the next-statement is de-
  900. fined in terms of other statements, as follows:
  901. FOR v = initial-value TO limit STEP increment
  902. (block)
  903. NEXT v
  904. is equivalent to:
  905. LET own1 = limit
  906. LET own2 = increment
  907. LET v = initial-value
  908. line1 IF (v-own1) * SGN (own2) > 0 THEN line2
  909. (block)
  910. LET v = v + own2
  911. GOTO line1
  912. line2 REM continued in sequence
  913. ...
  914. ***************************************************************/
  915. LineType *
  916. bwb_FOR(LineType * l)
  917. {
  918. LineType *r;
  919. VariableType *v;
  920. BasicNumberType Value;
  921. BasicNumberType Target;
  922. BasicNumberType Step;
  923. VariantType variant;
  924. bwx_DEBUG(__FUNCTION__);
  925. /* if this is the first time at this FOR statement, note it */
  926. if (FindTopLineOnStack(l) == FALSE)
  927. {
  928. if( bwb_incexec() )
  929. {
  930. /* OK */
  931. }
  932. else
  933. {
  934. /* ERROR */
  935. WARN_OUT_OF_MEMORY;
  936. return &My->bwb_end;
  937. }
  938. }
  939. /* INITIALIZE */
  940. if( (v = line_read_scalar( l )) == NULL )
  941. {
  942. WARN_VARIABLE_NOT_DECLARED;
  943. return bwb_zline(l);
  944. }
  945. if( v->dimensions > 0 )
  946. {
  947. WARN_TYPE_MISMATCH;
  948. return bwb_zline(l);
  949. }
  950. if( v->VariableTypeChar == BasicStringSuffix )
  951. {
  952. WARN_TYPE_MISMATCH;
  953. return bwb_zline(l);
  954. }
  955. if( line_skip_char( l, '=' ) == FALSE )
  956. {
  957. WARN_SYNTAX_ERROR;
  958. return bwb_zline(l);
  959. }
  960. if( line_read_numeric_expression( l, &Value) == FALSE )
  961. {
  962. WARN_ILLEGAL_FUNCTION_CALL;
  963. return bwb_zline(l);
  964. }
  965. if (My->CurrentVersion->OptionFlags & OPTION_BUGS_ON /* FOR X = ... */ )
  966. {
  967. /* Assign Variable */
  968. variant.TypeChar = v->VariableTypeChar;
  969. variant.Number = Value;
  970. if( var_set( v, &variant ) == FALSE )
  971. {
  972. WARN_VARIABLE_NOT_DECLARED;
  973. return bwb_zline( l );
  974. }
  975. }
  976. else
  977. {
  978. /* assigned below */
  979. }
  980. if( line_skip_word( l, "TO" ) == FALSE )
  981. {
  982. WARN_SYNTAX_ERROR;
  983. return bwb_zline(l);
  984. }
  985. if( line_read_numeric_expression( l, &Target) == FALSE )
  986. {
  987. WARN_ILLEGAL_FUNCTION_CALL;
  988. return bwb_zline(l);
  989. }
  990. if( line_skip_word( l, "STEP" ) )
  991. {
  992. if( line_read_numeric_expression( l, &Step) == FALSE )
  993. {
  994. WARN_ILLEGAL_FUNCTION_CALL;
  995. return bwb_zline(l);
  996. }
  997. }
  998. else
  999. {
  1000. Step = 1;
  1001. }
  1002. if (My->CurrentVersion->OptionFlags & OPTION_BUGS_ON /* FOR X = ... */ )
  1003. {
  1004. /* assigned above */
  1005. }
  1006. else
  1007. {
  1008. /* Assign Variable */
  1009. variant.TypeChar = v->VariableTypeChar;
  1010. variant.Number = Value;
  1011. if( var_set( v, &variant ) == FALSE )
  1012. {
  1013. WARN_VARIABLE_NOT_DECLARED;
  1014. return bwb_zline( l );
  1015. }
  1016. }
  1017. /* CHECK */
  1018. if ( for_limit_check( Value, Target, Step ) )
  1019. {
  1020. /* EXIT FOR */
  1021. bwb_decexec();
  1022. r = l->OtherLine; /* line of NEXT */
  1023. r = r->next; /* line after NEXT */
  1024. r->position = 0;
  1025. return r;
  1026. }
  1027. /* we will loop at least once */
  1028. My->stack_head->line = l;
  1029. My->stack_head->code = EXEC_FOR;
  1030. My->stack_head->local_variable = v;
  1031. My->stack_head->for_step = Step;
  1032. My->stack_head->for_target = Target;
  1033. My->stack_head->LoopTopLine = l;
  1034. My->stack_head->OnErrorGoto = 0;
  1035. /* proceed with processing */
  1036. return bwb_zline(l);
  1037. }
  1038. LineType *
  1039. bwb_EXIT_FOR(LineType * l)
  1040. {
  1041. LineType *r;
  1042. bwx_DEBUG(__FUNCTION__);
  1043. if (FindTopLineOnStack(l->OtherLine) == FALSE)
  1044. {
  1045. WARN_EXIT_FOR_WITHOUT_FOR;
  1046. return bwb_zline(l);
  1047. }
  1048. My->stack_head->code = EXEC_FOR;
  1049. bwb_decexec();
  1050. r = l->OtherLine; /* line of FOR */
  1051. r = r->OtherLine; /* line of NEXT */
  1052. r = r->next; /* line after NEXT */
  1053. r->position = 0;
  1054. return r;
  1055. }
  1056. LineType *
  1057. bwb_NEXT(LineType * l)
  1058. {
  1059. LineType *r;
  1060. VariableType *v;
  1061. BasicNumberType Value;
  1062. BasicNumberType Target;
  1063. BasicNumberType Step;
  1064. bwx_DEBUG(__FUNCTION__);
  1065. if (FindTopLineOnStack(l->OtherLine) == FALSE)
  1066. {
  1067. WARN_NEXT_WITHOUT_FOR;
  1068. return bwb_zline(l);
  1069. }
  1070. My->stack_head->code = EXEC_FOR;
  1071. /* INCREMENT */
  1072. v = My->stack_head->local_variable;
  1073. Target = My->stack_head->for_target;
  1074. Step = My->stack_head->for_step;
  1075. /* if( TRUE ) */
  1076. {
  1077. VariantType variant;
  1078. if( var_get( v, &variant ) == FALSE )
  1079. {
  1080. WARN_NEXT_WITHOUT_FOR;
  1081. return bwb_zline(l);
  1082. }
  1083. if( variant.TypeChar == '$' )
  1084. {
  1085. WARN_NEXT_WITHOUT_FOR;
  1086. return bwb_zline(l);
  1087. }
  1088. variant.Number += Step;
  1089. Value = variant.Number;
  1090. if( var_set( v, &variant ) == FALSE )
  1091. {
  1092. WARN_NEXT_WITHOUT_FOR;
  1093. return bwb_zline(l);
  1094. }
  1095. }
  1096. /* CHECK */
  1097. if ( for_limit_check( Value, Target, Step ) )
  1098. {
  1099. /* EXIT FOR */
  1100. bwb_decexec();
  1101. return bwb_zline(l);
  1102. }
  1103. /* proceed with processing */
  1104. r = l->OtherLine; /* line of FOR */
  1105. #if 0
  1106. /*
  1107. This example causes a Syntax Error:
  1108. 100 FOR I = 1 TO 1000:NEXT
  1109. The error is actually caused by execline().
  1110. Note that the example is a delay loop.
  1111. Only NEXT has this issue, because it jumps to TOP->next.
  1112. All other loop structures jump to either TOP or BOTTOM->next.
  1113. */
  1114. r = r->next; /* line after FOR */
  1115. r->position = 0;
  1116. #endif
  1117. line_skip_eol(r);
  1118. return r;
  1119. }
  1120. /*
  1121. --------------------------------------------------------------------------------------------
  1122. STATIC UTILITY ROUTINES
  1123. --------------------------------------------------------------------------------------------
  1124. */
  1125. static int FindTopLineOnStack(LineType * l)
  1126. {
  1127. /* since we are at the top of a loop, we MIGHT be on the stack */
  1128. StackType * stack_item;
  1129. bwx_DEBUG(__FUNCTION__);
  1130. for ( stack_item = My->stack_head; stack_item != NULL; stack_item = stack_item->next )
  1131. {
  1132. LineType *current;
  1133. current = stack_item->LoopTopLine;
  1134. if (current != NULL)
  1135. {
  1136. if (current == l)
  1137. {
  1138. /* FOUND */
  1139. while (My->stack_head != stack_item)
  1140. {
  1141. bwb_decexec();
  1142. }
  1143. /* we are now the top item on the stack */
  1144. return TRUE;
  1145. }
  1146. /* do NOT cross a function/sub boundary */
  1147. switch (current->cmdnum)
  1148. {
  1149. case C_FUNCTION:
  1150. case C_SUB:
  1151. case C_GOSUB:
  1152. /* NOT FOUND */
  1153. return FALSE;
  1154. /* break; */
  1155. }
  1156. }
  1157. }
  1158. /* NOT FOUND */
  1159. return FALSE;
  1160. }
  1161. static LineType * bwb__if_file(LineType * l, int ThenValue )
  1162. {
  1163. /* IF END # filenumber THEN linenumber */
  1164. /* IF MORE # filenumber THEN linenumber */
  1165. int Value;
  1166. int FileNumber;
  1167. bwx_DEBUG(__FUNCTION__);
  1168. if( line_skip_char(l,BasicFileNumberPrefix) )
  1169. {
  1170. /* IF END # */
  1171. FileType * F;
  1172. if( line_read_integer_expression( l, &FileNumber ) == FALSE )
  1173. {
  1174. WARN_BAD_FILE_NUMBER;
  1175. return bwb_zline(l);
  1176. }
  1177. if( FileNumber < 0 )
  1178. {
  1179. /* Printer is NOT EOF */
  1180. Value = FALSE;
  1181. }
  1182. else
  1183. if( FileNumber == 0 )
  1184. {
  1185. /* Console is NOT EOF */
  1186. Value = FALSE;
  1187. }
  1188. else
  1189. {
  1190. /* normal file */
  1191. F = find_file_by_number( FileNumber );
  1192. if( F == NULL )
  1193. {
  1194. WARN_BAD_FILE_NUMBER;
  1195. return bwb_zline(l);
  1196. }
  1197. /* if( TRUE ) */
  1198. {
  1199. /* actual file -- are we at the end? */
  1200. FILE *fp;
  1201. long current;
  1202. long total;
  1203. fp = F->cfp;
  1204. current = ftell(fp);
  1205. fseek(fp, 0, SEEK_END);
  1206. total = ftell(fp);
  1207. if (total == current)
  1208. {
  1209. /* EOF */
  1210. Value = TRUE;
  1211. }
  1212. else
  1213. {
  1214. /* NOT EOF */
  1215. Value = FALSE;
  1216. fseek(fp, current, SEEK_SET);
  1217. }
  1218. }
  1219. }
  1220. }
  1221. else
  1222. {
  1223. WARN_SYNTAX_ERROR;
  1224. return bwb_zline(l);
  1225. }
  1226. if (Value == ThenValue)
  1227. {
  1228. /* expression is TRUE, take THEN path */
  1229. return bwb_then_else(l, TRUE);
  1230. }
  1231. /* expression is FALSE, take ELSE path */
  1232. return bwb_then_else(l, FALSE);
  1233. }
  1234. static LineType * bwb_then_else(LineType * l, int Value)
  1235. {
  1236. /*
  1237. ... THEN 100
  1238. ... THEN 100 ELSE 200
  1239. The deciding expression has already been parsed and evaluated.
  1240. If Value != 0, then we want to take the THEN path.
  1241. If Value == 0, then we want to take the ELSE path.
  1242. */
  1243. int LineNumber;
  1244. LineType *x;
  1245. if( line_skip_comma(l) )
  1246. {
  1247. /* OK */
  1248. }
  1249. else
  1250. {
  1251. /* OPTIONAL */
  1252. }
  1253. if( line_skip_word( l, "THEN" ) )
  1254. {
  1255. /* OK */
  1256. }
  1257. else
  1258. if( line_skip_word( l, "GOTO" ) )
  1259. {
  1260. /* OK */
  1261. }
  1262. else
  1263. {
  1264. /* REQUIRED */
  1265. WARN_SYNTAX_ERROR;
  1266. return bwb_zline(l);
  1267. }
  1268. /* read THEN's LineNumber */
  1269. if( line_read_integer_expression(l, &LineNumber) == FALSE )
  1270. {
  1271. WARN_SYNTAX_ERROR;
  1272. return bwb_zline(l);
  1273. }
  1274. if (Value == 0)
  1275. {
  1276. /* expression is FALSE, take ELSE path */
  1277. if( line_is_eol( l ) )
  1278. {
  1279. /* OPTIONAL */
  1280. return bwb_zline(l);
  1281. }
  1282. if( line_skip_comma(l) )
  1283. {
  1284. /* OK */
  1285. }
  1286. else
  1287. {
  1288. /* OPTIONAL */
  1289. }
  1290. if( line_skip_word( l, "ELSE" ) )
  1291. {
  1292. /* OK */
  1293. }
  1294. else
  1295. {
  1296. /* REQUIRED */
  1297. WARN_SYNTAX_ERROR;
  1298. return bwb_zline(l);
  1299. }
  1300. if( line_read_integer_expression(l, &LineNumber) == FALSE )
  1301. {
  1302. WARN_SYNTAX_ERROR;
  1303. return bwb_zline(l);
  1304. }
  1305. }
  1306. x = NULL;
  1307. #if THE_PRICE_IS_RIGHT
  1308. if( l->OtherLine != NULL )
  1309. {
  1310. /* look in the cache */
  1311. if( l->OtherLine->number == LineNumber )
  1312. {
  1313. x = l->OtherLine; /* found in cache */
  1314. }
  1315. }
  1316. #endif /* THE_PRICE_IS_RIGHT */
  1317. if( x == NULL )
  1318. {
  1319. x = find_line_number( LineNumber, TRUE );
  1320. }
  1321. if (x != NULL)
  1322. {
  1323. line_skip_eol(l);
  1324. x->position = 0;
  1325. #if THE_PRICE_IS_RIGHT
  1326. l->OtherLine = x; /* save in cache */
  1327. #endif /* THE_PRICE_IS_RIGHT */
  1328. return x;
  1329. }
  1330. WARN_SYNTAX_ERROR;
  1331. return bwb_zline(l);
  1332. }
  1333. static int IsTypeMismatch( char L, char R )
  1334. {
  1335. if( L == BasicStringSuffix && R == BasicStringSuffix )
  1336. {
  1337. /* both STRING */
  1338. return FALSE;
  1339. }
  1340. if( L != BasicStringSuffix && R != BasicStringSuffix )
  1341. {
  1342. /* both NUMBER */
  1343. return FALSE;
  1344. }
  1345. /* TYPE MISMATCH */
  1346. return TRUE;
  1347. }
  1348. static int for_limit_check( BasicNumberType Value, BasicNumberType Target, BasicNumberType Step )
  1349. {
  1350. if (Step > 0)
  1351. {
  1352. /* POSITIVE */
  1353. if (Value > Target)
  1354. {
  1355. /* FOR I = 3 TO 2 STEP 1 */
  1356. return TRUE;
  1357. }
  1358. }
  1359. else
  1360. {
  1361. /* NEGATIVE */
  1362. if (Value < Target)
  1363. {
  1364. /* FOR I = -3 TO -2 STEP -1 */
  1365. return TRUE;
  1366. }
  1367. }
  1368. return FALSE;
  1369. }
  1370. /* EOF */