ChipMaster's bwBASIC This also includes history going back to v2.10. *WARN* some binary files might have been corrupted by CRLF.
 
 
 
 
 
 

3375 lines
84 KiB

  1. /****************************************************************
  2. bwb_fnc.c Interpretation Routines
  3. for Predefined Functions
  4. for Bywater BASIC Interpreter
  5. Copyright (c) 1993, Ted A. Campbell
  6. Bywater Software
  7. email: tcamp@delphi.com
  8. Copyright and Permissions Information:
  9. All U.S. and international rights are claimed by the author,
  10. Ted A. Campbell.
  11. This software is released under the terms of the GNU General
  12. Public License (GPL), which is distributed with this software
  13. in the file "COPYING". The GPL specifies the terms under
  14. which users may copy and use the software in this distribution.
  15. A separate license is available for commercial distribution,
  16. for information on which you should contact the author.
  17. ***************************************************************/
  18. /*---------------------------------------------------------------*/
  19. /* NOTE: Modifications marked "JBV" were made by Jon B. Volkoff, */
  20. /* 11/1995 (eidetics@cerf.net). */
  21. /* */
  22. /* Those additionally marked with "DD" were at the suggestion of */
  23. /* Dale DePriest (daled@cadence.com). */
  24. /* */
  25. /* Version 3.00 by Howard Wulf, AF5NE */
  26. /* */
  27. /*---------------------------------------------------------------*/
  28. #include "bwbasic.h"
  29. #ifndef RAND_MAX /* added in v1.11 */
  30. #define RAND_MAX 32767
  31. #endif
  32. static time_t t;
  33. static struct tm *lt;
  34. /* ORD() Table 1 */
  35. /* ACRONYM */
  36. typedef struct
  37. {
  38. const int Value;
  39. const char *Name;
  40. } Acronym;
  41. #define NUM_ACRONYMS (34)
  42. Acronym AcronymTable[NUM_ACRONYMS] =
  43. {
  44. {0, "NUL"},
  45. {1, "SOH"},
  46. {2, "STX"},
  47. {3, "ETX"},
  48. {4, "EOT"},
  49. {5, "ENQ"},
  50. {6, "ACK"},
  51. {7, "BEL"},
  52. {8, "BS"},
  53. {9, "HT"},
  54. {10, "LF"},
  55. {11, "VT"},
  56. {12, "FF"},
  57. {13, "CR"},
  58. {14, "SO"},
  59. {15, "SI"},
  60. {16, "DLE"},
  61. {17, "DC1"},
  62. {18, "DC2"},
  63. {19, "DC3"},
  64. {20, "DC4"},
  65. {21, "NAK"},
  66. {22, "SYN"},
  67. {23, "ETB"},
  68. {24, "CAN"},
  69. {25, "EM"},
  70. {26, "SUB"},
  71. {27, "ESC"},
  72. {28, "FS"},
  73. {29, "GS"},
  74. {30, "RS"},
  75. {31, "US"},
  76. {32, "SP"},
  77. {127, "DEL"}
  78. };
  79. /* ... ORD() */
  80. struct bwb_variable *
  81. fnc_intrinsic(int argc, struct bwb_variable * argv, int unique_id)
  82. {
  83. /* // this is the generic handler for all intrinsic BASIC functions */
  84. /* BasicStringLengthMax must be <= INT_MAX */
  85. struct bwb_function *f;
  86. struct bwb_variable *argn;
  87. unsigned char IsError;/* for ERROR messages */
  88. /* Follow the BASIC naming conventions, so the code is easier to
  89. * maintain */
  90. char *S; /* S$ - STRING functions */
  91. BasicStringLengthType s;/* LEN( S$ ) */
  92. BasicNumberType N; /* N - NUMBER functions */
  93. char *A; /* A$ - 1st STRING parameter */
  94. BasicStringLengthType a;/* LEN( A$ ) */
  95. char *B; /* B$ - 2nd STRING parameter */
  96. BasicStringLengthType b;/* LEN( B$ ) */
  97. #if FALSE
  98. char *C; /* C$ - 3rd STRING parameter */
  99. BasicStringLengthType c;/* LEN( C$ ) */
  100. #endif
  101. BasicNumberType X; /* X - 1st NUMBER parameter */
  102. BasicIntegerType x; /* INT( X ) */
  103. BasicNumberType Y; /* Y - 2nd NUMBER parameter */
  104. BasicIntegerType y; /* INT( Y ) */
  105. #if FALSE
  106. BasicNumberType Z; /* Z - 3rd NUMBER parameter */
  107. BasicIntegerType z; /* INT( Z ) */
  108. #endif
  109. bwx_DEBUG(__FUNCTION__);
  110. /* so the following code is easier to read and maintain */
  111. #define PARAM_NUMBER *argn->memnum
  112. #define PARAM_LENGTH argn->memstr->length
  113. #define PARAM_BUFFER argn->memstr->sbuffer
  114. #define RESULT_NUMBER *argv->memnum
  115. #define RESULT_BUFFER argv->memstr->sbuffer
  116. #define RESULT_LENGTH argv->memstr->length
  117. /* no errors have occurred (yet) */
  118. IsError = 0;
  119. /* look up the intrinsic function, so we can get the details */
  120. {
  121. f = fnc_find_by_id(unique_id);
  122. if (f == NULL)
  123. {
  124. /* bwb_prefuncs[] in bwb_tbl.c is wrong -- this is
  125. * really bad */
  126. sprintf(bwb_ebuf, "INTERNAL ERROR in fnc_intrinsic() - did not find unique_id %d", unique_id);
  127. bwb_error(bwb_ebuf);
  128. return NULL;
  129. }
  130. }
  131. /* the RETURN variable is the first variable in the 'argv' vaariable
  132. * chain */
  133. if (argv == NULL)
  134. {
  135. bwb_error("INTERNAL ERROR");
  136. return argv;
  137. }
  138. if (argv->type == STRING)
  139. {
  140. if (argv->memstr == NULL)
  141. {
  142. bwb_error("INTERNAL ERROR");
  143. return argv;
  144. }
  145. RESULT_LENGTH = 0;
  146. RESULT_BUFFER[RESULT_LENGTH] = '\0';
  147. }
  148. else
  149. {
  150. if (argv->memnum == NULL)
  151. {
  152. bwb_error("INTERNAL ERROR");
  153. return argv;
  154. }
  155. RESULT_NUMBER = 0;
  156. }
  157. argn = argv;
  158. /* don't make a bad situation worse */
  159. if (ERROR_PENDING)
  160. {
  161. /* An unrecognized NON-FATAL ERROR is pending. Just return a
  162. * sane value. */
  163. /* LET N = LOG(SQR(X)) ' X = -1 */
  164. return argv;
  165. }
  166. /* Follow the BASIC naming conventions, so the code is easier to read
  167. * and maintain */
  168. {
  169. int i;
  170. int StrCount = 0; /* count of STRING parameters
  171. * - NEVER > 3 */
  172. int NumCount = 0; /* count of NUMBER parameters
  173. * - NEVER > 3 */
  174. unsigned long ParameterTests;
  175. ParameterTests = f->ParameterTests;
  176. /* assign reasonable default values */
  177. S = NULL; /* S$ - return value is a STRING */
  178. s = 0; /* LEN( S$ ) */
  179. N = 0; /* N - return value is a NUMBER */
  180. A = NULL; /* A$ - 1st STRING parameter */
  181. a = 0; /* LEN( A$ ) */
  182. B = NULL; /* B$ - 2nd STRING parameter */
  183. b = 0; /* LEN( B$ ) */
  184. #if FALSE
  185. C = NULL; /* C$ - 3rd STRING parameter */
  186. c = 0; /* LEN( C$ ) */
  187. #endif
  188. X = 0; /* X - 1st NUMBER parameter */
  189. x = 0; /* INT( X ) */
  190. Y = 0; /* Y - 2nd NUMBER parameter */
  191. y = 0; /* INT( Y ) */
  192. #if FALSE
  193. Z = 0; /* Z - 3rd NUMBER parameter */
  194. z = 0; /* INT( Z ) */
  195. #endif
  196. /* assign actual values */
  197. if (f->ReturnType == STRING)
  198. {
  199. S = RESULT_BUFFER;
  200. s = RESULT_LENGTH;
  201. }
  202. else
  203. {
  204. N = RESULT_NUMBER;
  205. }
  206. for (i = 0; i < argc && IsError == 0; i++)
  207. {
  208. argn = argn->next;
  209. if (argn == NULL)
  210. {
  211. bwb_error("INTERNAL ERROR");
  212. return argv;
  213. }
  214. if (argn->type == STRING)
  215. {
  216. if (argn->memstr == NULL)
  217. {
  218. bwb_error("INTERNAL ERROR");
  219. return argv;
  220. }
  221. StrCount++;
  222. switch (StrCount)
  223. {
  224. case 1:
  225. /* 1st STRING parameter = A$ */
  226. A = PARAM_BUFFER;
  227. a = PARAM_LENGTH;
  228. if (StringLengthCheck(ParameterTests, a))
  229. {
  230. IsError = 'A';
  231. }
  232. else
  233. {
  234. A[a] = 0;
  235. }
  236. break;
  237. case 2:
  238. /* 2nd STRING parameter = B$ */
  239. B = PARAM_BUFFER;
  240. b = PARAM_LENGTH;
  241. if (StringLengthCheck(ParameterTests, b))
  242. {
  243. IsError = 'B';
  244. }
  245. else
  246. {
  247. B[b] = 0;
  248. }
  249. break;
  250. #if FALSE
  251. case 3:
  252. /* 3rd STRING parameter = C$ */
  253. /* not currently used */
  254. C = PARAM_BUFFER;
  255. c = PARAM_LENGTH;
  256. if (StringLengthCheck(ParameterTests, c))
  257. {
  258. IsError = 'C';
  259. }
  260. else
  261. {
  262. C[c] = 0;
  263. }
  264. break;
  265. #endif
  266. default:
  267. /* Nth STRING parameter = ERROR */
  268. IsError = i + 1;
  269. break;
  270. }
  271. }
  272. else
  273. {
  274. if (argn->memnum == NULL)
  275. {
  276. bwb_error("INTERNAL ERROR");
  277. return argv;
  278. }
  279. NumCount++;
  280. switch (NumCount)
  281. {
  282. case 1:
  283. /* 1st NUMBER parameter = X */
  284. X = PARAM_NUMBER;
  285. if (NumberValueCheck(ParameterTests, X))
  286. {
  287. IsError = 'X';
  288. }
  289. else
  290. {
  291. BasicNumberType R;
  292. R = rint(X);
  293. if (R < INT_MIN || R > INT_MAX)
  294. {
  295. /* certainly not a
  296. * classic BASIC
  297. * integer */
  298. }
  299. else
  300. {
  301. /* Many classic BASIC
  302. * intrinsic
  303. * functions use the
  304. * rounded integer
  305. * value. */
  306. x = (int) R;
  307. }
  308. }
  309. break;
  310. case 2:
  311. /* 2nd NUMBER parameter = Y */
  312. Y = PARAM_NUMBER;
  313. if (NumberValueCheck(ParameterTests, Y))
  314. {
  315. IsError = 'Y';
  316. }
  317. else
  318. {
  319. BasicNumberType R;
  320. R = rint(Y);
  321. if (R < INT_MIN || R > INT_MAX)
  322. {
  323. /* certainly not a
  324. * classic BASIC
  325. * integer */
  326. }
  327. else
  328. {
  329. /* Many classic BASIC
  330. * intrinsic
  331. * functions use the
  332. * rounded integer
  333. * value. */
  334. y = (int) R;
  335. }
  336. }
  337. break;
  338. #if FALSE
  339. case 3:
  340. /* 3rd NUMBER parameter = Z */
  341. /* not currently used */
  342. Z = PARAM_NUMBER;
  343. if (NumberValueCheck(ParameterTests, Z))
  344. {
  345. IsError = 'Z';
  346. }
  347. else
  348. {
  349. BasicNumberType R;
  350. R = rint(Z);
  351. if (R < INT_MIN || R > INT_MAX)
  352. {
  353. /* certainly not a
  354. * classic BASIC
  355. * integer */
  356. }
  357. else
  358. {
  359. /* Many classic BASIC
  360. * intrinsic
  361. * functions use the
  362. * rounded integer
  363. * value. */
  364. z = (int) R;
  365. }
  366. }
  367. break;
  368. #endif
  369. default:
  370. /* Nth NUMBER parameter = ERROR */
  371. IsError = i + 1;
  372. break;
  373. }
  374. }
  375. ParameterTests = ParameterTests >> 4;
  376. }
  377. }
  378. #ifndef PI
  379. #define PI 3.14159265358979323846
  380. #endif /* PI */
  381. #define MIN( X, Y ) X < Y ? X : Y;
  382. #define MAX( X, Y ) X > Y ? X : Y;
  383. /* execute the intrinsic function */
  384. if (IsError == 0 /* WARNING -- do NOT execute a BASIC
  385. intrinsic function with bogus parameters */ )
  386. switch (unique_id)
  387. {
  388. /* ALL paramters have been checked for TYPE MISMATCH
  389. * and INVALID RANGE */
  390. /* ONLY A HANDFUL OF ERRORS CAN OCCUR */
  391. case 0:
  392. {
  393. /* INTERNAL ERROR */
  394. IsError = 1;
  395. }
  396. break;
  397. case F_DEF_FN_N:
  398. {
  399. /* INTERNAL ERROR */
  400. IsError = 1;
  401. }
  402. break;
  403. case F_ARGC_N:
  404. /* N = ARGC */
  405. {
  406. /* determine number of parameters to the
  407. * current USER DEFINED FUNCTION */
  408. int n;
  409. n = 0;
  410. if (CURTASK exsc >= 0)
  411. {
  412. int Loop;
  413. int i;
  414. Loop = TRUE;
  415. for (i = CURTASK exsc; i >= 0 && Loop == TRUE; i--)
  416. {
  417. if (CURTASK excs[i].LoopTopLine != NULL)
  418. {
  419. switch (CURTASK excs[i].LoopTopLine->cmdnum)
  420. {
  421. case C_FUNCTION:
  422. case C_SUB:
  423. /* we have
  424. * checked
  425. * all the
  426. * way to a
  427. * FUNCTION
  428. * or SUB
  429. * boundary */
  430. /* FOUND */
  431. {
  432. struct bwb_variable *v;
  433. for (v = CURTASK excs[i].local_variable; v != NULL && Loop == TRUE; v = v->next)
  434. {
  435. n++;
  436. }
  437. }
  438. Loop = FALSE;
  439. break;
  440. }
  441. }
  442. }
  443. }
  444. n--; /* FUNCTION or SUB name */
  445. N = n;
  446. }
  447. break;
  448. case F_ARGT_X_S:
  449. /* S$ = ARGT$( X ) */
  450. {
  451. /* determine parameter type to the current
  452. * USER DEFINED FUNCTION */
  453. int Found;
  454. int n;
  455. Found = FALSE;
  456. n = 0;
  457. s = 0;
  458. if (x < 1)
  459. {
  460. /* bad param number */
  461. }
  462. else
  463. if (CURTASK exsc >= 0)
  464. {
  465. int Loop;
  466. int i;
  467. Loop = TRUE;
  468. for (i = CURTASK exsc; i >= 0 && Loop == TRUE; i--)
  469. {
  470. if (CURTASK excs[i].LoopTopLine != NULL)
  471. {
  472. switch (CURTASK excs[i].LoopTopLine->cmdnum)
  473. {
  474. case C_FUNCTION:
  475. case C_SUB:
  476. /* we hav e
  477. * che cke d
  478. * all
  479. *
  480. * the
  481. *
  482. * way to a FUN
  483. * CTI ON or
  484. * SUB
  485. *
  486. * boun dar y */
  487. /* FOU ND */
  488. {
  489. struct bwb_variable *v;
  490. for (v = CURTASK excs[i].local_variable; v != NULL && Loop == TRUE; v = v->next)
  491. {
  492. if (n == x)
  493. {
  494. if (v->type == STRING)
  495. {
  496. S[0] = BasicStringSuffix;
  497. s = 1;
  498. Found = TRUE;
  499. }
  500. else
  501. {
  502. S[0] = BasicDoubleSuffix;
  503. s = 1;
  504. Found = TRUE;
  505. }
  506. Loop = FALSE;
  507. }
  508. n++;
  509. }
  510. }
  511. Loop = FALSE;
  512. break;
  513. }
  514. }
  515. }
  516. }
  517. if (Found == FALSE)
  518. {
  519. IsError = 'X';
  520. }
  521. }
  522. break;
  523. case F_ARGV_X_S:
  524. /* S$ = ARGV$( X ) */
  525. {
  526. /* determine parameter value to the current
  527. * USER DEFINED FUNCTION */
  528. int Found;
  529. int n;
  530. Found = FALSE;
  531. n = 0;
  532. if (x < 1)
  533. {
  534. /* bad param number */
  535. }
  536. else
  537. if (CURTASK exsc >= 0)
  538. {
  539. int Loop;
  540. int i;
  541. Loop = TRUE;
  542. for (i = CURTASK exsc; i >= 0 && Loop == TRUE; i--)
  543. {
  544. if (CURTASK excs[i].LoopTopLine != NULL)
  545. {
  546. switch (CURTASK excs[i].LoopTopLine->cmdnum)
  547. {
  548. case C_FUNCTION:
  549. case C_SUB:
  550. /* FOU ND */
  551. {
  552. struct bwb_variable *v;
  553. for (v = CURTASK excs[i].local_variable; v != NULL && Loop == TRUE; v = v->next)
  554. {
  555. if (n == x)
  556. {
  557. if (v->type == STRING)
  558. {
  559. s = v->memstr->length;
  560. memcpy(S, v->memstr->sbuffer, s);
  561. Found = TRUE;
  562. }
  563. else
  564. {
  565. }
  566. Loop = FALSE;
  567. }
  568. n++;
  569. }
  570. }
  571. Loop = FALSE;
  572. break;
  573. }
  574. }
  575. }
  576. }
  577. if (Found == FALSE)
  578. {
  579. IsError = 'X';
  580. }
  581. }
  582. break;
  583. case F_ARGV_X_N:
  584. /* S$ = ARGV( X ) */
  585. {
  586. /* determine parameter value to the current
  587. * USER DEFINED FUNCTION */
  588. int Found;
  589. int n;
  590. Found = FALSE;
  591. n = 0;
  592. if (x < 1)
  593. {
  594. /* bad param number */
  595. }
  596. else
  597. if (CURTASK exsc >= 0)
  598. {
  599. int Loop;
  600. int i;
  601. Loop = TRUE;
  602. for (i = CURTASK exsc; i >= 0 && Loop == TRUE; i--)
  603. {
  604. if (CURTASK excs[i].LoopTopLine != NULL)
  605. {
  606. switch (CURTASK excs[i].LoopTopLine->cmdnum)
  607. {
  608. case C_FUNCTION:
  609. case C_SUB:
  610. /* FOU ND */
  611. {
  612. struct bwb_variable *v;
  613. for (v = CURTASK excs[i].local_variable; v != NULL && Loop == TRUE; v = v->next)
  614. {
  615. if (n == x)
  616. {
  617. if (v->type == STRING)
  618. {
  619. }
  620. else
  621. {
  622. N = *v->memnum;
  623. Found = TRUE;
  624. }
  625. Loop = FALSE;
  626. }
  627. n++;
  628. }
  629. }
  630. Loop = FALSE;
  631. break;
  632. }
  633. }
  634. }
  635. }
  636. if (Found == FALSE)
  637. {
  638. IsError = 'X';
  639. }
  640. }
  641. break;
  642. case F_ASC_A_N:
  643. /* N = ASC( A$ ) */
  644. {
  645. /* P1BYT */
  646. N = A[0];
  647. }
  648. break;
  649. case F_CDBL_X_N:
  650. /* N = CDBL( X ) */
  651. {
  652. /* P1DBL */
  653. N = X;
  654. }
  655. break;
  656. case F_CSNG_X_N:
  657. /* N = CSNG( X ) */
  658. {
  659. /* P1FLT */
  660. N = X;
  661. }
  662. break;
  663. case F_CINT_X_N:
  664. /* N = CINT( X ) */
  665. {
  666. /* P1INT */
  667. N = rint(X);
  668. }
  669. break;
  670. case F_CLNG_X_N:
  671. /* N = CLNG( X ) */
  672. {
  673. /* P1LNG */
  674. N = rint(X);
  675. }
  676. break;
  677. case F_CCUR_X_N:
  678. /* N = CCUR( X ) */
  679. {
  680. /* P1CUR */
  681. N = rint(X);
  682. }
  683. break;
  684. case F_MKD_X_S:
  685. /* S$ = MKD$( X ) */
  686. {
  687. /* P1DBL */
  688. BasicDoubleType x;
  689. x = (BasicDoubleType) X;
  690. s = sizeof(BasicDoubleType);
  691. memcpy(S, &x, s);
  692. }
  693. break;
  694. case F_MKS_X_S:
  695. /* S$ = MKS$( X ) */
  696. {
  697. /* P1FLT */
  698. BasicSingleType x;
  699. x = (BasicSingleType) X;
  700. s = sizeof(BasicSingleType);
  701. memcpy(S, &x, s);
  702. }
  703. break;
  704. case F_MKI_X_S:
  705. /* S$ = MKI$( X ) */
  706. {
  707. /* P1INT */
  708. BasicIntegerType x;
  709. x = (BasicIntegerType) rint(X);
  710. s = sizeof(BasicIntegerType);
  711. memcpy(S, &x, s);
  712. }
  713. break;
  714. case F_MKL_X_S:
  715. /* S$ = MKL$( X ) */
  716. {
  717. /* P1LNG */
  718. BasicLongType x;
  719. x = (BasicLongType) rint(X);
  720. s = sizeof(BasicLongType);
  721. memcpy(S, &x, s);
  722. }
  723. break;
  724. case F_MKC_X_S:
  725. /* S$ = MKC$( X ) */
  726. {
  727. /* P1CUR */
  728. BasicCurrencyType x;
  729. x = (BasicCurrencyType) rint(X);
  730. s = sizeof(BasicCurrencyType);
  731. memcpy(S, &x, s);
  732. }
  733. break;
  734. case F_CVD_A_N:
  735. /* N = CVD( A$ ) */
  736. {
  737. /* P1DBL */
  738. BasicDoubleType n;
  739. a = sizeof(BasicDoubleType);
  740. memcpy(&n, A, a);
  741. N = n;
  742. }
  743. break;
  744. case F_CVS_A_N:
  745. /* N = CVS( X$ ) */
  746. {
  747. /* P1FLT */
  748. BasicSingleType n;
  749. a = sizeof(BasicSingleType);
  750. memcpy(&n, A, a);
  751. N = n;
  752. }
  753. break;
  754. case F_CVI_A_N:
  755. /* N = CVI( X$ ) */
  756. {
  757. /* P1INT */
  758. BasicIntegerType n;
  759. a = sizeof(BasicIntegerType);
  760. memcpy(&n, A, a);
  761. N = n;
  762. }
  763. break;
  764. case F_CVL_A_N:
  765. /* N = CVL( X$ ) */
  766. {
  767. /* P1LNG */
  768. BasicLongType n;
  769. a = sizeof(BasicLongType);
  770. memcpy(&n, A, a);
  771. N = n;
  772. }
  773. break;
  774. case F_CVC_A_N:
  775. /* N = CVC( X$ ) */
  776. {
  777. /* P1CUR */
  778. BasicCurrencyType n;
  779. a = sizeof(BasicCurrencyType);
  780. memcpy(&n, A, a);
  781. N = n;
  782. }
  783. break;
  784. case F_ENVIRON_A_S:
  785. /* S$ = ENVIRON$( A$ ) */
  786. {
  787. /* P1BYT */
  788. char *CharPointer;
  789. CharPointer = getenv(A);
  790. if (CharPointer == NULL)
  791. {
  792. /* empty string */
  793. }
  794. else
  795. {
  796. s = strlen(CharPointer);
  797. s = MIN(s, BasicStringLengthMax);
  798. if (s == 0)
  799. {
  800. /* empty string */
  801. }
  802. else
  803. {
  804. memcpy(S, CharPointer, s);
  805. }
  806. }
  807. }
  808. break;
  809. case F_ENVIRON_A_N:
  810. /* ENVIRON A$ */
  811. {
  812. /* P1BYT */
  813. char *CharPointer;
  814. CharPointer = strchr(A, '=');
  815. if (CharPointer == NULL)
  816. {
  817. /* missing required '=' */
  818. IsError = 'A';
  819. }
  820. else
  821. {
  822. if (putenv(A) == -1)
  823. {
  824. IsError = 'A';
  825. }
  826. else
  827. {
  828. /* OK */
  829. N = 0;
  830. }
  831. }
  832. }
  833. break;
  834. case F_OPEN_A_X_B_Y_N:
  835. /* OPEN "I"|"O"|"R"|"A", [#]n, filename [,rlen] */
  836. {
  837. /* P1STR|P2NUM|P3STR|P4NUM */
  838. /* P1BYT|P2DEV|P3BYT|P4INT */
  839. int mode;
  840. while (*A == ' ')
  841. {
  842. A++; /* LTRIM$ */
  843. }
  844. mode = ToUpper(*A);
  845. switch (mode)
  846. {
  847. case 'I':
  848. case 'O':
  849. case 'A':
  850. case 'B':
  851. case 'R':
  852. break;
  853. default:
  854. mode = DEVMODE_CLOSED;
  855. break;
  856. }
  857. if (x == CONSOLE_FILE_NUMBER)
  858. {
  859. IsError = 'X';
  860. }
  861. else
  862. if (mode == DEVMODE_CLOSED)
  863. {
  864. IsError = 'A';
  865. }
  866. else
  867. if (dev_table[x].mode != DEVMODE_CLOSED)
  868. {
  869. IsError = 'X';
  870. }
  871. else
  872. if (y < 0)
  873. {
  874. IsError = 'Y';
  875. }
  876. else
  877. if (y == 0 && mode == 'R')
  878. {
  879. IsError = 'Y';
  880. }
  881. else
  882. {
  883. FILE *fp = NULL;
  884. char *buffer = NULL;
  885. switch (mode)
  886. {
  887. case 'I':
  888. mode = DEVMODE_INPUT;
  889. fp = fopen(B, "r");
  890. y = 0;
  891. break;
  892. case 'O':
  893. mode = DEVMODE_OUTPUT;
  894. fp = fopen(B, "w");
  895. y = 0;
  896. break;
  897. case 'A':
  898. mode = DEVMODE_APPEND;
  899. fp = fopen(B, "a");
  900. y = 0;
  901. break;
  902. case 'B':
  903. mode = DEVMODE_BINARY;
  904. fp = fopen(B, "r+");
  905. if (fp == NULL)
  906. {
  907. fp = fopen(B, "w");
  908. fclose(fp);
  909. fp = fopen(B, "r+");
  910. }
  911. y = 0;
  912. break;
  913. case 'R':
  914. mode = DEVMODE_RANDOM;
  915. fp = fopen(B, "r+");
  916. if (fp == NULL)
  917. {
  918. fp = fopen(B, "w");
  919. fclose(fp);
  920. fp = fopen(B, "r+");
  921. }
  922. if (fp != NULL)
  923. {
  924. buffer = CALLOC(y, 1, "F_OPEN_A_X_B_Y_V");
  925. }
  926. break;
  927. }
  928. if (fp == NULL)
  929. {
  930. /* i n v a l i d
  931. *
  932. * fi l e
  933. *
  934. * na m e */
  935. IsError = 'B';
  936. }
  937. else
  938. if (mode == DEVMODE_RANDOM && buffer == NULL)
  939. {
  940. /* i n v a l i d
  941. *
  942. * re c o r d
  943. *
  944. * le n g t h */
  945. IsError = 'Y';
  946. }
  947. else
  948. {
  949. dev_table[x].mode = mode;
  950. dev_table[x].cfp = fp;
  951. dev_table[x].width = y;
  952. /* N O T E :
  953. *
  954. * WI D T H
  955. *
  956. * ==
  957. * RE C L E N */
  958. dev_table[x].col = 1;
  959. dev_table[x].buffer = buffer;
  960. strcpy(dev_table[x].filename, B);
  961. if (mode == DEVMODE_APPEND)
  962. {
  963. fseek(fp, 0, SEEK_END);
  964. }
  965. else
  966. if (mode == DEVMODE_RANDOM)
  967. {
  968. memset(buffer, ' ', y); /* flush */
  969. }
  970. }
  971. }
  972. }
  973. break;
  974. case F_OPEN_A_X_B_N:
  975. /* default LEN is 128 for RANDOM, 0 for all others */
  976. /* OPEN "I"|"O"|"R"|"A", [#]n, filename [,rlen] */
  977. {
  978. /* P1STR|P2NUM|P3STR|P4NUM */
  979. /* P1BYT|P2DEV|P3BYT|P4INT */
  980. int mode;
  981. int y = 0;
  982. while (*A == ' ')
  983. {
  984. A++; /* LTRIM$ */
  985. }
  986. mode = ToUpper(*A);
  987. switch (mode)
  988. {
  989. case 'I':
  990. case 'O':
  991. case 'A':
  992. case 'B':
  993. break;
  994. case 'R':
  995. y = bwx_RANDOM_RECORD_SIZE();
  996. break;
  997. default:
  998. mode = DEVMODE_CLOSED;
  999. break;
  1000. }
  1001. if (x == CONSOLE_FILE_NUMBER)
  1002. {
  1003. IsError = 'X';
  1004. }
  1005. else
  1006. if (mode == DEVMODE_CLOSED)
  1007. {
  1008. IsError = 'A';
  1009. }
  1010. else
  1011. if (dev_table[x].mode != DEVMODE_CLOSED)
  1012. {
  1013. IsError = 'X';
  1014. }
  1015. else
  1016. if (y < 0)
  1017. {
  1018. IsError = 'Y';
  1019. }
  1020. else
  1021. if (y == 0 && mode == 'R')
  1022. {
  1023. IsError = 'Y';
  1024. }
  1025. else
  1026. if (y > 0 && mode == 'B')
  1027. {
  1028. IsError = 'Y';
  1029. }
  1030. else
  1031. {
  1032. FILE *fp = NULL;
  1033. char *buffer = NULL;
  1034. switch (mode)
  1035. {
  1036. case 'I':
  1037. mode = DEVMODE_INPUT;
  1038. fp = fopen(B, "r");
  1039. y = 0;
  1040. break;
  1041. case 'O':
  1042. mode = DEVMODE_OUTPUT;
  1043. fp = fopen(B, "w");
  1044. y = 0;
  1045. break;
  1046. case 'A':
  1047. mode = DEVMODE_APPEND;
  1048. fp = fopen(B, "a");
  1049. y = 0;
  1050. break;
  1051. case 'B':
  1052. mode = DEVMODE_BINARY;
  1053. fp = fopen(B, "r+");
  1054. if (fp == NULL)
  1055. {
  1056. fp = fopen(B, "w");
  1057. fclose(fp);
  1058. fp = fopen(B, "r+");
  1059. }
  1060. y = 0;
  1061. break;
  1062. case 'R':
  1063. mode = DEVMODE_RANDOM;
  1064. fp = fopen(B, "r+");
  1065. if (fp == NULL)
  1066. {
  1067. fp = fopen(B, "w");
  1068. fclose(fp);
  1069. fp = fopen(B, "r+");
  1070. }
  1071. if (fp != NULL)
  1072. {
  1073. buffer = CALLOC(y, 1, "F_OPEN_A_X_B_Y_V");
  1074. }
  1075. break;
  1076. }
  1077. if (fp == NULL)
  1078. {
  1079. /* i n v a l i d
  1080. *
  1081. * fi l e
  1082. *
  1083. * na m e */
  1084. IsError = 'B';
  1085. }
  1086. else
  1087. if (mode == DEVMODE_RANDOM && buffer == NULL)
  1088. {
  1089. /* i n v a l i d
  1090. *
  1091. * re c o r d
  1092. *
  1093. * le n g t h */
  1094. IsError = 'Y';
  1095. }
  1096. else
  1097. {
  1098. dev_table[x].mode = mode;
  1099. dev_table[x].cfp = fp;
  1100. dev_table[x].width = y;
  1101. /* N O T E :
  1102. *
  1103. * WI D T H
  1104. *
  1105. * ==
  1106. * RE C L E N */
  1107. dev_table[x].col = 1;
  1108. dev_table[x].buffer = buffer;
  1109. strcpy(dev_table[x].filename, B);
  1110. if (mode == DEVMODE_APPEND)
  1111. {
  1112. fseek(fp, 0, SEEK_END);
  1113. }
  1114. else
  1115. if (mode == DEVMODE_RANDOM)
  1116. {
  1117. memset(buffer, ' ', y); /* flush */
  1118. }
  1119. }
  1120. }
  1121. }
  1122. break;
  1123. case F_LOC_X_N:
  1124. /* N = LOC( X ) */
  1125. {
  1126. /* P1DEV */
  1127. if (x == CONSOLE_FILE_NUMBER)
  1128. {
  1129. N = 0;
  1130. }
  1131. else
  1132. if (dev_table[x].mode == DEVMODE_CLOSED)
  1133. {
  1134. IsError = 'X';
  1135. }
  1136. else
  1137. {
  1138. FILE *fp;
  1139. fp = dev_table[x].cfp;
  1140. N = ftell(fp);
  1141. if (dev_table[x].mode == DEVMODE_RANDOM)
  1142. {
  1143. /* record number */
  1144. N /= dev_table[x].width;
  1145. }
  1146. else
  1147. if (dev_table[x].mode == DEVMODE_BINARY)
  1148. {
  1149. /* byte position */
  1150. }
  1151. else
  1152. {
  1153. /* byte positiion / 128 */
  1154. N /= 128;
  1155. }
  1156. N = floor(N);
  1157. N++; /* C to BASIC */
  1158. }
  1159. }
  1160. break;
  1161. case F_SEEK_X_N:
  1162. /* N = SEEK( X ) */
  1163. {
  1164. /* P1DEV */
  1165. if (x == CONSOLE_FILE_NUMBER)
  1166. {
  1167. N = 0;
  1168. }
  1169. else
  1170. if (dev_table[x].mode == DEVMODE_CLOSED)
  1171. {
  1172. IsError = 'X';
  1173. }
  1174. else
  1175. {
  1176. FILE *fp;
  1177. fp = dev_table[x].cfp;
  1178. N = ftell(fp);
  1179. if (dev_table[x].mode == DEVMODE_RANDOM)
  1180. {
  1181. /* record number */
  1182. N /= dev_table[x].width;
  1183. }
  1184. else
  1185. {
  1186. /* byte positiion */
  1187. }
  1188. N = floor(N);
  1189. N++; /* C to BASIC */
  1190. }
  1191. }
  1192. break;
  1193. case F_SEEK_X_Y_N:
  1194. /* SEEK X, Y */
  1195. {
  1196. /* P1DEV|P2INT */
  1197. if (x == CONSOLE_FILE_NUMBER)
  1198. {
  1199. IsError = 'X';
  1200. }
  1201. else
  1202. if (dev_table[x].mode == DEVMODE_CLOSED)
  1203. {
  1204. IsError = 'X';
  1205. }
  1206. else
  1207. if (y < 1)
  1208. {
  1209. IsError = 'Y';
  1210. }
  1211. else
  1212. {
  1213. long offset;
  1214. offset = y;
  1215. offset--; /* BASIC to C */
  1216. if (dev_table[x].mode == DEVMODE_RANDOM)
  1217. {
  1218. offset *= dev_table[x].width;
  1219. }
  1220. if (fseek(dev_table[x].cfp, offset, SEEK_SET) != 0)
  1221. {
  1222. IsError = 'Y';
  1223. }
  1224. else
  1225. {
  1226. /* OK */
  1227. N = 0;
  1228. }
  1229. }
  1230. }
  1231. break;
  1232. case F_LOF_X_N:
  1233. /* N = LOF( X ) */
  1234. {
  1235. /* P1DEV */
  1236. if (x == CONSOLE_FILE_NUMBER)
  1237. {
  1238. N = 0;
  1239. }
  1240. else
  1241. if (dev_table[x].mode == DEVMODE_CLOSED)
  1242. {
  1243. IsError = 'X';
  1244. }
  1245. else
  1246. {
  1247. /* file size in bytes */
  1248. FILE *fp;
  1249. int current;
  1250. int total;
  1251. fp = dev_table[x].cfp;
  1252. current = ftell(fp);
  1253. fseek(fp, 0, SEEK_END);
  1254. total = ftell(fp);
  1255. if (total == current)
  1256. {
  1257. /* EOF */
  1258. }
  1259. else
  1260. {
  1261. fseek(fp, current, SEEK_SET);
  1262. }
  1263. N = total;
  1264. }
  1265. }
  1266. break;
  1267. case F_EOF_X_N:
  1268. /* N = EOF( X ) */
  1269. {
  1270. /* P1DEV */
  1271. if (x == CONSOLE_FILE_NUMBER)
  1272. {
  1273. N = 0;
  1274. }
  1275. else
  1276. if (dev_table[x].mode == DEVMODE_CLOSED)
  1277. {
  1278. IsError = 'X';
  1279. }
  1280. else
  1281. {
  1282. /* are we at the end? */
  1283. FILE *fp;
  1284. int current;
  1285. int total;
  1286. fp = dev_table[x].cfp;
  1287. current = ftell(fp);
  1288. fseek(fp, 0, SEEK_END);
  1289. total = ftell(fp);
  1290. if (total == current)
  1291. {
  1292. /* EOF */
  1293. N = -1;
  1294. }
  1295. else
  1296. {
  1297. fseek(fp, current, SEEK_SET);
  1298. N = 0;
  1299. }
  1300. }
  1301. }
  1302. break;
  1303. case F_FILEATTR_X_Y_N:
  1304. /* N = FILEATTR( X, Y ) */
  1305. {
  1306. /* P1DEV|P2INT */
  1307. if (x == CONSOLE_FILE_NUMBER)
  1308. {
  1309. IsError = 'X';
  1310. }
  1311. else
  1312. {
  1313. if (y == 1)
  1314. {
  1315. N = dev_table[x].mode;
  1316. }
  1317. else
  1318. if (y == 2)
  1319. {
  1320. N = 0;
  1321. }
  1322. else
  1323. {
  1324. IsError = 'Y';
  1325. }
  1326. }
  1327. }
  1328. break;
  1329. case F_CLOSE_X_N:
  1330. /* CLOSE X */
  1331. {
  1332. /* P1DEV */
  1333. if (x == CONSOLE_FILE_NUMBER)
  1334. {
  1335. IsError = 'X';
  1336. }
  1337. else
  1338. if (dev_table[x].mode == DEVMODE_CLOSED)
  1339. {
  1340. IsError = 'X';
  1341. }
  1342. else
  1343. {
  1344. if (dev_table[x].cfp != NULL)
  1345. {
  1346. fclose(dev_table[x].cfp);
  1347. }
  1348. if (dev_table[x].buffer != NULL)
  1349. {
  1350. FREE(dev_table[x].buffer, "F_CLOSE_X_N");
  1351. }
  1352. dev_table[x].mode = DEVMODE_CLOSED;
  1353. dev_table[x].width = 0;
  1354. dev_table[x].col = 0;
  1355. dev_table[x].filename[0] = '\0';
  1356. dev_table[x].cfp = NULL;
  1357. dev_table[x].buffer = NULL;
  1358. N = 0;
  1359. }
  1360. }
  1361. break;
  1362. case F_FREEFILE_N:
  1363. /* N = FREEFILE */
  1364. {
  1365. /* PNONE */
  1366. int x;
  1367. for (x = 0; x <= BasicFileNumberMax; x++)
  1368. {
  1369. if (x == CONSOLE_FILE_NUMBER)
  1370. {
  1371. /* ignore */
  1372. }
  1373. else
  1374. if (dev_table[x].mode == DEVMODE_CLOSED)
  1375. {
  1376. N = x;
  1377. break;
  1378. }
  1379. }
  1380. }
  1381. break;
  1382. case F_RESET_N:
  1383. /* RESET */
  1384. {
  1385. /* PNONE */
  1386. int x;
  1387. for (x = 0; x <= BasicFileNumberMax; x++)
  1388. {
  1389. if (x == CONSOLE_FILE_NUMBER)
  1390. {
  1391. /* ignore */
  1392. }
  1393. else
  1394. if (dev_table[x].mode != DEVMODE_CLOSED)
  1395. {
  1396. if (dev_table[x].cfp != NULL)
  1397. {
  1398. fclose(dev_table[x].cfp);
  1399. }
  1400. if (dev_table[x].buffer != NULL)
  1401. {
  1402. FREE(dev_table[x].buffer, "F_RESET_V");
  1403. }
  1404. dev_table[x].mode = DEVMODE_CLOSED;
  1405. dev_table[x].width = 0;
  1406. dev_table[x].col = 0;
  1407. dev_table[x].filename[0] = '\0';
  1408. dev_table[x].cfp = NULL;
  1409. dev_table[x].buffer = NULL;
  1410. }
  1411. }
  1412. N = 0;
  1413. }
  1414. break;
  1415. case F_GET_X_Y_N:
  1416. /* GET X, Y */
  1417. {
  1418. /* P1DEV|P2INT */
  1419. if (x == CONSOLE_FILE_NUMBER)
  1420. {
  1421. IsError = 'X';
  1422. }
  1423. else
  1424. if (dev_table[x].mode == DEVMODE_CLOSED)
  1425. {
  1426. IsError = 'X';
  1427. }
  1428. else
  1429. if (dev_table[x].mode != DEVMODE_RANDOM)
  1430. {
  1431. IsError = 'X';
  1432. }
  1433. else
  1434. if (y < 1)
  1435. {
  1436. IsError = 'Y';
  1437. }
  1438. else
  1439. {
  1440. long offset;
  1441. offset = y;
  1442. offset--; /* BASIC to C */
  1443. offset *= dev_table[x].width;
  1444. if (fseek(dev_table[x].cfp, offset, SEEK_SET) != 0)
  1445. {
  1446. IsError = 'Y';
  1447. }
  1448. else
  1449. {
  1450. int i;
  1451. for (i = 0; i < dev_table[x].width; i++)
  1452. {
  1453. dev_table[x].buffer[i] = fgetc(dev_table[x].cfp);
  1454. }
  1455. N = 0;
  1456. }
  1457. }
  1458. }
  1459. break;
  1460. case F_GET_X_N:
  1461. /* GET X */
  1462. {
  1463. /* PDEV1 */
  1464. if (x == CONSOLE_FILE_NUMBER)
  1465. {
  1466. IsError = 'X';
  1467. }
  1468. else
  1469. if (dev_table[x].mode == DEVMODE_CLOSED)
  1470. {
  1471. IsError = 'X';
  1472. }
  1473. else
  1474. if (dev_table[x].mode != DEVMODE_RANDOM)
  1475. {
  1476. IsError = 'X';
  1477. }
  1478. else
  1479. {
  1480. {
  1481. int i;
  1482. for (i = 0; i < dev_table[x].width; i++)
  1483. {
  1484. dev_table[x].buffer[i] = fgetc(dev_table[x].cfp);
  1485. }
  1486. N = 0;
  1487. }
  1488. }
  1489. }
  1490. break;
  1491. case F_PUT_X_Y_N:
  1492. /* PUT X, Y */
  1493. {
  1494. /* P1DEV|P2INT */
  1495. if (x == CONSOLE_FILE_NUMBER)
  1496. {
  1497. IsError = 'X';
  1498. }
  1499. else
  1500. if (dev_table[x].mode == DEVMODE_CLOSED)
  1501. {
  1502. IsError = 'X';
  1503. }
  1504. else
  1505. if (dev_table[x].mode != DEVMODE_RANDOM)
  1506. {
  1507. IsError = 'X';
  1508. }
  1509. else
  1510. if (y < 1)
  1511. {
  1512. IsError = 'Y';
  1513. }
  1514. else
  1515. {
  1516. long offset;
  1517. offset = y;
  1518. offset--; /* BASIC to C */
  1519. offset *= dev_table[x].width;
  1520. if (fseek(dev_table[x].cfp, offset, SEEK_SET) != 0)
  1521. {
  1522. IsError = 'Y';
  1523. }
  1524. else
  1525. {
  1526. int i;
  1527. for (i = 0; i < dev_table[x].width; i++)
  1528. {
  1529. fputc(dev_table[x].buffer[i], dev_table[x].cfp);
  1530. dev_table[x].buffer[i] = ' '; /* flush */
  1531. }
  1532. N = 0;
  1533. }
  1534. }
  1535. }
  1536. break;
  1537. case F_PUT_X_N:
  1538. /* PUT X */
  1539. {
  1540. /* P1DEV */
  1541. if (x == CONSOLE_FILE_NUMBER)
  1542. {
  1543. IsError = 'X';
  1544. }
  1545. else
  1546. if (dev_table[x].mode == DEVMODE_CLOSED)
  1547. {
  1548. IsError = 'X';
  1549. }
  1550. else
  1551. if (dev_table[x].mode != DEVMODE_RANDOM)
  1552. {
  1553. IsError = 'X';
  1554. }
  1555. else
  1556. {
  1557. {
  1558. int i;
  1559. for (i = 0; i < dev_table[x].width; i++)
  1560. {
  1561. fputc(dev_table[x].buffer[i], dev_table[x].cfp);
  1562. dev_table[x].buffer[i] = ' '; /* flush */
  1563. }
  1564. N = 0;
  1565. }
  1566. }
  1567. }
  1568. break;
  1569. case F_WIDTH_X_N:
  1570. /* WIDTH X */
  1571. {
  1572. /* P1BYT */
  1573. /* console is #0 */
  1574. dev_table[CONSOLE_FILE_NUMBER].width = x;
  1575. dev_table[CONSOLE_FILE_NUMBER].col = 1;
  1576. N = 0;
  1577. }
  1578. break;
  1579. case F_WIDTH_X_Y_N:
  1580. /* WIDTH X, Y */
  1581. {
  1582. /* P1DEV|PB2YT */
  1583. if (dev_table[x].mode == DEVMODE_CLOSED)
  1584. {
  1585. IsError = 'X';
  1586. }
  1587. else
  1588. if (dev_table[x].mode == DEVMODE_RANDOM)
  1589. {
  1590. IsError = 'X';
  1591. }
  1592. else
  1593. {
  1594. dev_table[x].width = y;
  1595. dev_table[x].col = 1;
  1596. N = 0;
  1597. }
  1598. }
  1599. break;
  1600. case F_INSTR_X_A_B_N:
  1601. /* N = INSTR( X, A$, B$ ) */
  1602. {
  1603. /* P1POS */
  1604. if (a == 0)
  1605. {
  1606. /* empty searched */
  1607. }
  1608. else
  1609. if (b == 0)
  1610. {
  1611. /* empty pattern */
  1612. }
  1613. else
  1614. if (b > a)
  1615. {
  1616. /* pattern is longer than searched */
  1617. }
  1618. else
  1619. {
  1620. /* search */
  1621. int i;
  1622. int n;
  1623. n = a - b; /* last valid search
  1624. * position */
  1625. n++;
  1626. x--; /* BASIC to C */
  1627. A += x; /* advance to the start
  1628. * position */
  1629. for (i = x; i < n; i++)
  1630. {
  1631. if (memcmp(A, B, b) == 0)
  1632. {
  1633. /* FOU ND */
  1634. i++; /* C to BASIC */
  1635. N = i;
  1636. i = n; /* exit for */
  1637. }
  1638. A++;
  1639. }
  1640. }
  1641. }
  1642. break;
  1643. case F_INSTR_A_B_N:
  1644. /* N = INSTR( A$, B$ ) */
  1645. {
  1646. if (a == 0)
  1647. {
  1648. /* empty searched */
  1649. }
  1650. else
  1651. if (b == 0)
  1652. {
  1653. /* empty pattern */
  1654. }
  1655. else
  1656. if (b > a)
  1657. {
  1658. /* pattern is longer than searched */
  1659. }
  1660. else
  1661. {
  1662. /* search */
  1663. int i;
  1664. int n;
  1665. n = a - b; /* last valid search
  1666. * position */
  1667. n++;
  1668. /* search */
  1669. for (i = 0; i < n; i++)
  1670. {
  1671. if (memcmp(A, B, b) == 0)
  1672. {
  1673. /* FOU ND */
  1674. i++; /* C to BASIC */
  1675. N = i;
  1676. i = n; /* exit for */
  1677. }
  1678. A++;
  1679. }
  1680. }
  1681. }
  1682. break;
  1683. case F_SPACE_X_S:
  1684. /* S$ = SPACE$( X ) */
  1685. {
  1686. /* P1LEN */
  1687. if (x == 0)
  1688. {
  1689. /* no copies */
  1690. }
  1691. else
  1692. {
  1693. memset(S, ' ', x);
  1694. s = x;
  1695. }
  1696. }
  1697. break;
  1698. case F_STRING_X_Y_S:
  1699. /* S$ = STRING$( X, Y ) */
  1700. {
  1701. /* P1LEN|P2BYT */
  1702. if (x == 0)
  1703. {
  1704. /* no copies */
  1705. }
  1706. else
  1707. {
  1708. memset(S, (char) y, x);
  1709. s = x;
  1710. }
  1711. }
  1712. break;
  1713. case F_STRING_X_A_S:
  1714. /* S$ = STRING$( X, A$ ) */
  1715. {
  1716. /* P1LEN|P2BYT */
  1717. if (x == 0)
  1718. {
  1719. /* no copies */
  1720. }
  1721. else
  1722. {
  1723. memset(S, (char) A[0], x);
  1724. s = x;
  1725. }
  1726. }
  1727. break;
  1728. case F_MID_A_X_S:
  1729. /* S$ = MID$( A$, X ) */
  1730. {
  1731. /* P1ANY|P2POS */
  1732. if (a == 0)
  1733. {
  1734. /* empty string */
  1735. }
  1736. else
  1737. if (x > a)
  1738. {
  1739. /* start beyond length */
  1740. }
  1741. else
  1742. {
  1743. x--; /* BASIC to C */
  1744. a -= x; /* nummber of characters to
  1745. * copy */
  1746. A += x; /* pointer to first character
  1747. * to copy */
  1748. memcpy(S, A, a);
  1749. s = a;
  1750. }
  1751. }
  1752. break;
  1753. case F_MID_A_X_Y_S:
  1754. /* S$ = MID$( A$, X, Y ) */
  1755. {
  1756. /* P1ANY|P2POS|P3LEN */
  1757. if (a == 0)
  1758. {
  1759. /* empty string */
  1760. }
  1761. else
  1762. if (x > a)
  1763. {
  1764. /* start beyond length */
  1765. }
  1766. else
  1767. if (y == 0)
  1768. {
  1769. /* empty string */
  1770. }
  1771. else
  1772. {
  1773. x--; /* BASIC to C */
  1774. a -= x;
  1775. /* maximum nummber of characters to
  1776. * copy */
  1777. a = MIN(a, y);
  1778. A += x;
  1779. /* pointer to first character to copy */
  1780. memcpy(S, A, a);
  1781. s = a;
  1782. }
  1783. }
  1784. break;
  1785. case F_LEFT_A_X_S:
  1786. /* S$ = LEFT$( A$, X ) */
  1787. {
  1788. /* P1ANY|P2LEN */
  1789. if (a == 0)
  1790. {
  1791. /* empty string */
  1792. }
  1793. else
  1794. if (x == 0)
  1795. {
  1796. /* empty string */
  1797. }
  1798. else
  1799. {
  1800. a = MIN(a, x);
  1801. memcpy(S, A, a);
  1802. s = a;
  1803. }
  1804. }
  1805. break;
  1806. case F_RIGHT_A_X_S:
  1807. /* S$ = RIGHT$( A$, X ) */
  1808. {
  1809. /* P1ANY|P2LEN */
  1810. if (a == 0)
  1811. {
  1812. /* empty string */
  1813. }
  1814. else
  1815. if (x == 0)
  1816. {
  1817. /* empty string */
  1818. }
  1819. else
  1820. {
  1821. x = MIN(a, x);
  1822. A += a;
  1823. A -= x;
  1824. memcpy(S, A, x);
  1825. s = x;
  1826. }
  1827. }
  1828. break;
  1829. case F_HEX_X_S:
  1830. /* S$ = HEX$( X ) */
  1831. {
  1832. sprintf(S, "%X", x);
  1833. s = strlen(S);
  1834. }
  1835. break;
  1836. case F_OCT_X_S:
  1837. /* S$ = OCT$( X ) */
  1838. {
  1839. sprintf(S, "%o", x);
  1840. s = strlen(S);
  1841. }
  1842. break;
  1843. case F_CHR_X_S:
  1844. /* S$ = CHR$( X ) */
  1845. {
  1846. S[0] = (char) x;
  1847. s = 1;
  1848. }
  1849. break;
  1850. case F_LEN_A_N:
  1851. /* N = LEN( A$ ) */
  1852. {
  1853. N = a;
  1854. }
  1855. break;
  1856. case F_POS_A_B_N:
  1857. /* N = POS( A$, B$ ) */
  1858. {
  1859. if (b == 0)
  1860. {
  1861. /* empty pattern */
  1862. N = 1;
  1863. }
  1864. else
  1865. if (a == 0)
  1866. {
  1867. /* empty searched */
  1868. }
  1869. else
  1870. if (b > a)
  1871. {
  1872. /* pattern is longer than searched */
  1873. }
  1874. else
  1875. {
  1876. /* search */
  1877. int i;
  1878. int n;
  1879. n = a - b; /* last valid search
  1880. * position */
  1881. n++;
  1882. /* search */
  1883. for (i = 0; i < n; i++)
  1884. {
  1885. if (memcmp(A, B, b) == 0)
  1886. {
  1887. /* FOU ND */
  1888. i++; /* C to BASIC */
  1889. N = i;
  1890. i = n; /* exit for */
  1891. }
  1892. A++;
  1893. }
  1894. }
  1895. }
  1896. break;
  1897. case F_POS_A_B_X_N:
  1898. /* N = POS( A$, B$, X ) */
  1899. {
  1900. if (b == 0)
  1901. {
  1902. /* empty pattern */
  1903. N = 1;
  1904. }
  1905. else
  1906. if (a == 0)
  1907. {
  1908. /* empty searched */
  1909. }
  1910. else
  1911. if (b > a)
  1912. {
  1913. /* pattern is longer than searched */
  1914. }
  1915. else
  1916. {
  1917. /* search */
  1918. int i;
  1919. int n;
  1920. n = a - b; /* last valid search
  1921. * position */
  1922. n++;
  1923. /* search */
  1924. x--; /* BASIC to C */
  1925. A += x; /* advance to the start
  1926. * position */
  1927. for (i = x; i < n; i++)
  1928. {
  1929. if (memcmp(A, B, b) == 0)
  1930. {
  1931. /* FOU ND */
  1932. N = i + 1; /* C to BASIC */
  1933. i = n; /* exit for */
  1934. }
  1935. A++;
  1936. }
  1937. }
  1938. }
  1939. break;
  1940. case F_VAL_A_N:
  1941. /* N = VAL( A$ ) */
  1942. {
  1943. /* P1BYT */
  1944. /* FIXME: use the BASIC numeric value parse
  1945. * routine */
  1946. int ScanResult;
  1947. BasicNumberType Value;
  1948. ScanResult = sscanf(A, BasicNumberScanFormat, &Value);
  1949. if (ScanResult != 1)
  1950. {
  1951. /* not a number */
  1952. if (OptionFlags & OPTION_BUGS_ON)
  1953. {
  1954. /* IGNORE */
  1955. N = 0;
  1956. }
  1957. else
  1958. {
  1959. /* ERROR */
  1960. IsError = 'A';
  1961. }
  1962. }
  1963. else
  1964. {
  1965. /* OK */
  1966. N = Value;
  1967. }
  1968. }
  1969. break;
  1970. case F_STR_X_S:
  1971. /* S$ = STR$( X ) */
  1972. {
  1973. /* P1ANY */
  1974. /* sprintf( S, BasicNumberPrintFormat, X ); */
  1975. BasicNumerc(X, S);
  1976. s = strlen(S);
  1977. }
  1978. break;
  1979. case F_DATE_N:
  1980. /* N = DATE ' YYYYDDD */
  1981. {
  1982. /* PNONE */
  1983. /* ECMA-116 */
  1984. time(&t);
  1985. lt = localtime(&t);
  1986. N = lt->tm_year;
  1987. N *= 1000;
  1988. N += lt->tm_yday;
  1989. N += 1;
  1990. }
  1991. break;
  1992. case F_DATE_S:
  1993. /* S$ = DATE$ */
  1994. {
  1995. /* PNONE */
  1996. time(&t);
  1997. lt = localtime(&t);
  1998. s = strftime(S, BasicStringLengthMax, OptionDateFormat, lt);
  1999. }
  2000. break;
  2001. case F_TIME_S:
  2002. /* S$ = TIME$ */
  2003. {
  2004. /* PNONE */
  2005. time(&t);
  2006. lt = localtime(&t);
  2007. #if 0
  2008. sprintf(S, "%02d:%02d:%02d", lt->tm_hour, lt->tm_min, lt->tm_sec);
  2009. s = strlen(S);
  2010. #endif
  2011. s = strftime(S, BasicStringLengthMax, OptionTimeFormat, lt);
  2012. }
  2013. break;
  2014. case F_TIMER_N:
  2015. /* N = TIMER */
  2016. case F_TIME_N:
  2017. /* N = TIME */
  2018. {
  2019. /* PNONE */
  2020. time(&t);
  2021. lt = localtime(&t);
  2022. N = lt->tm_hour;
  2023. N *= 60;
  2024. N += lt->tm_min;
  2025. N *= 60;
  2026. N += lt->tm_sec;
  2027. }
  2028. break;
  2029. case F_COSH_X_N:
  2030. /* N = COSH( X ) */
  2031. {
  2032. /* P1ANY */
  2033. N = cosh(X);
  2034. }
  2035. break;
  2036. case F_SINH_X_N:
  2037. /* N = SINH( X ) */
  2038. {
  2039. /* P1ANY */
  2040. N = sinh(X);
  2041. }
  2042. break;
  2043. case F_TANH_X_N:
  2044. /* N = TANH( X ) */
  2045. {
  2046. /* P1ANY */
  2047. N = tanh(X);
  2048. }
  2049. break;
  2050. case F_LOG10_X_N:
  2051. /* N = LOG10( X ) */
  2052. {
  2053. /* P1GTZ */
  2054. N = log10(X);
  2055. }
  2056. break;
  2057. case F_LOG2_X_N:
  2058. /* N = LOG2( X ) */
  2059. {
  2060. /* P1GTZ */
  2061. N = log(X) / log((BasicNumberType) 2);
  2062. }
  2063. break;
  2064. case F_ACOS_X_N:
  2065. /* N = ACOS( X ) */
  2066. {
  2067. /* P1ANY */
  2068. if (X < -1 || X > 1)
  2069. {
  2070. IsError = 'X';
  2071. }
  2072. else
  2073. {
  2074. N = acos(X);
  2075. if (OptionFlags & OPTION_ANGLE_DEGREES)
  2076. {
  2077. N = N * 180 / PI;
  2078. }
  2079. }
  2080. }
  2081. break;
  2082. case F_ASIN_X_N:
  2083. /* N = ASIN( X ) */
  2084. {
  2085. /* P1ANY */
  2086. if (X < -1 || X > 1)
  2087. {
  2088. IsError = 'X';
  2089. }
  2090. else
  2091. {
  2092. N = asin(X);
  2093. if (OptionFlags & OPTION_ANGLE_DEGREES)
  2094. {
  2095. N = N * 180 / PI;
  2096. }
  2097. }
  2098. }
  2099. break;
  2100. case F_COT_X_N:
  2101. /* N = COT( X ) ' = 1 / TAN( X ) */
  2102. {
  2103. /* P1ANY */
  2104. BasicNumberType T;
  2105. if (OptionFlags & OPTION_ANGLE_DEGREES)
  2106. {
  2107. X = X * PI / 180;
  2108. }
  2109. T = tan(X);
  2110. if (T == 0)
  2111. {
  2112. IsError = 'X';
  2113. }
  2114. else
  2115. {
  2116. N = 1.0 / T;
  2117. }
  2118. }
  2119. break;
  2120. case F_CSC_X_N:
  2121. /* N = CSC( X ) ' = 1 / SIN( X ) */
  2122. {
  2123. /* P1ANY */
  2124. BasicNumberType T;
  2125. if (OptionFlags & OPTION_ANGLE_DEGREES)
  2126. {
  2127. X = X * PI / 180;
  2128. }
  2129. T = sin(X);
  2130. if (T == 0)
  2131. {
  2132. IsError = 'X';
  2133. }
  2134. else
  2135. {
  2136. N = 1.0 / T;
  2137. }
  2138. }
  2139. break;
  2140. case F_SEC_X_N:
  2141. /* N = SEC( X ) ' = 1 / COS( X ) */
  2142. {
  2143. /* P1ANY */
  2144. BasicNumberType T;
  2145. if (OptionFlags & OPTION_ANGLE_DEGREES)
  2146. {
  2147. X = X * PI / 180;
  2148. }
  2149. T = cos(X);
  2150. if (T == 0)
  2151. {
  2152. IsError = 'X';
  2153. }
  2154. else
  2155. {
  2156. N = 1.0 / T;
  2157. }
  2158. }
  2159. break;
  2160. case F_UCASE_A_S:
  2161. /* S$ = UCASE$( A$ ) */
  2162. {
  2163. /* P1ANY */
  2164. if (a == 0)
  2165. {
  2166. /* empty string */
  2167. }
  2168. else
  2169. {
  2170. int i;
  2171. memcpy(S, A, a);
  2172. s = a;
  2173. /* BASIC allows embedded NULL
  2174. * characters */
  2175. for (i = 0; i < a; i++)
  2176. {
  2177. S[i] = ToUpper(S[i]);
  2178. }
  2179. }
  2180. }
  2181. break;
  2182. case F_LCASE_A_S:
  2183. /* S$ = LCASE$( A$ ) */
  2184. {
  2185. /* P1ANY */
  2186. if (a == 0)
  2187. {
  2188. /* empty string */
  2189. }
  2190. else
  2191. {
  2192. int i;
  2193. memcpy(S, A, a);
  2194. s = a;
  2195. /* BASIC allows embedded NULL
  2196. * characters */
  2197. for (i = 0; i < a; i++)
  2198. {
  2199. S[i] = ToLower(S[i]);
  2200. }
  2201. }
  2202. }
  2203. break;
  2204. case F_ANGLE_X_Y_N:
  2205. /* N = ANGLE( X, Y ) */
  2206. {
  2207. /* P1ANY|P2ANY */
  2208. if (X == 0 && Y == 0)
  2209. {
  2210. IsError = 'X';
  2211. }
  2212. else
  2213. {
  2214. N = atan2(Y, X);
  2215. if (OptionFlags & OPTION_ANGLE_DEGREES)
  2216. {
  2217. N = N * 180 / PI;
  2218. }
  2219. }
  2220. }
  2221. break;
  2222. case F_CEIL_X_N:
  2223. /* N = CEIL( X ) */
  2224. {
  2225. /* P1ANY */
  2226. N = ceil(X);
  2227. }
  2228. break;
  2229. case F_DEG_X_N:
  2230. /* N = DEG( X ) */
  2231. {
  2232. /* P1ANY */
  2233. N = X * 180.0 / PI;
  2234. }
  2235. break;
  2236. case F_RAD_X_N:
  2237. /* N = RAD( X ) */
  2238. {
  2239. /* P1ANY */
  2240. N = X * PI / 180.0;
  2241. }
  2242. break;
  2243. case F_PI_N:
  2244. /* N = PI */
  2245. {
  2246. /* PNONE */
  2247. N = PI;
  2248. }
  2249. break;
  2250. case F_LTRIM_A_S:
  2251. /* S$ = LTRIM$( A$ ) */
  2252. {
  2253. /* P1ANY */
  2254. if (a == 0)
  2255. {
  2256. /* empty string */
  2257. }
  2258. else
  2259. {
  2260. int i;
  2261. /* BASIC allows embedded NULL
  2262. * characters */
  2263. for (i = 0; i < a && A[i] == ' '; i++)
  2264. {
  2265. /* skip spaces */
  2266. }
  2267. /* 'A[ i ]' is first non-space
  2268. * character */
  2269. if (i >= a)
  2270. {
  2271. /* empty string */
  2272. }
  2273. else
  2274. {
  2275. A += i;
  2276. a -= i;
  2277. memcpy(S, A, a);
  2278. s = a;
  2279. }
  2280. }
  2281. }
  2282. break;
  2283. case F_RTRIM_A_S:
  2284. /* S$ = RTRIM$( A$ ) */
  2285. {
  2286. /* P1ANY */
  2287. if (a == 0)
  2288. {
  2289. /* empty string */
  2290. }
  2291. else
  2292. {
  2293. int i;
  2294. /* BASIC allows embedded NULL
  2295. * characters */
  2296. for (i = a - 1; i >= 0 && A[i] == ' '; i--)
  2297. {
  2298. /* skip spaces */
  2299. }
  2300. /* 'A[ i ]' is last non-space
  2301. * character */
  2302. if (i < 0)
  2303. {
  2304. /* empty string */
  2305. }
  2306. else
  2307. {
  2308. a = i + 1;
  2309. memcpy(S, A, a);
  2310. s = a;
  2311. }
  2312. }
  2313. }
  2314. break;
  2315. case F_TRIM_A_S:
  2316. /* S$ = TRIM$( A$ ) */
  2317. {
  2318. /* P1ANY */
  2319. if (a == 0)
  2320. {
  2321. /* empty string */
  2322. }
  2323. else
  2324. {
  2325. /* LTRIM */
  2326. int i;
  2327. /* BASIC allows embedded NULL
  2328. * characters */
  2329. for (i = 0; i < a && A[i] == ' '; i++)
  2330. {
  2331. /* skip spaces */
  2332. }
  2333. /* 'A[ i ]' is first non-space
  2334. * character */
  2335. if (i >= a)
  2336. {
  2337. /* empty string */
  2338. }
  2339. else
  2340. {
  2341. A += i;
  2342. a -= i;
  2343. memcpy(S, A, a);
  2344. s = a;
  2345. /* RTRIM */
  2346. A = S;
  2347. a = s;
  2348. if (a == 0)
  2349. {
  2350. /* empty string */
  2351. }
  2352. else
  2353. {
  2354. int i;
  2355. /* BASIC allows
  2356. * embedded NULL
  2357. * characters */
  2358. for (i = a - 1; i >= 0 && A[i] == ' '; i--)
  2359. {
  2360. /* skip
  2361. * spaces */
  2362. }
  2363. /* 'A[ i ]' is last
  2364. * non-space
  2365. * character */
  2366. if (i < 0)
  2367. {
  2368. /* empty
  2369. * string */
  2370. }
  2371. else
  2372. {
  2373. a = i + 1;
  2374. /* memcpy( S,
  2375. * A, a ); */
  2376. s = a;
  2377. }
  2378. }
  2379. }
  2380. }
  2381. }
  2382. break;
  2383. case F_MAX_X_Y_N:
  2384. /* N = MAX( X, Y ) */
  2385. {
  2386. N = MAX(X, Y);
  2387. }
  2388. break;
  2389. case F_MIN_X_Y_N:
  2390. /* N = MIN( X, Y ) */
  2391. {
  2392. N = MIN(X, Y);
  2393. }
  2394. break;
  2395. case F_FP_X_N:
  2396. /* N = FP( X ) */
  2397. {
  2398. BasicNumberType FP;
  2399. BasicNumberType IP;
  2400. FP = modf(X, &IP);
  2401. N = FP;
  2402. }
  2403. break;
  2404. case F_IP_X_N:
  2405. /* N = IP( X ) */
  2406. {
  2407. BasicNumberType IP;
  2408. modf(X, &IP);
  2409. N = IP;
  2410. }
  2411. break;
  2412. case F_EPS_X_N:
  2413. /* N = EPS( Number ) */
  2414. {
  2415. N = DBL_MIN;
  2416. }
  2417. break;
  2418. case F_MAXLVL_N:
  2419. /* N = MAXLVL */
  2420. {
  2421. N = EXECLEVELS;
  2422. }
  2423. break;
  2424. case F_MAXNUM_N:
  2425. /* N = MAXNUM */
  2426. {
  2427. N = DBL_MAX;
  2428. }
  2429. break;
  2430. case F_MINNUM_N:
  2431. /* N = MINNUM */
  2432. {
  2433. N = -DBL_MAX;
  2434. }
  2435. break;
  2436. case F_MAXDBL_N:
  2437. /* N = MAXDBL */
  2438. {
  2439. N = DBL_MAX;
  2440. }
  2441. break;
  2442. case F_MINDBL_N:
  2443. /* N = MINDBL */
  2444. {
  2445. N = -DBL_MAX;
  2446. }
  2447. break;
  2448. case F_MAXSNG_N:
  2449. /* N = MAXSNG */
  2450. {
  2451. N = FLT_MAX;
  2452. }
  2453. break;
  2454. case F_MINSNG_N:
  2455. /* N = MINSNG */
  2456. {
  2457. N = -FLT_MAX;
  2458. }
  2459. break;
  2460. case F_MAXCUR_N:
  2461. /* N = MAXCUR */
  2462. {
  2463. N = LONG_MAX;
  2464. }
  2465. break;
  2466. case F_MINCUR_N:
  2467. /* N = MINCUR */
  2468. {
  2469. N = LONG_MIN;
  2470. }
  2471. break;
  2472. case F_MAXLNG_N:
  2473. /* N = MAXLNG */
  2474. {
  2475. N = LONG_MAX;
  2476. }
  2477. break;
  2478. case F_MINLNG_N:
  2479. /* N = MINLNG */
  2480. {
  2481. N = LONG_MIN;
  2482. }
  2483. break;
  2484. case F_MAXINT_N:
  2485. /* N = MAXINT */
  2486. {
  2487. N = SHRT_MAX;
  2488. }
  2489. break;
  2490. case F_MININT_N:
  2491. /* N = MININT */
  2492. {
  2493. N = SHRT_MIN;
  2494. }
  2495. break;
  2496. case F_MAXBYT_N:
  2497. /* N = MAXBYT */
  2498. {
  2499. N = UCHAR_MAX;
  2500. }
  2501. break;
  2502. case F_MINBYT_N:
  2503. /* N = MINBYT */
  2504. {
  2505. N = 0;
  2506. }
  2507. break;
  2508. case F_MAXDEV_N:
  2509. /* N = MAXDEV */
  2510. {
  2511. N = BasicFileNumberMax;
  2512. }
  2513. break;
  2514. case F_MINDEV_N:
  2515. /* N = MINDEV */
  2516. {
  2517. N = 0;
  2518. }
  2519. break;
  2520. case F_MOD_X_Y_N:
  2521. /* N = MOD( X, Y ) */
  2522. {
  2523. /* P1ANY|P2NEZ */
  2524. BasicNumberType IP;
  2525. IP = floor(X / Y);
  2526. N = X - (Y * IP);
  2527. }
  2528. break;
  2529. case F_REMAINDER_X_Y_N:
  2530. /* REMAINDER( X, Y ) */
  2531. {
  2532. /* P1ANY|P2NEZ */
  2533. BasicNumberType Value;
  2534. BasicNumberType IP;
  2535. Value = X / Y;
  2536. modf(Value, &IP);
  2537. N = X - (Y * IP);
  2538. }
  2539. break;
  2540. case F_ROUND_X_Y_N:
  2541. /* N = ROUND( X, Y ) == INT(X*10^Y+.5)/10^Y */
  2542. {
  2543. /* P1ANY | P2INT */
  2544. if (y < -32 || y > 32)
  2545. {
  2546. IsError = 'Y';
  2547. }
  2548. else
  2549. {
  2550. BasicNumberType T; /* 10^Y */
  2551. T = pow(10.0, Y);
  2552. if (T == 0)
  2553. {
  2554. IsError = 'Y';
  2555. }
  2556. else
  2557. {
  2558. N = floor(X * T + 0.5) / T;
  2559. }
  2560. }
  2561. }
  2562. break;
  2563. case F_TRUNCATE_X_Y_N:
  2564. /* N = TRUNCATE( X, Y ) == INT(X*10^Y)/10^Y */
  2565. {
  2566. /* P1ANY | P2INT */
  2567. if (y < -32 || y > 32)
  2568. {
  2569. IsError = 'Y';
  2570. }
  2571. else
  2572. {
  2573. BasicNumberType T; /* 10^Y */
  2574. T = pow(10.0, Y);
  2575. if (T == 0)
  2576. {
  2577. IsError = 'Y';
  2578. }
  2579. else
  2580. {
  2581. N = floor(X * T) / T;
  2582. }
  2583. }
  2584. }
  2585. break;
  2586. case F_MAXLEN_A_N:
  2587. /* N = MAXLEN( A$ ) */
  2588. {
  2589. N = BasicStringLengthMax;
  2590. }
  2591. break;
  2592. case F_ORD_A_N:
  2593. /* N = ORD( A$ ) */
  2594. {
  2595. /* P1BYT */
  2596. if (a == 1)
  2597. {
  2598. N = A[0];
  2599. }
  2600. else
  2601. {
  2602. int c;
  2603. N = -1; /* not found */
  2604. for (c = 0; c < NUM_ACRONYMS; c++)
  2605. {
  2606. if (strcasecmp(AcronymTable[c].Name, A) == 0)
  2607. {
  2608. /* found */
  2609. N = AcronymTable[c].Value;
  2610. c = NUM_ACRONYMS; /* exit for */
  2611. }
  2612. }
  2613. if (N < 0)
  2614. {
  2615. /* not found */
  2616. IsError = 'A';
  2617. }
  2618. }
  2619. }
  2620. break;
  2621. case F_REPEAT_X_Y_S:
  2622. /* S$ = REPEAT$( X, Y ) ' X is count, Y is code */
  2623. {
  2624. /* P1LEN | P2BYT */
  2625. if (x == 0)
  2626. {
  2627. /* empty string */
  2628. }
  2629. else
  2630. {
  2631. memset(S, (char) y, x);
  2632. s = x;
  2633. }
  2634. }
  2635. break;
  2636. case F_REPEAT_X_A_S:
  2637. /* S$ = REPEAT$( X, A$ ) ' X is count, A$ is code */
  2638. {
  2639. /* P1LEN | P2BYT */
  2640. if (x == 0)
  2641. {
  2642. /* empty string */
  2643. }
  2644. else
  2645. {
  2646. memset(S, (char) A[0], x);
  2647. s = x;
  2648. }
  2649. }
  2650. break;
  2651. case F_FIX_X_N:
  2652. /* N = FIX( X ) */
  2653. {
  2654. N = rint(X);
  2655. }
  2656. break;
  2657. case F_ABS_X_N:
  2658. /* N = ABS( X ) */
  2659. {
  2660. N = fabs(X);
  2661. }
  2662. break;
  2663. case F_ATN_X_N:
  2664. /* N = ATN( X ) */
  2665. {
  2666. N = atan(X);
  2667. if (OptionFlags & OPTION_ANGLE_DEGREES)
  2668. {
  2669. N = N * 180 / PI;
  2670. }
  2671. }
  2672. break;
  2673. case F_COS_X_N:
  2674. /* N = COS( X ) */
  2675. {
  2676. if (OptionFlags & OPTION_ANGLE_DEGREES)
  2677. {
  2678. X = X * PI / 180;
  2679. }
  2680. N = cos(X);
  2681. }
  2682. break;
  2683. case F_EXP_X_N:
  2684. /* N = EXP( X ) */
  2685. {
  2686. N = exp(X);
  2687. }
  2688. break;
  2689. case F_INT_X_N:
  2690. /* N = INT( X ) */
  2691. {
  2692. N = floor(X);
  2693. }
  2694. break;
  2695. case F_LOG_X_N:
  2696. /* N = LOG( X ) */
  2697. {
  2698. /* P1GTZ */
  2699. N = log(X);
  2700. }
  2701. break;
  2702. case F_RND_N:
  2703. /* N = RND */
  2704. {
  2705. N = rand();
  2706. N /= RAND_MAX;
  2707. }
  2708. break;
  2709. case F_RND_X_N:
  2710. /* N = RND( X ) */
  2711. {
  2712. N = rand();
  2713. N /= RAND_MAX;
  2714. }
  2715. break;
  2716. case F_SGN_X_N:
  2717. /* N = SGN( X ) */
  2718. {
  2719. if (X > 0)
  2720. {
  2721. N = 1;
  2722. }
  2723. else
  2724. if (X < 0)
  2725. {
  2726. N = -1;
  2727. }
  2728. else
  2729. {
  2730. N = 0;
  2731. }
  2732. }
  2733. break;
  2734. case F_SIN_X_N:
  2735. /* N = SIN( X ) */
  2736. {
  2737. if (OptionFlags & OPTION_ANGLE_DEGREES)
  2738. {
  2739. X = X * PI / 180;
  2740. }
  2741. N = sin(X);
  2742. }
  2743. break;
  2744. case F_SQR_X_N:
  2745. /* N = SQR( X ) */
  2746. {
  2747. /* P1GEZ */
  2748. N = sqrt(X);
  2749. }
  2750. break;
  2751. case F_TAN_X_N:
  2752. /* N = TAN( X ) */
  2753. {
  2754. if (OptionFlags & OPTION_ANGLE_DEGREES)
  2755. {
  2756. X = X * PI / 180;
  2757. }
  2758. N = tan(X);
  2759. }
  2760. break;
  2761. case F_SPC_X_S:
  2762. /* S$ = SPC( X ) */
  2763. {
  2764. /* P1ANY */
  2765. /* SPECIAL RULES APPLY. PART OF PRINT
  2766. * COMMAND. WIDTH > 0 */
  2767. X = rint(X);
  2768. if (X < 1 || X > 255)
  2769. {
  2770. bwb_Warning_Overflow("*** WARNING: INVALID SPC() ***");
  2771. X = 1;
  2772. }
  2773. x = (int) X;
  2774. S[0] = PRN_SPC;
  2775. S[1] = (char) x;
  2776. s = 2;
  2777. }
  2778. break;
  2779. case F_TAB_X_S:
  2780. /* S$ = TAB( X ) */
  2781. {
  2782. /* P1ANY */
  2783. /* SPECIAL RULES APPLY. PART OF PRINT
  2784. * COMMAND. WIDTH > 0 */
  2785. X = rint(X);
  2786. if (X < 1 || X > 255)
  2787. {
  2788. bwb_Warning_Overflow("*** WARNING: INVALID TAB() ***");
  2789. X = 1;
  2790. }
  2791. x = (int) X;
  2792. S[0] = PRN_TAB;
  2793. S[1] = (char) x;
  2794. s = 2;
  2795. }
  2796. break;
  2797. case F_POS_N:
  2798. /* N = POS */
  2799. {
  2800. /* PNONE */
  2801. N = dev_table[CONSOLE_FILE_NUMBER].col;
  2802. }
  2803. break;
  2804. case F_POS_X_N:
  2805. /* N = POS( X ) */
  2806. {
  2807. /* PDEV1 */
  2808. N = dev_table[x].col;
  2809. }
  2810. break;
  2811. case F_INPUT_X_Y_S:
  2812. /* S$ = INPUT$( X, Y ) */
  2813. {
  2814. /* P1LEN|P2DEV */
  2815. {
  2816. if ((dev_table[y].mode & DEVMODE_READ) == 0)
  2817. {
  2818. IsError = 'Y';
  2819. }
  2820. else
  2821. if (x == 0)
  2822. {
  2823. /* empty string */
  2824. }
  2825. else
  2826. {
  2827. FILE *fp;
  2828. fp = dev_table[y].cfp;
  2829. if (fp == NULL)
  2830. {
  2831. IsError = 'Y';
  2832. }
  2833. else
  2834. {
  2835. s = fread(S, 1, x, fp);
  2836. s = MAX(s, 0); /* if( s < 0 ) s = 0; */
  2837. }
  2838. }
  2839. }
  2840. }
  2841. break;
  2842. case F_ERROR_X_N:
  2843. /* ERROR X */
  2844. {
  2845. /* P1BYT */
  2846. bwb_Warning(x, "");
  2847. N = 0;
  2848. }
  2849. break;
  2850. case F_ERROR_X_A_N:
  2851. /* ERROR X, A$ */
  2852. {
  2853. /* P1BYT */
  2854. bwb_Warning(x, A);
  2855. N = 0;
  2856. }
  2857. break;
  2858. case F_ERR_N:
  2859. /* N = ERR */
  2860. {
  2861. /* PNONE */
  2862. N = err_number;
  2863. }
  2864. break;
  2865. case F_ERL_N:
  2866. /* N = ERL */
  2867. {
  2868. /* PNONE */
  2869. if( err_line != NULL )
  2870. {
  2871. N = err_line->number;
  2872. }
  2873. }
  2874. break;
  2875. case F_ERR_S:
  2876. /* S = ERR$ */
  2877. {
  2878. /* PNONE */
  2879. s = strlen(ErrMsg);
  2880. if (s > 0)
  2881. {
  2882. strcpy(S, ErrMsg);
  2883. }
  2884. }
  2885. break;
  2886. /********************************************************************************************
  2887. **
  2888. ** Keep the platform specific functions together. They should all call bwx_* functions.
  2889. **
  2890. *********************************************************************************************/
  2891. case F_INP_X_N:
  2892. /* N = INP( X ) */
  2893. {
  2894. /* P1BYT */
  2895. IsError = 0xFF;
  2896. }
  2897. break;
  2898. case F_WAIT_X_Y_N:
  2899. /* WAIT X, Y */
  2900. {
  2901. /* P1NUM|P2NUM */
  2902. /* P1INT|P2BYT */
  2903. IsError = 0xFF;
  2904. }
  2905. break;
  2906. case F_WAIT_X_Y_Z_N:
  2907. /* WAIT X, Y, Z */
  2908. {
  2909. /* P1NUM|P2NUM|P3NUM */
  2910. /* P1INT|P2BYT|P3BYT */
  2911. IsError = 0xFF;
  2912. }
  2913. break;
  2914. case F_OUT_X_Y_N:
  2915. /* OUT X, Y */
  2916. {
  2917. /* P1NUM|P2NUM */
  2918. /* P1INT|P2BYT */
  2919. IsError = 0xFF;
  2920. }
  2921. break;
  2922. case F_PEEK_X_N:
  2923. /* N = PEEK( X ) */
  2924. {
  2925. /* P1INT */
  2926. IsError = 0xFF;
  2927. }
  2928. break;
  2929. case F_POKE_X_Y_N:
  2930. /* POKE X, Y */
  2931. {
  2932. /* P1NUM|P2NUM */
  2933. /* P1INT|P2BYT */
  2934. IsError = 0xFF;
  2935. }
  2936. break;
  2937. case F_CLS_N:
  2938. /* CLS */
  2939. {
  2940. /* PNONE */
  2941. switch (OptionTerminalType)
  2942. {
  2943. case C_OPTION_TERMINAL_NONE:
  2944. break;
  2945. case C_OPTION_TERMINAL_ADM_3A:
  2946. fprintf(stdout, "%c", 26);
  2947. break;
  2948. case C_OPTION_TERMINAL_ANSI:
  2949. fprintf(stdout, "%c[2J", 27);
  2950. fprintf(stdout, "%c[%d;%dH", 27, 1, 1);
  2951. break;
  2952. default:
  2953. IsError = 0xFF;
  2954. break;
  2955. }
  2956. fflush(stdout);
  2957. }
  2958. break;
  2959. case F_LOCATE_X_Y_N:
  2960. /* LOCATE X, Y */
  2961. {
  2962. /* P1NUM|P2NUM */
  2963. /* P1BYT|P2BYT */
  2964. switch (OptionTerminalType)
  2965. {
  2966. case C_OPTION_TERMINAL_NONE:
  2967. break;
  2968. case C_OPTION_TERMINAL_ADM_3A:
  2969. fprintf(stdout, "%c=%c%c", 27, x + 32, y + 32);
  2970. break;
  2971. case C_OPTION_TERMINAL_ANSI:
  2972. fprintf(stdout, "%c[%d;%dH", 27, x, y);
  2973. break;
  2974. default:
  2975. IsError = 0xFF;
  2976. break;
  2977. }
  2978. fflush(stdout);
  2979. }
  2980. break;
  2981. case F_COLOR_X_Y_N:
  2982. /* COLOR X, Y */
  2983. {
  2984. /* P1NUM|P2NUM */
  2985. /* P1BYT|P2BYT */
  2986. switch (OptionTerminalType)
  2987. {
  2988. case C_OPTION_TERMINAL_NONE:
  2989. break;
  2990. case C_OPTION_TERMINAL_ADM_3A:
  2991. break;
  2992. case C_OPTION_TERMINAL_ANSI:
  2993. fprintf(stdout, "%c[%d;%dm", 27, 30 + x, 40 + y);
  2994. break;
  2995. default:
  2996. IsError = 0xFF;
  2997. break;
  2998. }
  2999. fflush(stdout);
  3000. }
  3001. break;
  3002. case F_FILES_N:
  3003. /* FILES */
  3004. {
  3005. /* PNONE */
  3006. char Buffer[BasicStringLengthMax + 1];
  3007. struct bwb_variable *v;
  3008. v = var_find(DEFVNAME_FILES);
  3009. str_btoc(Buffer, var_getsval(v));
  3010. N = system(Buffer);
  3011. }
  3012. break;
  3013. case F_FILES_A_N:
  3014. /* FILES A$ */
  3015. {
  3016. /* P1BYT */
  3017. char Buffer[BasicStringLengthMax + 1];
  3018. struct bwb_variable *v;
  3019. v = var_find(DEFVNAME_FILES);
  3020. str_btoc(Buffer, var_getsval(v));
  3021. strcat(Buffer, " ");
  3022. strcat(Buffer, A);
  3023. N = system(Buffer);
  3024. }
  3025. break;
  3026. case F_FRE_N:
  3027. case F_FRE_X_N:
  3028. case F_FRE_A_N:
  3029. /* N = FRE( ) */
  3030. /* N = FRE( X ) */
  3031. /* N = FRE( X$ ) */
  3032. {
  3033. N = 32000; /* reasonable value */
  3034. }
  3035. break;
  3036. case F_SHELL_A_N:
  3037. /* N = SHELL( A$ ) */
  3038. {
  3039. /* P1BYT */
  3040. N = system(A);
  3041. }
  3042. break;
  3043. case F_CHDIR_A_N:
  3044. /* CHDIR A$ */
  3045. {
  3046. /* P1BYT */
  3047. #if DIRECTORY_CMDS
  3048. N = chdir(A);
  3049. #else
  3050. IsError = 0xFF;
  3051. #endif
  3052. }
  3053. break;
  3054. case F_MKDIR_A_N:
  3055. /* MKDIR A$ */
  3056. {
  3057. /* P1BYT */
  3058. #if DIRECTORY_CMDS
  3059. #if MKDIR_ONE_ARG
  3060. N = mkdir(A);
  3061. #else
  3062. N = mkdir(A, PERMISSIONS);
  3063. #endif
  3064. #else
  3065. IsError = 0xFF;
  3066. #endif
  3067. }
  3068. break;
  3069. case F_RMDIR_A_N:
  3070. /* RMDIR A$ */
  3071. {
  3072. /* P1BYT */
  3073. #if DIRECTORY_CMDS
  3074. N = rmdir(A);
  3075. #else
  3076. IsError = 0xFF;
  3077. #endif
  3078. }
  3079. break;
  3080. case F_KILL_A_N:
  3081. /* KILL A$ */
  3082. {
  3083. /* P1BYT */
  3084. N = remove(A);
  3085. }
  3086. break;
  3087. case F_NAME_A_B_N:
  3088. /* NAME A$ AS B$ */
  3089. /* N = NAME( A$, B$ ) */
  3090. {
  3091. /* P1BYT|P2BYT */
  3092. N = rename(A, B);
  3093. }
  3094. break;
  3095. case F_INPUT_X_S:
  3096. /* S$ = INPUT$( X ) */
  3097. {
  3098. /* P1LEN */
  3099. if (x == 0)
  3100. {
  3101. /* empty string */
  3102. }
  3103. else
  3104. {
  3105. for (s = 0; s < x; s++)
  3106. {
  3107. int c;
  3108. c = getchar();
  3109. if ((c == EOF) || (c == '\n') || (c == '\r'))
  3110. {
  3111. break;
  3112. }
  3113. S[s] = c;
  3114. }
  3115. S[s] = 0;
  3116. }
  3117. }
  3118. break;
  3119. case F_INKEY_S:
  3120. /* S$ = INKEY$ */
  3121. {
  3122. /* PNONE */
  3123. int c;
  3124. c = getchar();
  3125. if (c < 0 || c > 255)
  3126. {
  3127. /* EOF */
  3128. }
  3129. else
  3130. {
  3131. S[s] = c;
  3132. s++;
  3133. }
  3134. S[s] = 0;
  3135. }
  3136. break;
  3137. case F_NULL_X_N:
  3138. /* NULL X */
  3139. {
  3140. /* P1NUM */
  3141. /* P1BYT */
  3142. LPRINT_NULLS = x;
  3143. N = 0;
  3144. }
  3145. break;
  3146. case F_LWIDTH_X_N:
  3147. /* LWIDTH X */
  3148. {
  3149. /* P1NUM */
  3150. /* P1BYT */
  3151. LPRINT_WIDTH = x;
  3152. LPRINT_COLUMN = 1;
  3153. N = 0;
  3154. }
  3155. break;
  3156. case F_LPOS_N:
  3157. /* N = LPOS */
  3158. {
  3159. /* PNONE */
  3160. /* PNONE */
  3161. N = LPRINT_COLUMN;
  3162. }
  3163. break;
  3164. case F_TRON_N:
  3165. /* TRON */
  3166. {
  3167. /* PNONE */
  3168. prn_xprintf("Trace is ON\n");
  3169. bwb_trace = TRUE;
  3170. N = 0;
  3171. }
  3172. break;
  3173. case F_TROFF_N:
  3174. /* TROFF */
  3175. {
  3176. /* PNONE */
  3177. prn_xprintf("Trace is OFF\n");
  3178. bwb_trace = FALSE;
  3179. N = 0;
  3180. }
  3181. break;
  3182. case F_RANDOMIZE_N:
  3183. /* RANDOMIZE */
  3184. {
  3185. /* PNONE */
  3186. /* USE THE CURRENT TIME AS THE SEED */
  3187. time(&t);
  3188. lt = localtime(&t);
  3189. x = lt->tm_hour * 3600 + lt->tm_min * 60 + lt->tm_sec;
  3190. srand(x);
  3191. N = 0;
  3192. }
  3193. break;
  3194. case F_RANDOMIZE_X_N:
  3195. /* RANDOMIZE X */
  3196. {
  3197. /* P1NUM */
  3198. /* P1ANY */
  3199. x = rint( X );
  3200. srand(x);
  3201. N = 0;
  3202. }
  3203. break;
  3204. default:
  3205. {
  3206. /* NOT IMPLEMENTED ON THIS PLATFORM */
  3207. IsError = 0xFF;
  3208. }
  3209. }
  3210. /* sanity check */
  3211. if (IsError == 0)
  3212. {
  3213. if (f->ReturnType == STRING)
  3214. {
  3215. /* STRING */
  3216. if ( /* s < 0 || */ s > BasicStringLengthMax)
  3217. {
  3218. /* ERROR */
  3219. sprintf(bwb_ebuf, "INTERNAL ERROR (%s) INVALID STRING LENGTH", f->Name);
  3220. bwb_error(bwb_ebuf);
  3221. return NULL;
  3222. }
  3223. else
  3224. if (S != RESULT_BUFFER)
  3225. {
  3226. /* ERROR */
  3227. sprintf(bwb_ebuf, "INTERNAL ERROR (%s) INVALID STRING BUFFER", f->Name);
  3228. bwb_error(bwb_ebuf);
  3229. return NULL;
  3230. }
  3231. else
  3232. {
  3233. RESULT_LENGTH = s;
  3234. RESULT_BUFFER[RESULT_LENGTH] = '\0';
  3235. }
  3236. }
  3237. else
  3238. {
  3239. /* NUMBER */
  3240. if (isnan(N))
  3241. {
  3242. /* ERROR */
  3243. /* this means the parameters were not
  3244. * properly checked */
  3245. sprintf(bwb_ebuf, "INTERNAL ERROR (%s) NOT A NUMBER", f->Name);
  3246. bwb_error(bwb_ebuf);
  3247. return NULL;
  3248. }
  3249. else
  3250. if (isinf(N))
  3251. {
  3252. /* Evaluation of an expression results in an
  3253. * overflow (nonfatal, the recommended
  3254. * recovery procedure is to supply machine
  3255. * in- finity with the algebraically correct
  3256. * sign and continue). */
  3257. if (N < 0)
  3258. {
  3259. N = -DBL_MAX;
  3260. }
  3261. else
  3262. {
  3263. N = DBL_MAX;
  3264. }
  3265. bwb_Warning_Overflow("*** Arithmetic Overflow ***");
  3266. }
  3267. RESULT_NUMBER = N;
  3268. }
  3269. }
  3270. /* process errors */
  3271. if (IsError == 0xFF)
  3272. {
  3273. /* NOT IMPLEMENTED ON THIS PLATFORM */
  3274. sprintf(bwb_ebuf, "%s IS NOT IMPLEMENTED ON THIS PLATFORM", f->Name);
  3275. bwb_Warning_AdvancedFeature(bwb_ebuf);
  3276. }
  3277. else
  3278. if (IsError != 0)
  3279. {
  3280. /* ERROR */
  3281. char Buffer[80];
  3282. switch (IsError)
  3283. {
  3284. case 'A':
  3285. case 'B':
  3286. case 'C':
  3287. /* STRING parameter's value is invalid */
  3288. sprintf(Buffer, "%s(%c$)", f->Name, IsError);
  3289. break;
  3290. case 'X':
  3291. case 'Y':
  3292. case 'Z':
  3293. /* NUMBER parameter's value is invalid */
  3294. sprintf(Buffer, "%s(%c)", f->Name, IsError);
  3295. break;
  3296. default:
  3297. /* All other errors */
  3298. sprintf(Buffer, "%s() #%d", f->Name, IsError);
  3299. break;
  3300. }
  3301. sprintf(bwb_ebuf, "ILLEGAL FUUNCTION CALL: %s", Buffer);
  3302. bwb_Warning_InvalidParameter(bwb_ebuf);
  3303. }
  3304. return argv; /* released by exp_function() in bwb_elx.c */
  3305. }
  3306. /* EOF */