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.
 
 
 
 
 
 

4722 lines
93 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. /* Version 3.10 by Howard Wulf, AF5NE */
  28. /* */
  29. /* Version 3.20 by Howard Wulf, AF5NE */
  30. /* */
  31. /*---------------------------------------------------------------*/
  32. #include "bwbasic.h"
  33. #ifndef RAND_MAX
  34. #define RAND_MAX 32767
  35. #endif /* RAND_MAX */
  36. #ifndef PI
  37. #define PI 3.14159265358979323846
  38. #endif /* PI */
  39. #define FromDegreesToRadians( X ) ( X * PI / 180.0 )
  40. #define FromRadiansToDegrees( X ) ( X * 180.0 / PI )
  41. #define FromGradiansToRadians( X ) ( X * PI / 200.0 )
  42. #define FromRadiansToGradians( X ) ( X * 200.0 / PI )
  43. static time_t t;
  44. static struct tm *lt;
  45. /* ORD() Table 1 */
  46. /* ACRONYM */
  47. typedef struct
  48. {
  49. const int Value;
  50. const char *Name;
  51. } Acronym;
  52. #define NUM_ACRONYMS (34)
  53. Acronym AcronymTable[NUM_ACRONYMS] = {
  54. {0, "NUL"},
  55. {1, "SOH"},
  56. {2, "STX"},
  57. {3, "ETX"},
  58. {4, "EOT"},
  59. {5, "ENQ"},
  60. {6, "ACK"},
  61. {7, "BEL"},
  62. {8, "BS"},
  63. {9, "HT"},
  64. {10, "LF"},
  65. {11, "VT"},
  66. {12, "FF"},
  67. {13, "CR"},
  68. {14, "SO"},
  69. {15, "SI"},
  70. {16, "DLE"},
  71. {17, "DC1"},
  72. {18, "DC2"},
  73. {19, "DC3"},
  74. {20, "DC4"},
  75. {21, "NAK"},
  76. {22, "SYN"},
  77. {23, "ETB"},
  78. {24, "CAN"},
  79. {25, "EM"},
  80. {26, "SUB"},
  81. {27, "ESC"},
  82. {28, "FS"},
  83. {29, "GS"},
  84. {30, "RS"},
  85. {31, "US"},
  86. {32, "SP"},
  87. {127, "DEL"}
  88. };
  89. /* ... ORD() */
  90. extern VariableType *
  91. IntrinsicFunction_execute (int argc, VariableType * argv,
  92. IntrinsicFunctionType * f)
  93. {
  94. /* this is the generic handler for all intrinsic BASIC functions */
  95. /* Follow the BASIC naming conventions, so the code is easier to read and maintain */
  96. /* assign reasonable default values */
  97. VariableType *argn;
  98. /* Follow the BASIC naming conventions, so the code is easier to maintain */
  99. char *S; /* S$ - STRING functions */
  100. size_t s; /* LEN( S$ ) */
  101. DoubleType N; /* N - NUMBER functions */
  102. char *A; /* A$ - 1st STRING parameter */
  103. size_t a; /* LEN( A$ ) */
  104. char *B; /* B$ - 2nd STRING parameter */
  105. size_t b; /* LEN( B$ ) */
  106. #if FALSE /* keep third parameter */
  107. char *C; /* C$ - 3rd STRING parameter */
  108. size_t c; /* LEN( C$ ) */
  109. #endif
  110. DoubleType X; /* X - 1st NUMBER parameter */
  111. IntegerType x; /* CINT( X ) */
  112. DoubleType Y; /* Y - 2nd NUMBER parameter */
  113. IntegerType y; /* CINT( Y ) */
  114. #if FALSE /* keep third parameter */
  115. DoubleType Z; /* Z - 3rd NUMBER parameter */
  116. IntegerType z; /* CINT( Z ) */
  117. #endif
  118. assert (argc >= 0);
  119. assert (argv != NULL);
  120. assert (f != NULL);
  121. assert(My != NULL);
  122. assert(My->CurrentVersion != NULL);
  123. assert(My->SYSOUT != NULL);
  124. assert(My->SYSOUT->cfp != NULL);
  125. assert(My->SYSPRN != NULL);
  126. assert(My->SYSPRN->cfp != NULL);
  127. assert(My->SYSIN != NULL);
  128. assert(My->SYSIN->cfp != NULL);
  129. S = NULL;
  130. s = 0;
  131. N = 0;
  132. A = NULL;
  133. a = 0;
  134. B = NULL;
  135. b = 0;
  136. #if FALSE /* keep third parameter */
  137. C = NULL;
  138. c = 0;
  139. #endif
  140. X = 0;
  141. x = 0;
  142. Y = 0;
  143. y = 0;
  144. #if FALSE /* keep third parameter */
  145. Z = 0;
  146. z = 0;
  147. #endif
  148. if (f == NULL)
  149. {
  150. WARN_INTERNAL_ERROR;
  151. return NULL;
  152. }
  153. if (argc < 0)
  154. {
  155. WARN_INTERNAL_ERROR;
  156. return NULL;
  157. }
  158. /* the RETURN variable is the first variable in the 'argv' vaariable chain */
  159. if (argv == NULL)
  160. {
  161. WARN_INTERNAL_ERROR;
  162. return NULL;
  163. }
  164. if (VAR_IS_STRING (argv))
  165. {
  166. if (argv->Value.String == NULL)
  167. {
  168. WARN_INTERNAL_ERROR;
  169. return NULL;
  170. }
  171. if (RESULT_BUFFER == NULL)
  172. {
  173. WARN_INTERNAL_ERROR;
  174. return NULL;
  175. }
  176. RESULT_LENGTH = 0;
  177. RESULT_BUFFER[RESULT_LENGTH] = NulChar;
  178. }
  179. else
  180. {
  181. if (argv->Value.Number == NULL)
  182. {
  183. WARN_INTERNAL_ERROR;
  184. return NULL;
  185. }
  186. RESULT_NUMBER = 0;
  187. }
  188. argn = argv;
  189. /* don't make a bad situation worse */
  190. if (My->IsErrorPending /* Keep This */ )
  191. {
  192. /* An unrecognized NON-FATAL ERROR is pending. Just return a sane value. */
  193. /* LET N = LOG(SQR(X)) ' X = -1 */
  194. return argv;
  195. }
  196. /* so the following code is easier to read and maintain */
  197. {
  198. /* assign actual values */
  199. if (f->ReturnTypeCode == StringTypeCode)
  200. {
  201. S = RESULT_BUFFER;
  202. s = RESULT_LENGTH;
  203. }
  204. else
  205. {
  206. N = RESULT_NUMBER;
  207. }
  208. if (f->ParameterCount == 255 /* (...) */ )
  209. {
  210. /* ... VARIANT number of parameters */
  211. }
  212. else
  213. {
  214. int i;
  215. int StrCount; /* count of STRING parameters - NEVER > 3 */
  216. int NumCount; /* count of NUMBER parameters - NEVER > 3 */
  217. ParamTestType ParameterTests;
  218. StrCount = 0;
  219. NumCount = 0;
  220. ParameterTests = f->ParameterTests;
  221. for (i = 0; i < argc && i < MAX_TESTS && My->IsErrorPending == FALSE;
  222. i++)
  223. {
  224. argn = argn->next;
  225. if (argn == NULL)
  226. {
  227. WARN_INTERNAL_ERROR;
  228. return NULL;
  229. }
  230. if (VAR_IS_STRING (argn))
  231. {
  232. if (argn->Value.String == NULL)
  233. {
  234. WARN_INTERNAL_ERROR;
  235. return NULL;
  236. }
  237. StrCount++;
  238. switch (StrCount)
  239. {
  240. case 1:
  241. /* 1st STRING parameter = A$ */
  242. A = PARAM_BUFFER;
  243. a = PARAM_LENGTH;
  244. if (StringLengthCheck (ParameterTests, a))
  245. {
  246. WARN_ILLEGAL_FUNCTION_CALL;
  247. }
  248. else
  249. {
  250. A[a] = NulChar;
  251. }
  252. break;
  253. case 2:
  254. /* 2nd STRING parameter = B$ */
  255. B = PARAM_BUFFER;
  256. b = PARAM_LENGTH;
  257. if (StringLengthCheck (ParameterTests, b))
  258. {
  259. WARN_ILLEGAL_FUNCTION_CALL;
  260. }
  261. else
  262. {
  263. B[b] = NulChar;
  264. }
  265. break;
  266. #if FALSE /* keep third parameter */
  267. case 3:
  268. /* 3rd STRING parameter = C$ */
  269. /* not currently used */
  270. C = PARAM_BUFFER;
  271. c = PARAM_LENGTH;
  272. if (StringLengthCheck (ParameterTests, c))
  273. {
  274. WARN_ILLEGAL_FUNCTION_CALL;
  275. }
  276. else
  277. {
  278. C[c] = NulChar;
  279. }
  280. break;
  281. #endif
  282. default:
  283. /* Nth STRING parameter = ERROR */
  284. WARN_ILLEGAL_FUNCTION_CALL;
  285. break;
  286. }
  287. }
  288. else
  289. {
  290. if (argn->Value.Number == NULL)
  291. {
  292. WARN_INTERNAL_ERROR;
  293. return NULL;
  294. }
  295. NumCount++;
  296. switch (NumCount)
  297. {
  298. case 1:
  299. /* 1st NUMBER parameter = X */
  300. X = PARAM_NUMBER;
  301. if (NumberValueCheck (ParameterTests, X))
  302. {
  303. WARN_ILLEGAL_FUNCTION_CALL;
  304. }
  305. else
  306. {
  307. DoubleType R;
  308. R = bwb_rint (X);
  309. if (R < INT_MIN || R > INT_MAX)
  310. {
  311. /* certainly not a
  312. * classic BASIC
  313. * integer */
  314. }
  315. else
  316. {
  317. /* Many classic BASIC
  318. * intrinsic
  319. * functions use the
  320. * rounded integer
  321. * value. */
  322. x = (int) R;
  323. }
  324. }
  325. break;
  326. case 2:
  327. /* 2nd NUMBER parameter = Y */
  328. Y = PARAM_NUMBER;
  329. if (NumberValueCheck (ParameterTests, Y))
  330. {
  331. WARN_ILLEGAL_FUNCTION_CALL;
  332. }
  333. else
  334. {
  335. DoubleType R;
  336. R = bwb_rint (Y);
  337. if (R < INT_MIN || R > INT_MAX)
  338. {
  339. /* certainly not a
  340. * classic BASIC
  341. * integer */
  342. }
  343. else
  344. {
  345. /* Many classic BASIC
  346. * intrinsic
  347. * functions use the
  348. * rounded integer
  349. * value. */
  350. y = (int) R;
  351. }
  352. }
  353. break;
  354. #if FALSE /* keep third parameter */
  355. case 3:
  356. /* 3rd NUMBER parameter = Z */
  357. /* not currently used */
  358. Z = PARAM_NUMBER;
  359. if (NumberValueCheck (ParameterTests, Z))
  360. {
  361. WARN_ILLEGAL_FUNCTION_CALL;
  362. }
  363. else
  364. {
  365. DoubleType R;
  366. R = bwb_rint (Z);
  367. if (R < INT_MIN || R > INT_MAX)
  368. {
  369. /* certainly not a
  370. * classic BASIC
  371. * integer */
  372. }
  373. else
  374. {
  375. /* Many classic BASIC
  376. * intrinsic
  377. * functions use the
  378. * rounded integer
  379. * value. */
  380. z = (int) R;
  381. }
  382. }
  383. break;
  384. #endif
  385. default:
  386. /* Nth NUMBER parameter = ERROR */
  387. WARN_ILLEGAL_FUNCTION_CALL;
  388. break;
  389. }
  390. }
  391. ParameterTests = ParameterTests >> 4;
  392. }
  393. }
  394. }
  395. if (My->IsErrorPending /* Keep This */ )
  396. {
  397. /* An unrecognized NON-FATAL ERROR is pending. Just return a sane value. */
  398. /* LET N = LOG(SQR(X)) ' X = -1 */
  399. return argv;
  400. }
  401. /*
  402. **
  403. ** all parameters have been checked and are OK
  404. ** execute the intrinsic function
  405. **
  406. */
  407. switch (f->FunctionID)
  408. {
  409. /*
  410. **
  411. ** ALL paramters have been checked
  412. ** for TYPE MISMATCH and INVALID RANGE.
  413. ** ONLY A HANDFUL OF ERRORS CAN OCCUR
  414. **
  415. */
  416. case 0:
  417. {
  418. /* INTERNAL ERROR */
  419. WARN_INTERNAL_ERROR;
  420. }
  421. break;
  422. case F_ARGC_N:
  423. /* N = ARGC */
  424. {
  425. /* determine number of parameters to the current USER DEFINED FUNCTION */
  426. int n;
  427. n = 0;
  428. if (My->StackHead != NULL)
  429. {
  430. int Loop;
  431. StackType *StackItem;
  432. Loop = TRUE;
  433. for (StackItem = My->StackHead; StackItem != NULL && Loop == TRUE;
  434. StackItem = StackItem->next)
  435. {
  436. if (StackItem->LoopTopLine != NULL)
  437. {
  438. switch (StackItem->LoopTopLine->cmdnum)
  439. {
  440. case C_FUNCTION:
  441. case C_SUB:
  442. /* we have checked all the way to a FUNCTION or SUB boundary */
  443. /* FOUND */
  444. {
  445. VariableType *v;
  446. for (v = StackItem->local_variable; v != NULL && Loop == TRUE;
  447. v = v->next)
  448. {
  449. n++;
  450. }
  451. }
  452. Loop = FALSE;
  453. break;
  454. }
  455. }
  456. }
  457. }
  458. n--; /* FUNCTION or SUB name */
  459. N = n;
  460. }
  461. break;
  462. case F_ARGT4_X_S:
  463. /* S$ = ARGT$( X ) */
  464. {
  465. /* determine parameter type to the current USER DEFINED FUNCTION */
  466. int Found;
  467. int n;
  468. Found = FALSE;
  469. n = 0;
  470. s = 0;
  471. if (x < 1)
  472. {
  473. /* bad param number */
  474. }
  475. else if (My->StackHead != NULL)
  476. {
  477. int Loop;
  478. StackType *StackItem;
  479. Loop = TRUE;
  480. for (StackItem = My->StackHead; StackItem != NULL && Loop == TRUE;
  481. StackItem = StackItem->next)
  482. {
  483. if (StackItem->LoopTopLine != NULL)
  484. {
  485. switch (StackItem->LoopTopLine->cmdnum)
  486. {
  487. case C_FUNCTION:
  488. case C_SUB:
  489. /* we have checked all the way to a FUNCTION or SUB boundary */
  490. /* FOUND */
  491. {
  492. VariableType *v;
  493. for (v = StackItem->local_variable; v != NULL && Loop == TRUE;
  494. v = v->next)
  495. {
  496. if (n == x)
  497. {
  498. char Char;
  499. Char = TypeCode_to_Char (v->VariableTypeCode);
  500. if (Char)
  501. {
  502. S[0] = Char;
  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. WARN_ILLEGAL_FUNCTION_CALL;
  520. }
  521. }
  522. break;
  523. case F_ARGV4_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 if (My->StackHead != NULL)
  537. {
  538. int Loop;
  539. StackType *StackItem;
  540. Loop = TRUE;
  541. for (StackItem = My->StackHead; StackItem != NULL && Loop == TRUE;
  542. StackItem = StackItem->next)
  543. {
  544. if (StackItem->LoopTopLine != NULL)
  545. {
  546. switch (StackItem->LoopTopLine->cmdnum)
  547. {
  548. case C_FUNCTION:
  549. case C_SUB:
  550. /* we have checked all the way to a FUNCTION or SUB boundary */
  551. /* FOUND */
  552. {
  553. VariableType *v;
  554. for (v = StackItem->local_variable; v != NULL && Loop == TRUE;
  555. v = v->next)
  556. {
  557. if (n == x)
  558. {
  559. if (VAR_IS_STRING (v))
  560. {
  561. s = v->Value.String->length;
  562. bwb_memcpy (S, v->Value.String->sbuffer, s);
  563. Found = TRUE;
  564. }
  565. else
  566. {
  567. }
  568. Loop = FALSE;
  569. }
  570. n++;
  571. }
  572. }
  573. Loop = FALSE;
  574. break;
  575. }
  576. }
  577. }
  578. }
  579. if (Found == FALSE)
  580. {
  581. WARN_ILLEGAL_FUNCTION_CALL;
  582. }
  583. }
  584. break;
  585. case F_ARGV_X_N:
  586. /* S$ = ARGV( X ) */
  587. {
  588. /* determine parameter value to the current USER DEFINED FUNCTION */
  589. int Found;
  590. int n;
  591. Found = FALSE;
  592. n = 0;
  593. if (x < 1)
  594. {
  595. /* bad param number */
  596. }
  597. else if (My->StackHead != NULL)
  598. {
  599. int Loop;
  600. StackType *StackItem;
  601. Loop = TRUE;
  602. for (StackItem = My->StackHead; StackItem != NULL && Loop == TRUE;
  603. StackItem = StackItem->next)
  604. {
  605. if (StackItem->LoopTopLine != NULL)
  606. {
  607. switch (StackItem->LoopTopLine->cmdnum)
  608. {
  609. case C_FUNCTION:
  610. case C_SUB:
  611. /* we have checked all the way to a FUNCTION or SUB boundary */
  612. /* FOUND */
  613. {
  614. VariableType *v;
  615. for (v = StackItem->local_variable; v != NULL && Loop == TRUE;
  616. v = v->next)
  617. {
  618. if (n == x)
  619. {
  620. if (VAR_IS_STRING (v))
  621. {
  622. }
  623. else
  624. {
  625. N = *v->Value.Number;
  626. Found = TRUE;
  627. }
  628. Loop = FALSE;
  629. }
  630. n++;
  631. }
  632. }
  633. Loop = FALSE;
  634. break;
  635. }
  636. }
  637. }
  638. }
  639. if (Found == FALSE)
  640. {
  641. WARN_ILLEGAL_FUNCTION_CALL;
  642. }
  643. }
  644. break;
  645. case F_BASE_N:
  646. /* N = BASE */
  647. {
  648. /* PNONE */
  649. N = My->CurrentVersion->OptionBaseInteger; /* implicit lower bound */
  650. }
  651. break;
  652. case F_RESIDUE_N:
  653. /* N = RESIDUE */
  654. {
  655. /* PNONE */
  656. N = My->RESIDUE; /* Residue of the last integer divide */
  657. }
  658. case F_DIGITS_X_N:
  659. /* N = DIGITS( X ) */
  660. {
  661. /* P1BYT */
  662. if (x == 0)
  663. {
  664. /* default */
  665. x = SIGNIFICANT_DIGITS;
  666. }
  667. if (x < MINIMUM_DIGITS || x > MAXIMUM_DIGITS)
  668. {
  669. WARN_ILLEGAL_FUNCTION_CALL;
  670. }
  671. else
  672. {
  673. My->OptionDigitsInteger = x;
  674. }
  675. }
  676. break;
  677. case F_SCALE_X_N:
  678. case F_PRECISION_X_N:
  679. /* N = SCALE( X ) */
  680. /* N = PRECISION( X ) */
  681. {
  682. /* P1BYT */
  683. if (x < MINIMUM_SCALE || x > MAXIMUM_SCALE)
  684. {
  685. WARN_ILLEGAL_FUNCTION_CALL;
  686. }
  687. else
  688. {
  689. My->OptionScaleInteger = x;
  690. }
  691. }
  692. break;
  693. case F_DIGITS_X_Y_N:
  694. /* N = DIGITS( X, Y ) */
  695. {
  696. /* P1BYT | P2BYT */
  697. if (x == 0)
  698. {
  699. /* default */
  700. x = SIGNIFICANT_DIGITS;
  701. }
  702. if (x < MINIMUM_DIGITS || x > MAXIMUM_DIGITS)
  703. {
  704. WARN_ILLEGAL_FUNCTION_CALL;
  705. }
  706. else if (y < MINIMUM_SCALE || y > MAXIMUM_SCALE)
  707. {
  708. WARN_ILLEGAL_FUNCTION_CALL;
  709. }
  710. else
  711. {
  712. My->OptionDigitsInteger = x;
  713. My->OptionScaleInteger = y;
  714. }
  715. }
  716. break;
  717. case F_ASC_A_N:
  718. case F_ASCII_A_N:
  719. case F_CODE_A_N:
  720. /* N = ASC( A$ ) */
  721. /* N = ASCII( A$ ) */
  722. /* N = CODE( A$ ) */
  723. {
  724. /* P1BYT */
  725. N = A[0];
  726. }
  727. break;
  728. case F_ASC_A_X_N:
  729. /* N = ASC( A$, X ) */
  730. {
  731. /* P1BYT|P2POS */
  732. x--; /* BASIC -> C */
  733. if (x < a)
  734. {
  735. N = A[x];
  736. }
  737. else
  738. {
  739. WARN_ILLEGAL_FUNCTION_CALL;
  740. }
  741. }
  742. break;
  743. case F_CDBL_X_N:
  744. /* N = CDBL( X ) */
  745. {
  746. /* P1DBL */
  747. N = X;
  748. }
  749. break;
  750. case F_CSNG_X_N:
  751. /* N = CSNG( X ) */
  752. {
  753. /* P1FLT */
  754. N = X;
  755. }
  756. break;
  757. case F_CCUR_X_N:
  758. /* N = CCUR( X ) */
  759. {
  760. /* P1CUR */
  761. N = bwb_rint (X);
  762. }
  763. break;
  764. case F_CLNG_X_N:
  765. /* N = CLNG( X ) */
  766. {
  767. /* P1LNG */
  768. N = bwb_rint (X);
  769. }
  770. break;
  771. case F_CINT_X_N:
  772. /* N = CINT( X ) */
  773. {
  774. /* P1INT */
  775. N = bwb_rint (X);
  776. }
  777. break;
  778. case F_MKD4_X_S:
  779. /* S$ = MKD$( X ) */
  780. {
  781. /* P1DBL */
  782. DoubleType x;
  783. x = (DoubleType) X;
  784. s = sizeof (DoubleType);
  785. bwb_memcpy (S, &x, s);
  786. }
  787. break;
  788. case F_MKS4_X_S:
  789. /* S$ = MKS$( X ) */
  790. {
  791. /* P1FLT */
  792. SingleType x;
  793. x = (SingleType) X;
  794. s = sizeof (SingleType);
  795. bwb_memcpy (S, &x, s);
  796. }
  797. break;
  798. case F_MKI4_X_S:
  799. /* S$ = MKI$( X ) */
  800. {
  801. /* P1INT */
  802. IntegerType x;
  803. x = (IntegerType) bwb_rint (X);
  804. s = sizeof (IntegerType);
  805. bwb_memcpy (S, &x, s);
  806. }
  807. break;
  808. case F_MKL4_X_S:
  809. /* S$ = MKL$( X ) */
  810. {
  811. /* P1LNG */
  812. LongType x;
  813. x = (LongType) bwb_rint (X);
  814. s = sizeof (LongType);
  815. bwb_memcpy (S, &x, s);
  816. }
  817. break;
  818. case F_MKC4_X_S:
  819. /* S$ = MKC$( X ) */
  820. {
  821. /* P1CUR */
  822. CurrencyType x;
  823. x = (CurrencyType) bwb_rint (X);
  824. s = sizeof (CurrencyType);
  825. bwb_memcpy (S, &x, s);
  826. }
  827. break;
  828. case F_CVD_A_N:
  829. /* N = CVD( A$ ) */
  830. {
  831. /* P1DBL */
  832. DoubleType n;
  833. a = sizeof (DoubleType);
  834. bwb_memcpy (&n, A, a);
  835. N = n;
  836. }
  837. break;
  838. case F_CVS_A_N:
  839. /* N = CVS( X$ ) */
  840. {
  841. /* P1FLT */
  842. SingleType n;
  843. a = sizeof (SingleType);
  844. bwb_memcpy (&n, A, a);
  845. N = n;
  846. }
  847. break;
  848. case F_CVI_A_N:
  849. /* N = CVI( X$ ) */
  850. {
  851. /* P1INT */
  852. IntegerType n;
  853. a = sizeof (IntegerType);
  854. bwb_memcpy (&n, A, a);
  855. N = n;
  856. }
  857. break;
  858. case F_CVL_A_N:
  859. /* N = CVL( X$ ) */
  860. {
  861. /* P1LNG */
  862. LongType n;
  863. a = sizeof (LongType);
  864. bwb_memcpy (&n, A, a);
  865. N = n;
  866. }
  867. break;
  868. case F_CVC_A_N:
  869. /* N = CVC( X$ ) */
  870. {
  871. /* P1CUR */
  872. CurrencyType n;
  873. a = sizeof (CurrencyType);
  874. bwb_memcpy (&n, A, a);
  875. N = n;
  876. }
  877. break;
  878. case F_ENVIRON4_A_S:
  879. /* S$ = ENVIRON$( A$ ) */
  880. {
  881. /* P1BYT */
  882. char *CharPointer;
  883. CharPointer = getenv (A);
  884. if (CharPointer == NULL)
  885. {
  886. /* empty string */
  887. }
  888. else
  889. {
  890. s = bwb_strlen (CharPointer);
  891. if (s > MAXLEN)
  892. {
  893. WARN_STRING_TOO_LONG; /* F_ENVIRON4_A_S */
  894. s = MAXLEN;
  895. }
  896. if (s == 0)
  897. {
  898. /* empty string */
  899. }
  900. else
  901. {
  902. bwb_memcpy (S, CharPointer, s);
  903. }
  904. }
  905. }
  906. break;
  907. case F_ENVIRON_A_N:
  908. /* ENVIRON A$ */
  909. {
  910. /* P1BYT */
  911. char *CharPointer;
  912. CharPointer = bwb_strchr (A, '=');
  913. if (CharPointer == NULL)
  914. {
  915. /* missing required '=' */
  916. WARN_ILLEGAL_FUNCTION_CALL;
  917. }
  918. else
  919. {
  920. if (putenv (A) == -1)
  921. {
  922. WARN_ILLEGAL_FUNCTION_CALL;
  923. }
  924. else
  925. {
  926. /* OK */
  927. N = 0;
  928. }
  929. }
  930. }
  931. break;
  932. case F_OPEN_A_X_B_Y_N:
  933. /* OPEN "I"|"O"|"R"|"A", [#]n, filename [,rlen] */
  934. {
  935. /* P1STR|P2NUM|P3STR|P4NUM */
  936. /* P1BYT|P2INT|P3BYT|P4INT */
  937. while (*A == ' ')
  938. {
  939. A++; /* LTRIM$ */
  940. }
  941. bwb_file_open (*A, x, B, y);
  942. }
  943. break;
  944. case F_OPEN_A_X_B_N:
  945. /* default LEN is 128 for RANDOM, 0 for all others */
  946. /* OPEN "I"|"O"|"R"|"A", [#]n, filename [,rlen] */
  947. {
  948. /* P1STR|P2NUM|P3STR|P4NUM */
  949. /* P1BYT|P2INT|P3BYT|P4INT */
  950. y = 0;
  951. while (*A == ' ')
  952. {
  953. A++; /* LTRIM$ */
  954. }
  955. if (bwb_toupper (*A) == 'R')
  956. {
  957. /* default RANDOM record size */
  958. y = 128;
  959. }
  960. bwb_file_open (*A, x, B, y);
  961. }
  962. break;
  963. case F_LOC_X_N:
  964. /* N = LOC( X ) */
  965. {
  966. /* P1INT */
  967. if (x <= 0)
  968. {
  969. /* Printer and Console */
  970. N = 0;
  971. }
  972. else
  973. {
  974. FileType *F;
  975. F = find_file_by_number (x);
  976. if (F == NULL)
  977. {
  978. WARN_ILLEGAL_FUNCTION_CALL;
  979. }
  980. else if (F == My->SYSIN)
  981. {
  982. N = 0;
  983. }
  984. else if (F == My->SYSOUT)
  985. {
  986. N = 0;
  987. }
  988. else if (F == My->SYSPRN)
  989. {
  990. N = 0;
  991. }
  992. else
  993. {
  994. FILE *fp;
  995. fp = F->cfp;
  996. N = ftell (fp);
  997. if (My->CurrentVersion->OptionVersionValue & (G65 | G67 | G74))
  998. {
  999. /* byte position, regardless of 'mode' */
  1000. }
  1001. else if (F->DevMode == DEVMODE_RANDOM)
  1002. {
  1003. /* record number */
  1004. if (F->width == 0)
  1005. {
  1006. /* byte position */
  1007. }
  1008. else
  1009. {
  1010. N /= F->width;
  1011. }
  1012. }
  1013. else if (F->DevMode == DEVMODE_BINARY)
  1014. {
  1015. /* byte position */
  1016. }
  1017. else
  1018. {
  1019. /* byte positiion / 128 */
  1020. N /= 128;
  1021. }
  1022. N = floor (N);
  1023. N++; /* C to BASIC */
  1024. }
  1025. }
  1026. }
  1027. break;
  1028. case F_SEEK_X_N:
  1029. /* N = SEEK( X ) */
  1030. {
  1031. /* P1INT */
  1032. if (x <= 0)
  1033. {
  1034. /* Printer and Console */
  1035. N = 0;
  1036. }
  1037. else
  1038. {
  1039. FileType *F;
  1040. F = find_file_by_number (x);
  1041. if (F == NULL)
  1042. {
  1043. WARN_ILLEGAL_FUNCTION_CALL;
  1044. }
  1045. else if (F == My->SYSIN)
  1046. {
  1047. N = 0;
  1048. }
  1049. else if (F == My->SYSOUT)
  1050. {
  1051. N = 0;
  1052. }
  1053. else if (F == My->SYSPRN)
  1054. {
  1055. N = 0;
  1056. }
  1057. else
  1058. {
  1059. FILE *fp;
  1060. fp = F->cfp;
  1061. N = ftell (fp);
  1062. if (F->DevMode == DEVMODE_RANDOM)
  1063. {
  1064. /* record number */
  1065. if (F->width > 0)
  1066. {
  1067. N /= F->width;
  1068. }
  1069. }
  1070. else
  1071. {
  1072. /* byte positiion */
  1073. }
  1074. N = floor (N);
  1075. N++; /* C to BASIC */
  1076. }
  1077. }
  1078. }
  1079. break;
  1080. case F_SEEK_X_Y_N:
  1081. /* SEEK X, Y */
  1082. {
  1083. /* P1INT|P2INT */
  1084. if (x <= 0)
  1085. {
  1086. /* Printer and Console */
  1087. WARN_ILLEGAL_FUNCTION_CALL;
  1088. }
  1089. else
  1090. {
  1091. FileType *F;
  1092. F = find_file_by_number (x);
  1093. if (F == NULL)
  1094. {
  1095. WARN_ILLEGAL_FUNCTION_CALL;
  1096. }
  1097. else if (F == My->SYSIN)
  1098. {
  1099. WARN_ILLEGAL_FUNCTION_CALL;
  1100. }
  1101. else if (F == My->SYSOUT)
  1102. {
  1103. WARN_ILLEGAL_FUNCTION_CALL;
  1104. }
  1105. else if (F == My->SYSPRN)
  1106. {
  1107. WARN_ILLEGAL_FUNCTION_CALL;
  1108. }
  1109. else if (y < 1)
  1110. {
  1111. WARN_ILLEGAL_FUNCTION_CALL;
  1112. }
  1113. else
  1114. {
  1115. long offset;
  1116. offset = y;
  1117. offset--; /* BASIC to C */
  1118. if (F->DevMode == DEVMODE_RANDOM)
  1119. {
  1120. if (F->width > 0)
  1121. {
  1122. offset *= F->width;
  1123. }
  1124. }
  1125. if (fseek (F->cfp, offset, SEEK_SET) != 0)
  1126. {
  1127. WARN_ILLEGAL_FUNCTION_CALL;
  1128. }
  1129. else
  1130. {
  1131. /* OK */
  1132. N = 0;
  1133. }
  1134. }
  1135. }
  1136. }
  1137. break;
  1138. case F_LOF_X_N:
  1139. /* N = LOF( X ) */
  1140. {
  1141. /* P1INT */
  1142. if (x <= 0)
  1143. {
  1144. /* Printer and Console */
  1145. N = 0;
  1146. }
  1147. else
  1148. {
  1149. FileType *F;
  1150. F = find_file_by_number (x);
  1151. if (F == NULL)
  1152. {
  1153. WARN_ILLEGAL_FUNCTION_CALL;
  1154. }
  1155. else if (F == My->SYSIN)
  1156. {
  1157. N = 0;
  1158. }
  1159. else if (F == My->SYSOUT)
  1160. {
  1161. N = 0;
  1162. }
  1163. else if (F == My->SYSPRN)
  1164. {
  1165. N = 0;
  1166. }
  1167. else
  1168. {
  1169. /* file size in bytes */
  1170. FILE *fp;
  1171. long current;
  1172. long total;
  1173. fp = F->cfp;
  1174. current = ftell (fp);
  1175. fseek (fp, 0, SEEK_END);
  1176. total = ftell (fp);
  1177. if (total == current)
  1178. {
  1179. /* EOF */
  1180. }
  1181. else
  1182. {
  1183. fseek (fp, current, SEEK_SET);
  1184. }
  1185. N = total;
  1186. }
  1187. }
  1188. }
  1189. break;
  1190. case F_EOF_X_N:
  1191. /* N = EOF( X ) */
  1192. {
  1193. /* P1INT */
  1194. if (x <= 0)
  1195. {
  1196. /* Printer and Console */
  1197. N = 0;
  1198. }
  1199. else
  1200. {
  1201. FileType *F;
  1202. F = find_file_by_number (x);
  1203. if (F == NULL)
  1204. {
  1205. WARN_ILLEGAL_FUNCTION_CALL;
  1206. }
  1207. else if (F == My->SYSIN)
  1208. {
  1209. N = 0;
  1210. }
  1211. else if (F == My->SYSOUT)
  1212. {
  1213. N = 0;
  1214. }
  1215. else if (F == My->SYSPRN)
  1216. {
  1217. N = 0;
  1218. }
  1219. else
  1220. {
  1221. /* are we at the end? */
  1222. N = bwb_is_eof (F->cfp);
  1223. }
  1224. }
  1225. }
  1226. break;
  1227. case F_FILEATTR_X_Y_N:
  1228. /* N = FILEATTR( X, Y ) */
  1229. {
  1230. /* P1INT|P2INT */
  1231. if (x <= 0)
  1232. {
  1233. /* Printer and Console */
  1234. WARN_ILLEGAL_FUNCTION_CALL;
  1235. }
  1236. else if (y == 1)
  1237. {
  1238. FileType *F;
  1239. F = find_file_by_number (x);
  1240. if (F == NULL)
  1241. {
  1242. /* normal CLOSED file */
  1243. N = 0;
  1244. }
  1245. else
  1246. {
  1247. /* normal OPEN file */
  1248. N = F->DevMode;
  1249. }
  1250. }
  1251. else if (y == 2)
  1252. {
  1253. N = 0;
  1254. }
  1255. else
  1256. {
  1257. WARN_ILLEGAL_FUNCTION_CALL;
  1258. }
  1259. }
  1260. break;
  1261. case F_CLOSE_X_N:
  1262. /* CLOSE X */
  1263. {
  1264. /* P1INT */
  1265. if (x <= 0)
  1266. {
  1267. /* Printer and Console */
  1268. WARN_ILLEGAL_FUNCTION_CALL;
  1269. }
  1270. else
  1271. {
  1272. FileType *F;
  1273. F = find_file_by_number (x);
  1274. if (F == NULL)
  1275. {
  1276. WARN_ILLEGAL_FUNCTION_CALL;
  1277. }
  1278. else if (F == My->SYSIN)
  1279. {
  1280. WARN_ILLEGAL_FUNCTION_CALL;
  1281. }
  1282. else if (F == My->SYSOUT)
  1283. {
  1284. WARN_ILLEGAL_FUNCTION_CALL;
  1285. }
  1286. else if (F == My->SYSPRN)
  1287. {
  1288. WARN_ILLEGAL_FUNCTION_CALL;
  1289. }
  1290. else
  1291. {
  1292. field_close_file (F);
  1293. file_clear (F);
  1294. N = 0;
  1295. }
  1296. }
  1297. }
  1298. break;
  1299. case F_RESET_N:
  1300. case F_CLOSE_N:
  1301. /* RESET */
  1302. /* CLOSE */
  1303. {
  1304. /* PNONE */
  1305. FileType *F;
  1306. for (F = My->FileHead; F != NULL; F = F->next)
  1307. {
  1308. field_close_file (F);
  1309. file_clear (F);
  1310. }
  1311. }
  1312. break;
  1313. case F_FREEFILE_N:
  1314. /* N = FREEFILE */
  1315. {
  1316. /* PNONE */
  1317. FileType *F;
  1318. x = 0;
  1319. y = 0;
  1320. for (F = My->FileHead; F != NULL; F = F->next)
  1321. {
  1322. if (F->DevMode != DEVMODE_CLOSED)
  1323. {
  1324. if (F->FileNumber > x)
  1325. {
  1326. x = F->FileNumber;
  1327. }
  1328. y++;
  1329. }
  1330. }
  1331. /* 'x' is the highest FileNumber that is currently open */
  1332. /* 'y' is the number of files that are currently open */
  1333. x++;
  1334. if (y >= MAXDEV)
  1335. {
  1336. /* no more slots available */
  1337. x = 0;
  1338. }
  1339. N = x;
  1340. }
  1341. break;
  1342. case F_GET_X_Y_N:
  1343. /* GET X, Y */
  1344. {
  1345. /* P1INT|P2INT */
  1346. if (x <= 0)
  1347. {
  1348. /* Printer and Console */
  1349. WARN_ILLEGAL_FUNCTION_CALL;
  1350. }
  1351. else
  1352. {
  1353. FileType *F;
  1354. F = find_file_by_number (x);
  1355. if (F == NULL)
  1356. {
  1357. WARN_ILLEGAL_FUNCTION_CALL;
  1358. }
  1359. else if (F == My->SYSIN)
  1360. {
  1361. WARN_ILLEGAL_FUNCTION_CALL;
  1362. }
  1363. else if (F == My->SYSOUT)
  1364. {
  1365. WARN_ILLEGAL_FUNCTION_CALL;
  1366. }
  1367. else if (F == My->SYSPRN)
  1368. {
  1369. WARN_ILLEGAL_FUNCTION_CALL;
  1370. }
  1371. else if (F->DevMode != DEVMODE_RANDOM)
  1372. {
  1373. WARN_ILLEGAL_FUNCTION_CALL;
  1374. }
  1375. else if (y < 1)
  1376. {
  1377. WARN_ILLEGAL_FUNCTION_CALL;
  1378. }
  1379. else
  1380. {
  1381. long offset;
  1382. offset = y;
  1383. offset--; /* BASIC to C */
  1384. if (F->DevMode == DEVMODE_RANDOM)
  1385. {
  1386. if (F->width > 0)
  1387. {
  1388. offset *= F->width;
  1389. }
  1390. }
  1391. if (fseek (F->cfp, offset, SEEK_SET) != 0)
  1392. {
  1393. WARN_ILLEGAL_FUNCTION_CALL;
  1394. }
  1395. else
  1396. {
  1397. int i;
  1398. for (i = 0; i < F->width; i++)
  1399. {
  1400. F->buffer[i] = fgetc (F->cfp);
  1401. }
  1402. field_get (F);
  1403. N = 0;
  1404. }
  1405. }
  1406. }
  1407. }
  1408. break;
  1409. case F_GET_X_N:
  1410. if (My->CurrentVersion->OptionVersionValue & (D73))
  1411. {
  1412. /* GET( X ) == ASC(INKEY$), X is ignored */
  1413. /* P1ANY */
  1414. int c;
  1415. c = fgetc (My->SYSIN->cfp);
  1416. N = c;
  1417. }
  1418. else
  1419. {
  1420. /* GET X */
  1421. /* P1INT */
  1422. if (x <= 0)
  1423. {
  1424. /* Printer and Console */
  1425. WARN_ILLEGAL_FUNCTION_CALL;
  1426. }
  1427. else
  1428. {
  1429. FileType *F;
  1430. F = find_file_by_number (x);
  1431. if (F == NULL)
  1432. {
  1433. WARN_ILLEGAL_FUNCTION_CALL;
  1434. }
  1435. else if (F == My->SYSIN)
  1436. {
  1437. WARN_ILLEGAL_FUNCTION_CALL;
  1438. }
  1439. else if (F == My->SYSOUT)
  1440. {
  1441. WARN_ILLEGAL_FUNCTION_CALL;
  1442. }
  1443. else if (F == My->SYSPRN)
  1444. {
  1445. WARN_ILLEGAL_FUNCTION_CALL;
  1446. }
  1447. else if (F->DevMode != DEVMODE_RANDOM)
  1448. {
  1449. WARN_ILLEGAL_FUNCTION_CALL;
  1450. }
  1451. else
  1452. {
  1453. {
  1454. int i;
  1455. for (i = 0; i < F->width; i++)
  1456. {
  1457. F->buffer[i] = fgetc (F->cfp);
  1458. }
  1459. field_get (F);
  1460. N = 0;
  1461. }
  1462. }
  1463. }
  1464. }
  1465. break;
  1466. case F_PUT_X_Y_N:
  1467. /* PUT X, Y */
  1468. {
  1469. /* P1INT|P2INT */
  1470. if (x <= 0)
  1471. {
  1472. /* Printer and Console */
  1473. WARN_ILLEGAL_FUNCTION_CALL;
  1474. }
  1475. else
  1476. {
  1477. FileType *F;
  1478. F = find_file_by_number (x);
  1479. if (F == NULL)
  1480. {
  1481. WARN_ILLEGAL_FUNCTION_CALL;
  1482. }
  1483. else if (F == My->SYSIN)
  1484. {
  1485. WARN_ILLEGAL_FUNCTION_CALL;
  1486. }
  1487. else if (F == My->SYSOUT)
  1488. {
  1489. WARN_ILLEGAL_FUNCTION_CALL;
  1490. }
  1491. else if (F == My->SYSPRN)
  1492. {
  1493. WARN_ILLEGAL_FUNCTION_CALL;
  1494. }
  1495. else if (F->DevMode != DEVMODE_RANDOM)
  1496. {
  1497. WARN_ILLEGAL_FUNCTION_CALL;
  1498. }
  1499. else if (y < 1)
  1500. {
  1501. WARN_ILLEGAL_FUNCTION_CALL;
  1502. }
  1503. else
  1504. {
  1505. long offset;
  1506. offset = y;
  1507. offset--; /* BASIC to C */
  1508. if (F->DevMode == DEVMODE_RANDOM)
  1509. {
  1510. if (F->width > 0)
  1511. {
  1512. offset *= F->width;
  1513. }
  1514. }
  1515. if (fseek (F->cfp, offset, SEEK_SET) != 0)
  1516. {
  1517. WARN_ILLEGAL_FUNCTION_CALL;
  1518. }
  1519. else
  1520. {
  1521. int i;
  1522. field_put (F);
  1523. for (i = 0; i < F->width; i++)
  1524. {
  1525. fputc (F->buffer[i], F->cfp);
  1526. F->buffer[i] = ' '; /* flush */
  1527. }
  1528. N = 0;
  1529. }
  1530. }
  1531. }
  1532. }
  1533. break;
  1534. case F_PUT_X_N:
  1535. if (My->CurrentVersion->OptionVersionValue & (D73))
  1536. {
  1537. /* PUT( X ) == PRINT CHR$(X); */
  1538. /* P1BYT */
  1539. fputc (x, My->SYSOUT->cfp);
  1540. N = x;
  1541. }
  1542. else
  1543. {
  1544. /* PUT X */
  1545. /* P1INT */
  1546. if (x <= 0)
  1547. {
  1548. /* Printer and Console */
  1549. WARN_ILLEGAL_FUNCTION_CALL;
  1550. }
  1551. else
  1552. {
  1553. FileType *F;
  1554. F = find_file_by_number (x);
  1555. if (F == NULL)
  1556. {
  1557. WARN_ILLEGAL_FUNCTION_CALL;
  1558. }
  1559. else if (F == My->SYSIN)
  1560. {
  1561. WARN_ILLEGAL_FUNCTION_CALL;
  1562. }
  1563. else if (F == My->SYSOUT)
  1564. {
  1565. WARN_ILLEGAL_FUNCTION_CALL;
  1566. }
  1567. else if (F == My->SYSPRN)
  1568. {
  1569. WARN_ILLEGAL_FUNCTION_CALL;
  1570. }
  1571. else if (F->DevMode != DEVMODE_RANDOM)
  1572. {
  1573. WARN_ILLEGAL_FUNCTION_CALL;
  1574. }
  1575. else
  1576. {
  1577. {
  1578. int i;
  1579. field_put (F);
  1580. for (i = 0; i < F->width; i++)
  1581. {
  1582. fputc (F->buffer[i], F->cfp);
  1583. F->buffer[i] = ' '; /* flush */
  1584. }
  1585. N = 0;
  1586. }
  1587. }
  1588. }
  1589. }
  1590. break;
  1591. case F_WIDTH_X_N:
  1592. /* WIDTH X */
  1593. {
  1594. /* P1BYT */
  1595. /* console is #0 */
  1596. My->SYSIN->width = x;
  1597. My->SYSIN->col = 1;
  1598. My->SYSOUT->width = x;
  1599. My->SYSOUT->col = 1;
  1600. N = 0;
  1601. }
  1602. break;
  1603. case F_WIDTH_X_Y_N:
  1604. /* WIDTH X, Y */
  1605. {
  1606. /* WIDTH #file, cols */
  1607. /* P1INT|PB2YT */
  1608. if (x == 0)
  1609. {
  1610. My->SYSIN->width = y;
  1611. My->SYSOUT->width = y;
  1612. N = 0;
  1613. }
  1614. else if (x < 0)
  1615. {
  1616. My->SYSPRN->width = y;
  1617. N = 0;
  1618. }
  1619. else
  1620. {
  1621. FileType *F;
  1622. F = find_file_by_number (x);
  1623. if (F == NULL)
  1624. {
  1625. /* WIDTH rows, cols */
  1626. My->SCREEN_ROWS = x;
  1627. My->SYSIN->width = y;
  1628. My->SYSIN->col = 1;
  1629. My->SYSOUT->width = y;
  1630. My->SYSOUT->col = 1;
  1631. N = 0;
  1632. }
  1633. else if (F->DevMode == DEVMODE_RANDOM)
  1634. {
  1635. WARN_ILLEGAL_FUNCTION_CALL;
  1636. }
  1637. else
  1638. {
  1639. /* WIDTH # file, cols */
  1640. F->width = y;
  1641. F->col = 1;
  1642. N = 0;
  1643. }
  1644. }
  1645. }
  1646. break;
  1647. case F_INSTR_X_A_B_N:
  1648. case F_INSTR_A_B_X_N:
  1649. /* N = INSTR( X, A$, B$ ) */
  1650. /* N = INSTR( A$, B$, X ) */
  1651. {
  1652. /* P1POS */
  1653. if (a == 0)
  1654. {
  1655. /* empty searched */
  1656. }
  1657. else if (b == 0)
  1658. {
  1659. /* empty pattern */
  1660. }
  1661. else if (b > a)
  1662. {
  1663. /* pattern is longer than searched */
  1664. }
  1665. else
  1666. {
  1667. /* search */
  1668. int i;
  1669. int n;
  1670. n = a - b; /* last valid search position */
  1671. n++;
  1672. x--; /* BASIC to C */
  1673. A += x; /* advance to the start
  1674. * position */
  1675. for (i = x; i < n; i++)
  1676. {
  1677. if (bwb_memcmp (A, B, b) == 0)
  1678. {
  1679. /* FOU ND */
  1680. i++; /* C to BASIC */
  1681. N = i;
  1682. i = n; /* exit for */
  1683. }
  1684. A++;
  1685. }
  1686. }
  1687. }
  1688. break;
  1689. case F_INSTR_A_B_N:
  1690. case F_INDEX_A_B_N:
  1691. /* N = INSTR( A$, B$ ) */
  1692. /* N = INDEX( A$, B$ ) */
  1693. {
  1694. if (a == 0)
  1695. {
  1696. /* empty searched */
  1697. }
  1698. else if (b == 0)
  1699. {
  1700. /* empty pattern */
  1701. }
  1702. else if (b > a)
  1703. {
  1704. /* pattern is longer than searched */
  1705. }
  1706. else
  1707. {
  1708. /* search */
  1709. int i;
  1710. int n;
  1711. n = a - b; /* last valid search
  1712. * position */
  1713. n++;
  1714. /* search */
  1715. for (i = 0; i < n; i++)
  1716. {
  1717. if (bwb_memcmp (A, B, b) == 0)
  1718. {
  1719. /* FOU ND */
  1720. i++; /* C to BASIC */
  1721. N = i;
  1722. i = n; /* exit for */
  1723. }
  1724. A++;
  1725. }
  1726. }
  1727. }
  1728. break;
  1729. case F_SPACE4_X_S:
  1730. case F_SPACE_X_S:
  1731. case F_SPA_X_S:
  1732. /* S$ = SPACE$( X ) */
  1733. /* S$ = SPACE( X ) */
  1734. /* S$ = SPA( X ) */
  1735. {
  1736. /* P1LEN */
  1737. if (x == 0)
  1738. {
  1739. /* no copies */
  1740. }
  1741. else
  1742. {
  1743. bwb_memset (S, (char) ' ', x);
  1744. s = x;
  1745. }
  1746. }
  1747. break;
  1748. case F_STRING4_X_Y_S:
  1749. case F_STRING_X_Y_S:
  1750. case F_STR_X_Y_S:
  1751. /* S$ = STRING$( X, Y ) */
  1752. /* S$ = STRING( X, Y ) */
  1753. /* S$ = STR( X, Y ) */
  1754. {
  1755. /* P1LEN|P2BYT */
  1756. if (x == 0)
  1757. {
  1758. /* no copies */
  1759. }
  1760. else
  1761. {
  1762. bwb_memset (S, (char) y, x);
  1763. s = x;
  1764. }
  1765. }
  1766. break;
  1767. case F_STRING4_X_A_S:
  1768. /* S$ = STRING$( X, A$ ) */
  1769. {
  1770. /* P1LEN|P2BYT */
  1771. if (x == 0)
  1772. {
  1773. /* no copies */
  1774. }
  1775. else
  1776. {
  1777. bwb_memset (S, (char) A[0], x);
  1778. s = x;
  1779. }
  1780. }
  1781. break;
  1782. case F_LIN_X_S:
  1783. /* S$ = LIN( X ) */
  1784. {
  1785. /* P1LEN */
  1786. if (x == 0)
  1787. {
  1788. /* no copies */
  1789. }
  1790. else
  1791. {
  1792. bwb_memset (S, (char) '\n', x);
  1793. s = x;
  1794. }
  1795. }
  1796. break;
  1797. case F_MID4_A_X_S:
  1798. case F_MID_A_X_S:
  1799. /* S$ = MID$( A$, X ) */
  1800. /* S$ = MID( A$, X ) */
  1801. {
  1802. /* P1ANY|P2POS */
  1803. if (a == 0)
  1804. {
  1805. /* empty string */
  1806. }
  1807. else if (x > a)
  1808. {
  1809. /* start beyond length */
  1810. }
  1811. else
  1812. {
  1813. x--; /* BASIC to C */
  1814. a -= x; /* nummber of characters to
  1815. * copy */
  1816. A += x; /* pointer to first character
  1817. * to copy */
  1818. bwb_memcpy (S, A, a);
  1819. s = a;
  1820. }
  1821. }
  1822. break;
  1823. case F_MID4_A_X_Y_S:
  1824. case F_MID_A_X_Y_S:
  1825. case F_SEG4_A_X_Y_S:
  1826. case F_SEG_A_X_Y_S:
  1827. /* S$ = MID$( A$, X, Y ) */
  1828. /* S$ = MID( A$, X, Y ) */
  1829. /* S$ = SEG$( A$, X, Y ) */
  1830. /* S$ = SEG( A$, X, Y ) */
  1831. {
  1832. /* P1ANY|P2POS|P3LEN */
  1833. if (a == 0)
  1834. {
  1835. /* empty string */
  1836. }
  1837. else if (x > a)
  1838. {
  1839. /* start beyond length */
  1840. }
  1841. else if (y == 0)
  1842. {
  1843. /* empty string */
  1844. }
  1845. else
  1846. {
  1847. x--; /* BASIC to C */
  1848. a -= x;
  1849. /* maximum nummber of characters to
  1850. * copy */
  1851. a = MIN (a, y);
  1852. A += x;
  1853. /* pointer to first character to copy */
  1854. bwb_memcpy (S, A, a);
  1855. s = a;
  1856. }
  1857. }
  1858. break;
  1859. case F_LEFT4_A_X_S:
  1860. case F_LEFT_A_X_S:
  1861. /* S$ = LEFT$( A$, X ) */
  1862. /* S$ = LEFT( A$, X ) */
  1863. {
  1864. /* P1ANY|P2LEN */
  1865. if (a == 0)
  1866. {
  1867. /* empty string */
  1868. }
  1869. else if (x == 0)
  1870. {
  1871. /* empty string */
  1872. }
  1873. else
  1874. {
  1875. a = MIN (a, x);
  1876. bwb_memcpy (S, A, a);
  1877. s = a;
  1878. }
  1879. }
  1880. break;
  1881. case F_RIGHT4_A_X_S:
  1882. case F_RIGHT_A_X_S:
  1883. /* S$ = RIGHT$( A$, X ) */
  1884. /* S$ = RIGHT( A$, X ) */
  1885. {
  1886. /* P1ANY|P2LEN */
  1887. if (a == 0)
  1888. {
  1889. /* empty string */
  1890. }
  1891. else if (x == 0)
  1892. {
  1893. /* empty string */
  1894. }
  1895. else
  1896. {
  1897. x = MIN (a, x);
  1898. A += a;
  1899. A -= x;
  1900. bwb_memcpy (S, A, x);
  1901. s = x;
  1902. }
  1903. }
  1904. break;
  1905. case F_HEX_A_N:
  1906. /* N = HEX( A$ ) */
  1907. {
  1908. if (a == 0)
  1909. {
  1910. /* empty string */
  1911. }
  1912. else
  1913. {
  1914. N = strtoul (A, (char **) NULL, 16);
  1915. }
  1916. }
  1917. break;
  1918. case F_HEX4_X_S:
  1919. /* S$ = HEX$( X ) */
  1920. {
  1921. /* P1NUM */
  1922. /* P1INT */
  1923. sprintf (S, "%X", x);
  1924. s = bwb_strlen (S);
  1925. }
  1926. break;
  1927. case F_HEX4_X_Y_S:
  1928. /* S$ = HEX$( X, Y ) */
  1929. {
  1930. /* P1NUM | P2NUM */
  1931. /* P1INT | P2BYT */
  1932. if (y == 0)
  1933. {
  1934. /* empty string */
  1935. }
  1936. else
  1937. {
  1938. sprintf (S, "%0*X", y, x);
  1939. s = bwb_strlen (S);
  1940. if (y < s)
  1941. {
  1942. A = S;
  1943. a = s - y; /* number of characters to trim */
  1944. A += a;
  1945. bwb_strcpy (S, A);
  1946. }
  1947. }
  1948. }
  1949. break;
  1950. case F_OCT4_X_S:
  1951. /* S$ = OCT$( X ) */
  1952. {
  1953. /* P1NUM */
  1954. /* P1INT */
  1955. sprintf (S, "%o", x);
  1956. s = bwb_strlen (S);
  1957. }
  1958. break;
  1959. case F_OCT4_X_Y_S:
  1960. /* S$ = OCT$( X, Y ) */
  1961. {
  1962. /* P1NUM | P2NUM */
  1963. /* P1INT | P2BYT */
  1964. if (y == 0)
  1965. {
  1966. /* empty string */
  1967. }
  1968. else
  1969. {
  1970. sprintf (S, "%0*o", y, x);
  1971. s = bwb_strlen (S);
  1972. if (y < s)
  1973. {
  1974. A = S;
  1975. a = s - y; /* number of characters to trim */
  1976. A += a;
  1977. bwb_strcpy (S, A);
  1978. }
  1979. }
  1980. }
  1981. break;
  1982. case F_BIN4_X_S:
  1983. /* S$ = BIN$( X ) */
  1984. {
  1985. /* P1NUM */
  1986. /* P1INT */
  1987. /*
  1988. **
  1989. ** we break this problem into two parts:
  1990. ** 1. generate the default string
  1991. ** 2. trim leading zeroes on the left
  1992. **
  1993. */
  1994. unsigned long z;
  1995. z = (unsigned long) x;
  1996. A = My->NumLenBuffer;
  1997. a = sizeof (z) * CHAR_BIT;
  1998. s = a;
  1999. bwb_memset (A, '0', a);
  2000. A[a] = NulChar;
  2001. while (a)
  2002. {
  2003. /* look at the Least Significant Bit */
  2004. a--;
  2005. if (z & 1)
  2006. {
  2007. A[a] = '1';
  2008. }
  2009. z /= 2;
  2010. }
  2011. /* bwb_strcpy( S, A ); */
  2012. /* same as HEX$(X) and OCT$(X), trim leading zeroes */
  2013. while (*A == '0')
  2014. {
  2015. A++;
  2016. }
  2017. if (*A)
  2018. {
  2019. bwb_strcpy (S, A);
  2020. }
  2021. else
  2022. {
  2023. /* special case (x == 0), we trimmed all the zeroes above */
  2024. S[0] = '0';
  2025. s = 1;
  2026. }
  2027. }
  2028. break;
  2029. case F_BIN4_X_Y_S:
  2030. /* S$ = BIN$( X, Y ) */
  2031. {
  2032. /* P1NUM | P2NUM */
  2033. /* P1INT | P2BYT */
  2034. /*
  2035. **
  2036. ** we break this problem into two parts:
  2037. ** 1. generate the default string
  2038. ** 2. pad or trim on the left
  2039. **
  2040. */
  2041. if (y == 0)
  2042. {
  2043. /* empty string */
  2044. }
  2045. else
  2046. {
  2047. unsigned long z;
  2048. z = (unsigned long) x;
  2049. A = My->NumLenBuffer;
  2050. a = sizeof (z) * CHAR_BIT;
  2051. s = a;
  2052. bwb_memset (A, '0', a);
  2053. A[a] = NulChar;
  2054. while (a)
  2055. {
  2056. /* look at the Least Significant Bit */
  2057. a--;
  2058. if (z & 1)
  2059. {
  2060. A[a] = '1';
  2061. }
  2062. z /= 2;
  2063. }
  2064. /* bwb_strcpy( S, A ); */
  2065. if (y > s)
  2066. {
  2067. /* pad left */
  2068. a = y - s; /* number of characters to pad (at least one) */
  2069. bwb_memset (S, '0', a);
  2070. S[a] = NulChar;
  2071. bwb_strcat (S, A);
  2072. }
  2073. else
  2074. {
  2075. /* trim left (y <= s) */
  2076. a = s - y; /* number of characters to trim (may be zero) */
  2077. A += a;
  2078. bwb_strcpy (S, A);
  2079. }
  2080. s = y;
  2081. }
  2082. }
  2083. break;
  2084. case F_EDIT4_A_X_S:
  2085. /* S$ = EDIT$( A$, X ) */
  2086. {
  2087. /* P1ANY|P2INT */
  2088. if (x < 0)
  2089. {
  2090. WARN_ILLEGAL_FUNCTION_CALL;
  2091. }
  2092. else if (a == 0)
  2093. {
  2094. /* empty string */
  2095. }
  2096. else if (x == 0)
  2097. {
  2098. /* no changes */
  2099. bwb_memcpy (S, A, a);
  2100. s = a;
  2101. }
  2102. else
  2103. {
  2104. int n;
  2105. char IsSuppress;
  2106. char LastC;
  2107. n = a;
  2108. a = 0;
  2109. IsSuppress = NulChar;
  2110. LastC = NulChar;
  2111. if (x & 8)
  2112. {
  2113. /* discard leading spaces and tabs */
  2114. while (A[a] == ' ' || A[a] == '\t')
  2115. a++;
  2116. }
  2117. while (a < n)
  2118. {
  2119. char C;
  2120. C = A[a];
  2121. if (x & 256)
  2122. {
  2123. /*
  2124. ** suppress editing for characters within quotes.
  2125. */
  2126. if (IsSuppress)
  2127. {
  2128. if (C == IsSuppress)
  2129. IsSuppress = NulChar;
  2130. goto VERBATIM;
  2131. }
  2132. if (C == '"')
  2133. {
  2134. IsSuppress = C;
  2135. goto VERBATIM;
  2136. }
  2137. if (C == '\'')
  2138. {
  2139. IsSuppress = C;
  2140. goto VERBATIM;
  2141. }
  2142. }
  2143. /* edit the character */
  2144. if (x & 1)
  2145. {
  2146. /* discard parity bit */
  2147. C = C & 0x7F;
  2148. }
  2149. if (x & 2)
  2150. {
  2151. /* discard all spaces and tabs */
  2152. if (C == ' ')
  2153. goto SKIP;
  2154. if (C == '\t')
  2155. goto SKIP;
  2156. }
  2157. if (x & 4)
  2158. {
  2159. /* discard all carriage returns, line feeds, form feeds, deletes, escapes and nulls */
  2160. if (C == '\r')
  2161. goto SKIP;
  2162. if (C == '\n')
  2163. goto SKIP;
  2164. if (C == '\f')
  2165. goto SKIP;
  2166. if (C == 127)
  2167. goto SKIP;
  2168. if (C == 26)
  2169. goto SKIP;
  2170. if (C == 0)
  2171. goto SKIP;
  2172. }
  2173. if (x & 16)
  2174. {
  2175. /* convert multiple spaces and tabs to one space */
  2176. if (C == '\t')
  2177. C = ' ';
  2178. if (C == ' ' && LastC == ' ')
  2179. goto SKIP;
  2180. }
  2181. if (x & 32)
  2182. {
  2183. /* convert lower case to upper case */
  2184. C = bwb_toupper (C);
  2185. }
  2186. if (x & 64)
  2187. {
  2188. /* convert left brackets to left parentheses and right brackes to right parentheses */
  2189. if (C == '[')
  2190. C = '(';
  2191. if (C == ']')
  2192. C = ')';
  2193. }
  2194. /* save results of editing */
  2195. VERBATIM:
  2196. S[s] = C;
  2197. s++;
  2198. SKIP:
  2199. LastC = C;
  2200. a++;
  2201. }
  2202. if (x & 128)
  2203. {
  2204. /* discard trailing spaces and tabs */
  2205. while (s > 0 && (S[s - 1] == ' ' || S[s - 1] == '\t'))
  2206. s--;
  2207. }
  2208. }
  2209. }
  2210. break;
  2211. case F_CHR_X_S:
  2212. case F_CHR4_X_S:
  2213. case F_CHAR4_X_S:
  2214. /* S$ = CHR( X ) */
  2215. /* S$ = CHR$( X ) */
  2216. /* S$ = CHAR$( X ) */
  2217. /* P1ANY */
  2218. if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
  2219. {
  2220. /* IBM System/360 & System/370 BASIC dialects: the opposite of N = NUM( A$ ) */
  2221. FormatBasicNumber (X, S);
  2222. s = bwb_strlen (S);
  2223. }
  2224. else
  2225. {
  2226. if (x < MINBYT || x > MAXBYT)
  2227. {
  2228. WARN_ILLEGAL_FUNCTION_CALL;
  2229. }
  2230. else
  2231. {
  2232. S[0] = (char) x;
  2233. s = 1;
  2234. }
  2235. }
  2236. break;
  2237. case F_CHAR_X_Y_S:
  2238. /* S$ = CHAR( X, Y ) ' same as STRING$(Y,X) */
  2239. {
  2240. /* P1BYT|P2LEN */
  2241. if (y == 0)
  2242. {
  2243. /* no copies */
  2244. }
  2245. else
  2246. {
  2247. bwb_memset (S, (char) x, y);
  2248. s = y;
  2249. }
  2250. }
  2251. break;
  2252. case F_LEN_A_N:
  2253. /* N = LEN( A$ ) */
  2254. {
  2255. N = a;
  2256. }
  2257. break;
  2258. case F_POS_A_B_N:
  2259. /* N = POS( A$, B$ ) */
  2260. {
  2261. if (b == 0)
  2262. {
  2263. /* empty pattern */
  2264. N = 1;
  2265. }
  2266. else if (a == 0)
  2267. {
  2268. /* empty searched */
  2269. }
  2270. else if (b > a)
  2271. {
  2272. /* pattern is longer than searched */
  2273. }
  2274. else
  2275. {
  2276. /* search */
  2277. int i;
  2278. int n;
  2279. n = a - b; /* last valid search
  2280. * position */
  2281. n++;
  2282. /* search */
  2283. for (i = 0; i < n; i++)
  2284. {
  2285. if (bwb_memcmp (A, B, b) == 0)
  2286. {
  2287. /* FOU ND */
  2288. i++; /* C to BASIC */
  2289. N = i;
  2290. i = n; /* exit for */
  2291. }
  2292. A++;
  2293. }
  2294. }
  2295. }
  2296. break;
  2297. case F_MATCH_A_B_X_N:
  2298. /* N = POS( A$, B$, X ) */
  2299. {
  2300. N = str_match (A, a, B, b, x);
  2301. }
  2302. break;
  2303. case F_POS_A_B_X_N:
  2304. /* N = POS( A$, B$, X ) */
  2305. {
  2306. if (b == 0)
  2307. {
  2308. /* empty pattern */
  2309. N = 1;
  2310. }
  2311. else if (a == 0)
  2312. {
  2313. /* empty searched */
  2314. }
  2315. else if (b > a)
  2316. {
  2317. /* pattern is longer than searched */
  2318. }
  2319. else
  2320. {
  2321. /* search */
  2322. int i;
  2323. int n;
  2324. n = a - b; /* last valid search position */
  2325. n++;
  2326. /* search */
  2327. x--; /* BASIC to C */
  2328. A += x; /* advance to the start
  2329. * position */
  2330. for (i = x; i < n; i++)
  2331. {
  2332. if (bwb_memcmp (A, B, b) == 0)
  2333. {
  2334. /* FOUND */
  2335. N = i + 1; /* C to BASIC */
  2336. i = n; /* exit for */
  2337. }
  2338. A++;
  2339. }
  2340. }
  2341. }
  2342. break;
  2343. case F_VAL_A_N:
  2344. case F_NUM_A_N:
  2345. /* N = VAL( A$ ) */
  2346. /* N = NUM( A$ ) */
  2347. {
  2348. /* P1ANY */
  2349. int n; /* number of characters read */
  2350. DoubleType Value;
  2351. n = 0;
  2352. if (sscanf (A, DecScanFormat, &Value, &n) == 1)
  2353. {
  2354. /* OK */
  2355. N = Value;
  2356. }
  2357. else
  2358. {
  2359. /* not a number */
  2360. if (My->CurrentVersion->OptionFlags & OPTION_BUGS_ON ) /* VAL("X") = 0 */
  2361. {
  2362. /* IGNORE */
  2363. N = 0;
  2364. }
  2365. else
  2366. {
  2367. /* ERROR */
  2368. WARN_ILLEGAL_FUNCTION_CALL;
  2369. }
  2370. }
  2371. }
  2372. break;
  2373. case F_STR4_X_S:
  2374. case F_NUM4_X_S:
  2375. /* S$ = STR$( X ) */
  2376. /* S$ = NUM$( X ) */
  2377. {
  2378. /* P1ANY */
  2379. FormatBasicNumber (X, S);
  2380. s = bwb_strlen (S);
  2381. }
  2382. break;
  2383. case F_DATE_N:
  2384. /* N = DATE ' YYYYDDD */
  2385. {
  2386. /* PNONE */
  2387. /* ECMA-116 */
  2388. time (&t);
  2389. lt = localtime (&t);
  2390. N = lt->tm_year;
  2391. N *= 1000;
  2392. N += lt->tm_yday;
  2393. N += 1;
  2394. }
  2395. break;
  2396. case F_DATE4_X_S:
  2397. case F_DATE4_S:
  2398. case F_DAT4_S:
  2399. /* S$ = DATE$( X ) ' value of X is ignored */
  2400. /* S$ = DATE$ */
  2401. /* S$ = DAT$ */
  2402. {
  2403. /* PNONE */
  2404. if (!is_empty_string (My->CurrentVersion->OptionDateFormat))
  2405. {
  2406. time (&t);
  2407. lt = localtime (&t);
  2408. s = strftime (S, MAXLEN, My->CurrentVersion->OptionDateFormat, lt);
  2409. }
  2410. }
  2411. break;
  2412. case F_CLK_X_S:
  2413. case F_CLK4_S:
  2414. case F_TI4_S:
  2415. case F_TIME4_S:
  2416. case F_TIME4_X_S:
  2417. /* S$ = CLK(X) ' the value of paameter X is ignored */
  2418. /* S$ = CLK$ */
  2419. /* S$ = TI$ */
  2420. /* S$ = TIME$ */
  2421. /* S$ = TIME$(X) ' the value of paameter X is ignored */
  2422. {
  2423. /* PNONE */
  2424. if (!is_empty_string (My->CurrentVersion->OptionTimeFormat))
  2425. {
  2426. time (&t);
  2427. lt = localtime (&t);
  2428. s = strftime (S, MAXLEN, My->CurrentVersion->OptionTimeFormat, lt);
  2429. }
  2430. }
  2431. break;
  2432. case F_TI_N:
  2433. case F_TIM_N:
  2434. case F_TIME_N:
  2435. case F_TIME_X_N:
  2436. case F_TIMER_N:
  2437. /* N = TI */
  2438. /* N = TIM */
  2439. /* N = TIME */
  2440. /* N = TIME( X ) ' value of X is ignored */
  2441. /* N = TIMER */
  2442. /* N = CPU */
  2443. {
  2444. /* PNONE */
  2445. time (&t);
  2446. lt = localtime (&t);
  2447. if (My->CurrentVersion->OptionVersionValue & (G67 | G74))
  2448. {
  2449. N = lt->tm_hour;
  2450. N *= 60;
  2451. N += lt->tm_min;
  2452. N *= 60;
  2453. N += lt->tm_sec;
  2454. /* number of seconds since midnight */
  2455. N -= My->StartTimeInteger;
  2456. /* elapsed run time */
  2457. }
  2458. else
  2459. {
  2460. N = lt->tm_hour;
  2461. N *= 60;
  2462. N += lt->tm_min;
  2463. N *= 60;
  2464. N += lt->tm_sec;
  2465. /* number of seconds since midnight */
  2466. }
  2467. }
  2468. break;
  2469. case F_CLK_X_N:
  2470. /* N = CLK( X ) ' value of X is ignored */
  2471. {
  2472. /* PNONE */
  2473. time (&t);
  2474. lt = localtime (&t);
  2475. N = lt->tm_hour;
  2476. N *= 60;
  2477. N += lt->tm_min;
  2478. N *= 60;
  2479. N += lt->tm_sec;
  2480. N /= 3600;
  2481. /* decimal hours: 3:30 PM = 15.50 */
  2482. }
  2483. break;
  2484. case F_TIM_X_N:
  2485. /* N = TIM( X ) */
  2486. {
  2487. /* P1BYT */
  2488. time (&t);
  2489. lt = localtime (&t);
  2490. if (My->CurrentVersion->OptionVersionValue & (G65 | G67 | G74))
  2491. {
  2492. /* value of 'X' is ignored */
  2493. N = lt->tm_hour;
  2494. N *= 60;
  2495. N += lt->tm_min;
  2496. N *= 60;
  2497. N += lt->tm_sec;
  2498. /* number of seconds since midnight */
  2499. N -= My->StartTimeInteger;
  2500. /* elapsed run time */
  2501. }
  2502. else
  2503. {
  2504. switch (x)
  2505. {
  2506. case 0:
  2507. /* TIM(0) == minute (0..59) */
  2508. N += lt->tm_min;
  2509. break;
  2510. case 1:
  2511. /* TIM(1) == hour (0..23) */
  2512. N = lt->tm_hour;
  2513. break;
  2514. case 2:
  2515. /* TIM(2) == day of year (1..366) */
  2516. N = 1 + lt->tm_yday;
  2517. break;
  2518. case 3:
  2519. /* TIM(3) == year since 1900 (0..) */
  2520. N = lt->tm_year;
  2521. break;
  2522. default:
  2523. WARN_ILLEGAL_FUNCTION_CALL;
  2524. }
  2525. }
  2526. }
  2527. break;
  2528. case F_COMMAND4_S:
  2529. /* S$ = COMMAND$ */
  2530. {
  2531. S[0] = NulChar;
  2532. for (x = 0; x < 10 && My->COMMAND4[x] != NULL; x++)
  2533. {
  2534. if (x > 0)
  2535. {
  2536. bwb_strcat (S, " ");
  2537. }
  2538. bwb_strcat (S, My->COMMAND4[x]);
  2539. }
  2540. s = bwb_strlen (S);
  2541. }
  2542. break;
  2543. case F_COMMAND4_X_S:
  2544. /* S$ = COMMAND$(X) */
  2545. if (x < 0 || x > 9)
  2546. {
  2547. WARN_ILLEGAL_FUNCTION_CALL;
  2548. }
  2549. else
  2550. {
  2551. if (My->COMMAND4[x] == NULL)
  2552. {
  2553. s = 0;
  2554. }
  2555. else
  2556. {
  2557. bwb_strcpy (S, My->COMMAND4[x]);
  2558. s = bwb_strlen (My->COMMAND4[x]);
  2559. }
  2560. }
  2561. break;
  2562. case F_COSH_X_N:
  2563. case F_CSH_X_N:
  2564. case F_HCS_X_N:
  2565. /* N = COSH( X ) */
  2566. /* N = CSH( X ) */
  2567. /* N = HCS( X ) */
  2568. {
  2569. /* P1ANY */
  2570. N = cosh (X);
  2571. }
  2572. break;
  2573. case F_SINH_X_N:
  2574. case F_SNH_X_N:
  2575. case F_HSN_X_N:
  2576. /* N = SINH( X ) */
  2577. /* N = SNH( X ) */
  2578. /* N = HSN( X ) */
  2579. {
  2580. /* P1ANY */
  2581. N = sinh (X);
  2582. }
  2583. break;
  2584. case F_TANH_X_N:
  2585. case F_HTN_X_N:
  2586. /* N = TANH( X ) */
  2587. /* N = HTN( X ) */
  2588. {
  2589. /* P1ANY */
  2590. N = tanh (X);
  2591. }
  2592. break;
  2593. case F_CLG_X_N:
  2594. case F_CLOG_X_N:
  2595. case F_LOG10_X_N:
  2596. case F_LGT_X_N:
  2597. /* N = CLG( X ) */
  2598. /* N = CLOG( X ) */
  2599. /* N = LOG10( X ) */
  2600. /* N = LGT( X ) */
  2601. {
  2602. /* P1GTZ */
  2603. N = log10 (X);
  2604. }
  2605. break;
  2606. case F_SLEEP_X_N:
  2607. case F_WAIT_X_N:
  2608. case F_PAUSE_X_N:
  2609. /* N = SLEEP( X ) */
  2610. /* N = WAIT( X ) */
  2611. /* N = PAUSE( X ) */
  2612. {
  2613. /* P1ANY */
  2614. X = X * My->OptionSleepDouble;
  2615. if (X <= 0 || X > MAXINT)
  2616. {
  2617. /* do nothing */
  2618. }
  2619. else
  2620. {
  2621. x = (int) bwb_rint (X);
  2622. sleep (x);
  2623. }
  2624. }
  2625. break;
  2626. case F_LOG2_X_N:
  2627. case F_LTW_X_N:
  2628. /* N = LOG2( X ) */
  2629. /* N = LTW( X ) */
  2630. {
  2631. /* P1GTZ */
  2632. N = log (X) / log ((DoubleType) 2);
  2633. }
  2634. break;
  2635. case F_ACOS_X_N:
  2636. case F_ACS_X_N:
  2637. case F_ARCCOS_X_N:
  2638. /* N = ACOS( X ) */
  2639. /* N = ACS( X ) */
  2640. /* N = ARCCOS( X ) */
  2641. {
  2642. /* P1ANY */
  2643. if (X < -1 || X > 1)
  2644. {
  2645. WARN_ILLEGAL_FUNCTION_CALL;
  2646. }
  2647. else
  2648. {
  2649. N = acos (X);
  2650. if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_DEGREES)
  2651. {
  2652. N = FromRadiansToDegrees (N);
  2653. }
  2654. else if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_GRADIANS)
  2655. {
  2656. N = FromRadiansToGradians (N);
  2657. }
  2658. }
  2659. }
  2660. break;
  2661. case F_ACSD_X_N:
  2662. /* N = ACSD( X ) */
  2663. {
  2664. /* P1ANY */
  2665. if (X < -1 || X > 1)
  2666. {
  2667. WARN_ILLEGAL_FUNCTION_CALL;
  2668. }
  2669. else
  2670. {
  2671. N = acos (X);
  2672. /* result is always in DEGREES, regardless of OPTION ANGLE setting */
  2673. N = FromRadiansToDegrees (N);
  2674. }
  2675. }
  2676. break;
  2677. case F_ACSG_X_N:
  2678. /* N = ACSG( X ) */
  2679. {
  2680. /* P1ANY */
  2681. if (X < -1 || X > 1)
  2682. {
  2683. WARN_ILLEGAL_FUNCTION_CALL;
  2684. }
  2685. else
  2686. {
  2687. N = acos (X);
  2688. /* result is always in GRADIANS, regardless of OPTION ANGLE setting */
  2689. N = FromRadiansToGradians (N);
  2690. }
  2691. }
  2692. break;
  2693. case F_ASIN_X_N:
  2694. case F_ASN_X_N:
  2695. case F_ARCSIN_X_N:
  2696. /* N = ASIN( X ) */
  2697. /* N = ASN( X ) */
  2698. /* N = ARCSIN( X ) */
  2699. {
  2700. /* P1ANY */
  2701. if (X < -1 || X > 1)
  2702. {
  2703. WARN_ILLEGAL_FUNCTION_CALL;
  2704. }
  2705. else
  2706. {
  2707. N = asin (X);
  2708. if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_DEGREES)
  2709. {
  2710. N = FromRadiansToDegrees (N);
  2711. }
  2712. else if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_GRADIANS)
  2713. {
  2714. N = FromRadiansToGradians (N);
  2715. }
  2716. }
  2717. }
  2718. break;
  2719. case F_ASND_X_N:
  2720. /* N = ASND( X ) */
  2721. {
  2722. /* P1ANY */
  2723. if (X < -1 || X > 1)
  2724. {
  2725. WARN_ILLEGAL_FUNCTION_CALL;
  2726. }
  2727. else
  2728. {
  2729. N = asin (X);
  2730. /* result is always in DEGREES, regardless of OPTION ANGLE setting */
  2731. N = FromRadiansToDegrees (N);
  2732. }
  2733. }
  2734. break;
  2735. case F_ASNG_X_N:
  2736. /* N = ASNG( X ) */
  2737. {
  2738. /* P1ANY */
  2739. if (X < -1 || X > 1)
  2740. {
  2741. WARN_ILLEGAL_FUNCTION_CALL;
  2742. }
  2743. else
  2744. {
  2745. N = asin (X);
  2746. /* result is always in GRADIANS, regardless of OPTION ANGLE setting */
  2747. N = FromRadiansToGradians (N);
  2748. }
  2749. }
  2750. break;
  2751. case F_COT_X_N:
  2752. /* N = COT( X ) ' = 1 / TAN( X ) */
  2753. {
  2754. /* P1ANY */
  2755. DoubleType T;
  2756. if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_DEGREES)
  2757. {
  2758. X = FromDegreesToRadians (X);
  2759. }
  2760. else if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_GRADIANS)
  2761. {
  2762. X = FromGradiansToRadians (X);
  2763. }
  2764. T = tan (X);
  2765. if (T == 0)
  2766. {
  2767. WARN_ILLEGAL_FUNCTION_CALL;
  2768. }
  2769. else
  2770. {
  2771. N = 1.0 / T;
  2772. }
  2773. }
  2774. break;
  2775. case F_CSC_X_N:
  2776. /* N = CSC( X ) ' = 1 / SIN( X ) */
  2777. {
  2778. /* P1ANY */
  2779. DoubleType T;
  2780. if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_DEGREES)
  2781. {
  2782. X = FromDegreesToRadians (X);
  2783. }
  2784. else if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_GRADIANS)
  2785. {
  2786. X = FromGradiansToRadians (X);
  2787. }
  2788. T = sin (X);
  2789. if (T == 0)
  2790. {
  2791. WARN_ILLEGAL_FUNCTION_CALL;
  2792. }
  2793. else
  2794. {
  2795. N = 1.0 / T;
  2796. }
  2797. }
  2798. break;
  2799. case F_SEC_X_N:
  2800. /* N = SEC( X ) ' = 1 / COS( X ) */
  2801. {
  2802. /* P1ANY */
  2803. DoubleType T;
  2804. if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_DEGREES)
  2805. {
  2806. X = FromDegreesToRadians (X);
  2807. }
  2808. else if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_GRADIANS)
  2809. {
  2810. X = FromGradiansToRadians (X);
  2811. }
  2812. T = cos (X);
  2813. if (T == 0)
  2814. {
  2815. WARN_ILLEGAL_FUNCTION_CALL;
  2816. }
  2817. else
  2818. {
  2819. N = 1.0 / T;
  2820. }
  2821. }
  2822. break;
  2823. case F_UCASE4_A_S:
  2824. case F_UPPER4_A_S:
  2825. /* S$ = UCASE$( A$ ) */
  2826. /* S$ = UPPER$( A$ ) */
  2827. {
  2828. /* P1ANY */
  2829. if (a == 0)
  2830. {
  2831. /* empty string */
  2832. }
  2833. else
  2834. {
  2835. int i;
  2836. bwb_memcpy (S, A, a);
  2837. s = a;
  2838. /* BASIC allows embedded NULL
  2839. * characters */
  2840. for (i = 0; i < a; i++)
  2841. {
  2842. S[i] = bwb_toupper (S[i]);
  2843. }
  2844. }
  2845. }
  2846. break;
  2847. case F_LCASE4_A_S:
  2848. case F_LOWER4_A_S:
  2849. /* S$ = LCASE$( A$ ) */
  2850. /* S$ = LOWER$( A$ ) */
  2851. {
  2852. /* P1ANY */
  2853. if (a == 0)
  2854. {
  2855. /* empty string */
  2856. }
  2857. else
  2858. {
  2859. int i;
  2860. bwb_memcpy (S, A, a);
  2861. s = a;
  2862. /* BASIC allows embedded NULL
  2863. * characters */
  2864. for (i = 0; i < a; i++)
  2865. {
  2866. S[i] = bwb_tolower (S[i]);
  2867. }
  2868. }
  2869. }
  2870. break;
  2871. case F_ANGLE_X_Y_N:
  2872. /* N = ANGLE( X, Y ) */
  2873. {
  2874. /* P1ANY|P2ANY */
  2875. if (X == 0 && Y == 0)
  2876. {
  2877. WARN_ILLEGAL_FUNCTION_CALL;
  2878. }
  2879. else
  2880. {
  2881. N = atan2 (Y, X);
  2882. if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_DEGREES)
  2883. {
  2884. N = FromRadiansToDegrees (N);
  2885. }
  2886. else if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_GRADIANS)
  2887. {
  2888. N = FromRadiansToGradians (N);
  2889. }
  2890. }
  2891. }
  2892. break;
  2893. case F_CEIL_X_N:
  2894. /* N = CEIL( X ) */
  2895. {
  2896. /* P1ANY */
  2897. N = ceil (X);
  2898. }
  2899. break;
  2900. case F_DET_N:
  2901. /* N = DET */
  2902. {
  2903. /* PNONE */
  2904. N = My->LastDeterminant;
  2905. }
  2906. break;
  2907. case F_NUM_N:
  2908. /* N = NUM */
  2909. {
  2910. /* PNONE */
  2911. N = My->LastInputCount;
  2912. }
  2913. break;
  2914. case F_DEG_N:
  2915. case F_DEGREE_N:
  2916. /* N = DEG */
  2917. /* N = DEGREE */
  2918. {
  2919. /* PNONE */
  2920. My->CurrentVersion->OptionFlags |= OPTION_ANGLE_DEGREES;
  2921. My->CurrentVersion->OptionFlags &= ~OPTION_ANGLE_GRADIANS;
  2922. N = 0;
  2923. }
  2924. break;
  2925. case F_RAD_N:
  2926. case F_RADIAN_N:
  2927. /* N = RAD */
  2928. /* N = RADIAN */
  2929. {
  2930. /* PNONE */
  2931. My->CurrentVersion->OptionFlags &= ~OPTION_ANGLE_DEGREES;
  2932. My->CurrentVersion->OptionFlags &= ~OPTION_ANGLE_GRADIANS;
  2933. N = 0;
  2934. }
  2935. break;
  2936. case F_GRAD_N:
  2937. case F_GRADIAN_N:
  2938. /* N = GRAD */
  2939. /* N = GRADIAN */
  2940. {
  2941. /* PNONE */
  2942. My->CurrentVersion->OptionFlags &= ~OPTION_ANGLE_DEGREES;
  2943. My->CurrentVersion->OptionFlags |= OPTION_ANGLE_GRADIANS;
  2944. N = 0;
  2945. }
  2946. break;
  2947. case F_DEG_X_N:
  2948. case F_DEGREE_X_N:
  2949. /* N = DEG( X ) */
  2950. /* N = DEGREE( X ) */
  2951. {
  2952. /* P1ANY */
  2953. if (My->CurrentVersion->OptionVersionValue & (R86))
  2954. {
  2955. if (x == 0)
  2956. {
  2957. /* DEG 0 */
  2958. My->CurrentVersion->OptionFlags &= ~OPTION_ANGLE_DEGREES;
  2959. My->CurrentVersion->OptionFlags &= ~OPTION_ANGLE_GRADIANS;
  2960. }
  2961. else
  2962. {
  2963. /* DEG 1 */
  2964. My->CurrentVersion->OptionFlags |= OPTION_ANGLE_DEGREES;
  2965. My->CurrentVersion->OptionFlags &= ~OPTION_ANGLE_GRADIANS;
  2966. }
  2967. N = 0;
  2968. }
  2969. else
  2970. {
  2971. N = FromRadiansToDegrees (X);
  2972. }
  2973. }
  2974. break;
  2975. case F_RAD_X_N:
  2976. /* N = RAD( X ) */
  2977. {
  2978. /* P1ANY */
  2979. N = FromDegreesToRadians (X);
  2980. }
  2981. break;
  2982. case F_PI_N:
  2983. /* N = PI */
  2984. {
  2985. /* PNONE */
  2986. N = PI;
  2987. }
  2988. break;
  2989. case F_PI_X_N:
  2990. /* N = PI(X) */
  2991. {
  2992. /* P1ANY */
  2993. N = PI * X;
  2994. }
  2995. break;
  2996. case F_LTRIM4_A_S:
  2997. /* S$ = LTRIM$( A$ ) */
  2998. {
  2999. /* P1ANY */
  3000. if (a == 0)
  3001. {
  3002. /* empty string */
  3003. }
  3004. else
  3005. {
  3006. int i;
  3007. /* BASIC allows embedded NULL characters */
  3008. for (i = 0; i < a && A[i] == ' '; i++)
  3009. {
  3010. /* skip spaces */
  3011. }
  3012. /* 'A[ i ]' is first non-space character */
  3013. if (i >= a)
  3014. {
  3015. /* empty string */
  3016. }
  3017. else
  3018. {
  3019. A += i;
  3020. a -= i;
  3021. bwb_memcpy (S, A, a);
  3022. s = a;
  3023. }
  3024. }
  3025. }
  3026. break;
  3027. case F_RTRIM4_A_S:
  3028. /* S$ = RTRIM$( A$ ) */
  3029. {
  3030. /* P1ANY */
  3031. if (a == 0)
  3032. {
  3033. /* empty string */
  3034. }
  3035. else
  3036. {
  3037. int i;
  3038. /* BASIC allows embedded NULL characters */
  3039. for (i = a - 1; i >= 0 && A[i] == ' '; i--)
  3040. {
  3041. /* skip spaces */
  3042. }
  3043. /* 'A[ i ]' is last non-space character */
  3044. if (i < 0)
  3045. {
  3046. /* empty string */
  3047. }
  3048. else
  3049. {
  3050. a = i + 1;
  3051. bwb_memcpy (S, A, a);
  3052. s = a;
  3053. }
  3054. }
  3055. }
  3056. break;
  3057. case F_STRIP4_A_S:
  3058. /* S$ = STRIP$( A$ ) */
  3059. {
  3060. /* P1ANY */
  3061. if (a == 0)
  3062. {
  3063. /* empty string */
  3064. }
  3065. else
  3066. {
  3067. int i;
  3068. for (i = 0; i < a; i++)
  3069. {
  3070. S[i] = A[i] & 0x7F;
  3071. }
  3072. s = a;
  3073. S[s] = NulChar;
  3074. }
  3075. }
  3076. break;
  3077. case F_TRIM4_A_S:
  3078. /* S$ = TRIM$( A$ ) */
  3079. {
  3080. /* P1ANY */
  3081. if (a == 0)
  3082. {
  3083. /* empty string */
  3084. }
  3085. else
  3086. {
  3087. /*
  3088. **
  3089. ** LTRIM
  3090. **
  3091. */
  3092. int i;
  3093. /* BASIC allows embedded NULL characters */
  3094. for (i = 0; i < a && A[i] == ' '; i++)
  3095. {
  3096. /* skip spaces */
  3097. }
  3098. /* 'A[ i ]' is first non-space character */
  3099. if (i >= a)
  3100. {
  3101. /* empty string */
  3102. }
  3103. else
  3104. {
  3105. A += i;
  3106. a -= i;
  3107. bwb_memcpy (S, A, a);
  3108. s = a;
  3109. /*
  3110. **
  3111. ** RTRIM
  3112. **
  3113. */
  3114. A = S;
  3115. a = s;
  3116. if (a == 0)
  3117. {
  3118. /* empty string */
  3119. }
  3120. else
  3121. {
  3122. int i;
  3123. /* BASIC allows embedded NULL characters */
  3124. for (i = a - 1; i >= 0 && A[i] == ' '; i--)
  3125. {
  3126. /* skip spaces */
  3127. }
  3128. /* 'A[ i ]' is last non-space character */
  3129. if (i < 0)
  3130. {
  3131. /* empty string */
  3132. }
  3133. else
  3134. {
  3135. a = i + 1;
  3136. /* bwb_memcpy( S, A, a ); */
  3137. s = a;
  3138. }
  3139. }
  3140. }
  3141. }
  3142. }
  3143. break;
  3144. case F_MAX_X_Y_N:
  3145. /* N = MAX( X, Y ) */
  3146. {
  3147. N = MAX (X, Y);
  3148. }
  3149. break;
  3150. case F_MAX_A_B_S:
  3151. /* S$ = MAX( A$, B$ ) */
  3152. {
  3153. StringType L;
  3154. StringType R;
  3155. L.length = a;
  3156. R.length = b;
  3157. L.sbuffer = A;
  3158. R.sbuffer = B;
  3159. if (str_cmp (&L, &R) >= 0)
  3160. {
  3161. /* A >= B */
  3162. bwb_memcpy (S, A, a);
  3163. s = a;
  3164. }
  3165. else
  3166. {
  3167. /* A < B */
  3168. bwb_memcpy (S, B, b);
  3169. s = b;
  3170. }
  3171. }
  3172. break;
  3173. case F_MIN_X_Y_N:
  3174. /* N = MIN( X, Y ) */
  3175. {
  3176. N = MIN (X, Y);
  3177. }
  3178. break;
  3179. case F_MIN_A_B_S:
  3180. /* S$ = MIN( A$, B$ ) */
  3181. {
  3182. StringType L;
  3183. StringType R;
  3184. L.length = a;
  3185. R.length = b;
  3186. L.sbuffer = A;
  3187. R.sbuffer = B;
  3188. if (str_cmp (&L, &R) <= 0)
  3189. {
  3190. /* A <= B */
  3191. bwb_memcpy (S, A, a);
  3192. s = a;
  3193. }
  3194. else
  3195. {
  3196. /* A > B */
  3197. bwb_memcpy (S, B, b);
  3198. s = b;
  3199. }
  3200. }
  3201. break;
  3202. case F_FP_X_N:
  3203. case F_FRAC_X_N:
  3204. /* N = FP( X ) */
  3205. /* N = FRAC( X ) */
  3206. {
  3207. DoubleType FP;
  3208. DoubleType IP;
  3209. FP = modf (X, &IP);
  3210. N = FP;
  3211. }
  3212. break;
  3213. case F_IP_X_N:
  3214. /* N = IP( X ) */
  3215. {
  3216. DoubleType IP;
  3217. modf (X, &IP);
  3218. N = IP;
  3219. }
  3220. break;
  3221. case F_EPS_X_N:
  3222. /* N = EPS( Number ) */
  3223. {
  3224. N = DBL_MIN;
  3225. }
  3226. break;
  3227. case F_MAXLVL_N:
  3228. /* N = MAXLVL */
  3229. {
  3230. N = EXECLEVELS;
  3231. }
  3232. break;
  3233. case F_MAXNUM_N:
  3234. /* N = MAXNUM */
  3235. {
  3236. N = MAXDBL;
  3237. }
  3238. break;
  3239. case F_MINNUM_N:
  3240. /* N = MINNUM */
  3241. {
  3242. N = MINDBL;
  3243. }
  3244. break;
  3245. case F_MAXDBL_N:
  3246. /* N = MAXDBL */
  3247. {
  3248. N = MAXDBL;
  3249. }
  3250. break;
  3251. case F_MINDBL_N:
  3252. /* N = MINDBL */
  3253. {
  3254. N = MINDBL;
  3255. }
  3256. break;
  3257. case F_MAXSNG_N:
  3258. /* N = MAXSNG */
  3259. {
  3260. N = MAXSNG;
  3261. }
  3262. break;
  3263. case F_MINSNG_N:
  3264. /* N = MINSNG */
  3265. {
  3266. N = MINSNG;
  3267. }
  3268. break;
  3269. case F_MAXCUR_N:
  3270. /* N = MAXCUR */
  3271. {
  3272. N = MAXCUR;
  3273. }
  3274. break;
  3275. case F_MINCUR_N:
  3276. /* N = MINCUR */
  3277. {
  3278. N = MINCUR;
  3279. }
  3280. break;
  3281. case F_MAXLNG_N:
  3282. /* N = MAXLNG */
  3283. {
  3284. N = MAXLNG;
  3285. }
  3286. break;
  3287. case F_MINLNG_N:
  3288. /* N = MINLNG */
  3289. {
  3290. N = MINLNG;
  3291. }
  3292. break;
  3293. case F_MAXINT_N:
  3294. /* N = MAXINT */
  3295. {
  3296. N = MAXINT;
  3297. }
  3298. break;
  3299. case F_MININT_N:
  3300. /* N = MININT */
  3301. {
  3302. N = MININT;
  3303. }
  3304. break;
  3305. case F_MAXBYT_N:
  3306. /* N = MAXBYT */
  3307. {
  3308. N = MAXBYT;
  3309. }
  3310. break;
  3311. case F_MINBYT_N:
  3312. /* N = MINBYT */
  3313. {
  3314. N = MINBYT;
  3315. }
  3316. break;
  3317. case F_MAXDEV_N:
  3318. /* N = MAXDEV */
  3319. {
  3320. N = MAXDEV;
  3321. }
  3322. break;
  3323. case F_MINDEV_N:
  3324. /* N = MINDEV */
  3325. {
  3326. N = MINDEV;
  3327. }
  3328. break;
  3329. case F_MOD_X_Y_N:
  3330. /* N = MOD( X, Y ) */
  3331. {
  3332. /* P1ANY|P2NEZ */
  3333. DoubleType IP;
  3334. IP = floor (X / Y);
  3335. N = X - (Y * IP);
  3336. }
  3337. break;
  3338. case F_REMAINDER_X_Y_N:
  3339. /* REMAINDER( X, Y ) */
  3340. {
  3341. /* P1ANY|P2NEZ */
  3342. DoubleType Value;
  3343. DoubleType IP;
  3344. Value = X / Y;
  3345. modf (Value, &IP);
  3346. N = X - (Y * IP);
  3347. }
  3348. break;
  3349. case F_ROUND_X_Y_N:
  3350. /* N = ROUND( X, Y ) == INT(X*10^Y+.5)/10^Y */
  3351. {
  3352. /* P1ANY | P2INT */
  3353. if (y < -32 || y > 32)
  3354. {
  3355. WARN_ILLEGAL_FUNCTION_CALL;
  3356. }
  3357. else
  3358. {
  3359. DoubleType T; /* 10^Y */
  3360. T = pow (10.0, Y);
  3361. if (T == 0)
  3362. {
  3363. WARN_ILLEGAL_FUNCTION_CALL;
  3364. }
  3365. else
  3366. {
  3367. N = floor (X * T + 0.5) / T;
  3368. }
  3369. }
  3370. }
  3371. break;
  3372. case F_TRUNCATE_X_Y_N:
  3373. /* N = TRUNCATE( X, Y ) == INT(X*10^Y)/10^Y */
  3374. {
  3375. /* P1ANY | P2INT */
  3376. if (y < -32 || y > 32)
  3377. {
  3378. WARN_ILLEGAL_FUNCTION_CALL;
  3379. }
  3380. else
  3381. {
  3382. DoubleType T; /* 10^Y */
  3383. T = pow (10.0, Y);
  3384. if (T == 0)
  3385. {
  3386. WARN_ILLEGAL_FUNCTION_CALL;
  3387. }
  3388. else
  3389. {
  3390. N = floor (X * T) / T;
  3391. }
  3392. }
  3393. }
  3394. break;
  3395. case F_MAXLEN_A_N:
  3396. case F_MAXLEN_N:
  3397. /* N = MAXLEN( A$ ) */
  3398. /* N = MAXLEN */
  3399. {
  3400. N = MAXLEN;
  3401. }
  3402. break;
  3403. case F_ORD_A_N:
  3404. /* N = ORD( A$ ) */
  3405. {
  3406. /* P1BYT */
  3407. if (a == 1)
  3408. {
  3409. /* same as ASC(A$) */
  3410. N = A[0];
  3411. }
  3412. else
  3413. {
  3414. /* lookup Acronym */
  3415. N = -1;
  3416. for (x = 0; x < NUM_ACRONYMS; x++)
  3417. {
  3418. if (bwb_stricmp (AcronymTable[x].Name, A) == 0)
  3419. {
  3420. /* FOUND */
  3421. N = AcronymTable[x].Value;
  3422. break;
  3423. }
  3424. }
  3425. if (N < 0)
  3426. {
  3427. /* NOT FOUND */
  3428. WARN_ILLEGAL_FUNCTION_CALL;
  3429. N = 0;
  3430. }
  3431. }
  3432. }
  3433. break;
  3434. case F_RENAME_A_B_N:
  3435. /* N = RENAME( A$, B$ ) */
  3436. {
  3437. /* P1BYT | P2BYT */
  3438. if (rename (A, B))
  3439. {
  3440. /* ERROR -- return FALSE */
  3441. N = 0;
  3442. }
  3443. else
  3444. {
  3445. /* OK -- return TRUE */
  3446. N = -1;
  3447. }
  3448. }
  3449. break;
  3450. case F_SIZE_A_N:
  3451. /* N = SIZE( A$ ) */
  3452. {
  3453. /* P1BYT */
  3454. FILE *F;
  3455. F = fopen (A, "rb");
  3456. if (F != NULL)
  3457. {
  3458. long n;
  3459. fseek (F, 0, SEEK_END);
  3460. n = ftell (F);
  3461. bwb_fclose (F);
  3462. if (n > 0)
  3463. {
  3464. /* round up filesize to next whole kilobyte */
  3465. n += 1023;
  3466. n /= 1024;
  3467. }
  3468. else
  3469. {
  3470. /* a zero-length file returns 0 */
  3471. n = 0;
  3472. }
  3473. N = n;
  3474. }
  3475. /* a non-existing file returns 0 */
  3476. }
  3477. break;
  3478. case F_REPEAT4_X_Y_S:
  3479. /* S$ = REPEAT$( X, Y ) ' X is count, Y is code */
  3480. {
  3481. /* P1LEN | P2BYT */
  3482. if (x == 0)
  3483. {
  3484. /* empty string */
  3485. }
  3486. else
  3487. {
  3488. bwb_memset (S, (char) y, x);
  3489. s = x;
  3490. }
  3491. }
  3492. break;
  3493. case F_REPEAT4_X_A_S:
  3494. /* S$ = REPEAT$( X, A$ ) ' X is count, A$ is code */
  3495. {
  3496. /* P1LEN | P2BYT */
  3497. if (x == 0)
  3498. {
  3499. /* empty string */
  3500. }
  3501. else
  3502. {
  3503. bwb_memset (S, (char) A[0], x);
  3504. s = x;
  3505. }
  3506. }
  3507. break;
  3508. case F_FIX_X_N:
  3509. /* N = FIX( X ) */
  3510. {
  3511. /* N = bwb_rint(X); */
  3512. if (X < 0)
  3513. {
  3514. N = -floor (-X);
  3515. }
  3516. else
  3517. {
  3518. N = floor (X);
  3519. }
  3520. }
  3521. break;
  3522. case F_ABS_X_N:
  3523. /* N = ABS( X ) */
  3524. {
  3525. N = fabs (X);
  3526. }
  3527. break;
  3528. case F_ATN_X_N:
  3529. case F_ATAN_X_N:
  3530. case F_ARCTAN_X_N:
  3531. /* N = ATN( X ) */
  3532. /* N = ATAN( X ) */
  3533. /* N = ARCTAN( X ) */
  3534. {
  3535. N = atan (X);
  3536. if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_DEGREES)
  3537. {
  3538. N = FromRadiansToDegrees (N);
  3539. }
  3540. else if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_GRADIANS)
  3541. {
  3542. N = FromRadiansToGradians (N);
  3543. }
  3544. }
  3545. break;
  3546. case F_ATND_X_N:
  3547. /* N = ATND( X ) */
  3548. {
  3549. N = atan (X);
  3550. N = FromRadiansToDegrees (N);
  3551. }
  3552. break;
  3553. case F_ATNG_X_N:
  3554. /* N = ATNG( X ) */
  3555. {
  3556. N = atan (X);
  3557. N = FromRadiansToGradians (N);
  3558. }
  3559. break;
  3560. case F_COS_X_N:
  3561. /* N = COS( X ) */
  3562. {
  3563. if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_DEGREES)
  3564. {
  3565. X = FromDegreesToRadians (X);
  3566. }
  3567. else if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_GRADIANS)
  3568. {
  3569. X = FromGradiansToRadians (X);
  3570. }
  3571. N = cos (X);
  3572. }
  3573. break;
  3574. case F_COSD_X_N:
  3575. /* N = COSD( X ) */
  3576. {
  3577. X = FromDegreesToRadians (X);
  3578. N = cos (X);
  3579. }
  3580. break;
  3581. case F_COSG_X_N:
  3582. /* N = COSG( X ) */
  3583. {
  3584. X = FromGradiansToRadians (X);
  3585. N = cos (X);
  3586. }
  3587. break;
  3588. case F_EXP_X_N:
  3589. /* N = EXP( X ) */
  3590. {
  3591. N = exp (X);
  3592. }
  3593. break;
  3594. case F_INT_X_N:
  3595. /* N = INT( X ) */
  3596. {
  3597. N = floor (X);
  3598. }
  3599. break;
  3600. case F_FLOAT_X_N:
  3601. case F_INT5_X_N:
  3602. /* N = FLOAT( X ) */
  3603. /* N = INT%( X ) */
  3604. {
  3605. N = bwb_rint (X);
  3606. }
  3607. break;
  3608. case F_INITIALIZE_N:
  3609. /* INITIALIZE */
  3610. {
  3611. N = 0;
  3612. }
  3613. break;
  3614. case F_LOG_X_N:
  3615. case F_LN_X_N:
  3616. case F_LOGE_X_N:
  3617. /* N = LOG( X ) */
  3618. /* N = LN( X ) */
  3619. /* N = LOGE( X ) */
  3620. {
  3621. /* P1GTZ */
  3622. N = log (X);
  3623. }
  3624. break;
  3625. case F_RND_N:
  3626. /* N = RND */
  3627. {
  3628. N = rand ();
  3629. N /= RAND_MAX;
  3630. }
  3631. break;
  3632. case F_RND_X_N:
  3633. /* N = RND( X ) */
  3634. {
  3635. N = rand ();
  3636. N /= RAND_MAX;
  3637. }
  3638. break;
  3639. case F_SGN_X_N:
  3640. /* N = SGN( X ) */
  3641. {
  3642. if (X > 0)
  3643. {
  3644. N = 1;
  3645. }
  3646. else if (X < 0)
  3647. {
  3648. N = -1;
  3649. }
  3650. else
  3651. {
  3652. N = 0;
  3653. }
  3654. }
  3655. break;
  3656. case F_SIN_X_N:
  3657. /* N = SIN( X ) */
  3658. {
  3659. if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_DEGREES)
  3660. {
  3661. X = FromDegreesToRadians (X);
  3662. }
  3663. else if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_GRADIANS)
  3664. {
  3665. X = FromGradiansToRadians (X);
  3666. }
  3667. N = sin (X);
  3668. }
  3669. break;
  3670. case F_SIND_X_N:
  3671. /* N = SIND( X ) */
  3672. {
  3673. X = FromDegreesToRadians (X);
  3674. N = sin (X);
  3675. }
  3676. break;
  3677. case F_SING_X_N:
  3678. /* N = SING( X ) */
  3679. {
  3680. X = FromGradiansToRadians (X);
  3681. N = sin (X);
  3682. }
  3683. break;
  3684. case F_SQR_X_N:
  3685. case F_SQRT_X_N:
  3686. /* N = SQR( X ) */
  3687. /* N = SQRT( X ) */
  3688. {
  3689. /* P1GEZ */
  3690. N = sqrt (X);
  3691. }
  3692. break;
  3693. case F_TAN_X_N:
  3694. /* N = TAN( X ) */
  3695. {
  3696. if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_DEGREES)
  3697. {
  3698. X = FromDegreesToRadians (X);
  3699. }
  3700. else if (My->CurrentVersion->OptionFlags & OPTION_ANGLE_GRADIANS)
  3701. {
  3702. X = FromGradiansToRadians (X);
  3703. }
  3704. N = tan (X);
  3705. }
  3706. break;
  3707. case F_TAND_X_N:
  3708. /* N = TAND( X ) */
  3709. {
  3710. X = FromDegreesToRadians (X);
  3711. N = tan (X);
  3712. }
  3713. break;
  3714. case F_TANG_X_N:
  3715. /* N = TANG( X ) */
  3716. {
  3717. X = FromGradiansToRadians (X);
  3718. N = tan (X);
  3719. }
  3720. break;
  3721. case F_SPC_X_S:
  3722. /* S$ = SPC( X ) */
  3723. {
  3724. /* P1ANY */
  3725. /* SPECIAL RULES APPLY. PART OF PRINT COMMAND. WIDTH > 0 */
  3726. X = bwb_rint (X);
  3727. if (X < 1 || X > 255)
  3728. {
  3729. if (WARN_OVERFLOW)
  3730. {
  3731. /* ERROR */
  3732. }
  3733. /* CONTINUE */
  3734. X = 1;
  3735. }
  3736. x = (int) X;
  3737. bwb_memset (S, ' ', x);
  3738. s = x;
  3739. }
  3740. break;
  3741. case F_TAB_X_S:
  3742. /* S$ = TAB( X ) */
  3743. {
  3744. /* P1ANY */
  3745. /* SPECIAL RULES APPLY. PART OF PRINT COMMAND. WIDTH > 0 */
  3746. int w;
  3747. int c;
  3748. X = bwb_rint (X);
  3749. if (X < 1 || X > 255)
  3750. {
  3751. if (WARN_OVERFLOW)
  3752. {
  3753. /* ERROR */
  3754. }
  3755. /* CONTINUE */
  3756. X = 1;
  3757. }
  3758. x = (int) X;
  3759. if (My->CurrentFile)
  3760. {
  3761. w = My->CurrentFile->width;
  3762. c = My->CurrentFile->col;
  3763. }
  3764. else
  3765. {
  3766. w = My->SYSOUT->width;
  3767. c = My->SYSOUT->col;
  3768. }
  3769. if (w > 0)
  3770. {
  3771. /* WIDTH 80 */
  3772. while (x > w)
  3773. {
  3774. /*
  3775. **
  3776. ** If n is greater than the margin m, then n is
  3777. ** reduced by an integral multiple of m so that it is
  3778. ** in the range 1 <= n <= m;
  3779. **
  3780. */
  3781. x -= w;
  3782. }
  3783. /* 190 PRINT TAB(A);"X" ' A = 0 */
  3784. if (x == 0)
  3785. {
  3786. /* use the value of one */
  3787. x = 1;
  3788. /* continue processing */
  3789. }
  3790. }
  3791. if (x < c)
  3792. {
  3793. S[0] = '\n';
  3794. s = 1;
  3795. c = 1;
  3796. }
  3797. if (c < x)
  3798. {
  3799. x -= c;
  3800. bwb_memset (&(S[s]), ' ', x);
  3801. s += x;
  3802. }
  3803. }
  3804. break;
  3805. case F_POS_N:
  3806. /* N = POS */
  3807. {
  3808. /* PNONE */
  3809. N = My->SYSOUT->col;
  3810. }
  3811. break;
  3812. case F_COUNT_N:
  3813. /* N = COUNT */
  3814. /* COUNT = POS - 1 */
  3815. {
  3816. /* PNONE */
  3817. N = My->SYSOUT->col;
  3818. N--;
  3819. }
  3820. break;
  3821. case F_POS_X_N:
  3822. /* N = POS( X ) */
  3823. {
  3824. /* P1INT */
  3825. if (x == 0)
  3826. {
  3827. N = My->SYSOUT->col;
  3828. }
  3829. else if (x < 0)
  3830. {
  3831. N = My->SYSPRN->col;
  3832. }
  3833. else
  3834. {
  3835. FileType *F;
  3836. F = find_file_by_number (x);
  3837. if (F == NULL)
  3838. {
  3839. WARN_ILLEGAL_FUNCTION_CALL;
  3840. }
  3841. else
  3842. {
  3843. N = F->col;
  3844. }
  3845. }
  3846. }
  3847. break;
  3848. case F_INPUT4_X_Y_S:
  3849. /* S$ = INPUT$( X, Y ) */
  3850. {
  3851. /* P1LEN|P2INT */
  3852. if (y <= 0)
  3853. {
  3854. /* Printer and Console */
  3855. WARN_ILLEGAL_FUNCTION_CALL;
  3856. }
  3857. else
  3858. {
  3859. FileType *F;
  3860. F = find_file_by_number (y);
  3861. if (F == NULL)
  3862. {
  3863. WARN_ILLEGAL_FUNCTION_CALL;
  3864. }
  3865. else
  3866. {
  3867. if ((F->DevMode & DEVMODE_READ) == 0)
  3868. {
  3869. WARN_ILLEGAL_FUNCTION_CALL;
  3870. }
  3871. else if (x == 0)
  3872. {
  3873. /* empty string */
  3874. }
  3875. else
  3876. {
  3877. FILE *fp;
  3878. fp = F->cfp;
  3879. if (fp == NULL)
  3880. {
  3881. WARN_ILLEGAL_FUNCTION_CALL;
  3882. }
  3883. else
  3884. {
  3885. s = fread (S, 1, x, fp);
  3886. s = MAX (s, 0); /* if( s < 0 ) s = 0; */
  3887. }
  3888. }
  3889. }
  3890. }
  3891. }
  3892. break;
  3893. case F_ERROR_X_N:
  3894. /* ERROR X */
  3895. {
  3896. /* P1BYT */
  3897. bwx_Error (x, NULL);
  3898. N = 0;
  3899. }
  3900. break;
  3901. case F_ERROR_X_A_N:
  3902. /* ERROR X, A$ */
  3903. {
  3904. /* P1BYT */
  3905. bwx_Error (x, A);
  3906. N = 0;
  3907. }
  3908. break;
  3909. case F_ERR_N:
  3910. case F_ERRN_N:
  3911. /* N = ERR */
  3912. /* N = ERRN */
  3913. {
  3914. /* PNONE */
  3915. N = My->ERR;
  3916. }
  3917. break;
  3918. case F_ERL_N:
  3919. case F_ERRL_N:
  3920. /* N = ERL */
  3921. /* N = ERRL */
  3922. {
  3923. /* PNONE */
  3924. if (My->ERL != NULL)
  3925. {
  3926. N = My->ERL->number;
  3927. }
  3928. }
  3929. break;
  3930. case F_ERR4_S:
  3931. case F_ERROR4_S:
  3932. /* S = ERR$ */
  3933. /* S = ERROR$ */
  3934. {
  3935. /* PNONE */
  3936. s = bwb_strlen (My->ERROR4);
  3937. if (s > 0)
  3938. {
  3939. bwb_strcpy (S, My->ERROR4);
  3940. }
  3941. }
  3942. break;
  3943. /********************************************************************************************
  3944. ** Keep the platform specific functions together.
  3945. *********************************************************************************************/
  3946. case F_INP_X_N:
  3947. case F_PIN_X_N:
  3948. /* N = INP( X ) */
  3949. /* N = PIN( X ) */
  3950. {
  3951. /* P1BYT */
  3952. WARN_ADVANCED_FEATURE;
  3953. }
  3954. break;
  3955. case F_PDL_X_N:
  3956. /* N = PDL( X ) */
  3957. {
  3958. /* P1BYT */
  3959. WARN_ADVANCED_FEATURE;
  3960. }
  3961. break;
  3962. case F_WAIT_X_Y_N:
  3963. /* WAIT X, Y */
  3964. {
  3965. /* P1NUM|P2NUM */
  3966. /* P1INT|P2BYT */
  3967. WARN_ADVANCED_FEATURE;
  3968. }
  3969. break;
  3970. case F_WAIT_X_Y_Z_N:
  3971. /* WAIT X, Y, Z */
  3972. {
  3973. /* P1NUM|P2NUM|P3NUM */
  3974. /* P1INT|P2BYT|P3BYT */
  3975. WARN_ADVANCED_FEATURE;
  3976. }
  3977. break;
  3978. case F_OUT_X_Y_N:
  3979. /* OUT X, Y */
  3980. {
  3981. /* P1NUM|P2NUM */
  3982. /* P1INT|P2BYT */
  3983. WARN_ADVANCED_FEATURE;
  3984. }
  3985. break;
  3986. case F_PEEK_X_N:
  3987. case F_EXAM_X_N:
  3988. case F_FETCH_X_N:
  3989. case F_DPEEK_X_N:
  3990. /* N = PEEK( X ) */
  3991. /* N = EXAM( X ) */
  3992. /* N = FETCH( X ) */
  3993. /* N = DPEEK( X ) */
  3994. {
  3995. /* P1INT */
  3996. WARN_ADVANCED_FEATURE;
  3997. }
  3998. break;
  3999. case F_POKE_X_Y_N:
  4000. case F_FILL_X_Y_N:
  4001. case F_STUFF_X_Y_N:
  4002. case F_DPOKE_X_Y_N:
  4003. /* POKE X, Y */
  4004. /* FILL X, Y */
  4005. /* STUFF X, Y */
  4006. /* DPOKE X, Y */
  4007. {
  4008. /* P1NUM|P2NUM */
  4009. /* P1INT|P2BYT */
  4010. WARN_ADVANCED_FEATURE;
  4011. }
  4012. break;
  4013. case F_LOCK_X_N:
  4014. /* LOCK X */
  4015. {
  4016. /* P1INT */
  4017. WARN_ADVANCED_FEATURE;
  4018. }
  4019. break;
  4020. case F_UNLOCK_X_N:
  4021. /* UNLOCK X */
  4022. {
  4023. /* P1INT */
  4024. WARN_ADVANCED_FEATURE;
  4025. }
  4026. break;
  4027. case F_USR_N:
  4028. case F_USR0_N:
  4029. case F_USR1_N:
  4030. case F_USR2_N:
  4031. case F_USR3_N:
  4032. case F_USR4_N:
  4033. case F_USR5_N:
  4034. case F_USR6_N:
  4035. case F_USR7_N:
  4036. case F_USR8_N:
  4037. case F_USR9_N:
  4038. case F_EXF_N:
  4039. case F_UUF_N:
  4040. /* N = USR( ... ) */
  4041. /* N = USR0( ... ) */
  4042. /* N = USR1( ... ) */
  4043. /* N = USR2( ... ) */
  4044. /* N = USR3( ... ) */
  4045. /* N = USR4( ... ) */
  4046. /* N = USR5( ... ) */
  4047. /* N = USR6( ... ) */
  4048. /* N = USR7( ... ) */
  4049. /* N = USR8( ... ) */
  4050. /* N = USR9( ... ) */
  4051. /* N = EXF( ... ) */
  4052. /* N = UUF( ... ) */
  4053. {
  4054. /* ... */
  4055. WARN_ADVANCED_FEATURE;
  4056. }
  4057. break;
  4058. case F_VARPTR_N:
  4059. case F_NAME_N:
  4060. case F_PTR_N:
  4061. /* N = VARPTR( ... ) */
  4062. /* N = NAME( ... ) */
  4063. /* N = PTR( ... ) */
  4064. {
  4065. /* ... */
  4066. WARN_ADVANCED_FEATURE;
  4067. }
  4068. break;
  4069. case F_FRE_N:
  4070. case F_FRE_X_N:
  4071. case F_FRE_A_N:
  4072. case F_FREE_N:
  4073. case F_FREE_X_N:
  4074. case F_FREE_A_N:
  4075. case F_MEM_N:
  4076. case F_TOP_N:
  4077. /* N = FRE( ) */
  4078. /* N = FRE( X ) */
  4079. /* N = FRE( X$ ) */
  4080. /* N = FREE( ) */
  4081. /* N = FREE( X ) */
  4082. /* N = FREE( X$ ) */
  4083. /* N = MEM( ) */
  4084. /* N = TOP( ) */
  4085. {
  4086. N = 32000; /* reasonable value */
  4087. }
  4088. break;
  4089. case F_CLS_N:
  4090. case F_HOME_N:
  4091. /* CLS */
  4092. /* HOME */
  4093. {
  4094. /* PNONE */
  4095. bwx_CLS ();
  4096. }
  4097. break;
  4098. case F_LOCATE_X_Y_N:
  4099. /* LOCATE X, Y */
  4100. {
  4101. /* P1NUM|P2NUM */
  4102. /* P1BYT|P2BYT */
  4103. bwx_LOCATE (x, y);
  4104. }
  4105. break;
  4106. case F_CUR_X_Y_S:
  4107. /* CUR X, Y */
  4108. {
  4109. /* P1NUM|P2NUM */
  4110. /* P1BYT|P2BYT */
  4111. x++; /* 0-based to 1-based row */
  4112. y++; /* 0-based to 1-based col */
  4113. bwx_LOCATE (x, y);
  4114. s = 0;
  4115. }
  4116. break;
  4117. case F_VTAB_X_N:
  4118. /* VTAB X */
  4119. {
  4120. /* P1BYT */
  4121. /* X is 1-based row */
  4122. /* col is 1 */
  4123. bwx_LOCATE (x, 1);
  4124. }
  4125. break;
  4126. case F_COLOR_X_Y_N:
  4127. /* COLOR X, Y */
  4128. {
  4129. /* P1NUM|P2NUM */
  4130. /* P1BYT|P2BYT */
  4131. /* X is Foreground color */
  4132. /* Y is Background color */
  4133. bwx_COLOR (X, Y);
  4134. }
  4135. break;
  4136. case F_SHELL_A_N:
  4137. case F_EXEC_A_N:
  4138. /* N = SHELL( A$ ) */
  4139. /* N = EXEC( A$ ) */
  4140. {
  4141. /* P1BYT */
  4142. N = system (A);
  4143. }
  4144. break;
  4145. case F_FILES_N:
  4146. case F_CATALOG_N:
  4147. /* FILES */
  4148. /* CATALOG */
  4149. {
  4150. /* PNONE */
  4151. if (is_empty_string (My->OptionFilesString))
  4152. {
  4153. WARN_ADVANCED_FEATURE;
  4154. }
  4155. else
  4156. {
  4157. N = system (My->OptionFilesString);
  4158. }
  4159. }
  4160. break;
  4161. case F_FILES_A_N:
  4162. case F_CATALOG_A_N:
  4163. /* FILES A$ */
  4164. /* CATALOG A$ */
  4165. {
  4166. /* P1BYT */
  4167. if (is_empty_string (My->OptionFilesString))
  4168. {
  4169. WARN_ADVANCED_FEATURE;
  4170. }
  4171. else
  4172. {
  4173. size_t n;
  4174. char *Buffer;
  4175. n = bwb_strlen (My->OptionFilesString) + 1 /* SpaceChar */ + a;
  4176. if ((Buffer =
  4177. (char *) calloc (n + 1 /* NulChar */ , sizeof (char))) == NULL)
  4178. {
  4179. WARN_OUT_OF_MEMORY;
  4180. }
  4181. else
  4182. {
  4183. bwb_strcpy (Buffer, My->OptionFilesString);
  4184. bwb_strcat (Buffer, " ");
  4185. bwb_strcat (Buffer, A);
  4186. N = system (Buffer);
  4187. free (Buffer);
  4188. Buffer = NULL;
  4189. }
  4190. }
  4191. }
  4192. break;
  4193. case F_CHDIR_A_N:
  4194. /* CHDIR A$ */
  4195. {
  4196. /* P1BYT */
  4197. #if DIRECTORY_CMDS
  4198. N = chdir (A);
  4199. #else
  4200. WARN_ADVANCED_FEATURE;
  4201. #endif
  4202. }
  4203. break;
  4204. case F_MKDIR_A_N:
  4205. /* MKDIR A$ */
  4206. {
  4207. /* P1BYT */
  4208. #if DIRECTORY_CMDS
  4209. #if MKDIR_ONE_ARG
  4210. N = mkdir (A);
  4211. #else
  4212. N = mkdir (A, PERMISSIONS);
  4213. #endif
  4214. #else
  4215. WARN_ADVANCED_FEATURE;
  4216. #endif
  4217. }
  4218. break;
  4219. case F_RMDIR_A_N:
  4220. /* RMDIR A$ */
  4221. {
  4222. /* P1BYT */
  4223. #if DIRECTORY_CMDS
  4224. N = rmdir (A);
  4225. #else
  4226. WARN_ADVANCED_FEATURE;
  4227. #endif
  4228. }
  4229. break;
  4230. case F_KILL_A_N:
  4231. case F_UNSAVE_A_N:
  4232. /* KILL A$ */
  4233. /* UNSAVE A$ */
  4234. {
  4235. /* P1BYT */
  4236. N = remove (A);
  4237. }
  4238. break;
  4239. case F_NAME_A_B_N:
  4240. /* NAME A$ AS B$ */
  4241. /* N = NAME( A$, B$ ) */
  4242. {
  4243. /* P1BYT|P2BYT */
  4244. N = rename (A, B);
  4245. }
  4246. break;
  4247. case F_INPUT4_X_S:
  4248. /* S$ = INPUT$( X ) */
  4249. {
  4250. /* P1LEN */
  4251. if (x == 0)
  4252. {
  4253. /* empty string */
  4254. }
  4255. else
  4256. {
  4257. for (s = 0; s < x; s++)
  4258. {
  4259. int c;
  4260. c = fgetc (My->SYSIN->cfp);
  4261. if ((c == EOF) || (c == '\n') || (c == '\r'))
  4262. {
  4263. break;
  4264. }
  4265. S[s] = c;
  4266. }
  4267. S[s] = 0;
  4268. }
  4269. }
  4270. break;
  4271. case F_INKEY4_S:
  4272. case F_KEY4_S:
  4273. case F_KEY_S:
  4274. case F_INCH4_S:
  4275. /* S$ = INKEY$ */
  4276. /* S$ = KEY$ */
  4277. /* S$ = KEY */
  4278. /* S$ = INCH$ */
  4279. {
  4280. /* PNONE */
  4281. int c;
  4282. c = fgetc (My->SYSIN->cfp);
  4283. if (c < MINBYT || c > MAXBYT)
  4284. {
  4285. /* EOF */
  4286. }
  4287. else
  4288. {
  4289. S[s] = c;
  4290. s++;
  4291. }
  4292. S[s] = 0;
  4293. }
  4294. break;
  4295. case F_NULL_X_N:
  4296. /* NULL X */
  4297. {
  4298. /* P1NUM */
  4299. /* P1BYT */
  4300. My->LPRINT_NULLS = x;
  4301. N = 0;
  4302. }
  4303. break;
  4304. case F_LWIDTH_X_N:
  4305. /* LWIDTH X */
  4306. {
  4307. /* P1NUM */
  4308. /* P1BYT */
  4309. My->SYSPRN->width = x;
  4310. My->SYSPRN->col = 1;
  4311. N = 0;
  4312. }
  4313. break;
  4314. case F_LPOS_N:
  4315. /* N = LPOS */
  4316. {
  4317. /* PNONE */
  4318. /* PNONE */
  4319. N = My->SYSPRN->col;
  4320. }
  4321. break;
  4322. case F_TRON_N:
  4323. case F_TRACE_N:
  4324. case F_FLOW_N:
  4325. /* TRON */
  4326. /* TRACE */
  4327. /* FLOW */
  4328. {
  4329. /* PNONE */
  4330. fprintf (My->SYSOUT->cfp, "Trace is ON\n");
  4331. ResetConsoleColumn ();
  4332. My->IsTraceOn = TRUE;
  4333. N = 0;
  4334. }
  4335. break;
  4336. case F_TROFF_N:
  4337. case F_NOTRACE_N:
  4338. case F_NOFLOW_N:
  4339. /* TROFF */
  4340. /* NOTRACE */
  4341. /* NOFLOW */
  4342. {
  4343. /* PNONE */
  4344. fprintf (My->SYSOUT->cfp, "Trace is OFF\n");
  4345. ResetConsoleColumn ();
  4346. My->IsTraceOn = FALSE;
  4347. N = 0;
  4348. }
  4349. break;
  4350. case F_TRACE_X_N:
  4351. /* TRACE X */
  4352. {
  4353. /* P1BYTE */
  4354. if (x == 0)
  4355. {
  4356. fprintf (My->SYSOUT->cfp, "Trace is OFF\n");
  4357. ResetConsoleColumn ();
  4358. My->IsTraceOn = FALSE;
  4359. }
  4360. else
  4361. {
  4362. fprintf (My->SYSOUT->cfp, "Trace is ON\n");
  4363. ResetConsoleColumn ();
  4364. My->IsTraceOn = TRUE;
  4365. }
  4366. N = 0;
  4367. }
  4368. break;
  4369. case F_RANDOMIZE_N:
  4370. case F_RAN_N:
  4371. case F_RANDOM_N:
  4372. /* RANDOMIZE */
  4373. /* RAN */
  4374. /* RANDOM */
  4375. {
  4376. /* PNONE */
  4377. /* USE THE CURRENT TIME AS THE SEED */
  4378. time (&t);
  4379. lt = localtime (&t);
  4380. x = lt->tm_hour * 3600 + lt->tm_min * 60 + lt->tm_sec;
  4381. srand (x);
  4382. N = 0;
  4383. }
  4384. break;
  4385. case F_RANDOMIZE_X_N:
  4386. case F_RAN_X_N:
  4387. case F_RANDOM_X_N:
  4388. /* RANDOMIZE X */
  4389. /* RAN X */
  4390. /* RANDOM X */
  4391. {
  4392. /* P1NUM */
  4393. /* P1ANY */
  4394. /* USE 'X' AS THE SEED */
  4395. x = (int) bwb_rint (X);
  4396. srand (x);
  4397. N = 0;
  4398. }
  4399. break;
  4400. case F_LNO_X_N:
  4401. /* N = LNO( X, Y ) */
  4402. {
  4403. /* P1NUM */
  4404. /* P1ANY */
  4405. N = X;
  4406. }
  4407. break;
  4408. case F_PAD_X_N:
  4409. case F_SEG_X_N:
  4410. /* N = PAD( X ) */
  4411. /* N = SEG( X ) */
  4412. {
  4413. /* P1NUM */
  4414. /* P1ANY */
  4415. N = 0;
  4416. }
  4417. break;
  4418. case F_CNTRL_X_Y_N:
  4419. /* N = CNTRL( X, Y ) */
  4420. {
  4421. /* P1NUM | P2NUM */
  4422. /* P1INT | P2INT */
  4423. switch (x)
  4424. {
  4425. case 0:
  4426. /*
  4427. CNTRL 0,line
  4428. This specifies a line to go to when the user presses Ctl-B.
  4429. */
  4430. break;
  4431. case 1:
  4432. /*
  4433. CNTRL 1,value
  4434. This sets the number of digits (1 to 6) to print
  4435. */
  4436. if (y == 0)
  4437. {
  4438. /* default */
  4439. y = SIGNIFICANT_DIGITS;
  4440. }
  4441. if (y < MINIMUM_DIGITS || y > MAXIMUM_DIGITS)
  4442. {
  4443. WARN_ILLEGAL_FUNCTION_CALL;
  4444. }
  4445. else
  4446. {
  4447. My->OptionDigitsInteger = y;
  4448. }
  4449. break;
  4450. case 2:
  4451. /*
  4452. CNTRL 2,value
  4453. This controls the front panel LED display.
  4454. */
  4455. break;
  4456. case 3:
  4457. /*
  4458. CNTRL 3,value
  4459. This command sets the width of the print zones.
  4460. */
  4461. if (y == 0)
  4462. {
  4463. /* default */
  4464. y = ZONE_WIDTH;
  4465. }
  4466. if (y < MINIMUM_ZONE || y > MAXIMUM_ZONE)
  4467. {
  4468. WARN_ILLEGAL_FUNCTION_CALL;
  4469. }
  4470. else
  4471. {
  4472. My->OptionZoneInteger = y;
  4473. }
  4474. break;
  4475. case 4:
  4476. /*
  4477. CNTRL 4,value
  4478. This command is used to load and unload the main HDOS overlay.
  4479. */
  4480. break;
  4481. default:
  4482. WARN_ILLEGAL_FUNCTION_CALL;
  4483. break;
  4484. }
  4485. N = 0;
  4486. }
  4487. break;
  4488. case F_ZONE_X_N:
  4489. /* N = ZONE( X ) */
  4490. {
  4491. /* P1NUM */
  4492. /* P1INT */
  4493. if (x == 0)
  4494. {
  4495. /* default */
  4496. x = ZONE_WIDTH;
  4497. }
  4498. if (x < MINIMUM_ZONE || x > MAXIMUM_ZONE)
  4499. {
  4500. WARN_ILLEGAL_FUNCTION_CALL;
  4501. }
  4502. else
  4503. {
  4504. My->OptionZoneInteger = x;
  4505. }
  4506. }
  4507. break;
  4508. case F_ZONE_X_Y_N:
  4509. /* N = ZONE( X, Y ) */
  4510. {
  4511. /* P1NUM | P2NUM */
  4512. /* P1INT | P2INT */
  4513. /* value of X is ignored */
  4514. if (y == 0)
  4515. {
  4516. /* default */
  4517. y = ZONE_WIDTH;
  4518. }
  4519. if (y < MINIMUM_ZONE || y > MAXIMUM_ZONE)
  4520. {
  4521. WARN_ILLEGAL_FUNCTION_CALL;
  4522. }
  4523. else
  4524. {
  4525. My->OptionZoneInteger = y;
  4526. }
  4527. }
  4528. break;
  4529. case F_CIN_X_N:
  4530. /* N = CIN( X ) */
  4531. {
  4532. /* P1INT */
  4533. if (x <= 0)
  4534. {
  4535. /* Printer and Console */
  4536. N = -1;
  4537. }
  4538. else
  4539. {
  4540. FileType *F;
  4541. F = find_file_by_number (x);
  4542. if (F == NULL)
  4543. {
  4544. N = -1;
  4545. }
  4546. else if (F->DevMode & DEVMODE_READ)
  4547. {
  4548. N = fgetc (F->cfp);
  4549. }
  4550. else
  4551. {
  4552. N = -1;
  4553. }
  4554. }
  4555. }
  4556. break;
  4557. case F_TRUE_N:
  4558. /* N = TRUE */
  4559. {
  4560. /* PNONE */
  4561. N = TRUE;
  4562. }
  4563. break;
  4564. case F_FALSE_N:
  4565. /* N = FALSE */
  4566. {
  4567. /* PNONE */
  4568. N = FALSE;
  4569. }
  4570. break;
  4571. default:
  4572. {
  4573. /* an unknown function code */
  4574. WARN_INTERNAL_ERROR;
  4575. }
  4576. }
  4577. /* sanity check */
  4578. if (f->ReturnTypeCode == StringTypeCode)
  4579. {
  4580. /* STRING */
  4581. if ( /* s < 0 || */ s > MAXLEN)
  4582. {
  4583. WARN_INTERNAL_ERROR;
  4584. s = 0;
  4585. }
  4586. if (S != RESULT_BUFFER)
  4587. {
  4588. WARN_INTERNAL_ERROR;
  4589. S = RESULT_BUFFER;
  4590. }
  4591. RESULT_LENGTH = s;
  4592. RESULT_BUFFER[RESULT_LENGTH] = NulChar;
  4593. }
  4594. else
  4595. {
  4596. /* NUMBER */
  4597. if (isnan (N))
  4598. {
  4599. /* ERROR */
  4600. /* this means the parameters were not properly checked */
  4601. WARN_INTERNAL_ERROR;
  4602. N = 0;
  4603. }
  4604. else if (isinf (N))
  4605. {
  4606. /* Evaluation of an expression results in an
  4607. * overflow (nonfatal, the recommended
  4608. * recovery procedure is to supply machine
  4609. * in- finity with the algebraically correct
  4610. * sign and continue). */
  4611. if (N < 0)
  4612. {
  4613. N = MINDBL;
  4614. }
  4615. else
  4616. {
  4617. N = MAXDBL;
  4618. }
  4619. WARN_OVERFLOW;
  4620. }
  4621. RESULT_NUMBER = N;
  4622. }
  4623. return argv; /* released by exp_function() in bwb_elx.c */
  4624. }
  4625. /* EOF */