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.
 
 
 
 
 
 

2307 lines
52 KiB

  1. /***************************************************************
  2. bwb_stc.c Commands Related to Structured Programming
  3. for Bywater BASIC Interpreter
  4. Commands: CALL
  5. SUB
  6. FUNCTION
  7. END SUB
  8. END FUNCTION
  9. Copyright (c) 1993, Ted A. Campbell
  10. Bywater Software
  11. email: tcamp@delphi.com
  12. Copyright and Permissions Information:
  13. All U.S. and international rights are claimed by the author,
  14. Ted A. Campbell.
  15. This software is released under the terms of the GNU General
  16. Public License (GPL), which is distributed with this software
  17. in the file "COPYING". The GPL specifies the terms under
  18. which users may copy and use the software in this distribution.
  19. A separate license is available for commercial distribution,
  20. for information on which you should contact the author.
  21. ***************************************************************/
  22. /*---------------------------------------------------------------*/
  23. /* NOTE: Modifications marked "JBV" were made by Jon B. Volkoff, */
  24. /* 11/1995 (eidetics@cerf.net). */
  25. /*---------------------------------------------------------------*/
  26. #include <stdio.h>
  27. #include <ctype.h>
  28. #include "bwbasic.h"
  29. #include "bwb_mes.h"
  30. /* prototypes */
  31. #if ANSI_C
  32. static int fslt_clear( void );
  33. static int fslt_add( struct bwb_line *line, int *position, int code );
  34. static struct bwb_line *fslt_findl( char *buffer );
  35. static struct fslte *fslt_findf( char *buffer );
  36. static int scan_getcmd( struct bwb_line *line, int *position );
  37. static int scan_readargs( struct fslte *f,
  38. struct bwb_line *line, int *position );
  39. static int call_readargs( struct fslte *f,
  40. char *expression, int *position );
  41. static int is_endsub( struct bwb_line *l );
  42. static struct bwb_line *find_endsub( struct bwb_line *l );
  43. static struct bwb_line *bwb_loopuntil( struct bwb_line *l );
  44. struct bwb_variable *bwb_vtov( struct bwb_variable *dst, struct bwb_variable *src );
  45. struct bwb_variable *bwb_etov( struct bwb_variable *dst, struct exp_ese *src );
  46. struct bwb_variable *var_pos( struct bwb_variable *firstvar, int p );
  47. int fslt_addcallvar( struct bwb_variable *v );
  48. int fslt_addlocalvar( struct fslte *f, struct bwb_variable *v );
  49. #else
  50. static int fslt_clear();
  51. static int fslt_add();
  52. static struct bwb_line *fslt_findl();
  53. static struct fslte *fslt_findf();
  54. static int scan_getcmd();
  55. static int scan_readargs();
  56. static int call_readargs();
  57. static int is_endsub();
  58. static struct bwb_line *find_endsub();
  59. static struct bwb_line *bwb_loopuntil();
  60. struct bwb_variable *bwb_vtov();
  61. struct bwb_variable *bwb_etov();
  62. struct bwb_variable *var_pos();
  63. int fslt_addcallvar();
  64. int fslt_addlocalvar();
  65. #endif /* ANSI_C for prototypes */
  66. /***************************************************************
  67. FUNCTION: bwb_scan()
  68. DESCRIPTION: This function scans all lines of the
  69. program in memory and creates a FUNCTION-
  70. SUB lookup table (fslt) for the program.
  71. ***************************************************************/
  72. #if ANSI_C
  73. int
  74. bwb_scan( void )
  75. #else
  76. int
  77. bwb_scan()
  78. #endif
  79. {
  80. struct bwb_line *current;
  81. int position;
  82. int c;
  83. #if PROG_ERRORS
  84. if ( CURTASK rescan != TRUE )
  85. {
  86. bwb_error( "in bwb_scan(): call to scan while CURTASK rescan != TRUE" );
  87. return FALSE;
  88. }
  89. #endif
  90. #if INTENSIVE_DEBUG
  91. sprintf( bwb_ebuf, "in bwb_scan(): beginning scan..." );
  92. bwb_debug( bwb_ebuf );
  93. #endif
  94. /* first run through the FUNCTION - SUB loopkup table
  95. and free any existing memory */
  96. fslt_clear();
  97. /* run through the list of lines and identify SUB and FUNCTION statements */
  98. for ( current = CURTASK bwb_start.next; current != &CURTASK bwb_end; current = current->next )
  99. {
  100. #if INTENSIVE_DEBUG
  101. sprintf( bwb_ebuf, "in bwb_scan(): scanning line <%d>", current->number );
  102. bwb_debug( bwb_ebuf );
  103. #endif
  104. c = scan_getcmd( current, &position );
  105. if ( c == getcmdnum( CMD_SUB ))
  106. {
  107. fslt_add( current, &position, EXEC_CALLSUB );
  108. }
  109. else if ( c == getcmdnum( CMD_FUNCTION ))
  110. {
  111. fslt_add( current, &position, EXEC_FUNCTION );
  112. }
  113. else if ( c == getcmdnum( CMD_DEF ))
  114. {
  115. fslt_add( current, &position, EXEC_FUNCTION );
  116. }
  117. #if STRUCT_CMDS
  118. else if ( c == getcmdnum( CMD_LABEL ))
  119. {
  120. fslt_add( current, &position, EXEC_LABEL );
  121. }
  122. #endif
  123. }
  124. /* return */
  125. CURTASK rescan = FALSE;
  126. return TRUE;
  127. }
  128. /***************************************************************
  129. FUNCTION: fslt_clear()
  130. DESCRIPTION: This C function clears all existing memory
  131. in the FUNCTION-SUB lookup table.
  132. ***************************************************************/
  133. #if ANSI_C
  134. static int
  135. fslt_clear( void )
  136. #else
  137. static int
  138. fslt_clear()
  139. #endif
  140. {
  141. struct fslte *current, *next;
  142. struct bwb_variable *c, *n;
  143. /* run through table and clear memory */
  144. next = CURTASK fslt_start.next;
  145. for ( current = CURTASK fslt_start.next; current != &CURTASK fslt_end;
  146. current = next )
  147. {
  148. /* check for local variables and free them */
  149. c = current->local_variable;
  150. while ( c != NULL )
  151. {
  152. n = c->next;
  153. /* Revised to FREE pass-thru call by JBV */
  154. FREE( c, "fslt_clear" );
  155. c = n;
  156. }
  157. next = current->next;
  158. /* Revised to FREE pass-thru calls by JBV */
  159. if (current->name != NULL)
  160. {
  161. FREE( current->name, "fslt_clear" ); /* JBV */
  162. current->name = NULL; /* JBV */
  163. }
  164. FREE( current, "fslt_clear" );
  165. current = NULL; /* JBV */
  166. }
  167. /* reset linkage */
  168. CURTASK fslt_start.next = &CURTASK fslt_end;
  169. return TRUE;
  170. }
  171. /***************************************************************
  172. FUNCTION: scan_getcmd()
  173. DESCRIPTION: This command returns the command number
  174. for the first BASIC command word encountered
  175. in a line.
  176. ***************************************************************/
  177. #if ANSI_C
  178. static int
  179. scan_getcmd( struct bwb_line *line, int *position )
  180. #else
  181. static int
  182. scan_getcmd( line, position )
  183. struct bwb_line *line;
  184. int *position;
  185. #endif
  186. {
  187. char tbuf[ MAXSTRINGSIZE + 1 ];
  188. *position = 0;
  189. adv_ws( line->buffer, position );
  190. /* check for NULL line */
  191. if ( line->buffer[ *position ] == '\0' )
  192. {
  193. return -1;
  194. }
  195. /* check for line number and advance beyond it */
  196. if ( isdigit( line->buffer[ *position ] ))
  197. {
  198. scan_element( line->buffer, position, tbuf );
  199. }
  200. /* get the command element in the buffer */
  201. scan_element( line->buffer, position, tbuf );
  202. #if INTENSIVE_DEBUG
  203. sprintf( bwb_ebuf, "in scan_getcmd(): scanning element <%s>", tbuf );
  204. bwb_debug( bwb_ebuf );
  205. #endif
  206. #if STRUCT_CMDS
  207. if ( is_label( tbuf ) == TRUE )
  208. {
  209. #if INTENSIVE_DEBUG
  210. sprintf( bwb_ebuf, "in scan_getcmd(): found label <%s>", tbuf );
  211. bwb_debug( bwb_ebuf );
  212. #endif
  213. return getcmdnum( CMD_LABEL );
  214. }
  215. #endif
  216. bwb_strtoupper( tbuf );
  217. /* return command number */
  218. return getcmdnum( tbuf );
  219. }
  220. /***************************************************************
  221. FUNCTION: scan_element()
  222. DESCRIPTION: This function reads characters in <buffer>
  223. beginning at <pos> and advances past a
  224. line element, incrementing <pos> appropri-
  225. ately and returning the line element in
  226. <element>.
  227. This function is almost identical to adv_element(),
  228. but it will not stop at a full colon. This is
  229. necessary to detect a label in the first element
  230. position. If MULTISEG_LINES is defined as TRUE,
  231. adv_element() will stop at the colon, interpreting
  232. it as the end-of-segment marker.
  233. ***************************************************************/
  234. #if ANSI_C
  235. extern int
  236. scan_element( char *buffer, int *pos, char *element )
  237. #else
  238. int
  239. scan_element( buffer, pos, element )
  240. char *buffer;
  241. int *pos;
  242. char *element;
  243. #endif
  244. {
  245. int loop; /* control loop */
  246. int e_pos; /* position in element buffer */
  247. int str_const; /* boolean: building a string constant */
  248. /* advance beyond any initial whitespace */
  249. adv_ws( buffer, pos );
  250. #if INTENSIVE_DEBUG
  251. sprintf( bwb_ebuf, "in adv_element(): receieved <%s>.", &( buffer[ *pos ] ));
  252. bwb_debug( bwb_ebuf );
  253. #endif
  254. /* now loop while building an element and looking for an
  255. element terminator */
  256. loop = TRUE;
  257. e_pos = 0;
  258. element[ e_pos ] = '\0';
  259. str_const = FALSE;
  260. while ( loop == TRUE )
  261. {
  262. switch( buffer[ *pos ] )
  263. {
  264. case ',': /* element terminators */
  265. case ';':
  266. case '=':
  267. case ' ':
  268. case '\t':
  269. case '\0':
  270. case '\n':
  271. case '\r':
  272. if ( str_const == TRUE )
  273. {
  274. element[ e_pos ] = buffer[ *pos ];
  275. ++e_pos;
  276. ++( *pos );
  277. element[ e_pos ] = '\0';
  278. }
  279. else
  280. {
  281. return TRUE;
  282. }
  283. break;
  284. case '\"': /* string constant */
  285. element[ e_pos ] = buffer[ *pos ];
  286. ++e_pos;
  287. ++( *pos );
  288. element[ e_pos ] = '\0';
  289. if ( str_const == TRUE ) /* termination of string constant */
  290. {
  291. return TRUE;
  292. }
  293. else /* beginning of string constant */
  294. {
  295. str_const = TRUE;
  296. }
  297. break;
  298. case '(': /* MID$ command termination (JBV) */
  299. /* If MID$ is here, get out */
  300. if (strcmp(element, CMD_MID) == 0)
  301. return TRUE;
  302. /* else add it to the accumulation element */
  303. element[ e_pos ] = buffer[ *pos ];
  304. ++e_pos;
  305. ++( *pos );
  306. element[ e_pos ] = '\0';
  307. break;
  308. default:
  309. element[ e_pos ] = buffer[ *pos ];
  310. ++e_pos;
  311. ++( *pos );
  312. element[ e_pos ] = '\0';
  313. break;
  314. }
  315. }
  316. /* This should not happen */
  317. return FALSE;
  318. }
  319. /***************************************************************
  320. FUNCTION: fslt_add()
  321. DESCRIPTION: This C function adds an entry to the
  322. FUNCTION-SUB lookup table.
  323. ***************************************************************/
  324. #if ANSI_C
  325. static int
  326. fslt_add( struct bwb_line *line, int *position, int code )
  327. #else
  328. static int
  329. fslt_add( line, position, code )
  330. struct bwb_line *line;
  331. int *position;
  332. int code;
  333. #endif
  334. {
  335. char tbuf[ MAXSTRINGSIZE + 1 ];
  336. char *name;
  337. struct bwb_variable *v;
  338. struct fslte *f, *n;
  339. int p;
  340. /* get the element for name */
  341. if ( code == EXEC_LABEL )
  342. {
  343. p = 0;
  344. scan_element( line->buffer, &p, tbuf );
  345. if ( isdigit( tbuf[ 0 ] ))
  346. {
  347. scan_element( line->buffer, &p, tbuf );
  348. }
  349. tbuf[ strlen( tbuf ) - 1 ] = '\0';
  350. }
  351. else
  352. {
  353. adv_ws( line->buffer, position );
  354. exp_getvfname( &( line->buffer[ *position ] ), tbuf );
  355. *position += strlen( tbuf );
  356. }
  357. #if INTENSIVE_DEBUG
  358. sprintf( bwb_ebuf, "in fslt_add(): adding SUB/FUNCTION/LABEL code <%d> name <%s>",
  359. code, tbuf );
  360. bwb_debug( bwb_ebuf );
  361. #endif
  362. /* get memory for name buffer */
  363. /* Revised to CALLOC pass-thru call by JBV */
  364. if ( ( name = CALLOC( 1, strlen( tbuf ) + 1, "fslt_add" ) ) == NULL )
  365. {
  366. #if PROG_ERRORS
  367. bwb_error( "in fslt_add(): failed to get memory for name buffer" );
  368. #else
  369. bwb_error( err_getmem );
  370. #endif
  371. return FALSE;
  372. }
  373. strcpy( name, tbuf );
  374. /* get memory for fslt structure */
  375. if ( ( f = CALLOC( 1, sizeof( struct fslte ), "fslt_add" ) ) == NULL )
  376. {
  377. #if PROG_ERRORS
  378. bwb_error( "in fslt_add(): failed to get memory for fslt structure" );
  379. #else
  380. bwb_error( err_getmem );
  381. #endif
  382. return FALSE;
  383. }
  384. /* fill in structure */
  385. f->line = line;
  386. f->name = name;
  387. f->code = code;
  388. f->local_variable = NULL;
  389. #if INTENSIVE_DEBUG
  390. sprintf( bwb_ebuf, "in fslt_add(): current buffer <%s>",
  391. &( line->buffer[ *position ] ) );
  392. bwb_debug( bwb_ebuf );
  393. #endif
  394. /* read arguments */
  395. adv_ws( line->buffer, position );
  396. if ( line->buffer[ *position ] == '(' )
  397. {
  398. scan_readargs( f, line, position );
  399. }
  400. /* if function, add one more local variable expressing the name
  401. of the function */
  402. if ( code == EXEC_FUNCTION )
  403. {
  404. v = var_new( tbuf );
  405. fslt_addlocalvar( f, v );
  406. #if INTENSIVE_DEBUG
  407. sprintf( bwb_ebuf, "in fslt_add(): added function-name variable <%s>",
  408. v->name );
  409. bwb_debug( bwb_ebuf );
  410. getchar();
  411. #endif
  412. }
  413. /* establish linkages */
  414. n = CURTASK fslt_start.next;
  415. CURTASK fslt_start.next = f;
  416. f->next = n;
  417. return TRUE;
  418. }
  419. /***************************************************************
  420. FUNCTION: scan_readargs()
  421. DESCRIPTION: This C function reads arguments (variable
  422. names for an entry added to the FUNCTION-
  423. SUB lookup table.
  424. ***************************************************************/
  425. #if ANSI_C
  426. static int
  427. scan_readargs( struct fslte *f, struct bwb_line *line, int *position )
  428. #else
  429. static int
  430. scan_readargs( f, line, position )
  431. struct fslte *f;
  432. struct bwb_line *line;
  433. int *position;
  434. #endif
  435. {
  436. int control_loop;
  437. struct bwb_variable *v;
  438. char tbuf[ MAXSTRINGSIZE + 1 ];
  439. #if INTENSIVE_DEBUG
  440. sprintf( bwb_ebuf, "in scan_readargs(): reading arguments, buffer <%s>",
  441. &( line->buffer[ *position ] ) );
  442. bwb_debug( bwb_ebuf );
  443. #endif
  444. /* if we are at begin paren, advance */
  445. if ( line->buffer[ *position ] == '(' )
  446. {
  447. ++( *position );
  448. }
  449. /* loop through looking for arguments */
  450. control_loop = TRUE;
  451. adv_ws( line->buffer, position );
  452. while ( control_loop == TRUE )
  453. {
  454. switch( line->buffer[ *position ] )
  455. {
  456. case '\n': /* premature end of line */
  457. case '\r':
  458. case '\0':
  459. control_loop = FALSE;
  460. f->startpos = *position;
  461. bwb_error( err_syntax );
  462. return FALSE;
  463. case ')': /* end of argument list */
  464. ++( *position );
  465. control_loop = FALSE;
  466. f->startpos = *position;
  467. return TRUE;
  468. default: /* presume beginning of argument == variable name */
  469. exp_getvfname( &( line->buffer[ *position ] ), tbuf );
  470. *position += strlen( tbuf );
  471. #if INTENSIVE_DEBUG
  472. sprintf( bwb_ebuf, "in scan_readargs(): read argument <%s>",
  473. tbuf );
  474. bwb_debug( bwb_ebuf );
  475. #endif
  476. /* initialize the variable and add it to local chain */
  477. v = var_new( tbuf );
  478. fslt_addlocalvar( f, v );
  479. /* advance past the comma */
  480. if ( line->buffer[ *position ] == ',' )
  481. {
  482. ++( *position );
  483. }
  484. break;
  485. }
  486. adv_ws( line->buffer, position );
  487. }
  488. return TRUE;
  489. }
  490. /***************************************************************
  491. FUNCTION: call_readargs()
  492. DESCRIPTION: This C function reads arguments (variable
  493. names for a subroutine CALL or function
  494. call.
  495. ***************************************************************/
  496. #if ANSI_C
  497. static int
  498. call_readargs( struct fslte *f, char *expression, int *position )
  499. #else
  500. static int
  501. call_readargs( f, expression, position )
  502. struct fslte *f;
  503. char *expression;
  504. int *position;
  505. #endif
  506. {
  507. int control_loop;
  508. struct bwb_variable *v, *c;
  509. char tbuf[ MAXSTRINGSIZE + 1 ];
  510. int argument_counter;
  511. int local_pos, single_var;
  512. struct exp_ese *e;
  513. #if INTENSIVE_DEBUG
  514. sprintf( bwb_ebuf, "in call_readargs(): reading arguments, buffer <%s>",
  515. &( expression[ *position ] ) );
  516. bwb_debug( bwb_ebuf );
  517. #endif
  518. /* if we are at begin paren, advance */
  519. if ( expression[ *position ] == '(' )
  520. {
  521. ++( *position );
  522. }
  523. /* loop through looking for arguments */
  524. control_loop = TRUE;
  525. argument_counter = 0;
  526. while ( control_loop == TRUE )
  527. {
  528. adv_ws( expression, position );
  529. #if INTENSIVE_DEBUG
  530. sprintf( bwb_ebuf, "in call_readargs(): in loop, buffer <%s>",
  531. &( expression[ *position ] ) );
  532. bwb_debug( bwb_ebuf );
  533. #endif
  534. switch( expression[ *position ] )
  535. {
  536. case '\n': /* end of line */
  537. case '\r':
  538. case '\0':
  539. #if MULTISEG_LINES
  540. case ':': /* end of segment */
  541. #endif
  542. control_loop = FALSE;
  543. return FALSE;
  544. case ')': /* end of argument list */
  545. ++( *position );
  546. control_loop = FALSE;
  547. return TRUE;
  548. default: /* presume beginning of argument */
  549. /* read the first word to see if it is a single variable name */
  550. single_var = FALSE;
  551. exp_getvfname( &( expression[ *position ] ), tbuf );
  552. local_pos = *position + strlen( tbuf );
  553. adv_ws( expression, &local_pos );
  554. #if INTENSIVE_DEBUG
  555. sprintf( bwb_ebuf, "in call_readargs(): in loop, tbuf <%s>",
  556. tbuf );
  557. bwb_debug( bwb_ebuf );
  558. #endif
  559. /* check now for the single variable name */
  560. if ( strlen( tbuf ) == 0 )
  561. {
  562. single_var = FALSE;
  563. }
  564. else
  565. {
  566. switch ( expression[ local_pos ] )
  567. {
  568. case ')': /* end of argument list */
  569. #if INTENSIVE_DEBUG
  570. sprintf( bwb_ebuf, "in call_readargs(): detected end of argument list" );
  571. bwb_debug( bwb_ebuf );
  572. #endif
  573. ++local_pos; /* and fall through */
  574. case '\n': /* end of line */
  575. case '\r':
  576. case '\0':
  577. #if MULTISEG_LINES
  578. case ':': /* end of segment */
  579. #endif
  580. control_loop = FALSE; /* and fall through */
  581. /* added 1993-06-16 */
  582. case ',': /* end of argument */
  583. single_var = TRUE;
  584. /* look for variable from previous (calling) level */
  585. -- CURTASK exsc;
  586. v = var_find( tbuf ); /* find variable there */
  587. ++ CURTASK exsc;
  588. c = var_pos( CURTASK excs[ CURTASK exsc ].local_variable,
  589. argument_counter ); /* find local equivalent */
  590. bwb_vtov( c, v ); /* assign calling value to local variable */
  591. #if INTENSIVE_DEBUG
  592. sprintf( bwb_ebuf, "in call_readargs(): variable name is <%s>, local name <%s>",
  593. v->name, c->name );
  594. bwb_debug( bwb_ebuf );
  595. #endif
  596. *position = local_pos;
  597. break;
  598. default:
  599. single_var = FALSE;
  600. break;
  601. }
  602. }
  603. if ( single_var == FALSE )
  604. {
  605. #if INTENSIVE_DEBUG
  606. sprintf( bwb_ebuf, "in call_readargs(): in loop, parse expression <%s>",
  607. &( expression[ *position ] ) );
  608. bwb_debug( bwb_ebuf );
  609. #endif
  610. e = bwb_exp( expression, FALSE, position ); /* parse */
  611. #if INTENSIVE_DEBUG
  612. sprintf( bwb_ebuf, "in call_readargs(): in loop, parsed expression, buffer <%s>",
  613. &( expression[ *position ] ) );
  614. bwb_debug( bwb_ebuf );
  615. #endif
  616. v = var_pos( CURTASK excs[ CURTASK exsc ].local_variable,
  617. argument_counter ); /* assign to variable */
  618. bwb_etov( v, e ); /* assign value */
  619. }
  620. /* add the variable to the calling variable chain */
  621. fslt_addcallvar( v );
  622. #if INTENSIVE_DEBUG
  623. str_btoc( tbuf, var_getsval( v ));
  624. if ( single_var == TRUE )
  625. {
  626. sprintf( bwb_ebuf, "in call_readargs(): added arg <%d> (single) name <%s> value <%s>",
  627. argument_counter, v->name, tbuf );
  628. }
  629. else
  630. {
  631. sprintf( bwb_ebuf, "in call_readargs(): added arg <%d> (expression) name <%s> value <%s>",
  632. argument_counter, v->name, tbuf );
  633. }
  634. bwb_debug( bwb_ebuf );
  635. getchar();
  636. #endif
  637. /* advance past comma if present */
  638. adv_ws( expression, position );
  639. if ( expression[ *position ] == ',' )
  640. {
  641. ++( *position );
  642. }
  643. break;
  644. }
  645. ++argument_counter;
  646. }
  647. #if INTENSIVE_DEBUG
  648. sprintf( bwb_ebuf, "in call_readargs(): exiting function" );
  649. bwb_debug( bwb_ebuf );
  650. #endif
  651. return TRUE;
  652. }
  653. /***************************************************************
  654. FUNCTION: fslt_findl()
  655. DESCRIPTION: This C function finds a line corresponding
  656. to a name in the FUNCTION-SUB lookup
  657. table.
  658. ***************************************************************/
  659. #if ANSI_C
  660. static struct bwb_line *
  661. fslt_findl( char *buffer )
  662. #else
  663. static struct bwb_line *
  664. fslt_findl( buffer )
  665. char *buffer;
  666. #endif
  667. {
  668. struct fslte *r;
  669. r = fslt_findf( buffer );
  670. return r->line;
  671. }
  672. /***************************************************************
  673. FUNCTION: fslt_findf()
  674. DESCRIPTION: This C function finds an fslte structure
  675. corresponding to a name in the FUNCTION-
  676. SUB lookup table.
  677. ***************************************************************/
  678. #if ANSI_C
  679. static struct fslte *
  680. fslt_findf( char *buffer )
  681. #else
  682. static struct fslte *
  683. fslt_findf( buffer )
  684. char *buffer;
  685. #endif
  686. {
  687. struct fslte *f;
  688. register int c;
  689. /* remove open-paren from string */
  690. for ( c = 0; buffer[ c ] != '\0'; ++c )
  691. {
  692. if ( buffer[ c ] == '(' )
  693. {
  694. buffer[ c ] = '\0';
  695. }
  696. }
  697. #if INTENSIVE_DEBUG
  698. sprintf( bwb_ebuf, "in fslt_findf(): search for name <%s>", buffer );
  699. bwb_debug( bwb_ebuf );
  700. #endif
  701. /* run through the table */
  702. for ( f = CURTASK fslt_start.next; f != &CURTASK fslt_end; f = f->next )
  703. {
  704. if ( strcmp( f->name, buffer ) == 0 )
  705. {
  706. return f;
  707. }
  708. }
  709. /* search has failed */
  710. #if PROG_ERRORS
  711. sprintf( bwb_ebuf, "in fslt_findf(): failed to find Function/Subroutine <%s>",
  712. buffer );
  713. bwb_error( bwb_ebuf );
  714. #else
  715. bwb_error( err_lnnotfound );
  716. #endif
  717. return NULL;
  718. }
  719. /***************************************************************
  720. FUNCTION: bwb_def()
  721. DESCRIPTION: This C function implements the BASIC
  722. DEF statement. Since DEF and FUNCTION
  723. are equivalent, it simply passes execution
  724. to bwb_function().
  725. SYNTAX: DEF FNname(arg...)] = expression
  726. NOTE: It is not a strict requirement that the
  727. function name should begin with "FN".
  728. ***************************************************************/
  729. #if ANSI_C
  730. struct bwb_line *
  731. bwb_def( struct bwb_line *l )
  732. #else
  733. struct bwb_line *
  734. bwb_def( l )
  735. struct bwb_line *l;
  736. #endif
  737. {
  738. #if MULTISEG_LINES
  739. adv_eos( l->buffer, &( l->position ));
  740. #endif
  741. return bwb_zline( l );
  742. }
  743. #if STRUCT_CMDS
  744. /***************************************************************
  745. FUNCTION: bwb_function()
  746. DESCRIPTION: This C function implements the BASIC
  747. FUNCTION and DEF commands.
  748. SYNTAX: FUNCTION function-definition
  749. ***************************************************************/
  750. #if ANSI_C
  751. struct bwb_line *
  752. bwb_function( struct bwb_line *l )
  753. #else
  754. struct bwb_line *
  755. bwb_function( l )
  756. struct bwb_line *l;
  757. #endif
  758. {
  759. return bwb_def( l );
  760. }
  761. /***************************************************************
  762. FUNCTION: bwb_endfnc()
  763. DESCRIPTION: This C function implements the BASIC
  764. END FUNCTION command, ending a subroutine
  765. definition. Because the command END
  766. can have multiple meanings, this function
  767. should be called from the bwb_xend()
  768. function, which should be able to identify
  769. an END FUNCTION command.
  770. SYNTAX: END FUNCTION
  771. ***************************************************************/
  772. #if ANSI_C
  773. struct bwb_line *
  774. bwb_endfnc( struct bwb_line *l )
  775. #else
  776. struct bwb_line *
  777. bwb_endfnc( l )
  778. struct bwb_line *l;
  779. #endif
  780. {
  781. struct bwb_variable *local;
  782. register int c;
  783. /* assign local variable values to calling variables */
  784. local = CURTASK excs[ CURTASK exsc ].local_variable;
  785. for ( c = 0; c < CURTASK excs[ CURTASK exsc ].n_cvs; ++c )
  786. {
  787. bwb_vtov( CURTASK excs[ CURTASK exsc ].calling_variable[ c ], local );
  788. local = local->next;
  789. }
  790. /* decrement the EXEC stack counter */
  791. bwb_decexec();
  792. /* and return next from old line */
  793. CURTASK excs[ CURTASK exsc ].line->next->position = 0;
  794. return CURTASK excs[ CURTASK exsc ].line->next;
  795. }
  796. /***************************************************************
  797. FUNCTION: bwb_call()
  798. DESCRIPTION: This C function implements the BASIC
  799. CALL subroutine command.
  800. SYNTAX: CALL subroutine-name
  801. ***************************************************************/
  802. #if ANSI_C
  803. struct bwb_line *
  804. bwb_call( struct bwb_line *l )
  805. #else
  806. struct bwb_line *
  807. bwb_call( l )
  808. struct bwb_line *l;
  809. #endif
  810. {
  811. char tbuf[ MAXSTRINGSIZE + 1 ];
  812. struct bwb_line *call_line;
  813. struct fslte *f;
  814. adv_element( l->buffer, &( l->position ), tbuf );
  815. #if INTENSIVE_DEBUG
  816. sprintf( bwb_ebuf, "in bwb_call(): call to subroutine <%s>", tbuf );
  817. bwb_debug( bwb_ebuf );
  818. #endif
  819. /* find the line to call */
  820. call_line = fslt_findl( tbuf );
  821. f = fslt_findf( tbuf );
  822. if ( call_line == NULL )
  823. {
  824. return bwb_zline( l );
  825. }
  826. #if INTENSIVE_DEBUG
  827. sprintf( bwb_ebuf, "in bwb_call(): found line <%s>",
  828. call_line->buffer );
  829. bwb_debug( bwb_ebuf );
  830. #endif
  831. /* save the old position on the EXEC stack */
  832. bwb_setexec( l, l->position, CURTASK excs[ CURTASK exsc ].code );
  833. /* increment and set new EXEC stack */
  834. bwb_incexec();
  835. call_line->position = 0;
  836. bwb_setexec( call_line, 0, EXEC_CALLSUB );
  837. /* attach local variables */
  838. CURTASK excs[ CURTASK exsc ].local_variable = f->local_variable;
  839. /* read calling variables for this call */
  840. call_readargs( f, l->buffer, &( l->position ) );
  841. return call_line;
  842. }
  843. /***************************************************************
  844. FUNCTION: bwb_sub()
  845. DESCRIPTION: This function implements the BASIC
  846. SUB command, introducing a named
  847. subroutine.
  848. SYNTAX: SUB subroutine-name
  849. (followed by subroutine definition ending
  850. with END SUB).
  851. ***************************************************************/
  852. #if ANSI_C
  853. struct bwb_line *
  854. bwb_sub( struct bwb_line *l )
  855. #else
  856. struct bwb_line *
  857. bwb_sub( l )
  858. struct bwb_line *l;
  859. #endif
  860. {
  861. char tbuf[ MAXSTRINGSIZE + 1 ];
  862. struct bwb_line *rline;
  863. #if MULTISEG_LINES
  864. struct fslte *f;
  865. #endif
  866. #if INTENSIVE_DEBUG
  867. sprintf( bwb_ebuf, "in bwb_sub(): entered function at exec level <%d>",
  868. CURTASK exsc );
  869. bwb_debug( bwb_ebuf );
  870. #endif
  871. /* check current exec level: if 1 then only MAIN should be executed */
  872. if ( CURTASK exsc == 0 )
  873. {
  874. adv_element( l->buffer, &( l->position ), tbuf );
  875. bwb_strtoupper( tbuf );
  876. if ( strcmp( tbuf, "MAIN" ) == 0 )
  877. {
  878. #if INTENSIVE_DEBUG
  879. sprintf( bwb_ebuf, "in bwb_sub(): found MAIN function at level 0" );
  880. bwb_debug( bwb_ebuf );
  881. #endif
  882. bwb_incexec();
  883. bwb_setexec( l->next, 0, EXEC_MAIN );
  884. return bwb_zline( l );
  885. }
  886. /* if a MAIN function was not found at level 0, then skip the subroutine */
  887. else
  888. {
  889. #if INTENSIVE_DEBUG
  890. sprintf( bwb_ebuf, "in bwb_sub(): found non-MAIN function at level 0" );
  891. bwb_debug( bwb_ebuf );
  892. #endif
  893. rline = find_endsub( l );
  894. bwb_setexec( rline->next, 0, EXEC_CALLSUB );
  895. rline->next->position = 0;
  896. return rline->next;
  897. }
  898. }
  899. /* check for integrity of CALL-SUB sequence if above level 0 */
  900. else if ( CURTASK excs[ CURTASK exsc ].code != EXEC_CALLSUB )
  901. {
  902. #if PROG_ERRORS
  903. sprintf( bwb_ebuf, "in bwb_sub(): SUB without CALL" );
  904. bwb_error( bwb_ebuf );
  905. #else
  906. bwb_error( err_retnogosub );
  907. #endif
  908. }
  909. /* advance position */
  910. #if MULTISEG_LINES
  911. adv_ws( l->buffer, &( l->position ));
  912. adv_element( l->buffer, &( l->position ), tbuf );
  913. f = fslt_findf( tbuf );
  914. l->position = f->startpos;
  915. return bwb_zline( l );
  916. #else
  917. return bwb_zline( l );
  918. #endif
  919. }
  920. /***************************************************************
  921. FUNCTION: find_endsub()
  922. DESCRIPTION: This function searches for a line containing
  923. an END SUB statement corresponding to a previous
  924. SUB statement.
  925. ***************************************************************/
  926. #if ANSI_C
  927. static struct bwb_line *
  928. find_endsub( struct bwb_line *l )
  929. #else
  930. static struct bwb_line *
  931. find_endsub( l )
  932. struct bwb_line *l;
  933. #endif
  934. {
  935. struct bwb_line *current;
  936. register int s_level;
  937. int position;
  938. s_level = 1;
  939. for ( current = l->next; current != &CURTASK bwb_end; current = current->next )
  940. {
  941. position = 0;
  942. if ( current->marked != TRUE )
  943. {
  944. line_start( current->buffer, &position, &( current->lnpos ),
  945. &( current->lnum ),
  946. &( current->cmdpos ),
  947. &( current->cmdnum ),
  948. &( current->startpos ) );
  949. }
  950. current->position = current->startpos;
  951. if ( current->cmdnum > -1 )
  952. {
  953. if ( bwb_cmdtable[ current->cmdnum ].vector == bwb_sub )
  954. {
  955. ++s_level;
  956. #if INTENSIVE_DEBUG
  957. sprintf( bwb_ebuf, "in find_endsub(): found SUB at line %d, level %d",
  958. current->number, s_level );
  959. bwb_debug( bwb_ebuf );
  960. #endif
  961. }
  962. else if ( is_endsub( current ) == TRUE )
  963. {
  964. --s_level;
  965. #if INTENSIVE_DEBUG
  966. sprintf( bwb_ebuf, "in find_endsub(): found END SUB at line %d, level %d",
  967. current->number, s_level );
  968. bwb_debug( bwb_ebuf );
  969. #endif
  970. if ( s_level == 0 )
  971. {
  972. return current;
  973. }
  974. }
  975. }
  976. }
  977. #if PROG_ERRORS
  978. sprintf( bwb_ebuf, "SUB without END SUB" );
  979. bwb_error( bwb_ebuf );
  980. #else
  981. bwb_error( err_syntax );
  982. #endif
  983. return NULL;
  984. }
  985. /***************************************************************
  986. FUNCTION: is_endsub()
  987. DESCRIPTION: This function determines whether the
  988. line buffer for line 'l' is positioned
  989. at an END SUB statement.
  990. ***************************************************************/
  991. #if ANSI_C
  992. static int
  993. is_endsub( struct bwb_line *l )
  994. #else
  995. static int
  996. is_endsub( l )
  997. struct bwb_line *l;
  998. #endif
  999. {
  1000. int position;
  1001. char tbuf[ MAXVARNAMESIZE + 1];
  1002. if ( bwb_cmdtable[ l->cmdnum ].vector != bwb_xend )
  1003. {
  1004. return FALSE;
  1005. }
  1006. position = l->startpos;
  1007. adv_ws( l->buffer, &position );
  1008. adv_element( l->buffer, &position, tbuf );
  1009. bwb_strtoupper( tbuf );
  1010. if ( strcmp( tbuf, "SUB" ) == 0 )
  1011. {
  1012. return TRUE;
  1013. }
  1014. return FALSE;
  1015. }
  1016. /***************************************************************
  1017. FUNCTION: bwb_endsub()
  1018. DESCRIPTION: This C function implements the BASIC
  1019. END SUB command, ending a subroutine
  1020. definition. Because the command END
  1021. can have multiple meanings, this function
  1022. should be called from the bwb_xend()
  1023. function, which should be able to identify
  1024. an END SUB command.
  1025. SYNTAX: END SUB
  1026. ***************************************************************/
  1027. #if ANSI_C
  1028. struct bwb_line *
  1029. bwb_endsub( struct bwb_line *line )
  1030. #else
  1031. struct bwb_line *
  1032. bwb_endsub( line )
  1033. struct bwb_line *line;
  1034. #endif
  1035. {
  1036. struct bwb_variable *l;
  1037. register int c;
  1038. /* assign local variable values to calling variables */
  1039. l = CURTASK excs[ CURTASK exsc ].local_variable;
  1040. for ( c = 0; c < CURTASK excs[ CURTASK exsc ].n_cvs; ++c )
  1041. {
  1042. bwb_vtov( CURTASK excs[ CURTASK exsc ].calling_variable[ c ], l );
  1043. l = l->next;
  1044. }
  1045. /* decrement the EXEC stack counter */
  1046. bwb_decexec();
  1047. /* if the previous level was EXEC_MAIN,
  1048. then execution continues from this point */
  1049. if ( CURTASK excs[ CURTASK exsc + 1 ].code == EXEC_MAIN )
  1050. {
  1051. return bwb_zline( line );
  1052. }
  1053. /* else return next from old line */
  1054. CURTASK excs[ CURTASK exsc ].line->next->position = 0;
  1055. return CURTASK excs[ CURTASK exsc ].line->next;
  1056. }
  1057. /***************************************************************
  1058. FUNCTION: find_label()
  1059. DESCRIPTION: This C function finds a program line that
  1060. begins with the label included in <buffer>.
  1061. ***************************************************************/
  1062. #if ANSI_C
  1063. extern struct bwb_line *
  1064. find_label( char *buffer )
  1065. #else
  1066. extern struct bwb_line *
  1067. find_label( buffer )
  1068. char *buffer;
  1069. #endif
  1070. {
  1071. struct fslte *f;
  1072. for ( f = CURTASK fslt_start.next; f != & ( CURTASK fslt_end ); f = f->next )
  1073. {
  1074. if ( strcmp( buffer, f->name ) == 0 )
  1075. {
  1076. #if INTENSIVE_DEBUG
  1077. sprintf( bwb_ebuf, "in find_label(): found label <%s>", buffer );
  1078. bwb_debug( bwb_ebuf );
  1079. #endif
  1080. return f->line;
  1081. }
  1082. }
  1083. #if PROG_ERRORS
  1084. sprintf( bwb_ebuf, "in find_label(): failed to find label <%s>", buffer );
  1085. bwb_error( bwb_ebuf );
  1086. #else
  1087. bwb_error( err_lnnotfound );
  1088. #endif
  1089. return NULL;
  1090. }
  1091. /***************************************************************
  1092. FUNCTION: bwb_doloop()
  1093. DESCRIPTION: This C function implements the ANSI BASIC
  1094. DO statement, when DO is not followed by
  1095. an argument. It is called by bwb_do() in
  1096. bwb_cmd.c.
  1097. SYNTAX: DO
  1098. ***************************************************************/
  1099. #if ANSI_C
  1100. struct bwb_line *
  1101. bwb_doloop( struct bwb_line *l )
  1102. #else
  1103. struct bwb_line *
  1104. bwb_doloop( l )
  1105. struct bwb_line *l;
  1106. #endif
  1107. {
  1108. /* if this is the first time at this DO statement, note it */
  1109. if ( CURTASK excs[ CURTASK exsc ].while_line != l )
  1110. {
  1111. bwb_incexec();
  1112. CURTASK excs[ CURTASK exsc ].while_line = l;
  1113. /* find the LOOP statement */
  1114. CURTASK excs[ CURTASK exsc ].wend_line = find_loop( l );
  1115. if ( CURTASK excs[ CURTASK exsc ].wend_line == NULL )
  1116. {
  1117. return bwb_zline( l );
  1118. }
  1119. #if INTENSIVE_DEBUG
  1120. sprintf( bwb_ebuf, "in bwb_doloop(): initialize DO loop, line <%d>",
  1121. l->number );
  1122. bwb_debug( bwb_ebuf );
  1123. #endif
  1124. }
  1125. #if INTENSIVE_DEBUG
  1126. else
  1127. {
  1128. sprintf( bwb_ebuf, "in bwb_doloop(): return to DO loop, line <%d>",
  1129. l->number );
  1130. bwb_debug( bwb_ebuf );
  1131. }
  1132. #endif
  1133. bwb_setexec( l, l->position, EXEC_DO );
  1134. return bwb_zline( l );
  1135. }
  1136. /***************************************************************
  1137. FUNCTION: bwb_loop()
  1138. DESCRIPTION: This C function implements the ANSI BASIC
  1139. LOOP statement.
  1140. SYNTAX: LOOP [UNTIL expression]
  1141. ***************************************************************/
  1142. #if ANSI_C
  1143. struct bwb_line *
  1144. bwb_loop( struct bwb_line *l )
  1145. #else
  1146. struct bwb_line *
  1147. bwb_loop( l )
  1148. struct bwb_line *l;
  1149. #endif
  1150. {
  1151. char tbuf[ MAXSTRINGSIZE + 1 ];
  1152. #if INTENSIVE_DEBUG
  1153. sprintf( bwb_ebuf, "in bwb_loop(): entered subroutine" );
  1154. bwb_debug( bwb_ebuf );
  1155. #endif
  1156. /* If the current exec stack is set for EXEC_WHILE, then we
  1157. presume that this is a LOOP statement ending a DO WHILE
  1158. loop */
  1159. if ( CURTASK excs[ CURTASK exsc ].code == EXEC_WHILE )
  1160. {
  1161. return bwb_wend( l );
  1162. }
  1163. /* check integrity of DO loop */
  1164. if ( CURTASK excs[ CURTASK exsc ].code != EXEC_DO )
  1165. {
  1166. #if PROG_ERRORS
  1167. sprintf( bwb_ebuf, "in bwb_loop(): exec stack code != EXEC_DO" );
  1168. bwb_error( bwb_ebuf );
  1169. #else
  1170. bwb_error( err_syntax );
  1171. #endif
  1172. }
  1173. if ( CURTASK excs[ CURTASK exsc ].while_line == NULL )
  1174. {
  1175. #if PROG_ERRORS
  1176. sprintf( bwb_ebuf, "in bwb_loop(): exec stack while_line == NULL" );
  1177. bwb_error( bwb_ebuf );
  1178. #else
  1179. bwb_error( err_syntax );
  1180. #endif
  1181. }
  1182. /* advance to find the first argument */
  1183. adv_element( l->buffer, &( l->position ), tbuf );
  1184. bwb_strtoupper( tbuf );
  1185. /* detect a LOOP UNTIL structure */
  1186. if ( strcmp( tbuf, CMD_XUNTIL ) == 0 )
  1187. {
  1188. #if INTENSIVE_DEBUG
  1189. sprintf( bwb_ebuf, "in bwb_loop(): detected LOOP UNTIL" );
  1190. bwb_debug( bwb_ebuf );
  1191. #endif
  1192. return bwb_loopuntil( l );
  1193. }
  1194. /* LOOP does not have UNTIL */
  1195. else
  1196. {
  1197. /* reset to the top of the current DO loop */
  1198. #if INTENSIVE_DEBUG
  1199. sprintf( bwb_ebuf, "in bwb_loop() return to line <%d>",
  1200. CURTASK excs[ CURTASK exsc ].while_line->number );
  1201. bwb_debug( bwb_ebuf );
  1202. #endif
  1203. CURTASK excs[ CURTASK exsc ].while_line->position = 0;
  1204. bwb_setexec( CURTASK excs[ CURTASK exsc ].while_line, 0, EXEC_DO );
  1205. return CURTASK excs[ CURTASK exsc ].while_line;
  1206. }
  1207. }
  1208. /***************************************************************
  1209. FUNCTION: bwb_loopuntil()
  1210. DESCRIPTION: This C function implements the ANSI BASIC
  1211. LOOP UNTIL statement and is called by
  1212. bwb_loop().
  1213. ***************************************************************/
  1214. #if ANSI_C
  1215. static struct bwb_line *
  1216. bwb_loopuntil( struct bwb_line *l )
  1217. #else
  1218. static struct bwb_line *
  1219. bwb_loopuntil( l )
  1220. struct bwb_line *l;
  1221. #endif
  1222. {
  1223. struct exp_ese *e;
  1224. struct bwb_line *r;
  1225. #if INTENSIVE_DEBUG
  1226. sprintf( bwb_ebuf, "in bwb_loopuntil(): entered subroutine" );
  1227. bwb_debug( bwb_ebuf );
  1228. #endif
  1229. /* call bwb_exp() to interpret the expression */
  1230. e = bwb_exp( l->buffer, FALSE, &( l->position ) );
  1231. if ( (int) exp_getnval( e ) != FALSE ) /* Was == TRUE (JBV 10/1996) */
  1232. {
  1233. CURTASK excs[ CURTASK exsc ].while_line = NULL;
  1234. r = CURTASK excs[ CURTASK exsc ].wend_line;
  1235. bwb_setexec( r, 0, CURTASK excs[ CURTASK exsc - 1 ].code );
  1236. r->position = 0;
  1237. bwb_decexec();
  1238. return r;
  1239. }
  1240. /* condition is false: loop around to DO again */
  1241. else
  1242. {
  1243. #if INTENSIVE_DEBUG
  1244. sprintf( bwb_ebuf, "in bwb_loopuntil() return to line <%d>",
  1245. CURTASK excs[ CURTASK exsc ].while_line->number );
  1246. bwb_debug( bwb_ebuf );
  1247. #endif
  1248. CURTASK excs[ CURTASK exsc ].while_line->position = 0;
  1249. bwb_setexec( CURTASK excs[ CURTASK exsc ].while_line, 0, EXEC_DO );
  1250. return CURTASK excs[ CURTASK exsc ].while_line;
  1251. }
  1252. }
  1253. /***************************************************************
  1254. FUNCTION: bwb_exit()
  1255. DESCRIPTION: This C function implements the BASIC EXIT
  1256. statement, calling subroutines for either
  1257. EXIT FOR or EXIT DO.
  1258. SYNTAX: EXIT FOR|DO
  1259. ***************************************************************/
  1260. #if ANSI_C
  1261. struct bwb_line *
  1262. bwb_exit( struct bwb_line *l )
  1263. #else
  1264. struct bwb_line *
  1265. bwb_exit( l )
  1266. struct bwb_line *l;
  1267. #endif
  1268. {
  1269. char tbuf[ MAXSTRINGSIZE + 1 ];
  1270. #if INTENSIVE_DEBUG
  1271. sprintf( bwb_ebuf, "in bwb_exit(): entered subroutine" );
  1272. bwb_debug( bwb_ebuf );
  1273. #endif
  1274. adv_element( l->buffer, &( l->position ), tbuf );
  1275. bwb_strtoupper( tbuf );
  1276. if ( strcmp( tbuf, CMD_XFOR ) == 0 )
  1277. {
  1278. #if INTENSIVE_DEBUG
  1279. sprintf( bwb_ebuf, "in bwb_exit(): detected EXIT FOR" );
  1280. bwb_debug( bwb_ebuf );
  1281. #endif
  1282. return bwb_exitfor( l );
  1283. }
  1284. if ( strcmp( tbuf, CMD_XDO ) == 0 )
  1285. {
  1286. return bwb_exitdo( l );
  1287. }
  1288. #if PROG_ERRORS
  1289. sprintf( bwb_ebuf, "in bwb_exit(): Nonsense or nothing following EXIT" );
  1290. bwb_error( bwb_ebuf );
  1291. #else
  1292. bwb_error( err_syntax );
  1293. #endif
  1294. return bwb_zline( l );
  1295. }
  1296. /***************************************************************
  1297. FUNCTION: bwb_exitdo()
  1298. DESCRIPTION: This function handles the BASIC EXIT
  1299. DO statement. This is a structured
  1300. programming command compatible with ANSI
  1301. BASIC. It is called from the bwb_exit()
  1302. subroutine.
  1303. ***************************************************************/
  1304. #if ANSI_C
  1305. struct bwb_line *
  1306. bwb_exitdo( struct bwb_line *l )
  1307. #else
  1308. struct bwb_line *
  1309. bwb_exitdo( l )
  1310. struct bwb_line *l;
  1311. #endif
  1312. {
  1313. struct bwb_line *next_line;
  1314. int found;
  1315. register int level;
  1316. #if INTENSIVE_DEBUG
  1317. sprintf( bwb_ebuf, "in bwb_exitdo(): entered subroutine" );
  1318. bwb_debug( bwb_ebuf );
  1319. #endif
  1320. /* Check the integrity of the DO statement */
  1321. found = FALSE;
  1322. level = CURTASK exsc;
  1323. do
  1324. {
  1325. if ( CURTASK excs[ level ].code == EXEC_DO )
  1326. {
  1327. next_line = CURTASK excs[ CURTASK level ].wend_line;
  1328. found = TRUE;
  1329. }
  1330. else
  1331. {
  1332. --level;
  1333. }
  1334. }
  1335. while ( ( level >= 0 ) && ( found == FALSE ) );
  1336. if ( found != TRUE )
  1337. {
  1338. #if PROG_ERRORS
  1339. /* JBV 1/97 (was "bwb_exitfor") */
  1340. sprintf( bwb_ebuf, "in bwb_exitdo(): EXIT DO without DO" );
  1341. bwb_error( bwb_ebuf );
  1342. #else
  1343. bwb_error( err_syntax );
  1344. #endif
  1345. return bwb_zline( l );
  1346. }
  1347. #if INTENSIVE_DEBUG
  1348. sprintf( bwb_ebuf, "in bwb_exitdo(): level found is <%d>, current <%d>",
  1349. level, CURTASK exsc );
  1350. bwb_debug( bwb_ebuf );
  1351. #endif
  1352. /* decrement below the level of the NEXT statement */
  1353. while( CURTASK exsc >= level )
  1354. {
  1355. bwb_decexec();
  1356. }
  1357. /* set the next line in the exec stack */
  1358. next_line->position = 0;
  1359. bwb_setexec( next_line, 0, EXEC_NORM );
  1360. return next_line;
  1361. }
  1362. #endif /* STRUCT_CMDS */
  1363. /***************************************************************
  1364. FUNCTION: bwb_vtov()
  1365. DESCRIPTION: This function assigns the value of one
  1366. bwBASIC variable (src) to the value of another
  1367. bwBASIC variable (dst).
  1368. ***************************************************************/
  1369. #if ANSI_C
  1370. struct bwb_variable *
  1371. bwb_vtov( struct bwb_variable *dst,
  1372. struct bwb_variable *src )
  1373. #else
  1374. struct bwb_variable *
  1375. bwb_vtov( dst, src )
  1376. struct bwb_variable *dst;
  1377. struct bwb_variable *src;
  1378. #endif
  1379. {
  1380. if ( dst == src )
  1381. {
  1382. return dst;
  1383. }
  1384. if ( src->type != dst->type )
  1385. {
  1386. #if PROG_ERRORS
  1387. sprintf( bwb_ebuf, "in bwb_vtov(): mismatch src <%s> type <%d> dst <%s> type <%d>",
  1388. src->name, src->type, dst->name, dst->type );
  1389. bwb_error( bwb_ebuf );
  1390. #else
  1391. bwb_error( err_mismatch );
  1392. #endif
  1393. return NULL;
  1394. }
  1395. if ( dst->type == NUMBER )
  1396. {
  1397. #if INTENSIVE_DEBUG
  1398. sprintf( bwb_ebuf, "in bwb_vtov(): assigning var <%s> val <%lf> to var <%s>",
  1399. src->name, var_getnval( src ), dst->name );
  1400. bwb_debug( bwb_ebuf );
  1401. #endif
  1402. * var_findnval( dst, dst->array_pos ) = var_getnval( src );
  1403. }
  1404. else
  1405. {
  1406. str_btob( var_getsval( dst ), var_getsval( src ) );
  1407. }
  1408. return dst;
  1409. }
  1410. /***************************************************************
  1411. FUNCTION: bwb_etov()
  1412. DESCRIPTION: This function assigns the value of a
  1413. bwBASIC expression stack element (src)
  1414. to the value of a bwBASIC variable (dst).
  1415. ***************************************************************/
  1416. #if ANSI_C
  1417. struct bwb_variable *
  1418. bwb_etov( struct bwb_variable *dst, struct exp_ese *src )
  1419. #else
  1420. struct bwb_variable *
  1421. bwb_etov( dst, src )
  1422. struct bwb_variable *dst;
  1423. struct exp_ese *src;
  1424. #endif
  1425. {
  1426. if ( (int) src->type != dst->type )
  1427. {
  1428. #if PROG_ERRORS
  1429. sprintf( bwb_ebuf, "in bwb_etov(): mismatch src <%d> dst <%d>",
  1430. src->type, dst->type );
  1431. bwb_error( bwb_ebuf );
  1432. #else
  1433. bwb_error( err_mismatch );
  1434. #endif
  1435. return NULL;
  1436. }
  1437. if ( dst->type == NUMBER )
  1438. {
  1439. * var_findnval( dst, dst->array_pos ) = exp_getnval( src );
  1440. }
  1441. else
  1442. {
  1443. str_btob( var_getsval( dst ), exp_getsval( src ) );
  1444. }
  1445. return dst;
  1446. }
  1447. /***************************************************************
  1448. FUNCTION: var_pos()
  1449. DESCRIPTION: This function returns the name of a
  1450. local variable at a specified position
  1451. in the local variable list.
  1452. ***************************************************************/
  1453. #if ANSI_C
  1454. struct bwb_variable *
  1455. var_pos( struct bwb_variable *firstvar, int p )
  1456. #else
  1457. struct bwb_variable *
  1458. var_pos( firstvar, p )
  1459. struct bwb_variable *firstvar;
  1460. int p;
  1461. #endif
  1462. {
  1463. register int c;
  1464. struct bwb_variable *v;
  1465. v = firstvar;
  1466. for ( c = 0; c != p; ++c )
  1467. {
  1468. v = v->next;
  1469. }
  1470. #if INTENSIVE_DEBUG
  1471. sprintf( bwb_ebuf, "in var_pos(): returning pos <%d> variable <%s>",
  1472. p, v->name );
  1473. bwb_debug( bwb_ebuf );
  1474. #endif
  1475. return v;
  1476. }
  1477. /***************************************************************
  1478. FUNCTION: fslt_addcallvar()
  1479. DESCRIPTION: This function adds a calling variable
  1480. to the FUNCTION-SUB lookup table at
  1481. a specific level.
  1482. ***************************************************************/
  1483. #if ANSI_C
  1484. int
  1485. fslt_addcallvar( struct bwb_variable *v )
  1486. #else
  1487. int
  1488. fslt_addcallvar( v )
  1489. struct bwb_variable *v;
  1490. #endif
  1491. {
  1492. if ( CURTASK excs[ CURTASK exsc ].n_cvs >= MAX_FARGS )
  1493. {
  1494. #if PROG_ERRORS
  1495. sprintf( bwb_ebuf, "in fslt_addcallvar(): Maximum number of Function Args Exceeded" );
  1496. bwb_error( bwb_ebuf );
  1497. #else
  1498. bwb_error( err_overflow );
  1499. #endif
  1500. }
  1501. CURTASK excs[ CURTASK exsc ].calling_variable[ CURTASK excs[ CURTASK exsc ].n_cvs ] = v;
  1502. ++CURTASK excs[ CURTASK exsc ].n_cvs;
  1503. return TRUE;
  1504. }
  1505. /***************************************************************
  1506. FUNCTION: exp_ufnc()
  1507. DESCRIPTION: This C function interprets a user-defined
  1508. function, returning its value at the current
  1509. level of the expression stack.
  1510. ***************************************************************/
  1511. #if ANSI_C
  1512. int
  1513. exp_ufnc( char *expression )
  1514. #else
  1515. int
  1516. exp_ufnc( expression )
  1517. char *expression;
  1518. #endif
  1519. {
  1520. char tbuf[ MAXSTRINGSIZE + 1 ];
  1521. struct bwb_line *call_line;
  1522. struct fslte *f, *c;
  1523. struct bwb_variable *v, *r;
  1524. struct exp_ese *e;
  1525. int save_elevel;
  1526. int position, epos;
  1527. #if INTENSIVE_DEBUG
  1528. register int i;
  1529. #endif
  1530. position = 0;
  1531. /* get the function name in tbuf */
  1532. exp_getvfname( expression, tbuf );
  1533. /* find the function name in the function-subroutine lookup table */
  1534. for ( f = CURTASK fslt_start.next; f != &CURTASK fslt_end; f = f->next )
  1535. {
  1536. if ( strcmp( f->name, tbuf ) == 0 )
  1537. {
  1538. #if INTENSIVE_DEBUG
  1539. sprintf( bwb_ebuf, "in exp_ufnc(): found user function <%s>",
  1540. tbuf );
  1541. bwb_debug( bwb_ebuf );
  1542. #endif
  1543. c = f; /* current function-subroutine lookup table element */
  1544. call_line = f->line; /* line to call for function */
  1545. }
  1546. }
  1547. #if INTENSIVE_DEBUG
  1548. sprintf( bwb_ebuf, "in exp_ufnc(): call to function <%s>", tbuf );
  1549. bwb_debug( bwb_ebuf );
  1550. #endif
  1551. position += strlen( tbuf );
  1552. #if INTENSIVE_DEBUG
  1553. sprintf( bwb_ebuf, "in exp_ufnc(): found line <%s>",
  1554. call_line->buffer );
  1555. bwb_debug( bwb_ebuf );
  1556. #endif
  1557. /* save the old position on the EXEC stack */
  1558. bwb_setexec( CURTASK excs[ CURTASK exsc ].line,
  1559. position, CURTASK excs[ CURTASK exsc ].code );
  1560. save_elevel = CURTASK exsc;
  1561. /* increment and set new EXEC stack */
  1562. bwb_incexec();
  1563. call_line->position = 0;
  1564. bwb_setexec( call_line, 0, EXEC_FUNCTION );
  1565. /* attach local variables */
  1566. CURTASK excs[ CURTASK exsc ].local_variable = c->local_variable;
  1567. #if INTENSIVE_DEBUG
  1568. i = 0;
  1569. sprintf( bwb_ebuf, "in exp_ufnc(): <%s> attached local variables EXEC level <%d>",
  1570. tbuf, CURTASK exsc );
  1571. bwb_debug( bwb_ebuf );
  1572. for ( v = CURTASK excs[ CURTASK exsc ].local_variable; v != NULL; v = v->next )
  1573. {
  1574. sprintf( bwb_ebuf, "in exp_ufnc(): <%s> level <%d> variable <%d> name <%s>",
  1575. tbuf, CURTASK exsc, i, v->name );
  1576. bwb_debug( bwb_ebuf );
  1577. ++i;
  1578. }
  1579. getchar();
  1580. #endif
  1581. /* read calling variables for this call */
  1582. call_readargs( c, expression, &position );
  1583. #if INTENSIVE_DEBUG
  1584. sprintf( bwb_ebuf, "in exp_ufnc(): current buffer <%s>",
  1585. &( call_line->buffer[ c->startpos ] ) );
  1586. bwb_debug( bwb_ebuf );
  1587. #endif
  1588. /* determine if single-line function */
  1589. epos = c->startpos;
  1590. adv_ws( call_line->buffer, &epos );
  1591. if ( call_line->buffer[ epos ] == '=' )
  1592. {
  1593. #if INTENSIVE_DEBUG
  1594. sprintf( bwb_ebuf, "in exp_ufnc(): found SINGLE-LINE function" );
  1595. bwb_debug( bwb_ebuf );
  1596. #endif
  1597. ++epos;
  1598. call_line->position = epos;
  1599. bwb_setexec( call_line, epos, EXEC_FUNCTION );
  1600. #if INTENSIVE_DEBUG
  1601. sprintf( bwb_ebuf, "in exp_ufnc(): single line: parse <%s>",
  1602. &( call_line->buffer[ epos ] ) );
  1603. bwb_debug( bwb_ebuf );
  1604. #endif
  1605. e = bwb_exp( call_line->buffer, FALSE, &epos );
  1606. v = var_find( tbuf );
  1607. #if INTENSIVE_DEBUG
  1608. if ( e->type == STRING )
  1609. {
  1610. sprintf( bwb_ebuf, "in exp_ufnc(): expression returns <%d>-byte string",
  1611. exp_getsval( e )->length );
  1612. bwb_debug( bwb_ebuf );
  1613. }
  1614. else
  1615. {
  1616. sprintf( bwb_ebuf, "in exp_ufnc(): expression returns number <%lf>",
  1617. (double) exp_getnval( e ) );
  1618. bwb_debug( bwb_ebuf );
  1619. }
  1620. #endif
  1621. #if INTENSIVE_DEBUG
  1622. sprintf( bwb_ebuf, "in exp_ufnc(): single line after parsing, <%s>",
  1623. &( call_line->buffer[ epos ] ) );
  1624. bwb_debug( bwb_ebuf );
  1625. #endif
  1626. bwb_etov( v, e );
  1627. bwb_decexec();
  1628. }
  1629. /* multi-line function must be executed now */
  1630. else
  1631. {
  1632. #if INTENSIVE_DEBUG
  1633. sprintf( bwb_ebuf, "in exp_ufnc(): found MULTI-LINE function" );
  1634. bwb_debug( bwb_ebuf );
  1635. #endif
  1636. /* now execute until function is resolved */
  1637. bwb_execline();
  1638. while( CURTASK exsc > save_elevel )
  1639. {
  1640. bwb_execline();
  1641. }
  1642. /* find the return value */
  1643. for ( r = c->local_variable; r != NULL; r = r->next )
  1644. {
  1645. if ( strcmp( r->name, c->name ) == 0 )
  1646. {
  1647. v = r;
  1648. }
  1649. }
  1650. }
  1651. /* now place value in expression stack */
  1652. CURTASK exps[ CURTASK expsc ].type = (char) v->type;
  1653. CURTASK exps[ CURTASK expsc ].pos_adv = position;
  1654. switch( v->type )
  1655. {
  1656. case STRING:
  1657. CURTASK exps[ CURTASK expsc ].operation = CONST_STRING;
  1658. #if INTENSIVE_DEBUG
  1659. sprintf( bwb_ebuf, "in exp_ufnc(): ready to assign <%d>-byte STRING",
  1660. var_getsval( v )->length );
  1661. bwb_debug( bwb_ebuf );
  1662. #endif
  1663. str_btob( exp_getsval( &( CURTASK exps[ CURTASK expsc ] )),
  1664. var_getsval( v ) );
  1665. #if INTENSIVE_DEBUG
  1666. str_btoc( tbuf, var_getsval( v ) );
  1667. sprintf( bwb_ebuf, "in exp_ufnc(): string assigned <%s>", tbuf );
  1668. bwb_debug( bwb_ebuf );
  1669. #endif
  1670. break;
  1671. default:
  1672. CURTASK exps[ CURTASK expsc ].operation = NUMBER;
  1673. CURTASK exps[ CURTASK expsc ].nval = var_getnval( v );
  1674. break;
  1675. }
  1676. return TRUE;
  1677. }
  1678. /***************************************************************
  1679. FUNCTION: fslt_addlocalvar()
  1680. DESCRIPTION: This function adds a local variable
  1681. to the FUNCTION-SUB lookup table at
  1682. a specific level.
  1683. ***************************************************************/
  1684. #if ANSI_C
  1685. int
  1686. fslt_addlocalvar( struct fslte *f, struct bwb_variable *v )
  1687. #else
  1688. int
  1689. fslt_addlocalvar( f, v )
  1690. struct fslte *f;
  1691. struct bwb_variable *v;
  1692. #endif
  1693. {
  1694. struct bwb_variable *c, *p;
  1695. #if INTENSIVE_DEBUG
  1696. register int i;
  1697. #endif
  1698. /* find end of local chain */
  1699. if ( f->local_variable == NULL )
  1700. {
  1701. #if INTENSIVE_DEBUG
  1702. i = 0;
  1703. #endif
  1704. f->local_variable = v;
  1705. }
  1706. else
  1707. {
  1708. #if INTENSIVE_DEBUG
  1709. i = 1;
  1710. #endif
  1711. p = f->local_variable;
  1712. for ( c = f->local_variable->next; c != NULL; c = c->next )
  1713. {
  1714. p = c;
  1715. #if INTENSIVE_DEBUG
  1716. ++i;
  1717. #endif
  1718. }
  1719. p->next = v;
  1720. }
  1721. v->next = NULL;
  1722. #if INTENSIVE_DEBUG
  1723. sprintf( bwb_ebuf, "in fslt_addlocalvar(): added local variable variable <%s> arg number <%d>",
  1724. v->name, i );
  1725. bwb_debug( bwb_ebuf );
  1726. getchar();
  1727. #endif
  1728. return TRUE;
  1729. }
  1730. /***************************************************************
  1731. FUNCTION: fslt_init()
  1732. DESCRIPTION: This function initializes the FUNCTION-SUB
  1733. lookup table.
  1734. ***************************************************************/
  1735. #if ANSI_C
  1736. int
  1737. fslt_init( int task )
  1738. #else
  1739. int
  1740. fslt_init( task )
  1741. int task;
  1742. #endif
  1743. {
  1744. LOCALTASK fslt_start.next = &(LOCALTASK fslt_end);
  1745. return TRUE;
  1746. }
  1747. /***************************************************************
  1748. FUNCTION: is_label()
  1749. DESCRIPTION: This function determines whether the string
  1750. pointed to by 'buffer' is a label (i.e.,
  1751. ends with colon).
  1752. ***************************************************************/
  1753. #if ANSI_C
  1754. extern int
  1755. is_label( char *buffer )
  1756. #else
  1757. int
  1758. is_label( buffer )
  1759. char *buffer;
  1760. #endif
  1761. {
  1762. #if INTENSIVE_DEBUG
  1763. sprintf( bwb_ebuf, "in is_label(): check element <%s>", buffer );
  1764. bwb_debug( bwb_ebuf );
  1765. #endif
  1766. if ( buffer[ strlen( buffer ) - 1 ] == ':' )
  1767. {
  1768. return TRUE;
  1769. }
  1770. else
  1771. {
  1772. return FALSE;
  1773. }
  1774. }