diff options
Diffstat (limited to 'bwb_stc.c')
| -rw-r--r-- | bwb_stc.c | 1433 |
1 files changed, 1433 insertions, 0 deletions
diff --git a/bwb_stc.c b/bwb_stc.c new file mode 100644 index 0000000..bc310af --- /dev/null +++ b/bwb_stc.c @@ -0,0 +1,1433 @@ +/*************************************************************** + + bwb_stc.c Commands Related to Structured Programming + 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 */ +/* */ +/* Version 3.10 by Howard Wulf, AF5NE */ +/* */ +/* Version 3.20 by Howard Wulf, AF5NE */ +/* */ +/*---------------------------------------------------------------*/ + + + +#include "bwbasic.h" + +static int ErrorMessage (LineType * current); +static LineType *FindParentCommand (int cmdnum, unsigned int Indention, + LineType * Previous[]); +static LineType *find_BottomLineInCode (LineType * l); +static int MissingBottomLine (LineType * current, int cmdnum); +static int scan_readargs (UserFunctionType * f, LineType * l); +static int UserFunction_clear (void); + +/*************************************************************** + + FUNCTION: UserFunction_init() + + DESCRIPTION: This function initializes the FUNCTION-SUB + lookup table. + +***************************************************************/ + +extern int +UserFunction_init (void) +{ + assert( My != NULL ); + + My->UserFunctionHead = NULL; + return TRUE; +} + +/*************************************************************** + + FUNCTION: bwb_scan() + + DESCRIPTION: This function scans all lines of the + program in memory and creates a FUNCTION- + SUB lookup table (fslt) for the program. + +***************************************************************/ + +static int +ErrorMessage (LineType * current) +{ + char tbuf[64]; + + assert (current != NULL); + + switch (current->cmdnum) + { + case C_FOR: + bwb_strcpy (tbuf, "FOR without NEXT"); + break; + case C_EXIT_FOR: + bwb_strcpy (tbuf, "EXIT FOR without FOR"); + break; + case C_NEXT: + bwb_strcpy (tbuf, "NEXT without FOR"); + break; + case C_DO: + bwb_strcpy (tbuf, "DO without LOOP"); + break; + case C_EXIT_DO: + bwb_strcpy (tbuf, "EXIT DO without DO"); + break; + case C_LOOP: + bwb_strcpy (tbuf, "LOOP without DO"); + break; + case C_REPEAT: + bwb_strcpy (tbuf, "REPEAT without UNTIL"); + break; + case C_EXIT_REPEAT: + bwb_strcpy (tbuf, "EXIT REPEAT without REPEAT"); + break; + case C_UNTIL: + bwb_strcpy (tbuf, "UNTIL without REPEAT"); + break; + case C_WHILE: + bwb_strcpy (tbuf, "WHILE without WEND"); + break; + case C_EXIT_WHILE: + bwb_strcpy (tbuf, "EXIT WHILE without WHILE"); + break; + case C_WEND: + bwb_strcpy (tbuf, "WEND without WHILE"); + break; + case C_SUB: + bwb_strcpy (tbuf, "SUB without END SUB"); + break; + case C_EXIT_SUB: + bwb_strcpy (tbuf, "EXIT SUB without SUB"); + break; + case C_END_SUB: + bwb_strcpy (tbuf, "END SUB without SUB"); + break; + case C_FUNCTION: + bwb_strcpy (tbuf, "FUNCTION without END FUNCTION"); + break; + case C_EXIT_FUNCTION: + bwb_strcpy (tbuf, "EXIT FUNCTION without FUNCTION"); + break; + case C_END_FUNCTION: + bwb_strcpy (tbuf, "END FUNCTION without FUNCTION"); + break; + case C_IF8THEN: + bwb_strcpy (tbuf, "IF THEN without END IF"); + break; + case C_ELSEIF: + bwb_strcpy (tbuf, "ELSEIF without IF THEN"); + break; + case C_ELSE: + bwb_strcpy (tbuf, "ELSE without IF THEN"); + break; + case C_END_IF: + bwb_strcpy (tbuf, "END IF without IF THEN"); + break; + case C_SELECT_CASE: + bwb_strcpy (tbuf, "SELECT CASE without END SELECT"); + break; + case C_CASE: + bwb_strcpy (tbuf, "CASE without SELECT CASE"); + break; + case C_CASE_ELSE: + bwb_strcpy (tbuf, "CASE ELSE without SELECT CASE"); + break; + case C_END_SELECT: + bwb_strcpy (tbuf, "END SELECT without SELECT CASE"); + break; + default: + bwb_strcpy (tbuf, "UNKNOWN COMMAND"); + break; + } + fprintf (My->SYSOUT->cfp, "%s: %d %s\n", tbuf, current->number, + current->buffer); + ResetConsoleColumn (); + return FALSE; +} + +static LineType * +find_BottomLineInCode (LineType * l) +{ + + + if (l == NULL) + { + return NULL; + } + while (l->OtherLine != NULL) + { + switch (l->cmdnum) + { + case C_NEXT: + case C_LOOP: + case C_UNTIL: + case C_WEND: + case C_END_SUB: + case C_END_FUNCTION: + case C_END_IF: + case C_END_SELECT: + return l; + } + l = l->OtherLine; + } + /* l->OtherLine == NULL */ + return l; +} + +static int +MissingBottomLine (LineType * current, int cmdnum) +{ + LineType *BottomLineInCode; + + + BottomLineInCode = find_BottomLineInCode (current); + if (BottomLineInCode == NULL) + { + return TRUE; + } + if (BottomLineInCode->cmdnum != cmdnum) + { + return TRUE; + } + return FALSE; +} + +static LineType * +FindParentCommand (int cmdnum, unsigned int Indention, + LineType * Previous[ /* EXECLEVELS */ ]) +{ + + assert (Previous != NULL); + + if (Indention > 0) + { + unsigned int i; + for (i = Indention - 1; /* i >= 0 */ ; i--) + { + if (Previous[i]->cmdnum == cmdnum) + { + /* FOUND */ + return Previous[i]; /* EXIT_FOR->OtherLine == FOR */ + } + if (i == 0) + { + /* NOT FOUND */ + } + } + } + /* NOT FOUND */ + return NULL; +} + +extern int +bwb_scan (void) +{ + /* + STATIC ANALYSIS + + + Background. + This routine began as a way to record the line numbers associated with the cmdnum of FUNCTION, SUB, or LABEL. + + Pretty-printing. + Indention was added for pretty-printing by LIST, based upon the cmdnum (Indetion++, Indention--). + + Mismatched structured commands. + When reviewing a properly indented listing, mismatched structured commands are easier to visually indentify + (FOR without NEXT and so on), so Previous[] was added to record the previous cmdnum at a given Indention. + Comparing Current->cmdnum with Previous->cmdnum allows mismatched structured commands to be detected. + + Reduce stack usage for structured loops. + OtherLine, which was previously determined at runtime for loops, could now be determined during the scan. + Previously all loops used the stack so the EXIT command could find the loop's bottom line. + The EXIT commands could now look in Previous[] to determine their loop's top line and follow that to the loop's bottom line. + As a result, now the FOR loops use the stack to hold the current iteration value, but all other loops do not. + + Reduce stack usaage for structured IF/SELECT. + Previuosly the structured IF/SELECT command used the stack to hold the results of comparisons and intermediate values. + OtherLine is now used to link these commands to their next occurring command. + As a result, the path thru the structure is now chosen at the IF/SELECT command, and the stack is no longer used. + The RESUME command knows about this linkage, so a simple "RESUME" jumps to the "IF THEN" or "SELECT CASE" + and "RESUME NEXT" jumps to the "END IF" or "END SELECT". + + Caching for unstructured commands. + OtherLine was not previously used for any purpose for the unstructured GOTO, GOSUB, IF and ON commands. + It is now used to cache the line last executed by these commands to reduce the time required to find the target line. + The cache reduces execution time because the target line is usually (but not always) the same. + For the simple commands "GOTO 100", "GOSUB 100" and "IF x THEN 100", the cache will always succeed. + For the command "IF x THEN 100 ELSE 200", the cache will succeed for the last taken path. + Because programs are typically written so one path is more likely, the cache usually succeeds. + For the "ON x GOTO ..." and "ON x GOSUB ...", the cache succeeds when the result of the test expression repeats, such as: + FOR I = 1 TO 100 + ON INT(I/10) GOSUB ... + NEXT I + In this example, the cache will succeed 90 times and fail 10 times. + + Checking FOR/NEXT variable names. + If a variable name is provided for a NEXT command, then it is compared against the variable name of the matching FOR command. + This detects the following kind of mismatch: + FOR I = ... + NEXT J + + OtherLine is now used for different purposes depending upon the command. + + For structured IF8THEN and SELECT_CASE, OtherLine is used to form a one-way list: + IF8THEN->OtherLine == next occuring ELSE_IF, ELSE, END_IF + ELSE_IF->Otherline == next occuring ELSE_IF, ELSE, END_IF + ELSE->OtherLine == END_IF + END_IF->OtherLine == NULL + + + For the structured loops, OtherLine is uses as a circular list: + WHILE->OtherLine == WEND + EXIT_WHILE->OtherLine == WHILE + WEND->OtherLine == WHILE + + For unstructured flow-of-control commands, OtherLine is used as a one-entry cache. + It contains a pointer to the Most Recently Used line returned by the command: + + GOTO->OtherLine == MRU target line + GOSUB->OtherLine == MRU target line + IF->OtherLine == MRU target line + ON->OtherLine == MRU target line + + For DATA commands, OtherLine points to the next DATA line (if it exists), otherwise it points to EndMarker. + StartMarker->OtherLine points to the first DATA line (if it exists), otherwise it points to EndMarker. + RESTORE knows about this. + + For other commands, OtherLine is not used. + + Any command which _requires_ OtherLine is not allowed be executed from the console in immediate mode. + + */ + LineType *current; + LineType *prev_DATA; /* previous DATA statement */ + unsigned int Indention; + LineType *Previous[EXECLEVELS]; /* previous part of structured command */ + + + assert( My != NULL ); + assert( My->StartMarker != NULL ); + assert( My->EndMarker != NULL ); + + + prev_DATA = NULL; + if (My->IsScanRequired == FALSE) + { + /* program is clean, no scan required */ + return TRUE; + } + /* program needs to be scanned again, because a line was added or deleted */ + + /* reset these whenever a SCAN occurs */ + My->StartMarker->OtherLine = My->EndMarker; /* default when no DATA statements exist */ + My->DataLine = My->EndMarker; /* default when no DATA statements exist */ + My->DataPosition = My->DataLine->Startpos; + My->ERL = NULL; + My->ContinueLine = NULL; + + + /* first run through the FUNCTION - SUB loopkup table and free any existing memory */ + + UserFunction_clear (); + + + + for (Indention = 0; Indention < EXECLEVELS; Indention++) + { + Previous[Indention] = NULL; + } + Indention = 0; + + for (current = My->StartMarker->next; current != My->EndMarker; + current = current->next) + { + assert( current != NULL ); + current->OtherLine = NULL; + + if (current->cmdnum == C_DATA) + { + if (prev_DATA == NULL) + { + /* I am the first DATA statement */ + My->StartMarker->OtherLine = current; + My->DataLine = current; + My->DataPosition = My->DataLine->Startpos; + } + else + { + /* link the previous DATA statement to me */ + prev_DATA->OtherLine = current; + } + /* I am the last DATA statement so far */ + current->OtherLine = My->EndMarker; + /* I should point at the next DATA statement */ + prev_DATA = current; + } + + switch (current->cmdnum) + { + case C_DEF: + case C_FUNCTION: + case C_SUB: + case C_DEF8LBL: + UserFunction_add (current); + } + + /* verify the 'current' command is consistent with a 'previous' command at a lower indention */ + switch (current->cmdnum) + { + case C_EXIT_FOR: + current->OtherLine = FindParentCommand (C_FOR, Indention, Previous); /* EXIT_FOR->OtherLine == FOR */ + if (current->OtherLine == NULL) + { + return ErrorMessage (current); + } + break; + case C_EXIT_WHILE: + current->OtherLine = FindParentCommand (C_WHILE, Indention, Previous); /* EXIT_WHILE->OtherLine == WHILE */ + if (current->OtherLine == NULL) + { + return ErrorMessage (current); + } + break; + case C_EXIT_REPEAT: + current->OtherLine = FindParentCommand (C_REPEAT, Indention, Previous); /* EXIT_REPEAT->OtherLine == REPEAT */ + if (current->OtherLine == NULL) + { + return ErrorMessage (current); + } + break; + case C_EXIT_FUNCTION: + current->OtherLine = FindParentCommand (C_FUNCTION, Indention, Previous); /* EXIT_FUNCTION->OtherLine == FUNCTION */ + if (current->OtherLine == NULL) + { + return ErrorMessage (current); + } + break; + case C_EXIT_SUB: + current->OtherLine = FindParentCommand (C_SUB, Indention, Previous); /* EXIT_SUB->OtherLine == SUB */ + if (current->OtherLine == NULL) + { + return ErrorMessage (current); + } + break; + case C_EXIT_DO: + current->OtherLine = FindParentCommand (C_DO, Indention, Previous); /* EXIT_DO->OtherLine == DO */ + if (current->OtherLine == NULL) + { + return ErrorMessage (current); + } + break; + } + + + /* verify the 'current' command is consistent with a 'previous' command at the same indention */ + switch (current->cmdnum) + { + case C_NEXT: + if (Indention == 0) + { + return ErrorMessage (current); + } + Indention--; + switch (Previous[Indention]->cmdnum) + { + case C_FOR: + /* if( TRUE ) */ + { + /* compare the 'NEXT' variable with the 'FOR' variable */ + current->position = current->Startpos; + Previous[Indention]->position = Previous[Indention]->Startpos; + if (line_is_eol (current)) + { + /* NEXT */ + /* there is no variable to compare */ + } + else + { + /* NEXT variable */ + char NextVarName[NameLengthMax + 1]; + char ForVarName[NameLengthMax + 1]; + + if (line_read_varname (current, NextVarName) == FALSE) + { + return ErrorMessage (current); + } + if (line_read_varname (Previous[Indention], ForVarName) == FALSE) + { + return ErrorMessage (current); + } + if (bwb_stricmp (ForVarName, NextVarName) != 0) + { + return ErrorMessage (current); + } + } + /* MATCHED */ + current->Startpos = current->position; + Previous[Indention]->position = Previous[Indention]->Startpos; + } + /* OK */ + Previous[Indention]->OtherLine = current; /* FOR->OtherLine = NEXT */ + current->OtherLine = Previous[Indention]; /* NEXT->OtherLine = FOR */ + Previous[Indention] = current; /* last command at this level = NEXT */ + break; + default: + return ErrorMessage (current); + } + break; + case C_LOOP: + if (Indention == 0) + { + return ErrorMessage (current); + } + Indention--; + switch (Previous[Indention]->cmdnum) + { + case C_DO: + /* OK */ + Previous[Indention]->OtherLine = current; /* DO->OtherLine = LOOP */ + current->OtherLine = Previous[Indention]; /* LOOP->OtherLine = DO */ + Previous[Indention] = current; /* last command at this level = LOOP */ + break; + default: + return ErrorMessage (current); + } + break; + case C_UNTIL: + if (Indention == 0) + { + return ErrorMessage (current); + } + Indention--; + switch (Previous[Indention]->cmdnum) + { + case C_REPEAT: + /* OK */ + Previous[Indention]->OtherLine = current; /* REPEAT->OtherLine = UNTIL */ + current->OtherLine = Previous[Indention]; /* UNTIL->OtherLine = REPEAT */ + Previous[Indention] = current; /* last command at this level = UNTIL */ + break; + default: + return ErrorMessage (current); + } + break; + case C_WEND: + if (Indention == 0) + { + fprintf (My->SYSOUT->cfp, "Unmatched command %d %s\n", + current->number, current->buffer); + ResetConsoleColumn (); + return FALSE; + } + Indention--; + switch (Previous[Indention]->cmdnum) + { + case C_WHILE: + /* OK */ + Previous[Indention]->OtherLine = current; /* WHILE->OtherLine = WEND */ + current->OtherLine = Previous[Indention]; /* WEND->OtherLine = WHILE */ + Previous[Indention] = current; /* last command at this level = WEND */ + break; + default: + return ErrorMessage (current); + } + break; + case C_END_SUB: + if (Indention == 0) + { + return ErrorMessage (current); + } + Indention--; + switch (Previous[Indention]->cmdnum) + { + case C_SUB: + /* OK */ + Previous[Indention]->OtherLine = current; /* SUB->OtherLine = END_SUB */ + current->OtherLine = Previous[Indention]; /* END_SUB->OtherLine = SUB */ + Previous[Indention] = current; /* last command at this level = END_SUB */ + break; + default: + return ErrorMessage (current); + } + break; + case C_END_FUNCTION: + if (Indention == 0) + { + return ErrorMessage (current); + } + Indention--; + switch (Previous[Indention]->cmdnum) + { + case C_FUNCTION: + /* OK */ + Previous[Indention]->OtherLine = current; /* FUNCTION->OtherLine = END_FUNCTION */ + current->OtherLine = Previous[Indention]; /* END_FUNCTION->OtherLine = FUNCTION */ + Previous[Indention] = current; /* last command at this level = END_FUNCTION */ + break; + default: + return ErrorMessage (current); + } + break; + case C_ELSEIF: + if (Indention == 0) + { + return ErrorMessage (current); + } + Indention--; + switch (Previous[Indention]->cmdnum) + { + case C_IF8THEN: + /* OK */ + Previous[Indention]->OtherLine = current; /* IF8THEN->OtherLine = ELSEIF */ + Previous[Indention] = current; /* last command at this level = ELSEIF */ + break; + case C_ELSEIF: + /* OK */ + Previous[Indention]->OtherLine = current; /* ELSEIF->OtherLine = ELSEIF */ + Previous[Indention] = current; /* last command at this level = ELSEIF */ + break; + default: + return ErrorMessage (current); + } + break; + case C_ELSE: + if (Indention == 0) + { + return ErrorMessage (current); + } + Indention--; + switch (Previous[Indention]->cmdnum) + { + case C_IF8THEN: + /* OK */ + Previous[Indention]->OtherLine = current; /* IF8THEN->OtherLine = ELSE */ + Previous[Indention] = current; /* last command at this level = ELSE */ + break; + case C_ELSEIF: + /* OK */ + Previous[Indention]->OtherLine = current; /* ELSEIF->OtherLine = ELSE */ + Previous[Indention] = current; /* last command at this level = ELSE */ + break; + default: + return ErrorMessage (current); + } + break; + case C_END_IF: + if (Indention == 0) + { + return ErrorMessage (current); + } + Indention--; + switch (Previous[Indention]->cmdnum) + { + case C_IF8THEN: + /* OK */ + Previous[Indention]->OtherLine = current; /* IF8THEN->OtherLine = END_IF */ + Previous[Indention] = current; /* last command at this level = END_IF */ + break; + case C_ELSEIF: + /* OK */ + Previous[Indention]->OtherLine = current; /* ELSEIF->OtherLine = END_IF */ + Previous[Indention] = current; /* last command at this level = END_IF */ + break; + case C_ELSE: + /* OK */ + Previous[Indention]->OtherLine = current; /* ELSE->OtherLine = END_IF */ + Previous[Indention] = current; /* last command at this level = END_IF */ + break; + default: + return ErrorMessage (current); + } + break; + case C_CASE: + if (Indention == 0) + { + return ErrorMessage (current); + } + Indention--; + switch (Previous[Indention]->cmdnum) + { + case C_SELECT_CASE: + /* OK */ + Previous[Indention]->OtherLine = current; /* C_SELECT_CASE->OtherLine = C_CASE */ + Previous[Indention] = current; /* last command at this level = C_CASE */ + break; + case C_CASE: + /* OK */ + Previous[Indention]->OtherLine = current; /* CASE->OtherLine = C_CASE */ + Previous[Indention] = current; /* last command at this level = C_CASE */ + break; + default: + return ErrorMessage (current); + } + break; + case C_CASE_ELSE: + if (Indention == 0) + { + return ErrorMessage (current); + } + Indention--; + switch (Previous[Indention]->cmdnum) + { + case C_CASE: + /* OK */ + Previous[Indention]->OtherLine = current; /* CASE->OtherLine = C_CASE_ELSE */ + Previous[Indention] = current; /* last command at this level = C_CASE_ELSE */ + break; + default: + return ErrorMessage (current); + } + break; + case C_END_SELECT: + if (Indention == 0) + { + return ErrorMessage (current); + } + Indention--; + switch (Previous[Indention]->cmdnum) + { + case C_CASE: + /* OK */ + Previous[Indention]->OtherLine = current; /* CASE->OtherLine = END_SELECT */ + Previous[Indention] = current; /* last command at this level = END_SELECT */ + break; + case C_CASE_ELSE: + /* OK */ + Previous[Indention]->OtherLine = current; /* CASE_ELSE->OtherLine = END_SELECT */ + Previous[Indention] = current; /* last command at this level = END_SELECT */ + break; + default: + return ErrorMessage (current); + } + break; + } + /* OK */ + + current->Indention = Indention; + + /* record the 'current' command as the 'previous' command at this indention */ + switch (current->cmdnum) + { + case C_FUNCTION: + case C_SUB: + /* this 'command' can NOT be inside the structure of another 'command' */ + if (Indention > 0) + { + return ErrorMessage (Previous[Indention - 1]); + } + case C_FOR: + case C_DO: + case C_REPEAT: + case C_WHILE: + case C_IF8THEN: + case C_SELECT_CASE: + if (Previous[Indention] != NULL) + { + /* we are NOT the first command at this indention level */ + /* verify the 'previous' command at this level was properly closed */ + switch (Previous[Indention]->cmdnum) + { + case C_FOR: + case C_DO: + case C_REPEAT: + case C_WHILE: + case C_FUNCTION: + case C_SUB: + case C_IF8THEN: + case C_ELSEIF: + case C_ELSE: + case C_SELECT_CASE: + case C_CASE: + case C_CASE_ELSE: + /* there is an existing unclosed structure */ + return ErrorMessage (Previous[Indention]); + } + } + Previous[Indention] = current; + Indention++; + if (Indention == EXECLEVELS) + { + fprintf (My->SYSOUT->cfp, "Program is nested too deep\n"); + ResetConsoleColumn (); + return FALSE; + } + Previous[Indention] = NULL; + break; + case C_ELSEIF: + case C_ELSE: + case C_CASE: + case C_CASE_ELSE: + /* + Previous[ Indention ] was already checked and assigned above, just indent. + */ + Indention++; + if (Indention == EXECLEVELS) + { + fprintf (My->SYSOUT->cfp, "Program is nested too deep\n"); + ResetConsoleColumn (); + return FALSE; + } + Previous[Indention] = NULL; + break; + } + } + + if (Indention > 0) + { + return ErrorMessage (Previous[Indention - 1]); + } + + /* verify the OtherLine chain terminates correctly; we should find the bottom command */ + for (current = My->StartMarker->next; current != My->EndMarker; + current = current->next) + { + assert( current != NULL ); + switch (current->cmdnum) + { + case C_FOR: + case C_EXIT_FOR: + if (MissingBottomLine (current, C_NEXT)) + { + return ErrorMessage (current); + } + break; + case C_DO: + case C_EXIT_DO: + if (MissingBottomLine (current, C_LOOP)) + { + return ErrorMessage (current); + } + break; + case C_REPEAT: + case C_EXIT_REPEAT: + if (MissingBottomLine (current, C_UNTIL)) + { + return ErrorMessage (current); + } + break; + case C_WHILE: + case C_EXIT_WHILE: + if (MissingBottomLine (current, C_WEND)) + { + return ErrorMessage (current); + } + break; + case C_FUNCTION: + case C_EXIT_FUNCTION: + if (MissingBottomLine (current, C_END_FUNCTION)) + { + return ErrorMessage (current); + } + break; + case C_SUB: + case C_EXIT_SUB: + if (MissingBottomLine (current, C_END_SUB)) + { + return ErrorMessage (current); + } + break; + case C_IF8THEN: + if (MissingBottomLine (current, C_END_IF)) + { + return ErrorMessage (current); + } + break; + case C_SELECT_CASE: + if (MissingBottomLine (current, C_END_SELECT)) + { + return ErrorMessage (current); + } + break; + } + } + + /* return */ + + My->IsScanRequired = FALSE; + return TRUE; + +} + +/*************************************************************** + + FUNCTION: UserFunction_clear() + + DESCRIPTION: This C function clears all existing memory + in the FUNCTION-SUB lookup table. + +***************************************************************/ + +static int +UserFunction_clear (void) +{ + UserFunctionType *current; + + assert( My != NULL ); + + + /* run through table and clear memory */ + for (current = My->UserFunctionHead; current != NULL;) + { + UserFunctionType *next; + + assert( current != NULL ); + next = current->next; + + /* check for local variables and free them */ + if (current->local_variable != NULL) + { + var_free (current->local_variable); + current->local_variable = NULL; + } + + if (current->name != NULL) + { + free (current->name); + current->name = NULL; + } + free (current); + current = next; + } + My->UserFunctionHead = NULL; + return TRUE; +} + +extern int +UserFunction_name (char *name) +{ + /* search USER functions */ + UserFunctionType *L; + + assert (name != NULL); + assert( My != NULL ); + assert( My->CurrentVersion != NULL ); + + for (L = My->UserFunctionHead; L != NULL; L = L->next) + { + if (My->CurrentVersion->OptionVersionValue & L->OptionVersionBitmask) + { + if (bwb_stricmp (L->name, name) == 0) + { + return TRUE; + } + } + } + return FALSE; +} + +extern UserFunctionType * +UserFunction_find_exact (char *name, unsigned char ParameterCount, + ParamBitsType ParameterTypes) +{ + /* search USER functions */ + UserFunctionType *L; + + assert (name != NULL); + assert( My != NULL ); + assert( My->CurrentVersion != NULL ); + + for (L = My->UserFunctionHead; L != NULL; L = L->next) + { + if (My->CurrentVersion->OptionVersionValue & L->OptionVersionBitmask) + { + if (L->ParameterCount == ParameterCount + && L->ParameterTypes == ParameterTypes) + { + if (bwb_stricmp (L->name, name) == 0) + { + /* FOUND */ + return L; + } + } + } + } + /* NOT FOUND */ + return NULL; +} + +/*************************************************************** + + FUNCTION: UserFunction_add() + + DESCRIPTION: This C function adds an entry to the + FUNCTION-SUB lookup table. + +***************************************************************/ + +extern int +UserFunction_add (LineType * l /* , int *position , int code */ ) +{ + char *name; + UserFunctionType *f; + char TypeCode; + char varname[NameLengthMax + 1]; + + assert (l != NULL); + assert( My != NULL ); + assert( My->CurrentVersion != NULL ); + assert( My->DefaultVariableType != NULL ); + + + /* get the element for name */ + switch (l->cmdnum) + { + case C_DEF: + case C_FUNCTION: + case C_SUB: + l->position = l->Startpos; + if (line_read_varname (l, varname) == FALSE) + { + WARN_SYNTAX_ERROR; + return FALSE; + } + break; + case C_DEF8LBL: + l->position = 0; + if (line_read_label (l, varname) == FALSE) + { + WARN_SYNTAX_ERROR; + return FALSE; + } + l->position = l->Startpos; + break; + default: + WARN_SYNTAX_ERROR; + return FALSE; + } + + /* get memory for name buffer */ + if ((name = + (char *) calloc (bwb_strlen (varname) + 1 /* NulChar */ , + sizeof (char))) == NULL) + { + WARN_OUT_OF_MEMORY; + return FALSE; + } + bwb_strcpy (name, varname); + + /* get memory for fslt structure */ + if ((f = + (UserFunctionType *) calloc (1, sizeof (UserFunctionType))) == NULL) + { + WARN_OUT_OF_MEMORY; + return FALSE; + } + /* fill in structure */ + + f->line = l; + f->name = name; + f->local_variable = NULL; + f->ParameterCount = 0; /* 0..32, 255 == (...) */ + f->ParameterTypes = 0; /* bit 0 is first parameter */ + f->startpos = l->position; + f->OptionVersionBitmask = My->CurrentVersion->OptionVersionValue; + + + + + /* read arguments */ + switch (l->cmdnum) + { + case C_DEF: + case C_FUNCTION: + case C_SUB: + TypeCode = var_nametype (varname); + if (line_peek_LparenChar (l)) + { + if (scan_readargs (f, l)) + { + f->startpos = l->position; + } + } + /* determine function type */ + if (TypeCode == NulChar) + { + /* function has no explicit type char */ + TypeCode = line_read_type_declaration (l); + if (TypeCode == NulChar) + { + /* function has no declared type */ + int i; + i = VarTypeIndex (varname[0]); + if (i < 0) + { + TypeCode = DoubleTypeCode; /* default */ + } + else + { + TypeCode = My->DefaultVariableType[i]; + } + } + } + break; + case C_DEF8LBL: + TypeCode = LongTypeCode; + break; + default: + WARN_SYNTAX_ERROR; + return FALSE; + } + f->ReturnTypeCode = TypeCode; + /* establish linkages */ + f->next = My->UserFunctionHead; + My->UserFunctionHead = f; + + return TRUE; +} + +/*************************************************************** + + FUNCTION: scan_readargs() + + DESCRIPTION: This C function reads arguments (variable + names for an entry added to the FUNCTION- + SUB lookup table. + +***************************************************************/ + +static int +scan_readargs (UserFunctionType * f, LineType * l) +{ + + assert (f != NULL); + assert (l != NULL); + assert( My != NULL ); + assert( My->CurrentVersion != NULL ); + assert( My->DefaultVariableType != NULL ); + + f->ParameterCount = 0; /* 0..32, 255 == (...) */ + f->ParameterTypes = 0; /* bit 0 is first parameter */ + + /* we should be at begin paren */ + if (line_skip_LparenChar (l) == FALSE) + { + WARN_SYNTAX_ERROR; + return FALSE; + } + if (line_skip_RparenChar (l)) + { + /* end of NO argument list */ + /* FUNCTION ABC() */ + return TRUE; + } + if (line_skip_word (l, "...")) + { + /* FUNCTION FRED( ... ) */ + if (line_skip_RparenChar (l)) + { + f->ParameterCount = 0xFF; /* VARIANT */ + f->ParameterTypes = 0; + return TRUE; + } + WARN_SYNTAX_ERROR; + return FALSE; + } + + /* loop through looking for arguments */ + do + { + VariableType *v; + char TypeCode; + char varname[NameLengthMax + 1]; + + /* presume beginning of argument == variable name */ + if (line_read_varname (l, varname) == FALSE) + { + WARN_SYNTAX_ERROR; + return FALSE; + } + /* determine variable type */ + TypeCode = var_nametype (varname); + if (TypeCode == NulChar) + { + /* variable has no explicit type char */ + TypeCode = line_read_type_declaration (l); + if (TypeCode == NulChar) + { + /* variable has no declared type */ + int i; + i = VarTypeIndex (varname[0]); + if (i < 0) + { + TypeCode = DoubleTypeCode; /* default */ + } + else + { + TypeCode = My->DefaultVariableType[i]; + } + } + } + + /* initialize the variable and add it to local chain */ + v = var_new (varname, TypeCode); + UserFunction_addlocalvar (f, v); + if (VAR_IS_STRING (v)) + { + f->ParameterTypes |= (1 << f->ParameterCount); + } + f->ParameterCount++; /* 0..32, 255 == (...) */ + if (f->ParameterCount > MAX_FARGS) + { + /* should have been declared VARIANT */ + WARN_SYNTAX_ERROR; + return FALSE; + } + } + while (line_skip_seperator (l)); + + if (line_skip_RparenChar (l)) + { + /* end of argument list */ + return TRUE; + } + + /* FUNCTION ABC( A$, B$, */ + WARN_SYNTAX_ERROR; + return FALSE; +} + + + +/*************************************************************** + + FUNCTION: UserFunction_addlocalvar() + + DESCRIPTION: This function adds a local variable + to the FUNCTION-SUB lookup table at + a specific level. + +***************************************************************/ + +extern int +UserFunction_addlocalvar (UserFunctionType * f, VariableType * v) +{ + + assert (f != NULL); + assert (v != NULL); + + /* find end of local chain */ + if (f->local_variable == NULL) + { + f->local_variable = v; + } + else + { + VariableType *p; + VariableType *c; + + p = f->local_variable; + for (c = f->local_variable->next; c != NULL; c = c->next) + { + p = c; + } + p->next = v; + } + v->next = NULL; + return TRUE; +} + +LineType * +bwb_DEF8LBL (LineType * l) +{ + /* + ** + ** this command is used for a line that is a user label + ** + */ + + assert (l != NULL); + + if (l->LineFlags & (LINE_USER)) + { + WARN_ILLEGAL_DIRECT; + return (l); + } + + line_skip_eol (l); + return (l); +} + +/*************************************************************** + + FUNCTION: bwb_def() + + DESCRIPTION: This C function implements the BASIC + DEF statement. + + SYNTAX: DEF FNname(arg...)] = expression + + NOTE: It is not a strict requirement that the + function name should begin with "FN". + +***************************************************************/ + +LineType * +bwb_DEF (LineType * l) +{ + + assert (l != NULL); + + if (l->LineFlags & (LINE_USER)) + { + WARN_ILLEGAL_DIRECT; + return (l); + } + + /* this line will be executed by IntrinsicFunction_deffn() in bwb_fnc.c */ + line_skip_eol (l); + + return (l); +} + + + +/*************************************************************** + + FUNCTION: bwb_call() + + DESCRIPTION: This C function implements the BASIC + CALL subroutine command. + + SYNTAX: CALL subroutine-name( param1, param2 ) + +***************************************************************/ + +LineType * +bwb_CALL (LineType * l) +{ + VariantType x; + VariantType *X; + + assert (l != NULL); + + X = &x; + CLEAR_VARIANT (X); + /* Call the expression interpreter to evaluate the function */ + if (line_read_expression (l, X) == FALSE) /* bwb_CALL */ + { + WARN_SYNTAX_ERROR; + goto EXIT; + } +EXIT: + RELEASE_VARIANT (X); + return (l); +} + + +/*************************************************************** + + FUNCTION: find_label() + + DESCRIPTION: This C function finds a program line that + begins with the label included in <buffer>. + +***************************************************************/ +LineType * +find_line_number (int number) +{ + /* + ** + ** LABELS are resolved to their line number by the expresson parser. + ** However, LABELS usually do not have the LINE_NUMBERED flag set. + ** + */ + assert( My != NULL ); + assert( My->StartMarker != NULL ); + assert( My->EndMarker != NULL ); + + + if (MINLIN <= number && number <= MAXLIN) + { + /* + ** + ** brute force search + ** + */ + LineType *x; + + for (x = My->StartMarker->next; x != NULL && x != My->EndMarker && x->number < number; + x = x->next); + assert( x != NULL ); + if (x->number == number) + { + /* FOUND */ + return x; + } + } + /* NOT FOUND */ + WARN_UNDEFINED_LINE; + return NULL; +} + +extern VariableType * +var_chain (VariableType * argv) +{ + /* create a variable chain */ + VariableType *argn; + + + if (argv == NULL) + { + /* we are the first variable in the chain */ + if ((argn = (VariableType *) calloc (1, sizeof (VariableType))) == NULL) + { + WARN_OUT_OF_MEMORY; + return NULL; + } + } + else + { + /* find the end of the chain */ + assert( argv != NULL ); + for (argn = argv; argn->next != NULL; argn = argn->next); + + /* add ourself to the end */ + assert( argn != NULL ); + if ((argn->next = + (VariableType *) calloc (1, sizeof (VariableType))) == NULL) + { + WARN_OUT_OF_MEMORY; + return NULL; + } + argn = argn->next; + } + assert( argn != NULL ); + argn->next = NULL; + + /* return pointer to the variable just created */ + return argn; +} + + +/* EOF */ |