/**************************************************************** bwb_fnc.c Interpretation Routines for Predefined Functions for Bywater BASIC Interpreter Copyright (c) 1993, Ted A. Campbell Bywater Software email: tcamp@delphi.com Copyright and Permissions Information: All U.S. and international rights are claimed by the author, Ted A. Campbell. This software is released under the terms of the GNU General Public License (GPL), which is distributed with this software in the file "COPYING". The GPL specifies the terms under which users may copy and use the software in this distribution. A separate license is available for commercial distribution, for information on which you should contact the author. ***************************************************************/ /*---------------------------------------------------------------*/ /* NOTE: Modifications marked "JBV" were made by Jon B. Volkoff, */ /* 11/1995 (eidetics@cerf.net). */ /* */ /* Those additionally marked with "DD" were at the suggestion of */ /* Dale DePriest (daled@cadence.com). */ /* */ /* Version 3.00 by Howard Wulf, AF5NE */ /* */ /*---------------------------------------------------------------*/ #include "bwbasic.h" #ifndef RAND_MAX /* added in v1.11 */ #define RAND_MAX 32767 #endif static time_t t; static struct tm *lt; /* ORD() Table 1 */ /* ACRONYM */ typedef struct { const int Value; const char *Name; } Acronym; #define NUM_ACRONYMS (34) Acronym AcronymTable[NUM_ACRONYMS] = { {0, "NUL"}, {1, "SOH"}, {2, "STX"}, {3, "ETX"}, {4, "EOT"}, {5, "ENQ"}, {6, "ACK"}, {7, "BEL"}, {8, "BS"}, {9, "HT"}, {10, "LF"}, {11, "VT"}, {12, "FF"}, {13, "CR"}, {14, "SO"}, {15, "SI"}, {16, "DLE"}, {17, "DC1"}, {18, "DC2"}, {19, "DC3"}, {20, "DC4"}, {21, "NAK"}, {22, "SYN"}, {23, "ETB"}, {24, "CAN"}, {25, "EM"}, {26, "SUB"}, {27, "ESC"}, {28, "FS"}, {29, "GS"}, {30, "RS"}, {31, "US"}, {32, "SP"}, {127, "DEL"} }; /* ... ORD() */ struct bwb_variable * fnc_intrinsic(int argc, struct bwb_variable * argv, int unique_id) { /* // this is the generic handler for all intrinsic BASIC functions */ /* BasicStringLengthMax must be <= INT_MAX */ struct bwb_function *f; struct bwb_variable *argn; unsigned char IsError;/* for ERROR messages */ /* Follow the BASIC naming conventions, so the code is easier to * maintain */ char *S; /* S$ - STRING functions */ BasicStringLengthType s;/* LEN( S$ ) */ BasicNumberType N; /* N - NUMBER functions */ char *A; /* A$ - 1st STRING parameter */ BasicStringLengthType a;/* LEN( A$ ) */ char *B; /* B$ - 2nd STRING parameter */ BasicStringLengthType b;/* LEN( B$ ) */ #if FALSE char *C; /* C$ - 3rd STRING parameter */ BasicStringLengthType c;/* LEN( C$ ) */ #endif BasicNumberType X; /* X - 1st NUMBER parameter */ BasicIntegerType x; /* INT( X ) */ BasicNumberType Y; /* Y - 2nd NUMBER parameter */ BasicIntegerType y; /* INT( Y ) */ #if FALSE BasicNumberType Z; /* Z - 3rd NUMBER parameter */ BasicIntegerType z; /* INT( Z ) */ #endif bwx_DEBUG(__FUNCTION__); /* so the following code is easier to read and maintain */ #define PARAM_NUMBER *argn->memnum #define PARAM_LENGTH argn->memstr->length #define PARAM_BUFFER argn->memstr->sbuffer #define RESULT_NUMBER *argv->memnum #define RESULT_BUFFER argv->memstr->sbuffer #define RESULT_LENGTH argv->memstr->length /* no errors have occurred (yet) */ IsError = 0; /* look up the intrinsic function, so we can get the details */ { f = fnc_find_by_id(unique_id); if (f == NULL) { /* bwb_prefuncs[] in bwb_tbl.c is wrong -- this is * really bad */ sprintf(bwb_ebuf, "INTERNAL ERROR in fnc_intrinsic() - did not find unique_id %d", unique_id); bwb_error(bwb_ebuf); return NULL; } } /* the RETURN variable is the first variable in the 'argv' vaariable * chain */ if (argv == NULL) { bwb_error("INTERNAL ERROR"); return argv; } if (argv->type == STRING) { if (argv->memstr == NULL) { bwb_error("INTERNAL ERROR"); return argv; } RESULT_LENGTH = 0; RESULT_BUFFER[RESULT_LENGTH] = '\0'; } else { if (argv->memnum == NULL) { bwb_error("INTERNAL ERROR"); return argv; } RESULT_NUMBER = 0; } argn = argv; /* don't make a bad situation worse */ if (ERROR_PENDING) { /* An unrecognized NON-FATAL ERROR is pending. Just return a * sane value. */ /* LET N = LOG(SQR(X)) ' X = -1 */ return argv; } /* Follow the BASIC naming conventions, so the code is easier to read * and maintain */ { int i; int StrCount = 0; /* count of STRING parameters * - NEVER > 3 */ int NumCount = 0; /* count of NUMBER parameters * - NEVER > 3 */ unsigned long ParameterTests; ParameterTests = f->ParameterTests; /* assign reasonable default values */ S = NULL; /* S$ - return value is a STRING */ s = 0; /* LEN( S$ ) */ N = 0; /* N - return value is a NUMBER */ A = NULL; /* A$ - 1st STRING parameter */ a = 0; /* LEN( A$ ) */ B = NULL; /* B$ - 2nd STRING parameter */ b = 0; /* LEN( B$ ) */ #if FALSE C = NULL; /* C$ - 3rd STRING parameter */ c = 0; /* LEN( C$ ) */ #endif X = 0; /* X - 1st NUMBER parameter */ x = 0; /* INT( X ) */ Y = 0; /* Y - 2nd NUMBER parameter */ y = 0; /* INT( Y ) */ #if FALSE Z = 0; /* Z - 3rd NUMBER parameter */ z = 0; /* INT( Z ) */ #endif /* assign actual values */ if (f->ReturnType == STRING) { S = RESULT_BUFFER; s = RESULT_LENGTH; } else { N = RESULT_NUMBER; } for (i = 0; i < argc && IsError == 0; i++) { argn = argn->next; if (argn == NULL) { bwb_error("INTERNAL ERROR"); return argv; } if (argn->type == STRING) { if (argn->memstr == NULL) { bwb_error("INTERNAL ERROR"); return argv; } StrCount++; switch (StrCount) { case 1: /* 1st STRING parameter = A$ */ A = PARAM_BUFFER; a = PARAM_LENGTH; if (StringLengthCheck(ParameterTests, a)) { IsError = 'A'; } else { A[a] = 0; } break; case 2: /* 2nd STRING parameter = B$ */ B = PARAM_BUFFER; b = PARAM_LENGTH; if (StringLengthCheck(ParameterTests, b)) { IsError = 'B'; } else { B[b] = 0; } break; #if FALSE case 3: /* 3rd STRING parameter = C$ */ /* not currently used */ C = PARAM_BUFFER; c = PARAM_LENGTH; if (StringLengthCheck(ParameterTests, c)) { IsError = 'C'; } else { C[c] = 0; } break; #endif default: /* Nth STRING parameter = ERROR */ IsError = i + 1; break; } } else { if (argn->memnum == NULL) { bwb_error("INTERNAL ERROR"); return argv; } NumCount++; switch (NumCount) { case 1: /* 1st NUMBER parameter = X */ X = PARAM_NUMBER; if (NumberValueCheck(ParameterTests, X)) { IsError = 'X'; } else { BasicNumberType R; R = rint(X); if (R < INT_MIN || R > INT_MAX) { /* certainly not a * classic BASIC * integer */ } else { /* Many classic BASIC * intrinsic * functions use the * rounded integer * value. */ x = (int) R; } } break; case 2: /* 2nd NUMBER parameter = Y */ Y = PARAM_NUMBER; if (NumberValueCheck(ParameterTests, Y)) { IsError = 'Y'; } else { BasicNumberType R; R = rint(Y); if (R < INT_MIN || R > INT_MAX) { /* certainly not a * classic BASIC * integer */ } else { /* Many classic BASIC * intrinsic * functions use the * rounded integer * value. */ y = (int) R; } } break; #if FALSE case 3: /* 3rd NUMBER parameter = Z */ /* not currently used */ Z = PARAM_NUMBER; if (NumberValueCheck(ParameterTests, Z)) { IsError = 'Z'; } else { BasicNumberType R; R = rint(Z); if (R < INT_MIN || R > INT_MAX) { /* certainly not a * classic BASIC * integer */ } else { /* Many classic BASIC * intrinsic * functions use the * rounded integer * value. */ z = (int) R; } } break; #endif default: /* Nth NUMBER parameter = ERROR */ IsError = i + 1; break; } } ParameterTests = ParameterTests >> 4; } } #ifndef PI #define PI 3.14159265358979323846 #endif /* PI */ #define MIN( X, Y ) X < Y ? X : Y; #define MAX( X, Y ) X > Y ? X : Y; /* execute the intrinsic function */ if (IsError == 0 /* WARNING -- do NOT execute a BASIC intrinsic function with bogus parameters */ ) switch (unique_id) { /* ALL paramters have been checked for TYPE MISMATCH * and INVALID RANGE */ /* ONLY A HANDFUL OF ERRORS CAN OCCUR */ case 0: { /* INTERNAL ERROR */ IsError = 1; } break; case F_DEF_FN_N: { /* INTERNAL ERROR */ IsError = 1; } break; case F_ARGC_N: /* N = ARGC */ { /* determine number of parameters to the * current USER DEFINED FUNCTION */ int n; n = 0; if (CURTASK exsc >= 0) { int Loop; int i; Loop = TRUE; for (i = CURTASK exsc; i >= 0 && Loop == TRUE; i--) { if (CURTASK excs[i].LoopTopLine != NULL) { switch (CURTASK excs[i].LoopTopLine->cmdnum) { case C_FUNCTION: case C_SUB: /* we have * checked * all the * way to a * FUNCTION * or SUB * boundary */ /* FOUND */ { struct bwb_variable *v; for (v = CURTASK excs[i].local_variable; v != NULL && Loop == TRUE; v = v->next) { n++; } } Loop = FALSE; break; } } } } n--; /* FUNCTION or SUB name */ N = n; } break; case F_ARGT_X_S: /* S$ = ARGT$( X ) */ { /* determine parameter type to the current * USER DEFINED FUNCTION */ int Found; int n; Found = FALSE; n = 0; s = 0; if (x < 1) { /* bad param number */ } else if (CURTASK exsc >= 0) { int Loop; int i; Loop = TRUE; for (i = CURTASK exsc; i >= 0 && Loop == TRUE; i--) { if (CURTASK excs[i].LoopTopLine != NULL) { switch (CURTASK excs[i].LoopTopLine->cmdnum) { case C_FUNCTION: case C_SUB: /* we hav e * che cke d * all * * the * * way to a FUN * CTI ON or * SUB * * boun dar y */ /* FOU ND */ { struct bwb_variable *v; for (v = CURTASK excs[i].local_variable; v != NULL && Loop == TRUE; v = v->next) { if (n == x) { if (v->type == STRING) { S[0] = BasicStringSuffix; s = 1; Found = TRUE; } else { S[0] = BasicDoubleSuffix; s = 1; Found = TRUE; } Loop = FALSE; } n++; } } Loop = FALSE; break; } } } } if (Found == FALSE) { IsError = 'X'; } } break; case F_ARGV_X_S: /* S$ = ARGV$( X ) */ { /* determine parameter value to the current * USER DEFINED FUNCTION */ int Found; int n; Found = FALSE; n = 0; if (x < 1) { /* bad param number */ } else if (CURTASK exsc >= 0) { int Loop; int i; Loop = TRUE; for (i = CURTASK exsc; i >= 0 && Loop == TRUE; i--) { if (CURTASK excs[i].LoopTopLine != NULL) { switch (CURTASK excs[i].LoopTopLine->cmdnum) { case C_FUNCTION: case C_SUB: /* FOU ND */ { struct bwb_variable *v; for (v = CURTASK excs[i].local_variable; v != NULL && Loop == TRUE; v = v->next) { if (n == x) { if (v->type == STRING) { s = v->memstr->length; memcpy(S, v->memstr->sbuffer, s); Found = TRUE; } else { } Loop = FALSE; } n++; } } Loop = FALSE; break; } } } } if (Found == FALSE) { IsError = 'X'; } } break; case F_ARGV_X_N: /* S$ = ARGV( X ) */ { /* determine parameter value to the current * USER DEFINED FUNCTION */ int Found; int n; Found = FALSE; n = 0; if (x < 1) { /* bad param number */ } else if (CURTASK exsc >= 0) { int Loop; int i; Loop = TRUE; for (i = CURTASK exsc; i >= 0 && Loop == TRUE; i--) { if (CURTASK excs[i].LoopTopLine != NULL) { switch (CURTASK excs[i].LoopTopLine->cmdnum) { case C_FUNCTION: case C_SUB: /* FOU ND */ { struct bwb_variable *v; for (v = CURTASK excs[i].local_variable; v != NULL && Loop == TRUE; v = v->next) { if (n == x) { if (v->type == STRING) { } else { N = *v->memnum; Found = TRUE; } Loop = FALSE; } n++; } } Loop = FALSE; break; } } } } if (Found == FALSE) { IsError = 'X'; } } break; case F_ASC_A_N: /* N = ASC( A$ ) */ { /* P1BYT */ N = A[0]; } break; case F_CDBL_X_N: /* N = CDBL( X ) */ { /* P1DBL */ N = X; } break; case F_CSNG_X_N: /* N = CSNG( X ) */ { /* P1FLT */ N = X; } break; case F_CINT_X_N: /* N = CINT( X ) */ { /* P1INT */ N = rint(X); } break; case F_CLNG_X_N: /* N = CLNG( X ) */ { /* P1LNG */ N = rint(X); } break; case F_CCUR_X_N: /* N = CCUR( X ) */ { /* P1CUR */ N = rint(X); } break; case F_MKD_X_S: /* S$ = MKD$( X ) */ { /* P1DBL */ BasicDoubleType x; x = (BasicDoubleType) X; s = sizeof(BasicDoubleType); memcpy(S, &x, s); } break; case F_MKS_X_S: /* S$ = MKS$( X ) */ { /* P1FLT */ BasicSingleType x; x = (BasicSingleType) X; s = sizeof(BasicSingleType); memcpy(S, &x, s); } break; case F_MKI_X_S: /* S$ = MKI$( X ) */ { /* P1INT */ BasicIntegerType x; x = (BasicIntegerType) rint(X); s = sizeof(BasicIntegerType); memcpy(S, &x, s); } break; case F_MKL_X_S: /* S$ = MKL$( X ) */ { /* P1LNG */ BasicLongType x; x = (BasicLongType) rint(X); s = sizeof(BasicLongType); memcpy(S, &x, s); } break; case F_MKC_X_S: /* S$ = MKC$( X ) */ { /* P1CUR */ BasicCurrencyType x; x = (BasicCurrencyType) rint(X); s = sizeof(BasicCurrencyType); memcpy(S, &x, s); } break; case F_CVD_A_N: /* N = CVD( A$ ) */ { /* P1DBL */ BasicDoubleType n; a = sizeof(BasicDoubleType); memcpy(&n, A, a); N = n; } break; case F_CVS_A_N: /* N = CVS( X$ ) */ { /* P1FLT */ BasicSingleType n; a = sizeof(BasicSingleType); memcpy(&n, A, a); N = n; } break; case F_CVI_A_N: /* N = CVI( X$ ) */ { /* P1INT */ BasicIntegerType n; a = sizeof(BasicIntegerType); memcpy(&n, A, a); N = n; } break; case F_CVL_A_N: /* N = CVL( X$ ) */ { /* P1LNG */ BasicLongType n; a = sizeof(BasicLongType); memcpy(&n, A, a); N = n; } break; case F_CVC_A_N: /* N = CVC( X$ ) */ { /* P1CUR */ BasicCurrencyType n; a = sizeof(BasicCurrencyType); memcpy(&n, A, a); N = n; } break; case F_ENVIRON_A_S: /* S$ = ENVIRON$( A$ ) */ { /* P1BYT */ char *CharPointer; CharPointer = getenv(A); if (CharPointer == NULL) { /* empty string */ } else { s = strlen(CharPointer); s = MIN(s, BasicStringLengthMax); if (s == 0) { /* empty string */ } else { memcpy(S, CharPointer, s); } } } break; case F_ENVIRON_A_N: /* ENVIRON A$ */ { /* P1BYT */ char *CharPointer; CharPointer = strchr(A, '='); if (CharPointer == NULL) { /* missing required '=' */ IsError = 'A'; } else { if (putenv(A) == -1) { IsError = 'A'; } else { /* OK */ N = 0; } } } break; case F_OPEN_A_X_B_Y_N: /* OPEN "I"|"O"|"R"|"A", [#]n, filename [,rlen] */ { /* P1STR|P2NUM|P3STR|P4NUM */ /* P1BYT|P2DEV|P3BYT|P4INT */ int mode; while (*A == ' ') { A++; /* LTRIM$ */ } mode = ToUpper(*A); switch (mode) { case 'I': case 'O': case 'A': case 'B': case 'R': break; default: mode = DEVMODE_CLOSED; break; } if (x == CONSOLE_FILE_NUMBER) { IsError = 'X'; } else if (mode == DEVMODE_CLOSED) { IsError = 'A'; } else if (dev_table[x].mode != DEVMODE_CLOSED) { IsError = 'X'; } else if (y < 0) { IsError = 'Y'; } else if (y == 0 && mode == 'R') { IsError = 'Y'; } else { FILE *fp = NULL; char *buffer = NULL; switch (mode) { case 'I': mode = DEVMODE_INPUT; fp = fopen(B, "r"); y = 0; break; case 'O': mode = DEVMODE_OUTPUT; fp = fopen(B, "w"); y = 0; break; case 'A': mode = DEVMODE_APPEND; fp = fopen(B, "a"); y = 0; break; case 'B': mode = DEVMODE_BINARY; fp = fopen(B, "r+"); if (fp == NULL) { fp = fopen(B, "w"); fclose(fp); fp = fopen(B, "r+"); } y = 0; break; case 'R': mode = DEVMODE_RANDOM; fp = fopen(B, "r+"); if (fp == NULL) { fp = fopen(B, "w"); fclose(fp); fp = fopen(B, "r+"); } if (fp != NULL) { buffer = CALLOC(y, 1, "F_OPEN_A_X_B_Y_V"); } break; } if (fp == NULL) { /* i n v a l i d * * fi l e * * na m e */ IsError = 'B'; } else if (mode == DEVMODE_RANDOM && buffer == NULL) { /* i n v a l i d * * re c o r d * * le n g t h */ IsError = 'Y'; } else { dev_table[x].mode = mode; dev_table[x].cfp = fp; dev_table[x].width = y; /* N O T E : * * WI D T H * * == * RE C L E N */ dev_table[x].col = 1; dev_table[x].buffer = buffer; strcpy(dev_table[x].filename, B); if (mode == DEVMODE_APPEND) { fseek(fp, 0, SEEK_END); } else if (mode == DEVMODE_RANDOM) { memset(buffer, ' ', y); /* flush */ } } } } break; case F_OPEN_A_X_B_N: /* default LEN is 128 for RANDOM, 0 for all others */ /* OPEN "I"|"O"|"R"|"A", [#]n, filename [,rlen] */ { /* P1STR|P2NUM|P3STR|P4NUM */ /* P1BYT|P2DEV|P3BYT|P4INT */ int mode; int y = 0; while (*A == ' ') { A++; /* LTRIM$ */ } mode = ToUpper(*A); switch (mode) { case 'I': case 'O': case 'A': case 'B': break; case 'R': y = bwx_RANDOM_RECORD_SIZE(); break; default: mode = DEVMODE_CLOSED; break; } if (x == CONSOLE_FILE_NUMBER) { IsError = 'X'; } else if (mode == DEVMODE_CLOSED) { IsError = 'A'; } else if (dev_table[x].mode != DEVMODE_CLOSED) { IsError = 'X'; } else if (y < 0) { IsError = 'Y'; } else if (y == 0 && mode == 'R') { IsError = 'Y'; } else if (y > 0 && mode == 'B') { IsError = 'Y'; } else { FILE *fp = NULL; char *buffer = NULL; switch (mode) { case 'I': mode = DEVMODE_INPUT; fp = fopen(B, "r"); y = 0; break; case 'O': mode = DEVMODE_OUTPUT; fp = fopen(B, "w"); y = 0; break; case 'A': mode = DEVMODE_APPEND; fp = fopen(B, "a"); y = 0; break; case 'B': mode = DEVMODE_BINARY; fp = fopen(B, "r+"); if (fp == NULL) { fp = fopen(B, "w"); fclose(fp); fp = fopen(B, "r+"); } y = 0; break; case 'R': mode = DEVMODE_RANDOM; fp = fopen(B, "r+"); if (fp == NULL) { fp = fopen(B, "w"); fclose(fp); fp = fopen(B, "r+"); } if (fp != NULL) { buffer = CALLOC(y, 1, "F_OPEN_A_X_B_Y_V"); } break; } if (fp == NULL) { /* i n v a l i d * * fi l e * * na m e */ IsError = 'B'; } else if (mode == DEVMODE_RANDOM && buffer == NULL) { /* i n v a l i d * * re c o r d * * le n g t h */ IsError = 'Y'; } else { dev_table[x].mode = mode; dev_table[x].cfp = fp; dev_table[x].width = y; /* N O T E : * * WI D T H * * == * RE C L E N */ dev_table[x].col = 1; dev_table[x].buffer = buffer; strcpy(dev_table[x].filename, B); if (mode == DEVMODE_APPEND) { fseek(fp, 0, SEEK_END); } else if (mode == DEVMODE_RANDOM) { memset(buffer, ' ', y); /* flush */ } } } } break; case F_LOC_X_N: /* N = LOC( X ) */ { /* P1DEV */ if (x == CONSOLE_FILE_NUMBER) { N = 0; } else if (dev_table[x].mode == DEVMODE_CLOSED) { IsError = 'X'; } else { FILE *fp; fp = dev_table[x].cfp; N = ftell(fp); if (dev_table[x].mode == DEVMODE_RANDOM) { /* record number */ N /= dev_table[x].width; } else if (dev_table[x].mode == DEVMODE_BINARY) { /* byte position */ } else { /* byte positiion / 128 */ N /= 128; } N = floor(N); N++; /* C to BASIC */ } } break; case F_SEEK_X_N: /* N = SEEK( X ) */ { /* P1DEV */ if (x == CONSOLE_FILE_NUMBER) { N = 0; } else if (dev_table[x].mode == DEVMODE_CLOSED) { IsError = 'X'; } else { FILE *fp; fp = dev_table[x].cfp; N = ftell(fp); if (dev_table[x].mode == DEVMODE_RANDOM) { /* record number */ N /= dev_table[x].width; } else { /* byte positiion */ } N = floor(N); N++; /* C to BASIC */ } } break; case F_SEEK_X_Y_N: /* SEEK X, Y */ { /* P1DEV|P2INT */ if (x == CONSOLE_FILE_NUMBER) { IsError = 'X'; } else if (dev_table[x].mode == DEVMODE_CLOSED) { IsError = 'X'; } else if (y < 1) { IsError = 'Y'; } else { long offset; offset = y; offset--; /* BASIC to C */ if (dev_table[x].mode == DEVMODE_RANDOM) { offset *= dev_table[x].width; } if (fseek(dev_table[x].cfp, offset, SEEK_SET) != 0) { IsError = 'Y'; } else { /* OK */ N = 0; } } } break; case F_LOF_X_N: /* N = LOF( X ) */ { /* P1DEV */ if (x == CONSOLE_FILE_NUMBER) { N = 0; } else if (dev_table[x].mode == DEVMODE_CLOSED) { IsError = 'X'; } else { /* file size in bytes */ FILE *fp; int current; int total; fp = dev_table[x].cfp; current = ftell(fp); fseek(fp, 0, SEEK_END); total = ftell(fp); if (total == current) { /* EOF */ } else { fseek(fp, current, SEEK_SET); } N = total; } } break; case F_EOF_X_N: /* N = EOF( X ) */ { /* P1DEV */ if (x == CONSOLE_FILE_NUMBER) { N = 0; } else if (dev_table[x].mode == DEVMODE_CLOSED) { IsError = 'X'; } else { /* are we at the end? */ FILE *fp; int current; int total; fp = dev_table[x].cfp; current = ftell(fp); fseek(fp, 0, SEEK_END); total = ftell(fp); if (total == current) { /* EOF */ N = -1; } else { fseek(fp, current, SEEK_SET); N = 0; } } } break; case F_FILEATTR_X_Y_N: /* N = FILEATTR( X, Y ) */ { /* P1DEV|P2INT */ if (x == CONSOLE_FILE_NUMBER) { IsError = 'X'; } else { if (y == 1) { N = dev_table[x].mode; } else if (y == 2) { N = 0; } else { IsError = 'Y'; } } } break; case F_CLOSE_X_N: /* CLOSE X */ { /* P1DEV */ if (x == CONSOLE_FILE_NUMBER) { IsError = 'X'; } else if (dev_table[x].mode == DEVMODE_CLOSED) { IsError = 'X'; } else { if (dev_table[x].cfp != NULL) { fclose(dev_table[x].cfp); } if (dev_table[x].buffer != NULL) { FREE(dev_table[x].buffer, "F_CLOSE_X_N"); } dev_table[x].mode = DEVMODE_CLOSED; dev_table[x].width = 0; dev_table[x].col = 0; dev_table[x].filename[0] = '\0'; dev_table[x].cfp = NULL; dev_table[x].buffer = NULL; N = 0; } } break; case F_FREEFILE_N: /* N = FREEFILE */ { /* PNONE */ int x; for (x = 0; x <= BasicFileNumberMax; x++) { if (x == CONSOLE_FILE_NUMBER) { /* ignore */ } else if (dev_table[x].mode == DEVMODE_CLOSED) { N = x; break; } } } break; case F_RESET_N: /* RESET */ { /* PNONE */ int x; for (x = 0; x <= BasicFileNumberMax; x++) { if (x == CONSOLE_FILE_NUMBER) { /* ignore */ } else if (dev_table[x].mode != DEVMODE_CLOSED) { if (dev_table[x].cfp != NULL) { fclose(dev_table[x].cfp); } if (dev_table[x].buffer != NULL) { FREE(dev_table[x].buffer, "F_RESET_V"); } dev_table[x].mode = DEVMODE_CLOSED; dev_table[x].width = 0; dev_table[x].col = 0; dev_table[x].filename[0] = '\0'; dev_table[x].cfp = NULL; dev_table[x].buffer = NULL; } } N = 0; } break; case F_GET_X_Y_N: /* GET X, Y */ { /* P1DEV|P2INT */ if (x == CONSOLE_FILE_NUMBER) { IsError = 'X'; } else if (dev_table[x].mode == DEVMODE_CLOSED) { IsError = 'X'; } else if (dev_table[x].mode != DEVMODE_RANDOM) { IsError = 'X'; } else if (y < 1) { IsError = 'Y'; } else { long offset; offset = y; offset--; /* BASIC to C */ offset *= dev_table[x].width; if (fseek(dev_table[x].cfp, offset, SEEK_SET) != 0) { IsError = 'Y'; } else { int i; for (i = 0; i < dev_table[x].width; i++) { dev_table[x].buffer[i] = fgetc(dev_table[x].cfp); } N = 0; } } } break; case F_GET_X_N: /* GET X */ { /* PDEV1 */ if (x == CONSOLE_FILE_NUMBER) { IsError = 'X'; } else if (dev_table[x].mode == DEVMODE_CLOSED) { IsError = 'X'; } else if (dev_table[x].mode != DEVMODE_RANDOM) { IsError = 'X'; } else { { int i; for (i = 0; i < dev_table[x].width; i++) { dev_table[x].buffer[i] = fgetc(dev_table[x].cfp); } N = 0; } } } break; case F_PUT_X_Y_N: /* PUT X, Y */ { /* P1DEV|P2INT */ if (x == CONSOLE_FILE_NUMBER) { IsError = 'X'; } else if (dev_table[x].mode == DEVMODE_CLOSED) { IsError = 'X'; } else if (dev_table[x].mode != DEVMODE_RANDOM) { IsError = 'X'; } else if (y < 1) { IsError = 'Y'; } else { long offset; offset = y; offset--; /* BASIC to C */ offset *= dev_table[x].width; if (fseek(dev_table[x].cfp, offset, SEEK_SET) != 0) { IsError = 'Y'; } else { int i; for (i = 0; i < dev_table[x].width; i++) { fputc(dev_table[x].buffer[i], dev_table[x].cfp); dev_table[x].buffer[i] = ' '; /* flush */ } N = 0; } } } break; case F_PUT_X_N: /* PUT X */ { /* P1DEV */ if (x == CONSOLE_FILE_NUMBER) { IsError = 'X'; } else if (dev_table[x].mode == DEVMODE_CLOSED) { IsError = 'X'; } else if (dev_table[x].mode != DEVMODE_RANDOM) { IsError = 'X'; } else { { int i; for (i = 0; i < dev_table[x].width; i++) { fputc(dev_table[x].buffer[i], dev_table[x].cfp); dev_table[x].buffer[i] = ' '; /* flush */ } N = 0; } } } break; case F_WIDTH_X_N: /* WIDTH X */ { /* P1BYT */ /* console is #0 */ dev_table[CONSOLE_FILE_NUMBER].width = x; dev_table[CONSOLE_FILE_NUMBER].col = 1; N = 0; } break; case F_WIDTH_X_Y_N: /* WIDTH X, Y */ { /* P1DEV|PB2YT */ if (dev_table[x].mode == DEVMODE_CLOSED) { IsError = 'X'; } else if (dev_table[x].mode == DEVMODE_RANDOM) { IsError = 'X'; } else { dev_table[x].width = y; dev_table[x].col = 1; N = 0; } } break; case F_INSTR_X_A_B_N: /* N = INSTR( X, A$, B$ ) */ { /* P1POS */ if (a == 0) { /* empty searched */ } else if (b == 0) { /* empty pattern */ } else if (b > a) { /* pattern is longer than searched */ } else { /* search */ int i; int n; n = a - b; /* last valid search * position */ n++; x--; /* BASIC to C */ A += x; /* advance to the start * position */ for (i = x; i < n; i++) { if (memcmp(A, B, b) == 0) { /* FOU ND */ i++; /* C to BASIC */ N = i; i = n; /* exit for */ } A++; } } } break; case F_INSTR_A_B_N: /* N = INSTR( A$, B$ ) */ { if (a == 0) { /* empty searched */ } else if (b == 0) { /* empty pattern */ } else if (b > a) { /* pattern is longer than searched */ } else { /* search */ int i; int n; n = a - b; /* last valid search * position */ n++; /* search */ for (i = 0; i < n; i++) { if (memcmp(A, B, b) == 0) { /* FOU ND */ i++; /* C to BASIC */ N = i; i = n; /* exit for */ } A++; } } } break; case F_SPACE_X_S: /* S$ = SPACE$( X ) */ { /* P1LEN */ if (x == 0) { /* no copies */ } else { memset(S, ' ', x); s = x; } } break; case F_STRING_X_Y_S: /* S$ = STRING$( X, Y ) */ { /* P1LEN|P2BYT */ if (x == 0) { /* no copies */ } else { memset(S, (char) y, x); s = x; } } break; case F_STRING_X_A_S: /* S$ = STRING$( X, A$ ) */ { /* P1LEN|P2BYT */ if (x == 0) { /* no copies */ } else { memset(S, (char) A[0], x); s = x; } } break; case F_MID_A_X_S: /* S$ = MID$( A$, X ) */ { /* P1ANY|P2POS */ if (a == 0) { /* empty string */ } else if (x > a) { /* start beyond length */ } else { x--; /* BASIC to C */ a -= x; /* nummber of characters to * copy */ A += x; /* pointer to first character * to copy */ memcpy(S, A, a); s = a; } } break; case F_MID_A_X_Y_S: /* S$ = MID$( A$, X, Y ) */ { /* P1ANY|P2POS|P3LEN */ if (a == 0) { /* empty string */ } else if (x > a) { /* start beyond length */ } else if (y == 0) { /* empty string */ } else { x--; /* BASIC to C */ a -= x; /* maximum nummber of characters to * copy */ a = MIN(a, y); A += x; /* pointer to first character to copy */ memcpy(S, A, a); s = a; } } break; case F_LEFT_A_X_S: /* S$ = LEFT$( A$, X ) */ { /* P1ANY|P2LEN */ if (a == 0) { /* empty string */ } else if (x == 0) { /* empty string */ } else { a = MIN(a, x); memcpy(S, A, a); s = a; } } break; case F_RIGHT_A_X_S: /* S$ = RIGHT$( A$, X ) */ { /* P1ANY|P2LEN */ if (a == 0) { /* empty string */ } else if (x == 0) { /* empty string */ } else { x = MIN(a, x); A += a; A -= x; memcpy(S, A, x); s = x; } } break; case F_HEX_X_S: /* S$ = HEX$( X ) */ { sprintf(S, "%X", x); s = strlen(S); } break; case F_OCT_X_S: /* S$ = OCT$( X ) */ { sprintf(S, "%o", x); s = strlen(S); } break; case F_CHR_X_S: /* S$ = CHR$( X ) */ { S[0] = (char) x; s = 1; } break; case F_LEN_A_N: /* N = LEN( A$ ) */ { N = a; } break; case F_POS_A_B_N: /* N = POS( A$, B$ ) */ { if (b == 0) { /* empty pattern */ N = 1; } else if (a == 0) { /* empty searched */ } else if (b > a) { /* pattern is longer than searched */ } else { /* search */ int i; int n; n = a - b; /* last valid search * position */ n++; /* search */ for (i = 0; i < n; i++) { if (memcmp(A, B, b) == 0) { /* FOU ND */ i++; /* C to BASIC */ N = i; i = n; /* exit for */ } A++; } } } break; case F_POS_A_B_X_N: /* N = POS( A$, B$, X ) */ { if (b == 0) { /* empty pattern */ N = 1; } else if (a == 0) { /* empty searched */ } else if (b > a) { /* pattern is longer than searched */ } else { /* search */ int i; int n; n = a - b; /* last valid search * position */ n++; /* search */ x--; /* BASIC to C */ A += x; /* advance to the start * position */ for (i = x; i < n; i++) { if (memcmp(A, B, b) == 0) { /* FOU ND */ N = i + 1; /* C to BASIC */ i = n; /* exit for */ } A++; } } } break; case F_VAL_A_N: /* N = VAL( A$ ) */ { /* P1BYT */ /* FIXME: use the BASIC numeric value parse * routine */ int ScanResult; BasicNumberType Value; ScanResult = sscanf(A, BasicNumberScanFormat, &Value); if (ScanResult != 1) { /* not a number */ if (OptionFlags & OPTION_BUGS_ON) { /* IGNORE */ N = 0; } else { /* ERROR */ IsError = 'A'; } } else { /* OK */ N = Value; } } break; case F_STR_X_S: /* S$ = STR$( X ) */ { /* P1ANY */ /* sprintf( S, BasicNumberPrintFormat, X ); */ BasicNumerc(X, S); s = strlen(S); } break; case F_DATE_N: /* N = DATE ' YYYYDDD */ { /* PNONE */ /* ECMA-116 */ time(&t); lt = localtime(&t); N = lt->tm_year; N *= 1000; N += lt->tm_yday; N += 1; } break; case F_DATE_S: /* S$ = DATE$ */ { /* PNONE */ time(&t); lt = localtime(&t); s = strftime(S, BasicStringLengthMax, OptionDateFormat, lt); } break; case F_TIME_S: /* S$ = TIME$ */ { /* PNONE */ time(&t); lt = localtime(&t); #if 0 sprintf(S, "%02d:%02d:%02d", lt->tm_hour, lt->tm_min, lt->tm_sec); s = strlen(S); #endif s = strftime(S, BasicStringLengthMax, OptionTimeFormat, lt); } break; case F_TIMER_N: /* N = TIMER */ case F_TIME_N: /* N = TIME */ { /* PNONE */ time(&t); lt = localtime(&t); N = lt->tm_hour; N *= 60; N += lt->tm_min; N *= 60; N += lt->tm_sec; } break; case F_COSH_X_N: /* N = COSH( X ) */ { /* P1ANY */ N = cosh(X); } break; case F_SINH_X_N: /* N = SINH( X ) */ { /* P1ANY */ N = sinh(X); } break; case F_TANH_X_N: /* N = TANH( X ) */ { /* P1ANY */ N = tanh(X); } break; case F_LOG10_X_N: /* N = LOG10( X ) */ { /* P1GTZ */ N = log10(X); } break; case F_LOG2_X_N: /* N = LOG2( X ) */ { /* P1GTZ */ N = log(X) / log((BasicNumberType) 2); } break; case F_ACOS_X_N: /* N = ACOS( X ) */ { /* P1ANY */ if (X < -1 || X > 1) { IsError = 'X'; } else { N = acos(X); if (OptionFlags & OPTION_ANGLE_DEGREES) { N = N * 180 / PI; } } } break; case F_ASIN_X_N: /* N = ASIN( X ) */ { /* P1ANY */ if (X < -1 || X > 1) { IsError = 'X'; } else { N = asin(X); if (OptionFlags & OPTION_ANGLE_DEGREES) { N = N * 180 / PI; } } } break; case F_COT_X_N: /* N = COT( X ) ' = 1 / TAN( X ) */ { /* P1ANY */ BasicNumberType T; if (OptionFlags & OPTION_ANGLE_DEGREES) { X = X * PI / 180; } T = tan(X); if (T == 0) { IsError = 'X'; } else { N = 1.0 / T; } } break; case F_CSC_X_N: /* N = CSC( X ) ' = 1 / SIN( X ) */ { /* P1ANY */ BasicNumberType T; if (OptionFlags & OPTION_ANGLE_DEGREES) { X = X * PI / 180; } T = sin(X); if (T == 0) { IsError = 'X'; } else { N = 1.0 / T; } } break; case F_SEC_X_N: /* N = SEC( X ) ' = 1 / COS( X ) */ { /* P1ANY */ BasicNumberType T; if (OptionFlags & OPTION_ANGLE_DEGREES) { X = X * PI / 180; } T = cos(X); if (T == 0) { IsError = 'X'; } else { N = 1.0 / T; } } break; case F_UCASE_A_S: /* S$ = UCASE$( A$ ) */ { /* P1ANY */ if (a == 0) { /* empty string */ } else { int i; memcpy(S, A, a); s = a; /* BASIC allows embedded NULL * characters */ for (i = 0; i < a; i++) { S[i] = ToUpper(S[i]); } } } break; case F_LCASE_A_S: /* S$ = LCASE$( A$ ) */ { /* P1ANY */ if (a == 0) { /* empty string */ } else { int i; memcpy(S, A, a); s = a; /* BASIC allows embedded NULL * characters */ for (i = 0; i < a; i++) { S[i] = ToLower(S[i]); } } } break; case F_ANGLE_X_Y_N: /* N = ANGLE( X, Y ) */ { /* P1ANY|P2ANY */ if (X == 0 && Y == 0) { IsError = 'X'; } else { N = atan2(Y, X); if (OptionFlags & OPTION_ANGLE_DEGREES) { N = N * 180 / PI; } } } break; case F_CEIL_X_N: /* N = CEIL( X ) */ { /* P1ANY */ N = ceil(X); } break; case F_DEG_X_N: /* N = DEG( X ) */ { /* P1ANY */ N = X * 180.0 / PI; } break; case F_RAD_X_N: /* N = RAD( X ) */ { /* P1ANY */ N = X * PI / 180.0; } break; case F_PI_N: /* N = PI */ { /* PNONE */ N = PI; } break; case F_LTRIM_A_S: /* S$ = LTRIM$( A$ ) */ { /* P1ANY */ if (a == 0) { /* empty string */ } else { int i; /* BASIC allows embedded NULL * characters */ for (i = 0; i < a && A[i] == ' '; i++) { /* skip spaces */ } /* 'A[ i ]' is first non-space * character */ if (i >= a) { /* empty string */ } else { A += i; a -= i; memcpy(S, A, a); s = a; } } } break; case F_RTRIM_A_S: /* S$ = RTRIM$( A$ ) */ { /* P1ANY */ if (a == 0) { /* empty string */ } else { int i; /* BASIC allows embedded NULL * characters */ for (i = a - 1; i >= 0 && A[i] == ' '; i--) { /* skip spaces */ } /* 'A[ i ]' is last non-space * character */ if (i < 0) { /* empty string */ } else { a = i + 1; memcpy(S, A, a); s = a; } } } break; case F_TRIM_A_S: /* S$ = TRIM$( A$ ) */ { /* P1ANY */ if (a == 0) { /* empty string */ } else { /* LTRIM */ int i; /* BASIC allows embedded NULL * characters */ for (i = 0; i < a && A[i] == ' '; i++) { /* skip spaces */ } /* 'A[ i ]' is first non-space * character */ if (i >= a) { /* empty string */ } else { A += i; a -= i; memcpy(S, A, a); s = a; /* RTRIM */ A = S; a = s; if (a == 0) { /* empty string */ } else { int i; /* BASIC allows * embedded NULL * characters */ for (i = a - 1; i >= 0 && A[i] == ' '; i--) { /* skip * spaces */ } /* 'A[ i ]' is last * non-space * character */ if (i < 0) { /* empty * string */ } else { a = i + 1; /* memcpy( S, * A, a ); */ s = a; } } } } } break; case F_MAX_X_Y_N: /* N = MAX( X, Y ) */ { N = MAX(X, Y); } break; case F_MIN_X_Y_N: /* N = MIN( X, Y ) */ { N = MIN(X, Y); } break; case F_FP_X_N: /* N = FP( X ) */ { BasicNumberType FP; BasicNumberType IP; FP = modf(X, &IP); N = FP; } break; case F_IP_X_N: /* N = IP( X ) */ { BasicNumberType IP; modf(X, &IP); N = IP; } break; case F_EPS_X_N: /* N = EPS( Number ) */ { N = DBL_MIN; } break; case F_MAXLVL_N: /* N = MAXLVL */ { N = EXECLEVELS; } break; case F_MAXNUM_N: /* N = MAXNUM */ { N = DBL_MAX; } break; case F_MINNUM_N: /* N = MINNUM */ { N = -DBL_MAX; } break; case F_MAXDBL_N: /* N = MAXDBL */ { N = DBL_MAX; } break; case F_MINDBL_N: /* N = MINDBL */ { N = -DBL_MAX; } break; case F_MAXSNG_N: /* N = MAXSNG */ { N = FLT_MAX; } break; case F_MINSNG_N: /* N = MINSNG */ { N = -FLT_MAX; } break; case F_MAXCUR_N: /* N = MAXCUR */ { N = LONG_MAX; } break; case F_MINCUR_N: /* N = MINCUR */ { N = LONG_MIN; } break; case F_MAXLNG_N: /* N = MAXLNG */ { N = LONG_MAX; } break; case F_MINLNG_N: /* N = MINLNG */ { N = LONG_MIN; } break; case F_MAXINT_N: /* N = MAXINT */ { N = SHRT_MAX; } break; case F_MININT_N: /* N = MININT */ { N = SHRT_MIN; } break; case F_MAXBYT_N: /* N = MAXBYT */ { N = UCHAR_MAX; } break; case F_MINBYT_N: /* N = MINBYT */ { N = 0; } break; case F_MAXDEV_N: /* N = MAXDEV */ { N = BasicFileNumberMax; } break; case F_MINDEV_N: /* N = MINDEV */ { N = 0; } break; case F_MOD_X_Y_N: /* N = MOD( X, Y ) */ { /* P1ANY|P2NEZ */ BasicNumberType IP; IP = floor(X / Y); N = X - (Y * IP); } break; case F_REMAINDER_X_Y_N: /* REMAINDER( X, Y ) */ { /* P1ANY|P2NEZ */ BasicNumberType Value; BasicNumberType IP; Value = X / Y; modf(Value, &IP); N = X - (Y * IP); } break; case F_ROUND_X_Y_N: /* N = ROUND( X, Y ) == INT(X*10^Y+.5)/10^Y */ { /* P1ANY | P2INT */ if (y < -32 || y > 32) { IsError = 'Y'; } else { BasicNumberType T; /* 10^Y */ T = pow(10.0, Y); if (T == 0) { IsError = 'Y'; } else { N = floor(X * T + 0.5) / T; } } } break; case F_TRUNCATE_X_Y_N: /* N = TRUNCATE( X, Y ) == INT(X*10^Y)/10^Y */ { /* P1ANY | P2INT */ if (y < -32 || y > 32) { IsError = 'Y'; } else { BasicNumberType T; /* 10^Y */ T = pow(10.0, Y); if (T == 0) { IsError = 'Y'; } else { N = floor(X * T) / T; } } } break; case F_MAXLEN_A_N: /* N = MAXLEN( A$ ) */ { N = BasicStringLengthMax; } break; case F_ORD_A_N: /* N = ORD( A$ ) */ { /* P1BYT */ if (a == 1) { N = A[0]; } else { int c; N = -1; /* not found */ for (c = 0; c < NUM_ACRONYMS; c++) { if (strcasecmp(AcronymTable[c].Name, A) == 0) { /* found */ N = AcronymTable[c].Value; c = NUM_ACRONYMS; /* exit for */ } } if (N < 0) { /* not found */ IsError = 'A'; } } } break; case F_REPEAT_X_Y_S: /* S$ = REPEAT$( X, Y ) ' X is count, Y is code */ { /* P1LEN | P2BYT */ if (x == 0) { /* empty string */ } else { memset(S, (char) y, x); s = x; } } break; case F_REPEAT_X_A_S: /* S$ = REPEAT$( X, A$ ) ' X is count, A$ is code */ { /* P1LEN | P2BYT */ if (x == 0) { /* empty string */ } else { memset(S, (char) A[0], x); s = x; } } break; case F_FIX_X_N: /* N = FIX( X ) */ { N = rint(X); } break; case F_ABS_X_N: /* N = ABS( X ) */ { N = fabs(X); } break; case F_ATN_X_N: /* N = ATN( X ) */ { N = atan(X); if (OptionFlags & OPTION_ANGLE_DEGREES) { N = N * 180 / PI; } } break; case F_COS_X_N: /* N = COS( X ) */ { if (OptionFlags & OPTION_ANGLE_DEGREES) { X = X * PI / 180; } N = cos(X); } break; case F_EXP_X_N: /* N = EXP( X ) */ { N = exp(X); } break; case F_INT_X_N: /* N = INT( X ) */ { N = floor(X); } break; case F_LOG_X_N: /* N = LOG( X ) */ { /* P1GTZ */ N = log(X); } break; case F_RND_N: /* N = RND */ { N = rand(); N /= RAND_MAX; } break; case F_RND_X_N: /* N = RND( X ) */ { N = rand(); N /= RAND_MAX; } break; case F_SGN_X_N: /* N = SGN( X ) */ { if (X > 0) { N = 1; } else if (X < 0) { N = -1; } else { N = 0; } } break; case F_SIN_X_N: /* N = SIN( X ) */ { if (OptionFlags & OPTION_ANGLE_DEGREES) { X = X * PI / 180; } N = sin(X); } break; case F_SQR_X_N: /* N = SQR( X ) */ { /* P1GEZ */ N = sqrt(X); } break; case F_TAN_X_N: /* N = TAN( X ) */ { if (OptionFlags & OPTION_ANGLE_DEGREES) { X = X * PI / 180; } N = tan(X); } break; case F_SPC_X_S: /* S$ = SPC( X ) */ { /* P1ANY */ /* SPECIAL RULES APPLY. PART OF PRINT * COMMAND. WIDTH > 0 */ X = rint(X); if (X < 1 || X > 255) { bwb_Warning_Overflow("*** WARNING: INVALID SPC() ***"); X = 1; } x = (int) X; S[0] = PRN_SPC; S[1] = (char) x; s = 2; } break; case F_TAB_X_S: /* S$ = TAB( X ) */ { /* P1ANY */ /* SPECIAL RULES APPLY. PART OF PRINT * COMMAND. WIDTH > 0 */ X = rint(X); if (X < 1 || X > 255) { bwb_Warning_Overflow("*** WARNING: INVALID TAB() ***"); X = 1; } x = (int) X; S[0] = PRN_TAB; S[1] = (char) x; s = 2; } break; case F_POS_N: /* N = POS */ { /* PNONE */ N = dev_table[CONSOLE_FILE_NUMBER].col; } break; case F_POS_X_N: /* N = POS( X ) */ { /* PDEV1 */ N = dev_table[x].col; } break; case F_INPUT_X_Y_S: /* S$ = INPUT$( X, Y ) */ { /* P1LEN|P2DEV */ { if ((dev_table[y].mode & DEVMODE_READ) == 0) { IsError = 'Y'; } else if (x == 0) { /* empty string */ } else { FILE *fp; fp = dev_table[y].cfp; if (fp == NULL) { IsError = 'Y'; } else { s = fread(S, 1, x, fp); s = MAX(s, 0); /* if( s < 0 ) s = 0; */ } } } } break; case F_ERROR_X_N: /* ERROR X */ { /* P1BYT */ bwb_Warning(x, ""); N = 0; } break; case F_ERROR_X_A_N: /* ERROR X, A$ */ { /* P1BYT */ bwb_Warning(x, A); N = 0; } break; case F_ERR_N: /* N = ERR */ { /* PNONE */ N = err_number; } break; case F_ERL_N: /* N = ERL */ { /* PNONE */ if( err_line != NULL ) { N = err_line->number; } } break; case F_ERR_S: /* S = ERR$ */ { /* PNONE */ s = strlen(ErrMsg); if (s > 0) { strcpy(S, ErrMsg); } } break; /******************************************************************************************** ** ** Keep the platform specific functions together. They should all call bwx_* functions. ** *********************************************************************************************/ case F_INP_X_N: /* N = INP( X ) */ { /* P1BYT */ IsError = 0xFF; } break; case F_WAIT_X_Y_N: /* WAIT X, Y */ { /* P1NUM|P2NUM */ /* P1INT|P2BYT */ IsError = 0xFF; } break; case F_WAIT_X_Y_Z_N: /* WAIT X, Y, Z */ { /* P1NUM|P2NUM|P3NUM */ /* P1INT|P2BYT|P3BYT */ IsError = 0xFF; } break; case F_OUT_X_Y_N: /* OUT X, Y */ { /* P1NUM|P2NUM */ /* P1INT|P2BYT */ IsError = 0xFF; } break; case F_PEEK_X_N: /* N = PEEK( X ) */ { /* P1INT */ IsError = 0xFF; } break; case F_POKE_X_Y_N: /* POKE X, Y */ { /* P1NUM|P2NUM */ /* P1INT|P2BYT */ IsError = 0xFF; } break; case F_CLS_N: /* CLS */ { /* PNONE */ switch (OptionTerminalType) { case C_OPTION_TERMINAL_NONE: break; case C_OPTION_TERMINAL_ADM_3A: fprintf(stdout, "%c", 26); break; case C_OPTION_TERMINAL_ANSI: fprintf(stdout, "%c[2J", 27); fprintf(stdout, "%c[%d;%dH", 27, 1, 1); break; default: IsError = 0xFF; break; } fflush(stdout); } break; case F_LOCATE_X_Y_N: /* LOCATE X, Y */ { /* P1NUM|P2NUM */ /* P1BYT|P2BYT */ switch (OptionTerminalType) { case C_OPTION_TERMINAL_NONE: break; case C_OPTION_TERMINAL_ADM_3A: fprintf(stdout, "%c=%c%c", 27, x + 32, y + 32); break; case C_OPTION_TERMINAL_ANSI: fprintf(stdout, "%c[%d;%dH", 27, x, y); break; default: IsError = 0xFF; break; } fflush(stdout); } break; case F_COLOR_X_Y_N: /* COLOR X, Y */ { /* P1NUM|P2NUM */ /* P1BYT|P2BYT */ switch (OptionTerminalType) { case C_OPTION_TERMINAL_NONE: break; case C_OPTION_TERMINAL_ADM_3A: break; case C_OPTION_TERMINAL_ANSI: fprintf(stdout, "%c[%d;%dm", 27, 30 + x, 40 + y); break; default: IsError = 0xFF; break; } fflush(stdout); } break; case F_FILES_N: /* FILES */ { /* PNONE */ char Buffer[BasicStringLengthMax + 1]; struct bwb_variable *v; v = var_find(DEFVNAME_FILES); str_btoc(Buffer, var_getsval(v)); N = system(Buffer); } break; case F_FILES_A_N: /* FILES A$ */ { /* P1BYT */ char Buffer[BasicStringLengthMax + 1]; struct bwb_variable *v; v = var_find(DEFVNAME_FILES); str_btoc(Buffer, var_getsval(v)); strcat(Buffer, " "); strcat(Buffer, A); N = system(Buffer); } break; case F_FRE_N: case F_FRE_X_N: case F_FRE_A_N: /* N = FRE( ) */ /* N = FRE( X ) */ /* N = FRE( X$ ) */ { N = 32000; /* reasonable value */ } break; case F_SHELL_A_N: /* N = SHELL( A$ ) */ { /* P1BYT */ N = system(A); } break; case F_CHDIR_A_N: /* CHDIR A$ */ { /* P1BYT */ #if DIRECTORY_CMDS N = chdir(A); #else IsError = 0xFF; #endif } break; case F_MKDIR_A_N: /* MKDIR A$ */ { /* P1BYT */ #if DIRECTORY_CMDS #if MKDIR_ONE_ARG N = mkdir(A); #else N = mkdir(A, PERMISSIONS); #endif #else IsError = 0xFF; #endif } break; case F_RMDIR_A_N: /* RMDIR A$ */ { /* P1BYT */ #if DIRECTORY_CMDS N = rmdir(A); #else IsError = 0xFF; #endif } break; case F_KILL_A_N: /* KILL A$ */ { /* P1BYT */ N = remove(A); } break; case F_NAME_A_B_N: /* NAME A$ AS B$ */ /* N = NAME( A$, B$ ) */ { /* P1BYT|P2BYT */ N = rename(A, B); } break; case F_INPUT_X_S: /* S$ = INPUT$( X ) */ { /* P1LEN */ if (x == 0) { /* empty string */ } else { for (s = 0; s < x; s++) { int c; c = getchar(); if ((c == EOF) || (c == '\n') || (c == '\r')) { break; } S[s] = c; } S[s] = 0; } } break; case F_INKEY_S: /* S$ = INKEY$ */ { /* PNONE */ int c; c = getchar(); if (c < 0 || c > 255) { /* EOF */ } else { S[s] = c; s++; } S[s] = 0; } break; case F_NULL_X_N: /* NULL X */ { /* P1NUM */ /* P1BYT */ LPRINT_NULLS = x; N = 0; } break; case F_LWIDTH_X_N: /* LWIDTH X */ { /* P1NUM */ /* P1BYT */ LPRINT_WIDTH = x; LPRINT_COLUMN = 1; N = 0; } break; case F_LPOS_N: /* N = LPOS */ { /* PNONE */ /* PNONE */ N = LPRINT_COLUMN; } break; case F_TRON_N: /* TRON */ { /* PNONE */ prn_xprintf("Trace is ON\n"); bwb_trace = TRUE; N = 0; } break; case F_TROFF_N: /* TROFF */ { /* PNONE */ prn_xprintf("Trace is OFF\n"); bwb_trace = FALSE; N = 0; } break; case F_RANDOMIZE_N: /* RANDOMIZE */ { /* PNONE */ /* USE THE CURRENT TIME AS THE SEED */ time(&t); lt = localtime(&t); x = lt->tm_hour * 3600 + lt->tm_min * 60 + lt->tm_sec; srand(x); N = 0; } break; case F_RANDOMIZE_X_N: /* RANDOMIZE X */ { /* P1NUM */ /* P1ANY */ x = rint( X ); srand(x); N = 0; } break; default: { /* NOT IMPLEMENTED ON THIS PLATFORM */ IsError = 0xFF; } } /* sanity check */ if (IsError == 0) { if (f->ReturnType == STRING) { /* STRING */ if ( /* s < 0 || */ s > BasicStringLengthMax) { /* ERROR */ sprintf(bwb_ebuf, "INTERNAL ERROR (%s) INVALID STRING LENGTH", f->Name); bwb_error(bwb_ebuf); return NULL; } else if (S != RESULT_BUFFER) { /* ERROR */ sprintf(bwb_ebuf, "INTERNAL ERROR (%s) INVALID STRING BUFFER", f->Name); bwb_error(bwb_ebuf); return NULL; } else { RESULT_LENGTH = s; RESULT_BUFFER[RESULT_LENGTH] = '\0'; } } else { /* NUMBER */ if (isnan(N)) { /* ERROR */ /* this means the parameters were not * properly checked */ sprintf(bwb_ebuf, "INTERNAL ERROR (%s) NOT A NUMBER", f->Name); bwb_error(bwb_ebuf); return NULL; } else if (isinf(N)) { /* Evaluation of an expression results in an * overflow (nonfatal, the recommended * recovery procedure is to supply machine * in- finity with the algebraically correct * sign and continue). */ if (N < 0) { N = -DBL_MAX; } else { N = DBL_MAX; } bwb_Warning_Overflow("*** Arithmetic Overflow ***"); } RESULT_NUMBER = N; } } /* process errors */ if (IsError == 0xFF) { /* NOT IMPLEMENTED ON THIS PLATFORM */ sprintf(bwb_ebuf, "%s IS NOT IMPLEMENTED ON THIS PLATFORM", f->Name); bwb_Warning_AdvancedFeature(bwb_ebuf); } else if (IsError != 0) { /* ERROR */ char Buffer[80]; switch (IsError) { case 'A': case 'B': case 'C': /* STRING parameter's value is invalid */ sprintf(Buffer, "%s(%c$)", f->Name, IsError); break; case 'X': case 'Y': case 'Z': /* NUMBER parameter's value is invalid */ sprintf(Buffer, "%s(%c)", f->Name, IsError); break; default: /* All other errors */ sprintf(Buffer, "%s() #%d", f->Name, IsError); break; } sprintf(bwb_ebuf, "ILLEGAL FUUNCTION CALL: %s", Buffer); bwb_Warning_InvalidParameter(bwb_ebuf); } return argv; /* released by exp_function() in bwb_elx.c */ } /* EOF */