bwbasic-2.20pl2.orig/ 40755 2140 24 0 6473161701 12302 5ustar dialoutbwbasic-2.20pl2.orig/COPYING100644 0 0 43100 5437750044 13564 0ustar rootroot GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. bwbasic-2.20pl2.orig/INSTALL100644 0 0 14170 5456355116 13571 0ustar rootrootSome Notes on Installation of the Bywater BASIC Interpreter: ----------------------------------------------------------- 0. Quick-Start Guide For Compiling To use the default configuration (which is reasonable for most situations): On Unix, type "configure; make". On MS-DOS using QuickC, type "nmake -f makefile.qcl". You can skip the rest of this file unless you want to customize the BASIC dialect that is supported, or something goes wrong in the above commands. 1. Compiler Requirements Although earlier versions of bwBASIC would compile only with ANSI C compilers, versions 2.10 and higher can be compiled with "stock" C compilers, i.e., compilers that comply with the older Kernighan and Ritchie C standard. Section I-B of bwbasic.h allows you to specify some compiler features. If you have an ANSI C compiler, you needn't worry with this. For stock C compilers, the default configuration presumes that your compiler supports signal() and raise() with the signal.h header, supports setjmp() and longjmp() with the setjmp.h header, and has a separate string.h header. If your compiler does not have these features and the related header files, you can indicate this in section I-B by setting appropriate flags to FALSE. 2. Configuration of header files You may need to examine file "bwbasic.h" to make important changes for specific hardware and compiler configurations. You may also need to change "bwx_tty.h" if you are using the TTY implementation or "bwx_iqc.h" if you are using the version for PCs with Microsoft QuickC (see below on "implementations"). If you want to redefine messages or even the BASIC command names, you will need to edit "bwb_mes.h". 3. Makefiles Several makefiles are provided: "makefile.qcl" will compile the program utilizing the Microsoft QuickC (tm) line-oriented compiler on DOS-based p.c.'s, and "makefile" will compile the program on Unix-based computers utilizing either a stock C compiler or Gnu C++. I have also compiled the program utilizing Borland's Turbo C++ (tm) on DOS-based machines, although I have not supplied a makefile for Turbo C++. If you try the "IQC" implementation, you will need to alter makefile.qcl to include bwx_iqc.c (and bqx_iqc.obj) instead of bwx_tty.*. 4. Implementations The present status of bwBASIC allows two major implementations controlled by the IMP_TTY and IMP_IQC flags in bwbasic.h. IMP_TTY is the base implementation and presumes a simple TTY-style environment, with all keyboard and screen input and output directed through stdin and stdout. If IMP_TTY is defined as TRUE, then the file bwx_tty.h will be included, and a makefile should include compilation of bwx_tty.c. IMP_IQC is a somewhat more elaborate implementation for the IBM PC and compatible microcomputers utilizing the Microsoft QuickC compiler. This allows some more elaborate commands (CLS and LOCATE) and the INKEY$ function, and allows greater control over output. If IMP_IQC is defined as TRUE in bwbasic.h, then bwx_iqc.h will be included and bwx_iqc.c should be compiled in the makefile. Only one of the flags IMP_TTY or IMP_IQC should be set to TRUE. 5. Flags Controlling Groups of Commands and Functions There are a number of flags which control groups of commands and functions to be implemented. (core) Commands and Functions in any implementation of bwBASIC; these are the ANSI Minimal BASIC core INTERACTIVE Commands supporting the interactive programming environment COMMON_CMDS Commands beyond ANSI Minimal BASIC which are common to Full ANSI BASIC and Microsoft BASICs COMMON_FUNCS Functions beyond the ANSI Mimimal BASIC core, but common to both ANSI Full BASIC and Microsoft-style BASIC varieties UNIX_CMDS Commands which require Unix-style directory and environment routines not specified in ANSI C STRUCT_CMDS Commands related to structured programming; all of these are part of the Full ANSI BASIC standard ANSI_FUNCS Functions unique to ANSI Full BASIC MS_CMDS Commands unique to Microsoft BASICs MS_FUNCS Functions unique to Microsoft BASICs 6. Configurations The file bwbasic.h includes a number of configuration options that will automatically select groups of commands and functions according to predetermined patterns. These are: CFG_ANSIMINIMAL Conforms to ANSI Minimal BASIC standard X3.60-1978. CFG_COMMON Small implementation with commands and functions common to GWBASIC (tm) and ANSI full BASIC. CFG_MSTYPE Configuration similar to Microsoft line-oriented BASICs. CFG_ANSIFULL Conforms to ANSI Full BASIC standard X3.113-1987 (subset at present). CFG_CUSTOM Custom Configuration specified by user. Only one of these flags should be set to TRUE. 7. Adding Commands and Functions In order to add a new command to bwBASIC, follow the following procedure: (a) Write the command body using function bwb_null() in bwb_cmd.c as a template. The command-body function (in C) must receive a pointer to a bwb_line structure, and must pass on a pointer to a bwb_line structure. The preferred method for returning from a command-body function is: return bwb_zline( l ); this will discriminate between MULTISEG_LINES programs which advance to the next segment and those which advance to the next line. (b) Add prototypes for the command-body function in bwbasic.h; you'll need one prototype with arguments in the ANSI_C section and one prototype without arguments in the non-ANSI_C section. (c) Add the command to the command table in bwb_tbl.c in the group you have selected for it. (d) Increment the number of commands for the group in which you have placed your command. The procedure for adding a new function is parallel to this, except that you should use fnc_null() in bwb_fnc.c as the template, and the function name must be added to the function table in bwb_tbl.c. bwbasic-2.20pl2.orig/Makefile.in100644 0 0 5647 6055714562 14576 0ustar rootroot# Unix Makefile for Bywater BASIC Interpreter ##---------------------------------------------------------------## ## NOTE: Modifications marked "JBV" were made by Jon B. Volkoff, ## ## 11/1995 (eidetics@cerf.net). ## ##---------------------------------------------------------------## srcdir = @srcdir@ VPATH = @srcdir@ CC = @CC@ INSTALL = @INSTALL@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_DATA = @INSTALL_DATA@ DEFS = @DEFS@ # Revised by JBV #CFLAGS = -O CFLAGS = -g -ansi # Revised by JBV #LDFLAGS = -s prefix = /usr/local exec_prefix = $(prefix) bindir = $(exec_prefix)/bin SHELL = /bin/sh CFILES= bwbasic.c bwb_int.c bwb_tbl.c bwb_cmd.c bwb_prn.c\ bwb_exp.c bwb_var.c bwb_inp.c bwb_fnc.c bwb_cnd.c\ bwb_ops.c bwb_dio.c bwb_str.c bwb_elx.c bwb_mth.c\ bwb_stc.c bwb_par.c bwx_tty.c OFILES= bwbasic.o bwb_int.o bwb_tbl.o bwb_cmd.o bwb_prn.o\ bwb_exp.o bwb_var.o bwb_inp.o bwb_fnc.o bwb_cnd.o\ bwb_ops.o bwb_dio.o bwb_str.o bwb_elx.o bwb_mth.o\ bwb_stc.o bwb_par.o bwx_tty.o HFILES= bwbasic.h bwb_mes.h bwx_tty.h MISCFILES= COPYING INSTALL Makefile.in README bwbasic.doc\ bwbasic.mak configure.in configure makefile.qcl\ bwb_tcc.c bwx_iqc.c bwx_iqc.h TESTFILES= \ abs.bas assign.bas callfunc.bas callsub.bas chain1.bas\ chain2.bas dataread.bas deffn.bas dim.bas doloop.bas\ dowhile.bas elseif.bas end.bas err.bas fncallfn.bas\ fornext.bas function.bas gosub.bas gotolabl.bas ifline.bas\ index.txt input.bas lof.bas loopuntl.bas main.bas\ mlifthen.bas on.bas onerr.bas onerrlbl.bas ongosub.bas\ opentest.bas option.bas putget.bas random.bas selcase.bas\ snglfunc.bas stop.bas term.bas whilwend.bas width.bas\ writeinp.bas pascaltr.bas DISTFILES= $(CFILES) $(HFILES) $(MISCFILES) # Revised by JBV #all: bwbasic all: bwbasic renum bwbasic: $(OFILES) $(CC) $(OFILES) -lm -o $@ $(LDFLAGS) # Added by JBV renum: $(CC) renum.c -o renum $(OFILES): $(HFILES) .c.o: $(CC) -c $(CPPFLAGS) -I$(srcdir) $(DEFS) $(CFLAGS) $< install: all $(INSTALL_PROGRAM) bwbasic $(bindir)/bwbasic uninstall: rm -f $(bindir)/bwbasic Makefile: Makefile.in config.status $(SHELL) config.status config.status: configure $(SHELL) config.status --recheck configure: configure.in cd $(srcdir); autoconf TAGS: $(CFILES) etags $(CFILES) clean: rm -f *.o bwbasic core mostlyclean: clean distclean: clean rm -f Makefile config.status realclean: distclean rm -f TAGS # Version number changed from 2.10 to 2.20 by JBV dist: $(DISTFILES) echo bwbasic-2.20 > .fname rm -rf `cat .fname` mkdir `cat .fname` ln $(DISTFILES) `cat .fname` mkdir `cat .fname`/bwbtest cd bwbtest; ln $(TESTFILES) ../`cat ../.fname`/bwbtest tar czhf `cat .fname`.tar.gz `cat .fname` rm -rf `cat .fname` .fname # Prevent GNU make v3 from overflowing arg limit on SysV. .NOEXPORT: bwbasic-2.20pl2.orig/README100644 0 0 13374 6055714562 13425 0ustar rootroot README file for Bywater BASIC Interpreter/Shell, version 2.20 --------------------------------------------- Copyright (c) 1993, Ted A. Campbell for bwBASIC version 2.10, 11 October 1993 Version 2.20 modifications by Jon B. Volkoff, 25 November 1995 DESCRIPTION: The Bywater BASIC Interpreter (bwBASIC) implements a large superset of the ANSI Standard for Minimal BASIC (X3.60-1978) and a significant subset of the ANSI Standard for Full BASIC (X3.113-1987) in C. It also offers shell programming facilities as an extension of BASIC. bwBASIC seeks to be as portable as possible. This version of Bywater BASIC 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. IMPROVEMENTS OVER PREVIOUS VERSION (2.10): * Plugged numerous memory leaks, resolved memory overruns and allocation difficulties. * General cleanup and bug fixes, too many to list in detail here. The major problem areas addressed were: - RUN command with file name argument - nested and cascaded FOR-NEXT loops - PRINT USING - EOF, LOF functions - string concatenation - operator hierarchy - multi-level expression evaluation - hex constant interpretation - hex and octal constants in INPUT and DATA statements * Added a CLOSE all files feature (when no argument supplied). * Added a unary minus sign operator. * Added a MID$ command to complement the MID$ function. * Added a RENUM facility in a standalone program. * Added checking in configure for unistd.h (important on Sun systems). OBTAINING THE SOURCE CODE: The source code for bwBASIC 2.20 is available immediately by anonymous ftp. To obtain the source code, ftp to site ftp.netcom.com, cd to pub/rh/rhn and get the file bwbasic-2.20.uu. Or you may receive a copy by e-mail by writing to Jon Volkoff at eidetics@cerf.net. COMMUNICATIONS: email: tcamp@delphi.com (for Ted Campbell) eidetics@cerf.net (for Jon Volkoff) A LIST OF BASIC COMMANDS AND FUNCTIONS IMPLEMENTED in bwBASIC 2.20: Be aware that many of these commands and functions will not be available unless you have set certain flags in the header files. ABS( number ) ASC( string$ ) ATN( number ) CALL subroutine-name CASE constant | IF partial-expression | ELSE CHAIN file-name CHDIR pathname CHR$( number ) CINT( number ) CLEAR CLOSE [[#]file-number]... CLS COMMON variable [, variable...] COS( number ) CSNG( number ) CVD( string$ ) CVI( string$ ) CVS( string$ ) DATA constant[,constant]... DATE$ DEF FNname(arg...)] = expression DEFDBL letter[-letter](, letter[-letter])... DEFINT letter[-letter](, letter[-letter])... DEFSNG letter[-letter](, letter[-letter])... DEFSTR letter[-letter](, letter[-letter])... DELETE line[-line] DIM variable(elements...)[variable(elements...)]... DO NUM|UNNUM DO [WHILE expression] EDIT (* depends on variable BWB.EDITOR$) ELSE ELSEIF END FUNCTION | IF | SELECT | SUB ENVIRON variable-string$ = string$ ENVIRON$( variable-string ) EOF( device-number ) ERASE variable[, variable]... ERL ERR ERROR number EXIT FOR|DO EXP( number ) FIELD [#] device-number, number AS string-variable [, number AS string-variable...] FILES filespec$ (* depends on variable BWB.FILES$) FOR counter = start TO finish [STEP increment] FUNCTION function-definition GET [#] device-number [, record-number] GOSUB line | label GOTO line | label HEX$( number ) IF expression THEN [statement [ELSE statement]] INKEY$ INPUT [# device-number]|[;]["prompt string";]list of variables INSTR( [start-position,] string-searched$, string-pattern$ ) INT( number ) KILL file-name LEFT$( string$, number-of-spaces ) LEN( string$ ) LET variable = expression LINE INPUT [[#] device-number,]["prompt string";] string-variable$ LIST line[-line] LOAD file-name LOC( device-number ) LOCATE LOF( device-number ) LOG( number ) LOOP [UNTIL expression] LSET string-variable$ = expression MERGE file-name MID$( string$, start-position-in-string[, number-of-spaces ] ) MKD$( number ) MKDIR pathname MKI$( number ) MKS$( number ) NAME old-file-name AS new-file-name NEW NEXT counter OCT$( number ) ON variable GOTO|GOSUB line[,line,line,...] ON ERROR GOSUB line | label OPEN O|I|R, [#]device-number, file-name [,record length] file-name FOR INPUT|OUTPUT|APPEND AS [#]device-number [LEN = record-length] OPTION BASE number POS PRINT [# device-number,][USING format-string$;] expressions... PUT [#] device-number [, record-number] RANDOMIZE number READ variable[, variable]... REM string RENUM RESTORE line RETURN RIGHT$( string$, number-of-spaces ) RMDIR pathname RND( number ) RSET string-variable$ = expression RUN [line]|[file-name] SAVE file-name SELECT CASE expression SGN( number ) SIN( number ) SPACE$( number ) SPC( number ) SQR( number ) STOP STR$( number ) STRING$( number, ascii-value|string$ ) SUB subroutine-name SWAP variable, variable SYSTEM TAB( number ) TAN( number ) TIME$ TIMER TROFF TRON VAL( string$ ) WEND WHILE expression WIDTH [# device-number,] number WRITE [# device-number,] element [, element ].... bwbasic-2.20pl2.orig/bwb_cmd.c100644 0 0 140720 6473161676 14330 0ustar rootroot/*************************************************************** bwb_cmd.c Miscellaneous Commands for Bywater BASIC Interpreter Commands: RUN LET LOAD MERGE CHAIN NEW RENUM SAVE LIST GOTO GOSUB RETURN ON STOP END SYSTEM TRON TROFF DELETE RANDOMIZE ENVIRON CMDS (*debugging) 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). */ /*---------------------------------------------------------------*/ #include #include #include #include "bwbasic.h" #include "bwb_mes.h" #if HAVE_SIGNAL #include #endif char err_gosubl[ MAXVARNAMESIZE + 1 ] = { '\0' }; /* line for error GOSUB */ #if ANSI_C extern struct bwb_line *bwb_xnew( struct bwb_line *l ); extern struct bwb_line *bwb_onerror( struct bwb_line *l ); struct bwb_line *bwb_donum( struct bwb_line *l ); struct bwb_line *bwb_dounnum( struct bwb_line *l ); static int xl_line( FILE *file, struct bwb_line *l ); #else extern struct bwb_line *bwb_xnew(); extern struct bwb_line *bwb_onerror(); struct bwb_line *bwb_donum(); struct bwb_line *bwb_dounnum(); static int xl_line(); #endif /*************************************************************** FUNCTION: bwb_null() DESCRIPTION: This is a null command function body, and can be used as the basis for developing new BASIC commands. ***************************************************************/ #if ANSI_C struct bwb_line * bwb_null( struct bwb_line *l ) #else struct bwb_line * bwb_null( l ) struct bwb_line *l; #endif { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_null(): NULL command" ); bwb_debug( bwb_ebuf ); #endif #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_rem() DESCRIPTION: This C function implements the BASIC rem (REMark) command, ignoring the remainder of the line. ***************************************************************/ #if ANSI_C struct bwb_line * bwb_rem( struct bwb_line *l ) #else struct bwb_line * bwb_rem( l ) struct bwb_line *l; #endif { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_rem(): REM command" ); bwb_debug( bwb_ebuf ); #endif /* do not use bwb_zline() here; blank out remainder of line */ l->next->position = 0; return l->next; } /*************************************************************** FUNCTION: bwb_let() DESCRIPTION: This C function implements the BASIC LET assignment command, even if LET is implied and not explicit. SYNTAX: LET variable = expression ***************************************************************/ #if ANSI_C struct bwb_line * bwb_let( struct bwb_line *l ) #else struct bwb_line * bwb_let( l ) struct bwb_line *l; #endif { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_let(): pos <%d> line <%s>", l->position, l->buffer ); bwb_debug( bwb_ebuf ); #endif /* Call the expression interpreter to evaluate the assignment */ bwb_exp( l->buffer, TRUE, &( l->position ) ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_go DESCRIPTION: This C function implements the BASIC GO command, branching appropriately to GOTO or GOSUB. ***************************************************************/ #if ANSI_C struct bwb_line * bwb_go( struct bwb_line *l ) #else struct bwb_line * bwb_go( l ) struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; adv_element( l->buffer, &( l->position ), tbuf ); bwb_strtoupper( tbuf ); if ( strcmp( tbuf, CMD_XSUB ) == 0 ) { return bwb_gosub( l ); } if ( strcmp( tbuf, CMD_XTO ) == 0 ) { return bwb_goto( l ); } #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_go(): Nonsense following GO" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_goto DESCRIPTION: This C function implements the BASIC GOTO command. SYNTAX: GOTO line | label ***************************************************************/ #if ANSI_C struct bwb_line * bwb_goto( struct bwb_line *l ) #else struct bwb_line * bwb_goto( l ) struct bwb_line *l; #endif { struct bwb_line *x; char tbuf[ MAXSTRINGSIZE + 1 ]; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_goto(): entered function" ); bwb_debug( bwb_ebuf ); #endif /* Check for argument */ adv_ws( l->buffer, &( l->position ) ); switch( l->buffer[ l->position ] ) { case '\0': case '\n': case '\r': case ':': bwb_error( err_noln ); return bwb_zline( l ); default: break; } adv_element( l->buffer, &( l->position ), tbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_goto(): buffer has <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif /* check for target label */ #if STRUCT_CMDS if ( isalpha( tbuf[ 0 ] )) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_goto(): found LABEL, <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif x = find_label( tbuf ); x->position = 0; return x; } else { for ( x = &CURTASK bwb_start; x != &CURTASK bwb_end; x = x->next ) { if ( x->number == atoi( tbuf ) ) { /* found the requested number */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_goto(): returning line <%d>", x->number ); bwb_debug( bwb_ebuf ); #endif x->position = 0; return x; } } } #else for ( x = &CURTASK bwb_start; x != &CURTASK bwb_end; x = x->next ) { if ( x->number == atoi( tbuf ) ) { /* found the requested number */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_goto(): returning line <%d>", x->number ); bwb_debug( bwb_ebuf ); #endif x->position = 0; return x; } } #endif sprintf( bwb_ebuf, err_lnnotfound, atoi( tbuf ) ); bwb_error( bwb_ebuf ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_gosub() DESCRIPTION: This function implements the BASIC GOSUB command. SYNTAX: GOSUB line | label ***************************************************************/ #if ANSI_C struct bwb_line * bwb_gosub( struct bwb_line *l ) #else struct bwb_line * bwb_gosub( l ) struct bwb_line *l; #endif { struct bwb_line *x; char atbuf[ MAXSTRINGSIZE + 1 ]; /* Check for argument */ adv_ws( l->buffer, &( l->position ) ); switch( l->buffer[ l->position ] ) { case '\0': case '\n': case '\r': case ':': sprintf( bwb_ebuf, err_noln ); bwb_error( bwb_ebuf ); return bwb_zline( l ); default: break; } /* get the target line number in tbuf */ adv_element( l->buffer, &( l->position ), atbuf ); #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif /* check for a label rather than line number */ #if STRUCT_CMDS if ( isalpha( atbuf[ 0 ] )) { x = find_label( atbuf ); #if MULTISEG_LINES CURTASK excs[ CURTASK exsc ].position = l->position; #endif bwb_incexec(); /* set the new position to x and return x */ x->cmdnum = -1; x->marked = FALSE; x->position = 0; bwb_setexec( x, 0, EXEC_GOSUB ); return x; } #endif for ( x = &CURTASK bwb_start; x != &CURTASK bwb_end; x = x->next ) { if ( x->number == atoi( atbuf )) { /* this is the line we are looking for */ #if MULTISEG_LINES CURTASK excs[ CURTASK exsc ].position = l->position; #endif /* increment the EXEC stack */ bwb_incexec(); /* set the new position to x and return x */ x->cmdnum = -1; x->marked = FALSE; x->position = 0; bwb_setexec( x, 0, EXEC_GOSUB ); return x; } } /* the requested line was not found */ sprintf( bwb_ebuf, err_lnnotfound, atoi( atbuf ) ); bwb_error( bwb_ebuf ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_return() DESCRIPTION: This function implements the BASIC RETURN command. SYNTAX: RETURN ***************************************************************/ #if ANSI_C struct bwb_line * bwb_return( struct bwb_line *l ) #else struct bwb_line * bwb_return( l ) struct bwb_line *l; #endif { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_return() at line <%d> cmdnum <%d>", l->number, l->cmdnum ); bwb_debug( bwb_ebuf ); #endif /* see if old position was "GOSUB" */ /* JBV 1/20/97 */ /* if ( CURTASK excs[ CURTASK exsc ].code != EXEC_GOSUB ) { bwb_error( err_retnogosub ); } */ /*--------------------------------------------------------------*/ /* Make sure we are at the right stack level! */ /* If we aren't (which could happen for legit reasons), fix the */ /* exec stack. */ /* JBV, 1/20/97 */ /*--------------------------------------------------------------*/ while ( CURTASK excs[ CURTASK exsc ].code != EXEC_GOSUB ) { bwb_decexec(); if ( CURTASK excs[ CURTASK exsc ].code == EXEC_NORM ) /* End of the line? */ { bwb_error( err_retnogosub ); } } /* decrement the EXEC stack counter */ bwb_decexec(); /* restore position and return old line */ #if MULTISEG_LINES CURTASK excs[ CURTASK exsc ].line->position = CURTASK excs[ CURTASK exsc ].position; return CURTASK excs[ CURTASK exsc ].line; #else CURTASK excs[ CURTASK exsc ].line->next->position = 0; return CURTASK excs[ CURTASK exsc ].line->next; #endif } /*************************************************************** FUNCTION: bwb_on DESCRIPTION: This function implements the BASIC ON... GOTO or ON...GOSUB statements. It will also detect the ON ERROR... statement and pass execution to bwb_onerror(). SYNTAX: ON variable GOTO|GOSUB line[,line,line,...] LIMITATION: As implemented here, the ON...GOSUB|GOTO command recognizes line numbers only (not labels). ***************************************************************/ #if ANSI_C struct bwb_line * bwb_on( struct bwb_line *l ) #else struct bwb_line * bwb_on( l ) struct bwb_line *l; #endif { struct bwb_line *oline, *x; char varname[ MAXVARNAMESIZE + 1 ]; char tbuf[ MAXSTRINGSIZE + 1 ]; static int p; struct exp_ese *rvar; int v; int loop; int num_lines; int command; int lines[ MAX_GOLINES ]; char sbuf[ 7 ]; /* Check for argument */ adv_ws( l->buffer, &( l->position ) ); switch( l->buffer[ l->position ] ) { case '\0': case '\n': case '\r': case ':': sprintf( bwb_ebuf, err_incomplete ); bwb_error( bwb_ebuf ); return bwb_zline( l ); default: break; } /* get the variable name or numerical constant */ adv_element( l->buffer, &( l->position ), varname ); /* check for ON ERROR statement */ #if COMMON_CMDS strncpy( sbuf, varname, 6 ); bwb_strtoupper( sbuf ); if ( strcmp( sbuf, CMD_XERROR ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_on(): detected ON ERROR" ); bwb_debug( bwb_ebuf ); #endif return bwb_onerror( l ); } #endif /* COMMON_CMDS */ /* evaluate the variable name or constant */ p = 0; rvar = bwb_exp( varname, FALSE, &p ); v = (int) exp_getnval( rvar ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_on(): value is <%d>", v ); bwb_debug( bwb_ebuf ); #endif /* Get GOTO or GOSUB statements */ adv_element( l->buffer, &( l->position ), tbuf ); bwb_strtoupper( tbuf ); if ( strncmp( tbuf, CMD_GOTO, (size_t) strlen( CMD_GOTO ) ) == 0 ) { command = getcmdnum( CMD_GOTO ); } else if ( strncmp( tbuf, CMD_GOSUB, (size_t) strlen( CMD_GOSUB ) ) == 0 ) { command = getcmdnum( CMD_GOSUB ); } else { sprintf( bwb_ebuf, ERR_ONNOGOTO ); bwb_error( bwb_ebuf ); return bwb_zline( l ); } num_lines = 0; loop = TRUE; while( loop == TRUE ) { /* read a line number */ inp_adv( l->buffer, &( l->position ) ); adv_element( l->buffer, &( l->position ), tbuf ); lines[ num_lines ] = atoi( tbuf ); ++num_lines; if ( num_lines >= MAX_GOLINES ) { loop = FALSE; } /* check for end of line */ adv_ws( l->buffer, &( l->position ) ); switch( l->buffer[ l->position ] ) { case '\0': case '\n': case '\r': case ':': loop = FALSE; break; } } /* advance to end of segment */ #if MULTISEG_LINES adv_eos( l->buffer, &( l->position ) ); #endif /* Be sure value is in range */ if ( ( v < 1 ) || ( v > num_lines )) { sprintf( bwb_ebuf, err_valoorange ); bwb_error( bwb_ebuf ); return bwb_zline( l ); } if ( command == getcmdnum( CMD_GOTO )) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_on(): executing ON...GOTO" ); bwb_debug( bwb_ebuf ); #endif oline = NULL; for ( x = &CURTASK bwb_start; x != &CURTASK bwb_end; x = x->next ) { if ( x->number == lines[ v - 1 ] ) { /* found the requested number */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_on(): returning line <%d>", x->number ); bwb_debug( bwb_ebuf ); #endif oline = x; } } if ( oline == NULL ) { bwb_error( err_lnnotfound ); return bwb_zline( l ); } oline->position = 0; bwb_setexec( oline, 0, CURTASK excs[ CURTASK exsc ].code ); return oline; } else if ( command == getcmdnum( CMD_GOSUB )) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_on(): executing ON...GOSUB" ); bwb_debug( bwb_ebuf ); #endif /* save current stack level */ bwb_setexec( l, l->position, CURTASK excs[ CURTASK exsc ].code ); /* increment exec stack */ bwb_incexec(); /* get memory for line and buffer */ /* Revised to CALLOC pass-thru call by JBV */ if ( ( oline = CALLOC( 1, sizeof( struct bwb_line ), "bwb_on") ) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_on(): failed to find memory for oline" ); #else bwb_error( err_getmem ); #endif } /* Revised to CALLOC pass-thru call by JBV */ if ( ( oline->buffer = CALLOC( 1, MAXSTRINGSIZE + 1, "bwb_on") ) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_on(): failed to find memory for oline buffer" ); #else bwb_error( err_getmem ); #endif } CURTASK excs[ CURTASK exsc ].while_line = oline; sprintf( oline->buffer, "%s %d", CMD_GOSUB, lines[ v - 1 ] ); oline->marked = FALSE; oline->position = 0; oline->next = l->next; bwb_setexec( oline, 0, EXEC_ON ); return oline; } else { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_on(): invalid value for command." ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } } /*************************************************************** FUNCTION: bwb_stop() DESCRIPTION: This C function implements the BASIC STOP command, interrupting program flow at a specific point. SYNTAX: STOP ***************************************************************/ #if ANSI_C struct bwb_line * bwb_stop( struct bwb_line *l ) #else struct bwb_line * bwb_stop( l ) struct bwb_line *l; #endif { #if HAVE_SIGNAL #if HAVE_RAISE raise( SIGINT ); #else kill( getpid(), SIGINT ); #endif #endif return bwb_xend( l ); } /*************************************************************** FUNCTION: bwb_xend() DESCRIPTION: This C function implements the BASIC END command, checking for END SUB or END FUNCTION, else stopping program execution for a simple END command. ***************************************************************/ #if ANSI_C struct bwb_line * bwb_xend( struct bwb_line *l ) #else struct bwb_line * bwb_xend( l ) struct bwb_line *l; #endif { #if STRUCT_CMDS char tbuf[ MAXSTRINGSIZE + 1 ]; #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xend(): entered funtion" ); bwb_debug( bwb_ebuf ); #endif /* Detect END SUB or END FUNCTION here */ #if STRUCT_CMDS adv_element( l->buffer, &( l->position ), tbuf ); bwb_strtoupper( tbuf ); if ( strcmp( tbuf, CMD_XSUB ) == 0 ) { return bwb_endsub( l ); } if ( strcmp( tbuf, CMD_XFUNCTION ) == 0 ) { return bwb_endfnc( l ); } if ( strcmp( tbuf, CMD_XIF ) == 0 ) { return bwb_endif( l ); } if ( strcmp( tbuf, CMD_XSELECT ) == 0 ) { return bwb_endselect( l ); } #endif /* STRUCT_CMDS */ /* else a simple END statement */ break_handler(); return &CURTASK bwb_end; } /*************************************************************** FUNCTION: bwb_do() DESCRIPTION: This C function implements the BASIC DO command, also checking for the DO NUM and DO UNNUM commands for interactive programming environment. ***************************************************************/ #if ANSI_C struct bwb_line * bwb_do( struct bwb_line *l ) #else struct bwb_line * bwb_do( l ) struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; adv_element( l->buffer, &( l->position ), tbuf ); bwb_strtoupper( tbuf ); /* if there is no argument (with STRUCT_CMDS) then we have a DO-LOOP structure: pass on to bwb_doloop() in bwb_stc.c */ #if STRUCT_CMDS if ( strlen( tbuf ) == 0 ) { return bwb_doloop( l ); } if ( strcmp( tbuf, CMD_WHILE ) == 0 ) { return bwb_while( l ); } #endif #if INTERACTIVE if ( strcmp( tbuf, CMD_XNUM ) == 0 ) { return bwb_donum( l ); } if ( strcmp( tbuf, CMD_XUNNUM ) == 0 ) { return bwb_dounnum( l ); } #endif /* INTERACTIVE */ /* if none of these occurred, then presume an error */ bwb_error( err_syntax ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_run() DESCRIPTION: This C function implements the BASIC RUN command. Even though RUN is not a core statement, the function bwb_run() is called from core, so it must be present for a minimal implementation. SYNTAX: RUN [line]|[file-name] ***************************************************************/ #if ANSI_C struct bwb_line * bwb_run( struct bwb_line *l ) #else struct bwb_line * bwb_run( l ) struct bwb_line *l; #endif { struct bwb_line *current, *x; int go_lnumber; /* line number to go to */ char tbuf[ MAXSTRINGSIZE + 1 ]; struct exp_ese *e; FILE *input; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_run(): entered function. buffer <%s> pos <%d>", l->buffer, l->position ); bwb_debug( bwb_ebuf ); #endif /* see if there is an element */ current = NULL; adv_ws( l->buffer, &( l->position ) ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_run(): check buffer <%s> pos <%d> char <0x%x>", l->buffer, l->position, l->buffer[ l->position ] ); bwb_debug( bwb_ebuf ); #endif switch ( l->buffer[ l->position ] ) { case '\0': case '\n': case '\r': case ':': #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_run(): no argument; begin at start.next" ); bwb_debug( bwb_ebuf ); #endif current = CURTASK bwb_start.next; e = NULL; break; default: e = bwb_exp( l->buffer, FALSE, &( l->position ) ); break; } /* check its type: if it is a string, open the file and execute it */ if (( e != NULL ) && ( e->type == STRING )) { bwb_new( l ); /* clear memory */ str_btoc( tbuf, exp_getsval( e ) ); /* get string in tbuf */ if ( ( input = fopen( tbuf, "r" )) == NULL ) /* open file */ { sprintf( bwb_ebuf, err_openfile, tbuf ); bwb_error( bwb_ebuf ); } bwb_fload( input ); /* load program */ /* Next line removed by JBV (unnecessary recursion asks for trouble) */ /* bwb_run( &CURTASK bwb_start ); */ /* and call bwb_run() recursively */ current = &CURTASK bwb_start; /* JBV */ } /* else if it is a line number, execute the program in memory at that line number */ /* Removed by JBV */ /* else { */ /* Removed by JBV */ /* if ( current == NULL ) { */ /* Added expression type check and changed loop boundaries (JBV) */ if (( e != NULL ) && ( e->type != STRING )) { go_lnumber = (int) exp_getnval( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_run(): element detected <%s>, lnumber <%d>", tbuf, go_lnumber ); bwb_debug( bwb_ebuf ); #endif for ( x = CURTASK bwb_start.next; x != &CURTASK bwb_end; x = x->next ) { if ( x->number == go_lnumber ) { current = x; } } } /* } */ /* Removed by JBV */ if ( current == NULL ) { sprintf( bwb_ebuf, err_lnnotfound, go_lnumber ); bwb_error( bwb_ebuf ); return &CURTASK bwb_end; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_run(): ready to run starting at line %d", current->number ); bwb_debug( bwb_ebuf ); #endif if ( CURTASK rescan == TRUE ) { bwb_scan(); } current->position = 0; CURTASK exsc = 0; bwb_setexec( current, 0, EXEC_NORM ); /* } */ /* Removed by JBV */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_run(): function complete." ); bwb_debug( bwb_ebuf ); #endif return current; } /*************************************************************** FUNCTION: bwb_new() DESCRIPTION: This C function implements the BASIC NEW command. Even though NEW is not a core statement, the function bwb_run() is called from core, so it must be present for a minimal implementation. SYNTAX: NEW ***************************************************************/ #if ANSI_C struct bwb_line * bwb_new( struct bwb_line *l ) #else struct bwb_line * bwb_new( l ) struct bwb_line *l; #endif { /* clear program in memory */ bwb_xnew( l ); /* clear all variables */ bwb_clear( l ); return bwb_zline( l ); } /* End of Core Functions Section */ #if INTERACTIVE /*************************************************************** FUNCTION: bwb_system() DESCRIPTION: This C function implements the BASIC SYSTEM command, exiting to the operating system (or calling program). It is also called by the QUIT command, a functional equivalent for SYSTEM in Bywater BASIC. SYNTAX: SYSTEM QUIT ***************************************************************/ #if ANSI_C struct bwb_line * bwb_system( struct bwb_line *l ) #else struct bwb_line * bwb_system( l ) struct bwb_line *l; #endif { prn_xprintf( stdout, "\n" ); #if INTENSIVE_DEBUG bwb_debug( "in bwb_system(): ready to exit" ); #endif bwx_terminate(); return &CURTASK bwb_end; /* to make LINT happy */ } /*************************************************************** FUNCTION: bwb_load() DESCRIPTION: This C function implements the BASIC LOAD command. SYNTAX: LOAD file-name ***************************************************************/ #if ANSI_C struct bwb_line * bwb_load( struct bwb_line *l ) #else struct bwb_line * bwb_load( l ) struct bwb_line *l; #endif { /* clear current contents */ bwb_new( l ); /* call xload function to load program in memory */ bwb_xload( l ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_xload() DESCRIPTION: This C function loads a BASIC program into memory. ***************************************************************/ #if ANSI_C struct bwb_line * bwb_xload( struct bwb_line *l ) #else struct bwb_line * bwb_xload( l ) struct bwb_line *l; #endif { FILE *loadfile; struct exp_ese *e; /* JBV */ /* Get an argument for filename */ adv_ws( l->buffer, &( l->position ) ); switch( l->buffer[ l->position ] ) { case '\0': case '\n': case '\r': case ':': bwb_error( err_nofn ); /* Added by JBV (bug found by DD) */ return bwb_zline( l ); default: break; } /* Section added by JBV (bug found by DD) */ e = bwb_exp( l->buffer, FALSE, &( l->position ) ); if ( e->type != STRING ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_xload(): Missing filespec" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } /* This line removed by JBV (no longer required) */ /* bwb_const( l->buffer, CURTASK progfile, &( l->position ) ); */ str_btoc( CURTASK progfile, exp_getsval( e ) ); /* JBV */ if ( ( loadfile = fopen( CURTASK progfile, "r" )) == NULL ) { sprintf( bwb_ebuf, err_openfile, CURTASK progfile ); bwb_error( bwb_ebuf ); return bwb_zline( l ); } bwb_fload( loadfile ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_save() DESCRIPTION: This C function implements the BASIC SAVE command. SYNTAX: SAVE file-name ***************************************************************/ #if ANSI_C struct bwb_line * bwb_save( struct bwb_line *l ) #else struct bwb_line * bwb_save( l ) struct bwb_line *l; #endif { FILE *outfile; static char filename[ MAXARGSIZE ]; struct exp_ese *e; /* JBV */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_save(): entered function." ); bwb_debug( bwb_ebuf ); #endif /* Get an argument for filename */ adv_ws( l->buffer, &( l->position ) ); switch( l->buffer[ l->position ] ) { case '\0': case '\n': case '\r': case ':': bwb_error( err_nofn ); return bwb_zline( l ); default: break; } /* Section added by JBV (bug found by DD) */ e = bwb_exp( l->buffer, FALSE, &( l->position ) ); if ( e->type != STRING ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_save(): Missing filespec" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } /* This line removed by JBV (no longer required) */ /* bwb_const( l->buffer, filename, &( l->position ) ); */ str_btoc( filename, exp_getsval( e ) ); /* JBV */ if ( ( outfile = fopen( filename, "w" )) == NULL ) { sprintf( bwb_ebuf, err_openfile, filename ); bwb_error( bwb_ebuf ); return bwb_zline( l ); } bwb_xlist( l, outfile ); fclose( outfile ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_list() DESCRIPTION: This C function implements the BASIC LIST command. SYNTAX: LIST line[-line] ***************************************************************/ #if ANSI_C struct bwb_line * bwb_list( struct bwb_line *l ) #else struct bwb_line * bwb_list( l ) struct bwb_line *l; #endif { bwb_xlist( l, stdout ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_xlist() DESCRIPTION: This C function lists the program in memory to a specified output device. ***************************************************************/ #if ANSI_C struct bwb_line * bwb_xlist( struct bwb_line *l, FILE *file ) #else struct bwb_line * bwb_xlist( l, file ) struct bwb_line *l; FILE *file; #endif { struct bwb_line *start, *end, *current; int s, e; int f, r; start = CURTASK bwb_start.next; end = &CURTASK bwb_end; r = bwb_numseq( &( l->buffer[ l->position ] ), &s, &e ); /* advance to the end of the segment */ #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif if (( r == FALSE ) || ( s == 0 )) { s = CURTASK bwb_start.next->number; } if ( e == 0 ) { e = s; } if ( r == FALSE ) { for ( current = CURTASK bwb_start.next; current != &CURTASK bwb_end; current = current->next ) { if ( current->next == &CURTASK bwb_end ) { e = current->number; } } } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xlist(): LBUFFER sequence is %d-%d", s, e ); bwb_debug( bwb_ebuf ); #endif /* abort if either number == (MAXLINENO + 1) which denotes CURTASK bwb_end */ if ( ( s == (MAXLINENO + 1)) || ( e == (MAXLINENO + 1 ) ) ) { return bwb_zline( l ); } /* Now try to find the actual lines in memory */ f = FALSE; for ( current = CURTASK bwb_start.next; current != &CURTASK bwb_end; current = current->next ) { if ( current != l ) { if (( current->number == s ) && ( f == FALSE )) { f = TRUE; start = current; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xlist(): start line number is <%d>", s ); bwb_debug( bwb_ebuf ); #endif } } } /* check and see if a line number was found */ if ( f == FALSE ) { sprintf( bwb_ebuf, err_lnnotfound, s ); bwb_error( bwb_ebuf ); return bwb_zline( l ); } if ( e >= s ) { for ( current = CURTASK bwb_start.next; current != &CURTASK bwb_end; current = current->next ) { if ( current != l ) { if ( current->number == e ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xlist(): end line number is <%d>", current->next->number ); bwb_debug( bwb_ebuf ); #endif end = current->next; } } } } else { end = start; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xlist(): line sequence is <%d-%d>", start->number, end->number ); bwb_debug( bwb_ebuf ); #endif /* previous should now be set to the line previous to the first in the omission list */ /* now go through and list appropriate lines */ if ( start == end ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xlist(): start == end" ); bwb_debug( bwb_ebuf ); #endif xl_line( file, start ); } else { for ( current = start; current != end; current = current->next ) { xl_line( file, current ); } } return bwb_zline( l ); } /*************************************************************** FUNCTION: xl_line() DESCRIPTION: This function lists a single program line to a specified device of file. It is called by bwb_xlist(); ***************************************************************/ #if ANSI_C static int xl_line( FILE *file, struct bwb_line *l ) #else static int xl_line( file, l ) FILE *file; struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; if (( file == stdout ) || ( file == stderr )) { if ( l->xnum == (char) TRUE ) /* Better recast this one (JBV) */ { sprintf( tbuf, "%7d: %s\n", l->number, l->buffer ); } else { sprintf( tbuf, " : %s\n", l->buffer ); } prn_xprintf( file, tbuf ); } else { if ( l->xnum == (char) TRUE ) /* Better recast this one (JBV) */ { fprintf( file, "%d %s\n", l->number, l->buffer ); } else { fprintf( file, "%s\n", l->buffer ); } } return TRUE; } /*************************************************************** FUNCTION: bwb_delete() DESCRIPTION: This C function implements the BASIC DELETE command for interactive programming, deleting a specified program line (or lines) from memory. SYNTAX: DELETE line[-line] ***************************************************************/ #if ANSI_C struct bwb_line * bwb_delete( struct bwb_line *l ) #else struct bwb_line * bwb_delete( l ) struct bwb_line *l; #endif { struct bwb_line *start, *end, *current, *previous, *p, *next; static int s, e; int f; previous = &CURTASK bwb_start; start = CURTASK bwb_start.next; end = &CURTASK bwb_end; bwb_numseq( &( l->buffer[ l->position ] ), &s, &e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_delete(): LBUFFER sequence is %d-%d", s, e ); bwb_debug( bwb_ebuf ); #endif /* advance to the end of the segment */ #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif /* Now try to find the actual lines in memory */ previous = p = &CURTASK bwb_start; f = FALSE; for ( current = CURTASK bwb_start.next; current != &CURTASK bwb_end; current = current->next ) { if ( current != l ) { /* Following line revised by JBV */ if (( current->xnum == (char) TRUE ) && ( current->number == s )) { f = TRUE; previous = p; start = current; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_delete(): start line number is <%d>", s ); bwb_debug( bwb_ebuf ); #endif } } p = current; } /* check and see if a line number was found */ if ( f == FALSE ) { sprintf( bwb_ebuf, err_lnnotfound, s ); bwb_error( bwb_ebuf ); return bwb_zline( l ); } if ( e > s ) { for ( current = CURTASK bwb_start.next; current != &CURTASK bwb_end; current = current->next ) { if ( current != l ) { /* Following line revised by JBV */ if (( current->xnum == (char) TRUE) && ( current->number == e )) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_delete(): end line number is <%d>", e ); bwb_debug( bwb_ebuf ); #endif end = current->next; } } } } else { end = start->next; } /* previous should now be set to the line previous to the first in the omission list */ /* now go through and delete appropriate lines */ current = start; while (( current != end ) && ( current != &CURTASK bwb_end )) { next = current->next; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_delete(): deleting line %d", current->number ); bwb_debug( bwb_ebuf ); #endif /* free line memory */ bwb_freeline( current ); /* recycle */ current = next; } /* reset link */ previous->next = current; return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_donum() DESCRIPTION: This function implements the BASIC DO NUM command, numbering all program lines in memory in increments of 10 beginning at 10. SYNTAX: DO NUM ***************************************************************/ #if ANSI_C struct bwb_line * bwb_donum( struct bwb_line *l ) #else struct bwb_line * bwb_donum( l ) struct bwb_line *l; #endif { struct bwb_line *current; register int lnumber; lnumber = 10; for ( current = bwb_start.next; current != &bwb_end; current = current->next ) { current->number = lnumber; current->xnum = TRUE; lnumber += 10; if ( lnumber >= MAXLINENO ) { return bwb_zline( l ); } } return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_dounnum() DESCRIPTION: This function implements the BASIC DO UNNUM command, removing all line numbers from the program in memory. SYNTAX: DO UNNUM ***************************************************************/ #if ANSI_C struct bwb_line * bwb_dounnum( struct bwb_line *l ) #else struct bwb_line * bwb_dounnum( l ) struct bwb_line *l; #endif { struct bwb_line *current; for ( current = bwb_start.next; current != &bwb_end; current = current->next ) { current->number = 0; current->xnum = FALSE; } return bwb_zline( l ); } #endif /* INTERACTIVE */ #if COMMON_CMDS /*************************************************************** FUNCTION: bwb_chain() DESCRIPTION: This C function implements the BASIC CHAIN command. SYNTAX: CHAIN file-name ***************************************************************/ #if ANSI_C struct bwb_line * bwb_chain( struct bwb_line *l ) #else struct bwb_line * bwb_chain( l ) struct bwb_line *l; #endif { /* deallocate all variables except common ones */ var_delcvars(); /* remove old program from memory */ bwb_xnew( l ); /* call xload function to load new program in memory */ bwb_xload( l ); /* reset all stack counters */ CURTASK exsc = -1; CURTASK expsc = 0; CURTASK xtxtsc = 0; /* run the program */ return bwb_run( &CURTASK bwb_start ); } /*************************************************************** FUNCTION: bwb_merge() DESCRIPTION: This C function implements the BASIC MERGE command, merging command lines from a specified file into the program in memory without deleting the lines already in memory. SYNTAX: MERGE file-name ***************************************************************/ #if ANSI_C struct bwb_line * bwb_merge( struct bwb_line *l ) #else struct bwb_line * bwb_merge( l ) struct bwb_line *l; #endif { /* call xload function to merge program in memory */ bwb_xload( l ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_onerror() DESCRIPTION: This C function implements the BASIC ON ERROR GOSUB command. SYNTAX: ON ERROR GOSUB line | label ***************************************************************/ #if ANSI_C struct bwb_line * bwb_onerror( struct bwb_line *l ) #else struct bwb_line * bwb_onerror( l ) struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_onerror(): entered function" ); bwb_debug( bwb_ebuf ); #endif /* get the GOSUB STATEMENT */ adv_element( l->buffer, &( l->position ), tbuf ); /* check for GOSUB statement */ bwb_strtoupper( tbuf ); if ( strcmp( tbuf, CMD_GOSUB ) != 0 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_onerror(): GOSUB statement missing" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } /* get the GOSUB line */ adv_element( l->buffer, &( l->position ), err_gosubl ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_tron() DESCRIPTION: This function implements the BASIC TRON command, turning the trace mechanism on. SYNTAX: TRON ***************************************************************/ #if ANSI_C struct bwb_line * bwb_tron( struct bwb_line *l ) #else struct bwb_line * bwb_tron( l ) struct bwb_line *l; #endif { bwb_trace = TRUE; prn_xprintf( stdout, "Trace is ON\n" ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_troff() DESCRIPTION: This function implements the BASIC TROFF command, turning the trace mechanism off. SYNTAX: TROFF ***************************************************************/ #if ANSI_C struct bwb_line * bwb_troff( struct bwb_line *l ) #else struct bwb_line * bwb_troff( l ) struct bwb_line *l; #endif { bwb_trace = FALSE; prn_xprintf( stdout, "Trace is OFF\n" ); return bwb_zline( l ); } #endif /* COMMON_CMDS */ /*************************************************************** FUNCTION: bwb_randomize() DESCRIPTION: This function implements the BASIC RANDOMIZE command, seeding the pseudo- random number generator. SYNTAX: RANDOMIZE number ***************************************************************/ #if ANSI_C struct bwb_line * bwb_randomize( struct bwb_line *l ) #else struct bwb_line * bwb_randomize( l ) struct bwb_line *l; #endif { register unsigned n; struct exp_ese *e; /* Check for argument */ adv_ws( l->buffer, &( l->position ) ); switch( l->buffer[ l->position ] ) { case '\0': case '\n': case '\r': #if MULTISEG_LINES case ':': #endif n = (unsigned) 1; break; default: n = (unsigned) 0; break; } /* get the argument in tbuf */ if ( n == (unsigned) 0 ) { e = bwb_exp( l->buffer, FALSE, &( l->position ) ); n = (unsigned) exp_getnval( e ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_randomize(): argument is <%d>", n ); bwb_debug( bwb_ebuf ); #endif srand( n ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_xnew() DESCRIPTION: Clears the program in memory, but does not deallocate all variables. ***************************************************************/ #if ANSI_C struct bwb_line * bwb_xnew( struct bwb_line *l ) #else struct bwb_line * bwb_xnew( l ) struct bwb_line *l; #endif { struct bwb_line *current, *previous; int wait; wait = TRUE; for ( current = CURTASK bwb_start.next; current != &CURTASK bwb_end; current = current->next ) { if ( wait != TRUE ) { /* Revised to FREE pass-thru call by JBV */ FREE( previous, "bwb_xnew" ); previous = NULL; /* JBV */ } wait = FALSE; previous = current; } CURTASK bwb_start.next = &CURTASK bwb_end; return bwb_zline( l ); } #if UNIX_CMDS /*************************************************************** FUNCTION: bwb_environ() DESCRIPTION: This C function implements the BASIC ENVIRON command, assigning a string value to an environment variable. SYNTAX: ENVIRON variable-string$ = string$ ***************************************************************/ #if ANSI_C struct bwb_line * bwb_environ( struct bwb_line *l ) #else struct bwb_line * bwb_environ( l ) struct bwb_line *l; #endif { static char tbuf[ MAXSTRINGSIZE + 1 ]; char tmp[ MAXSTRINGSIZE + 1 ]; register int i; int pos; struct exp_ese *e; /* find the equals sign */ for ( i = 0; ( l->buffer[ l->position ] != '=' ) && ( l->buffer[ l->position ] != '\0' ); ++i ) { tbuf[ i ] = l->buffer[ l->position ]; tbuf[ i + 1 ] = '\0'; ++( l->position ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_environ(): variable string is <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif /* get the value string to be assigned */ pos = 0; e = bwb_exp( tbuf, FALSE, &pos ); str_btoc( tbuf, exp_getsval( e ) ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_environ(): variable string resolves to <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif /* find the equals sign */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] != '=' ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_environ(): failed to find equal sign" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } ++( l->position ); /* get the value string to be assigned */ e = bwb_exp( l->buffer, FALSE, &( l->position )); str_btoc( tmp, exp_getsval( e ) ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_environ(): value string resolves to <%s>", tmp ); bwb_debug( bwb_ebuf ); #endif /* construct string */ strcat( tbuf, "=" ); strcat( tbuf, tmp ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_environ(): assignment string is <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif /* now assign value to variable */ if ( putenv( tbuf ) == -1 ) { bwb_error( err_opsys ); return bwb_zline( l ); } /* return */ return bwb_zline( l ); } #endif /* UNIX_CMDS */ /*************************************************************** FUNCTION: bwb_cmds() DESCRIPTION: This function implements a CMD command, which lists all commands implemented. It is not part of a BASIC specification, but is used for debugging bwBASIC. SYNTAX: CMDS ***************************************************************/ #if PERMANENT_DEBUG #if ANSI_C struct bwb_line * bwb_cmds( struct bwb_line *l ) #else struct bwb_line * bwb_cmds( l ) struct bwb_line *l; #endif { register int n; char tbuf[ MAXSTRINGSIZE + 1 ]; prn_xprintf( stdout, "BWBASIC COMMANDS AVAILABLE: \n" ); /* run through the command table and print comand names */ for ( n = 0; n < COMMANDS; ++n ) { sprintf( tbuf, "%s \n", bwb_cmdtable[ n ].name ); prn_xprintf( stdout, tbuf ); } return bwb_zline( l ); } #endif /*************************************************************** FUNCTION: getcmdnum() DESCRIPTION: This function returns the number associated with a specified command (cmdstr) in the command table. ***************************************************************/ #if ANSI_C int getcmdnum( char *cmdstr ) #else int getcmdnum( cmdstr ) char *cmdstr; #endif { register int c; for ( c = 0; c < COMMANDS; ++c ) { if ( strcmp( bwb_cmdtable[ c ].name, cmdstr ) == 0 ) { return c; } } return -1; } /*************************************************************** FUNCTION: bwb_zline() DESCRIPTION: This function is called at the exit from Bywater BASIC command functions. If MULTISEG_LINES is TRUE, then it returns a pointer to the current line; otherwise it sets the position in the next line to zero and returns a pointer to the next line. ***************************************************************/ #if ANSI_C extern struct bwb_line * bwb_zline( struct bwb_line *l ) #else struct bwb_line * bwb_zline( l ) struct bwb_line *l; #endif { #if MULTISEG_LINES /* l->marked = FALSE; */ return l; #else l->next->position = 0; return l->next; #endif } bwbasic-2.20pl2.orig/bwb_cnd.c100644 0 0 163020 6473161676 14327 0ustar rootroot/*************************************************************** bwb_cnd.c Conditional Expressions and Commands 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). */ /*---------------------------------------------------------------*/ #include #include #include #include "bwbasic.h" #include "bwb_mes.h" /* declarations of functions visible to this file only */ #if ANSI_C static int cnd_thenels( char *buffer, int position, int *then, int *els ); static int cnd_tostep( char *buffer, int position, int *to, int *step ); static struct bwb_line *find_wend( struct bwb_line *l ); static struct bwb_line *find_endif( struct bwb_line *l, struct bwb_line **else_line ); static int is_endif( struct bwb_line *l ); extern int var_setnval( struct bwb_variable *v, bnumber i ); static int case_eval( struct exp_ese *expression, struct exp_ese *minval, struct exp_ese *maxval ); static struct bwb_line *find_case( struct bwb_line *l ); static struct bwb_line *find_endselect( struct bwb_line *l ); static int is_endselect( struct bwb_line *l ); static struct bwb_line *bwb_caseif( struct bwb_line *l ); #if STRUCT_CMDS static struct bwb_line *find_next( struct bwb_line *l ); #endif #else static int cnd_thenels(); static int cnd_tostep(); static struct bwb_line *find_wend(); static struct bwb_line *find_endif(); static int is_endif(); extern int var_setnval(); static int case_eval(); static struct bwb_line *find_case(); static struct bwb_line *find_endselect(); static int is_endselect(); static struct bwb_line *bwb_caseif(); #if STRUCT_CMDS static struct bwb_line *find_next(); #endif #endif /* ANSI_C for prototypes */ /*** IF-THEN-ELSE ***/ /*************************************************************** FUNCTION: bwb_if() DESCRIPTION: This function handles the BASIC IF statement. SYNTAX: IF expression THEN [statement [ELSE statement]] ***************************************************************/ #if ANSI_C struct bwb_line * bwb_if( struct bwb_line *l ) #else struct bwb_line * bwb_if( l ) struct bwb_line *l; #endif { int then, els; struct exp_ese *e; int glnumber; int tpos; static char tbuf[ MAXSTRINGSIZE + 1 ]; static struct bwb_line gline; #if STRUCT_CMDS static struct bwb_line *else_line; static struct bwb_line *endif_line; #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_if(): entry, line <%d> buffer <%s>", l->number, &( l->buffer[ l->position ] ) ); bwb_debug( bwb_ebuf ); getchar(); #endif #if INTENSIVE_DEBUG if ( l == &gline ) { sprintf( bwb_ebuf, "in bwb_if(): recursive call, l = &gline" ); bwb_debug( bwb_ebuf ); } #endif /* Call bwb_exp() to evaluate the condition. This should return with position set to the "THEN" statement */ e = bwb_exp( l->buffer, FALSE, &( l->position ) ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_if(): line <%d> condition returns <%d>", l->number, exp_getnval( e ) ); bwb_debug( bwb_ebuf ); #endif /* test for "THEN" and "ELSE" statements */ cnd_thenels( l->buffer, l->position, &then, &els ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_if(): return from cnd_thenelse, line is <%s>", l->buffer ); bwb_debug( bwb_ebuf ); #endif /* test for multiline IF statement: this presupposes ANSI-compliant structured BASIC */ #if STRUCT_CMDS tpos = then + strlen( CMD_THEN ) + 1; if ( is_eol( l->buffer, &tpos ) == TRUE ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_if(): found multi-line IF statement, line <%d>", l->number ); bwb_debug( bwb_ebuf ); #endif /* find END IF and possibly ELSE[IF] line(s) */ else_line = NULL; endif_line = find_endif( l, &else_line ); /* evaluate the expression */ if ( (int) exp_getnval( e ) != FALSE ) { bwb_incexec(); bwb_setexec( l->next, 0, EXEC_IFTRUE ); #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif return bwb_zline( l ); } else if ( else_line != NULL ) { bwb_incexec(); bwb_setexec( else_line, 0, EXEC_IFFALSE ); else_line->position = 0; return else_line; } else { /* Following line incorrect, replaced by next two (bug found by DD) */ /* bwb_setexec( endif_line, 0, CURTASK excs[ CURTASK exsc ].code ); */ bwb_incexec(); /* JBV */ bwb_setexec( endif_line, 0, EXEC_IFFALSE ); /* JBV */ endif_line->position = 0; return endif_line; } } #endif /* STRUCT_CMDS for Multi-line IF...THEN */ /* Not a Multi-line IF...THEN: test for THEN line-number */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_if(): not multi-line; line is <%s>", l->buffer ); bwb_debug( bwb_ebuf ); #endif /* evaluate and execute */ if ( (int) exp_getnval( e ) != FALSE ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_if(): expression is TRUE" ); bwb_debug( bwb_ebuf ); #endif if ( then == FALSE ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_if(): IF without THEN" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif } else { /* check for THEN followed by literal line number */ tpos = then + strlen( CMD_THEN ) + 1; adv_element( l->buffer, &tpos, tbuf ); if ( isdigit( tbuf[ 0 ] ) != 0 ) { glnumber = atoi( tbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "Detected THEN followed by line number <%d>", glnumber ); bwb_debug( bwb_ebuf ); #endif sprintf( tbuf, "%s %d", CMD_GOTO, glnumber ); gline.buffer = tbuf; gline.marked = FALSE; gline.position = 0; gline.next = l->next; bwb_setexec( &gline, 0, CURTASK excs[ CURTASK exsc ].code ); return &gline; } /* form is not THEN followed by line number */ else { bwb_setexec( l, then, CURTASK excs[ CURTASK exsc ].code ); l->position = then + strlen( CMD_THEN ) + 1; } return l; } } else { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_if(): expression is FALSE" ); bwb_debug( bwb_ebuf ); #endif if ( els != FALSE ) { l->position = els + strlen( CMD_ELSE ) + 1; /* bwb_setexec( l, els, EXEC_NORM ); */ /* Nope (JBV) */ bwb_setexec( l, els, CURTASK excs[ CURTASK exsc ].code ); /* JBV */ return l; } } /* if neither then nor else were found, advance to next line */ /* DO NOT advance to next segment (only if TRUE should we do that) */ l->next->position = 0; return l->next; } /*************************************************************** FUNCTION: cnd_thenelse() DESCRIPTION: This function searches through the beginning at point and attempts to find positions of THEN and ELSE statements. ***************************************************************/ #if ANSI_C static int cnd_thenels( char *buffer, int position, int *then, int *els ) #else static int cnd_thenels( buffer, position, then, els ) char *buffer; int position; int *then; int *els; #endif { int loop, t_pos, b_pos, p_word; char tbuf[ MAXSTRINGSIZE + 1 ]; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in cnd_thenels(): entry, line is <%s>", &( buffer[ position ] ) ); bwb_debug( bwb_ebuf ); #endif /* set then and els to 0 initially */ *then = *els = 0; /* loop to find words */ p_word = b_pos = position; t_pos = 0; tbuf[ 0 ] = '\0'; loop = TRUE; while( loop == TRUE ) { switch( buffer[ b_pos ] ) { case '\0': /* end of string */ case ' ': /* whitespace = end of word */ case '\t': #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in cnd_thenels(): word is <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif if ( strncmp( tbuf, CMD_THEN, (size_t) strlen( CMD_THEN ) ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in cnd_thenels(): THEN found at position <%d>.", p_word ); bwb_debug( bwb_ebuf ); sprintf( bwb_ebuf, "in cnd_thenelse(): after THEN, line is <%s>", buffer ); bwb_debug( bwb_ebuf ); #endif *then = p_word; } else if ( strncmp( tbuf, CMD_ELSE, (size_t) strlen( CMD_ELSE ) ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in cnd_thenels(): ELSE found at position <%d>.", p_word ); bwb_debug( bwb_ebuf ); sprintf( bwb_ebuf, "in cnd_thenelse(): after ELSE, line is <%s>", buffer ); bwb_debug( bwb_ebuf ); #endif *els = p_word; } /* check for end of the line */ if ( buffer[ b_pos ] == '\0' ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in cnd_thenels(): return: end of string" ); bwb_debug( bwb_ebuf ); #endif return TRUE; } ++b_pos; p_word = b_pos; t_pos = 0; tbuf[ 0 ] = '\0'; break; default: if ( islower( buffer[ b_pos ] ) != FALSE ) { tbuf[ t_pos ] = (char) toupper( buffer[ b_pos ] ); } else { tbuf[ t_pos ] = buffer[ b_pos ]; } ++b_pos; ++t_pos; tbuf[ t_pos ] = '\0'; break; } } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in cnd_thenelse(): exit, line is <%s>", buffer ); bwb_debug( bwb_ebuf ); #endif return FALSE; } #if STRUCT_CMDS /*************************************************************** FUNCTION: bwb_else() DESCRIPTION: This function handles the BASIC ELSE statement. SYNTAX: ELSE ***************************************************************/ #if ANSI_C struct bwb_line * bwb_else( struct bwb_line *l ) #else struct bwb_line * bwb_else( l ) struct bwb_line *l; #endif { struct bwb_line *endif_line; struct bwb_line *else_line; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_else(): entered function" ); bwb_debug( bwb_ebuf ); #endif /* If the code is EXEC_NORM, then this is a continuation of a single- line IF...THEN...ELSE... statement and we should return */ /*----------------------------------------------------------------------*/ /* Well, not really... better to check for EXEC_IFTRUE or EXEC_IFFALSE, */ /* and if not equal, then blow entirely out of current line (JBV) */ /*----------------------------------------------------------------------*/ /* Section removed by JBV */ /* if ( CURTASK excs[ CURTASK exsc ].code == EXEC_NORM ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_else(): detected EXEC_NORM" ); bwb_debug( bwb_ebuf ); #endif return bwb_zline( l ); } */ /* Section added by JBV */ if (( CURTASK excs[ CURTASK exsc ].code != EXEC_IFTRUE ) && ( CURTASK excs[ CURTASK exsc ].code != EXEC_IFFALSE )) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_else(): no EXEC_IFTRUE or EXEC_IFFALSE" ); bwb_debug( bwb_ebuf ); #endif l->next->position = 0; return l->next; } endif_line = find_endif( l, &else_line ); if ( CURTASK excs[ CURTASK exsc ].code == EXEC_IFTRUE ) { endif_line->position = 0; return endif_line; } else if ( CURTASK excs[ CURTASK exsc ].code == EXEC_IFFALSE ) { return bwb_zline( l ); } #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_else(): ELSE without IF" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_elseif() DESCRIPTION: This function handles the BASIC ELSEIF statement. SYNTAX: ELSEIF ***************************************************************/ #if ANSI_C struct bwb_line * bwb_elseif( struct bwb_line *l ) #else struct bwb_line * bwb_elseif( l ) struct bwb_line *l; #endif { struct bwb_line *endif_line; struct bwb_line *else_line; struct exp_ese *e; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_elseif(): entered function" ); bwb_debug( bwb_ebuf ); #endif else_line = NULL; endif_line = find_endif( l, &else_line ); if ( CURTASK excs[ CURTASK exsc ].code == EXEC_IFTRUE ) { endif_line->position = 0; return endif_line; } else if ( CURTASK excs[ CURTASK exsc ].code == EXEC_IFFALSE ) { /* Call bwb_exp() to evaluate the condition. This should return with position set to the "THEN" statement */ e = bwb_exp( l->buffer, FALSE, &( l->position ) ); if ( (int) exp_getnval( e ) != FALSE ) /* Was == TRUE (JBV 10/1996) */ { /* ELSEIF condition is TRUE: proceed to the next line */ CURTASK excs[ CURTASK exsc ].code = EXEC_IFTRUE; #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif return bwb_zline( l ); } /* ELSEIF condition FALSE: proceed to next ELSE line if there is one */ else if ( else_line != NULL ) { bwb_setexec( else_line, 0, EXEC_IFFALSE ); else_line->position = 0; return else_line; } /* ELSEIF condition is FALSE and no more ELSExx lines: proceed to END IF */ else { bwb_setexec( endif_line, 0, CURTASK excs[ CURTASK exsc ].code ); endif_line->position = 0; return endif_line; } } #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_elseif(): ELSEIF without IF" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_endif() DESCRIPTION: This function handles the BASIC END IF statement. SYNTAX: END IF ***************************************************************/ #if ANSI_C struct bwb_line * bwb_endif( struct bwb_line *l ) #else struct bwb_line * bwb_endif( l ) struct bwb_line *l; #endif { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_endif(): entered function" ); bwb_debug( bwb_ebuf ); #endif if (( CURTASK excs[ CURTASK exsc ].code != EXEC_IFTRUE ) && ( CURTASK excs[ CURTASK exsc ].code != EXEC_IFFALSE )) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_endif(): END IF without IF" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif } bwb_decexec(); #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif return bwb_zline( l ); } /*************************************************************** FUNCTION: find_endif() DESCRIPTION: This C function attempts to find an END IF statement. ***************************************************************/ #if ANSI_C static struct bwb_line * find_endif( struct bwb_line *l, struct bwb_line **else_line ) #else static struct bwb_line * find_endif( l, else_line ) struct bwb_line *l; struct bwb_line **else_line; #endif { struct bwb_line *current; register int i_level; int position; *else_line = NULL; i_level = 1; for ( current = l->next; current != &CURTASK bwb_end; current = current->next ) { position = 0; if ( current->marked != TRUE ) { line_start( current->buffer, &position, &( current->lnpos ), &( current->lnum ), &( current->cmdpos ), &( current->cmdnum ), &( current->startpos ) ); } current->position = current->startpos; if ( current->cmdnum > -1 ) { if ( bwb_cmdtable[ current->cmdnum ].vector == bwb_if ) { ++i_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in find_endif(): found IF at line %d, level %d", current->number, i_level ); bwb_debug( bwb_ebuf ); #endif } else if ( is_endif( current ) == TRUE ) { --i_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in find_endif(): found END IF at line %d, level %d", current->number, i_level ); bwb_debug( bwb_ebuf ); #endif if ( i_level == 0 ) { return current; } } else if ( ( bwb_cmdtable[ current->cmdnum ].vector == bwb_else ) || ( bwb_cmdtable[ current->cmdnum ].vector == bwb_elseif )) { /* we must only report the first ELSE or ELSE IF we encounter at level 1 */ if ( ( i_level == 1 ) && ( *else_line == NULL )) { *else_line = current; } } } } #if PROG_ERRORS sprintf( bwb_ebuf, "Multiline IF without END IF" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return NULL; } /*************************************************************** FUNCTION: is_endif() DESCRIPTION: This C function attempts to determine if a given line contains an END IF statement. ***************************************************************/ #if ANSI_C static int is_endif( struct bwb_line *l ) #else static int is_endif( l ) struct bwb_line *l; #endif { int position; char tbuf[ MAXVARNAMESIZE + 1]; if ( bwb_cmdtable[ l->cmdnum ].vector != bwb_xend ) { return FALSE; } position = l->startpos; adv_ws( l->buffer, &position ); adv_element( l->buffer, &position, tbuf ); bwb_strtoupper( tbuf ); if ( strcmp( tbuf, "IF" ) == 0 ) { return TRUE; } return FALSE; } /*************************************************************** FUNCTION: bwb_select() DESCRIPTION: This C function handles the BASIC SELECT statement. SYNTAX: SELECT CASE expression ***************************************************************/ #if ANSI_C struct bwb_line * bwb_select( struct bwb_line *l ) #else struct bwb_line * bwb_select( l ) struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; struct exp_ese *e; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_select(): entered function" ); bwb_debug( bwb_ebuf ); #endif /* first element should be "CASE" */ adv_element( l->buffer, &( l->position ), tbuf ); bwb_strtoupper( tbuf ); if ( strcmp( tbuf, "CASE" ) != 0 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "SELECT without CASE" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); return bwb_zline( l ); #endif } /* increment the level and set to EXEC_SELFALSE */ bwb_incexec(); CURTASK excs[ CURTASK exsc ].code = EXEC_SELFALSE; /* evaluate the expression at this level */ e = bwb_exp( l->buffer, FALSE, &( l->position ) ); #if OLDWAY memcpy( &( CURTASK excs[ CURTASK exsc ].expression ), e, sizeof( struct exp_ese ) ); #endif if ( e->type == STRING ) { CURTASK excs[ CURTASK exsc ].expression.type = STRING; str_btob( &( CURTASK excs[ CURTASK exsc ].expression.sval ), &( e->sval ) ); } else { CURTASK excs[ CURTASK exsc ].expression.type = NUMBER; CURTASK excs[ CURTASK exsc ].expression.nval = exp_getnval( e ); } /* return */ #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_case() DESCRIPTION: This C function handles the BASIC CASE statement. SYNTAX: CASE constant | IF partial-expression | ELSE ***************************************************************/ #if ANSI_C struct bwb_line * bwb_case( struct bwb_line *l ) #else struct bwb_line * bwb_case( l ) struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; int oldpos; struct exp_ese minvalue; struct exp_ese *maxval, *minval; struct bwb_line *retline; char cbuf1[ MAXSTRINGSIZE + 1 ]; char cbuf2[ MAXSTRINGSIZE + 1 ]; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_case(): entered function" ); bwb_debug( bwb_ebuf ); #endif /* if code is EXEC_SELTRUE, then we should jump to the end */ if ( CURTASK excs[ CURTASK exsc ].code == EXEC_SELTRUE ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_case(): exit EXEC_SELTRUE" ); bwb_debug( bwb_ebuf ); #endif retline = find_endselect( l ); retline->position = 0; return retline; } /* read first element */ oldpos = l->position; adv_element( l->buffer, &( l->position ), tbuf ); bwb_strtoupper( tbuf ); /* check for CASE IF */ if ( strcmp( tbuf, CMD_IF ) == 0 ) { return bwb_caseif( l ); } /* check for CASE ELSE: if true, simply proceed to the next line, because other options should have been detected by now */ else if ( strcmp( tbuf, CMD_ELSE ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_case(): execute CASE ELSE" ); bwb_debug( bwb_ebuf ); #endif return bwb_zline( l ); } /* neither CASE ELSE nor CASE IF; presume constant here for min value */ l->position = oldpos; minval = bwb_exp( l->buffer, FALSE, &( l->position )); memcpy( &minvalue, minval, sizeof( struct exp_ese ) ); maxval = minval = &minvalue; /* check for string value */ if ( minvalue.type == STRING ) { str_btoc( cbuf1, &( CURTASK excs[ CURTASK exsc ].expression.sval ) ); str_btoc( cbuf2, &( minvalue.sval ) ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_case(): compare strings <%s> and <%s>", cbuf1, cbuf2 ); bwb_debug( bwb_ebuf ); #endif if ( strncmp( cbuf1, cbuf2, MAXSTRINGSIZE ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_case(): string comparison returns TRUE" ); bwb_debug( bwb_ebuf ); #endif CURTASK excs[ CURTASK exsc ].code = EXEC_SELTRUE; #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif return bwb_zline( l ); } else { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_case(): string comparison returns FALSE" ); bwb_debug( bwb_ebuf ); #endif retline = find_case( l ); retline->position = 0; return retline; } } /* not a string; advance */ adv_ws( l->buffer, &( l->position )); /* check for TO */ if ( is_eol( l->buffer, &( l->position )) != TRUE ) { /* find the TO statement */ adv_element( l->buffer, &( l->position ), tbuf ); bwb_strtoupper( tbuf ); if ( strcmp( tbuf, CMD_TO ) != 0 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "CASE has inexplicable code following expression" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif return bwb_zline( l ); #endif } /* now evaluate the MAX expression */ maxval = bwb_exp( l->buffer, FALSE, &( l->position )); } /* evaluate the expression */ if ( case_eval( &( CURTASK excs[ CURTASK exsc ].expression ), minval, maxval ) == TRUE ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_case(): evaluation returns TRUE" ); bwb_debug( bwb_ebuf ); #endif CURTASK excs[ CURTASK exsc ].code = EXEC_SELTRUE; #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif return bwb_zline( l ); } /* evaluation returns a FALSE value; find next CASE or END SELECT statement */ else { #if INTENSIVE_DEBUGb sprintf( bwb_ebuf, "in bwb_case(): evaluation returns FALSE" ); bwb_debug( bwb_ebuf ); #endif retline = find_case( l ); retline->position = 0; return retline; } } /*************************************************************** FUNCTION: bwb_caseif() DESCRIPTION: This C function handles the BASIC CASE IF statement. ***************************************************************/ #if ANSI_C static struct bwb_line * bwb_caseif( struct bwb_line *l ) #else static struct bwb_line * bwb_caseif( l ) struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; int position; struct exp_ese *r; struct bwb_line *retline; if ( CURTASK excs[ CURTASK exsc ].expression.type == NUMBER ) { sprintf( tbuf, "%f %s", (float) CURTASK excs[ CURTASK exsc ].expression.nval, &( l->buffer[ l->position ] ) ); } else { bwb_error( err_mismatch ); #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif return bwb_zline( l ); } position = 0; r = bwb_exp( tbuf, FALSE, &position ); if ( r->nval == (bnumber) TRUE ) { CURTASK excs[ CURTASK exsc ].code = EXEC_SELTRUE; #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif return bwb_zline( l ); } else { retline = find_case( l ); retline->position = 0; return retline; } } /*************************************************************** FUNCTION: case_eval() DESCRIPTION: This function evaluates a case statement by comparing minimum and maximum values with a set expression. It returns either TRUE or FALSE ***************************************************************/ #if ANSI_C static int case_eval( struct exp_ese *expression, struct exp_ese *minval, struct exp_ese *maxval ) #else static int case_eval( expression, minval, maxval ) struct exp_ese *expression; struct exp_ese *minval; struct exp_ese *maxval; #endif { /* string value */ if ( expression->type == STRING ) { bwb_error( err_mismatch ); return FALSE; } /* numerical value */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in case_eval(): n <%f> min <%f> max <%f>", (float) expression->nval, (float) minval->nval, (float) maxval->nval ); bwb_debug( bwb_ebuf ); #endif if ( ( expression->nval >= minval->nval ) && ( expression->nval <= maxval->nval )) { return TRUE; } return FALSE; } /*************************************************************** FUNCTION: find_case() DESCRIPTION: This function searches for a line containing a CASE statement corresponding to a previous SELECT CASE statement. ***************************************************************/ #if ANSI_C static struct bwb_line * find_case( struct bwb_line *l ) #else static struct bwb_line * find_case( l ) struct bwb_line *l; #endif { struct bwb_line *current; register int c_level; int position; c_level = 1; for ( current = l->next; current != &CURTASK bwb_end; current = current->next ) { position = 0; if ( current->marked != TRUE ) { line_start( current->buffer, &position, &( current->lnpos ), &( current->lnum ), &( current->cmdpos ), &( current->cmdnum ), &( current->startpos ) ); } current->position = current->startpos; if ( current->cmdnum > -1 ) { if ( bwb_cmdtable[ current->cmdnum ].vector == bwb_select ) { ++c_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in find_case(): found SELECT at line %d, level %d", current->number, c_level ); bwb_debug( bwb_ebuf ); #endif } else if ( is_endselect( current ) == TRUE ) { --c_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in find_endif(): found END SELECT at line %d, level %d", current->number, c_level ); bwb_debug( bwb_ebuf ); #endif if ( c_level == 0 ) { return current; } } else if ( bwb_cmdtable[ current->cmdnum ].vector == bwb_case ) { --c_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in find_case(): found CASE at line %d, level %d", current->number, c_level ); bwb_debug( bwb_ebuf ); #endif if ( c_level == 0 ) { return current; } } } } #if PROG_ERRORS sprintf( bwb_ebuf, "SELECT without CASE" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return NULL; } /*************************************************************** FUNCTION: find_case() DESCRIPTION: This function searches for a line containing an END SELECT statement corresponding to a previous SELECT CASE statement. ***************************************************************/ #if ANSI_C static struct bwb_line * find_endselect( struct bwb_line *l ) #else static struct bwb_line * find_endselect( l ) struct bwb_line *l; #endif { struct bwb_line *current; register int c_level; int position; c_level = 1; for ( current = l->next; current != &CURTASK bwb_end; current = current->next ) { position = 0; if ( current->marked != TRUE ) { line_start( current->buffer, &position, &( current->lnpos ), &( current->lnum ), &( current->cmdpos ), &( current->cmdnum ), &( current->startpos ) ); } current->position = current->startpos; if ( current->cmdnum > -1 ) { if ( bwb_cmdtable[ current->cmdnum ].vector == bwb_select ) { ++c_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in find_case(): found SELECT at line %d, level %d", current->number, c_level ); bwb_debug( bwb_ebuf ); #endif } else if ( is_endselect( current ) == TRUE ) { --c_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in find_endif(): found END SELECT at line %d, level %d", current->number, c_level ); bwb_debug( bwb_ebuf ); #endif if ( c_level == 0 ) { return current; } } } } #if PROG_ERRORS sprintf( bwb_ebuf, "SELECT without END SELECT" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return NULL; } /*************************************************************** FUNCTION: is_endselect() DESCRIPTION: This C function attempts to determine if a given line contains an END SELECT statement. ***************************************************************/ #if ANSI_C static int is_endselect( struct bwb_line *l ) #else static int is_endselect( l ) struct bwb_line *l; #endif { int position; char tbuf[ MAXVARNAMESIZE + 1]; if ( bwb_cmdtable[ l->cmdnum ].vector != bwb_xend ) { return FALSE; } position = l->startpos; adv_ws( l->buffer, &position ); adv_element( l->buffer, &position, tbuf ); bwb_strtoupper( tbuf ); if ( strcmp( tbuf, "SELECT" ) == 0 ) { return TRUE; } return FALSE; } /*************************************************************** FUNCTION: bwb_endselect() DESCRIPTION: This function handles the BASIC END SELECT statement. SYNTAX: END SELECT ***************************************************************/ #if ANSI_C struct bwb_line * bwb_endselect( struct bwb_line *l ) #else struct bwb_line * bwb_endselect( l ) struct bwb_line *l; #endif { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_endselect(): entered function" ); bwb_debug( bwb_ebuf ); #endif if ( ( CURTASK excs[ CURTASK exsc ].code != EXEC_SELTRUE ) && ( CURTASK excs[ CURTASK exsc ].code != EXEC_SELFALSE )) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_endselect(): END SELECT without SELECT" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif } bwb_decexec(); #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif return bwb_zline( l ); } #endif /* STRUCT_CMDS */ #if COMMON_CMDS || STRUCT_CMDS /*** WHILE-WEND ***/ /*************************************************************** FUNCTION: bwb_while() DESCRIPTION: This function handles the BASIC WHILE statement and also the ANSI DO WHILE statement. SYNTAX: WHILE expression DO WHILE expression ***************************************************************/ #if ANSI_C struct bwb_line * bwb_while( struct bwb_line *l ) #else struct bwb_line * bwb_while( l ) struct bwb_line *l; #endif { struct exp_ese *e; struct bwb_line *r; /* if this is the first time at this WHILE statement, note it */ if ( CURTASK excs[ CURTASK exsc ].while_line != l ) { bwb_incexec(); CURTASK excs[ CURTASK exsc ].while_line = l; /* find the WEND statement (or LOOP statement) */ #if STRUCT_CMDS if ( l->cmdnum == getcmdnum( CMD_DO )) { CURTASK excs[ CURTASK exsc ].wend_line = find_loop( l ); } else { CURTASK excs[ CURTASK exsc ].wend_line = find_wend( l ); } #else CURTASK excs[ CURTASK exsc ].wend_line = find_wend( l ); #endif if ( CURTASK excs[ CURTASK exsc ].wend_line == NULL ) { return bwb_zline( l ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_while(): initialize WHILE loop, line <%d>", l->number ); bwb_debug( bwb_ebuf ); #endif } #if INTENSIVE_DEBUG else { sprintf( bwb_ebuf, "in bwb_while(): return to WHILE loop, line <%d>", l->number ); bwb_debug( bwb_ebuf ); } #endif /*----------------------------------------------------*/ /* Expression evaluation was at the top of bwb_while, */ /* and the init portion was performed only if TRUE. */ /* The init routine should be performed regardless of */ /* expression value, else a segmentation fault can */ /* occur! (JBV) */ /*----------------------------------------------------*/ /* call bwb_exp() to interpret the expression */ e = bwb_exp( l->buffer, FALSE, &( l->position ) ); if ( (int) exp_getnval( e ) != FALSE ) /* Was == TRUE (JBV 10/1996) */ { bwb_setexec( l, l->position, EXEC_WHILE ); return bwb_zline( l ); } else { CURTASK excs[ CURTASK exsc ].while_line = NULL; r = CURTASK excs[ CURTASK exsc ].wend_line; bwb_setexec( r, 0, CURTASK excs[ CURTASK exsc - 1 ].code ); r->position = 0; bwb_decexec(); return r; } } /*************************************************************** FUNCTION: bwb_wend() DESCRIPTION: This function handles the BASIC WEND statement and the LOOP statement ending a DO WHILE loop. SYNTAX: WEND LOOP ***************************************************************/ #if ANSI_C struct bwb_line * bwb_wend( struct bwb_line *l ) #else struct bwb_line * bwb_wend( l ) struct bwb_line *l; #endif { /* check integrity of WHILE loop */ if ( CURTASK excs[ CURTASK exsc ].code != EXEC_WHILE ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_wend(): exec stack code != EXEC_WHILE" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif } if ( CURTASK excs[ CURTASK exsc ].while_line == NULL ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_wend(): exec stack while_line == NULL" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif } /* reset to the top of the current WHILE loop */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_wend() return to line <%d>", CURTASK excs[ CURTASK exsc ].while_line->number ); bwb_debug( bwb_ebuf ); #endif CURTASK excs[ CURTASK exsc ].while_line->position = 0; bwb_setexec( CURTASK excs[ CURTASK exsc ].while_line, 0, EXEC_WHILE ); return CURTASK excs[ CURTASK exsc ].while_line; } /*************************************************************** FUNCTION: find_wend() DESCRIPTION: This function searches for a line containing a WEND statement corresponding to a previous WHILE statement. ***************************************************************/ #if ANSI_C static struct bwb_line * find_wend( struct bwb_line *l ) #else static struct bwb_line * find_wend( l ) struct bwb_line *l; #endif { struct bwb_line *current; register int w_level; int position; w_level = 1; for ( current = l->next; current != &CURTASK bwb_end; current = current->next ) { position = 0; if ( current->marked != TRUE ) { line_start( current->buffer, &position, &( current->lnpos ), &( current->lnum ), &( current->cmdpos ), &( current->cmdnum ), &( current->startpos ) ); } current->position = current->startpos; if ( current->cmdnum > -1 ) { if ( bwb_cmdtable[ current->cmdnum ].vector == bwb_while ) { ++w_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in find_wend(): found WHILE at line %d, level %d", current->number, w_level ); bwb_debug( bwb_ebuf ); #endif } else if ( bwb_cmdtable[ current->cmdnum ].vector == bwb_wend ) { --w_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in find_wend(): found WEND at line %d, level %d", current->number, w_level ); bwb_debug( bwb_ebuf ); #endif if ( w_level == 0 ) { return current->next; } } } } #if PROG_ERRORS sprintf( bwb_ebuf, "in find_wend(): WHILE without WEND" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return NULL; } #if STRUCT_CMDS /*************************************************************** FUNCTION: find_loop() DESCRIPTION: This function searches for a line containing a LOOP statement corresponding to a previous DO statement. ***************************************************************/ #if ANSI_C extern struct bwb_line * find_loop( struct bwb_line *l ) #else extern struct bwb_line * find_loop( l ) struct bwb_line *l; #endif { struct bwb_line *current; register int w_level; int position; w_level = 1; for ( current = l->next; current != &CURTASK bwb_end; current = current->next ) { position = 0; if ( current->marked != TRUE ) { line_start( current->buffer, &position, &( current->lnpos ), &( current->lnum ), &( current->cmdpos ), &( current->cmdnum ), &( current->startpos ) ); } current->position = current->startpos; if ( current->cmdnum > -1 ) { if ( bwb_cmdtable[ current->cmdnum ].vector == bwb_do ) { ++w_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in find_loop(): found DO at line %d, level %d", current->number, w_level ); bwb_debug( bwb_ebuf ); #endif } else if ( bwb_cmdtable[ current->cmdnum ].vector == bwb_loop ) { --w_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnd_loop(): found LOOP at line %d, level %d", current->number, w_level ); bwb_debug( bwb_ebuf ); #endif if ( w_level == 0 ) { return current->next; } } } } #if PROG_ERRORS sprintf( bwb_ebuf, "in find_loop(): DO without LOOP" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return NULL; } #endif /* STRUCT_CMDS */ #endif /* COMMON_CMDS || STRUCT_CMDS */ /*** FOR-NEXT ***/ /*************************************************************** FUNCTION: bwb_for() DESCRIPTION: This function handles the BASIC FOR statement. SYNTAX: FOR counter = start TO finish [STEP increment] ***************************************************************/ #if ANSI_C struct bwb_line * bwb_for( struct bwb_line *l ) #else struct bwb_line * bwb_for( l ) struct bwb_line *l; #endif { register int n; int e, loop; int to, step, p; int for_step, for_target; struct exp_ese *exp; struct bwb_variable *v; char tbuf[ MAXSTRINGSIZE + 1 ]; /* get the variable name */ exp_getvfname( &( l->buffer[ l->position ] ), tbuf ); l->position += strlen( tbuf ); v = var_find( tbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_for(): variable name <%s>.", v->name ); bwb_debug( bwb_ebuf ); #endif /*--------------------------------------------------------------*/ /* Make sure we are in the right FOR-NEXT level! */ /* If we aren't (which could happen for legit reasons), fix the */ /* exec stack. */ /* JBV, 9/20/95 */ /*--------------------------------------------------------------*/ if (v == CURTASK excs[ CURTASK exsc].local_variable) bwb_decexec(); /* at this point one should find an equals sign ('=') */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] != '=' ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_for(): failed to find equals sign, buf <%s>", &( l->buffer[ l->position ] ) ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } else { ++( l->position ); } /* Find the TO and STEP statements */ cnd_tostep( l->buffer, l->position, &to, &step ); /* if there is no TO statement, then an error has ocurred */ if ( to < 1 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "FOR statement without TO" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } /* copy initial value to buffer and evaluate it */ tbuf[ 0 ] = '\0'; p = 0; for ( n = l->position; n < to; ++n ) { tbuf[ p ] = l->buffer[ n ]; ++p; ++l->position; tbuf[ p ] = '\0'; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_for(): initial value string <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif p = 0; exp = bwb_exp( tbuf, FALSE, &p ); var_setnval( v, exp_getnval( exp ) ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_for(): initial value <%d> pos <%d>", exp_getnval( exp ), l->position ); bwb_debug( bwb_ebuf ); #endif /* copy target value to small buffer and evaluate it */ tbuf[ 0 ] = '\0'; p = 0; l->position = to + 2; if ( step < 1 ) { e = strlen( l->buffer ); } else { e = step - 1; } loop = TRUE; n = l->position; while( loop == TRUE ) { tbuf[ p ] = l->buffer[ n ]; ++p; ++l->position; tbuf[ p ] = '\0'; if ( n >= e ) { loop = FALSE; } ++n; if ( l->buffer[ n ] == ':' ) { loop = FALSE; } } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_for(): target value string <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif p = 0; exp = bwb_exp( tbuf, FALSE, &p ); for_target = (int) exp_getnval( exp ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_for(): target value <%d> pos <%d>", exp_getnval( exp ), l->position ); bwb_debug( bwb_ebuf ); #endif /* If there is a STEP statement, copy it to a buffer and evaluate it */ if ( step > 1 ) { tbuf[ 0 ] = '\0'; p = 0; l->position = step + 4; for ( n = l->position; n < (int) strlen( l->buffer ); ++n ) { tbuf[ p ] = l->buffer[ n ]; ++p; ++l->position; tbuf[ p ] = '\0'; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_for(): step value string <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif p = 0; exp = bwb_exp( tbuf, FALSE, &p ); for_step = (int) exp_getnval( exp ); } else { for_step = 1; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_for(): step value <%d>", for_step ); bwb_debug( bwb_ebuf ); #endif /* set position in current line and increment EXEC counter */ /* bwb_setexec( l, l->position, EXEC_NORM ); */ /* WRONG */ bwb_incexec(); CURTASK excs[ CURTASK exsc ].local_variable = v; CURTASK excs[ CURTASK exsc ].for_step = for_step; CURTASK excs[ CURTASK exsc ].for_target = for_target; /* set exit line to be used by EXIT FOR */ #if STRUCT_CMDS CURTASK excs[ CURTASK exsc ].wend_line = find_next( l ); #endif /* set top line and position to be used in multisegmented FOR-NEXT loop */ #if MULTISEG_LINES CURTASK excs[ CURTASK exsc ].for_line = l; CURTASK excs[ CURTASK exsc ].for_position = l->position; #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_for(): setting code to EXEC_FOR", l->position ); bwb_debug( bwb_ebuf ); #endif bwb_setexec( l, l->position, EXEC_FOR ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_for(): ready to exit, position <%d>", l->position ); bwb_debug( bwb_ebuf ); #endif /* proceed with processing */ return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_next() DESCRIPTION: This function handles the BASIC NEXT statement. SYNTAX: NEXT counter ***************************************************************/ #if ANSI_C struct bwb_line * bwb_next( struct bwb_line *l ) #else struct bwb_line * bwb_next( l ) struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; struct bwb_variable *v; /* Relocated from INTENSIVE_DEBUG (JBV) */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_next(): entered function, cmdnum <%d> exsc level <%d> code <%d>", l->cmdnum, CURTASK exsc, CURTASK excs[ CURTASK exsc ].code ); bwb_debug( bwb_ebuf ); #endif /* Check the integrity of the FOR statement */ if ( CURTASK excs[ CURTASK exsc ].code != EXEC_FOR ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_next(): NEXT without FOR; code is <%d> instead of <%d>", CURTASK excs[ CURTASK exsc ].code, EXEC_FOR ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif } /* read the argument, if there is one */ /* Relocated from MULTISEG_LINES (JBV) */ exp_getvfname( &( l->buffer[ l->position ] ), tbuf ); if (strlen(tbuf) != 0) { /* Relocated from INTENSIVE_DEBUG (JBV) */ v = var_find( tbuf ); #if MULTISEG_LINES /* not currently needed otherwise */ l->position += strlen( tbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_next(): variable name detected <%s>.", v->name ); bwb_debug( bwb_ebuf ); #endif #endif /* decrement or increment the value */ /*--------------------------------------------------------------*/ /* Make sure we are in the right FOR-NEXT level! */ /* If we aren't (which could happen for legit reasons), fix the */ /* exec stack. */ /* JBV, 9/20/95 */ /*--------------------------------------------------------------*/ while (v != CURTASK excs[ CURTASK exsc].local_variable) bwb_decexec(); } var_setnval( CURTASK excs[ CURTASK exsc ].local_variable, var_getnval( CURTASK excs[ CURTASK exsc ].local_variable ) + (bnumber) CURTASK excs[ CURTASK exsc ].for_step ); /* check for completion of the loop */ if ( CURTASK excs[ CURTASK exsc ].for_step > 0 ) /* if step is positive */ { if ( (int) var_getnval( CURTASK excs[ CURTASK exsc ].local_variable ) > CURTASK excs[ CURTASK exsc ].for_target ) { bwb_decexec(); #if MULTISEG_LINES bwb_setexec( l, l->position, CURTASK excs[ CURTASK exsc ].code ); #else bwb_setexec( l->next, 0, CURTASK excs[ CURTASK exsc ].code ); #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_next(): end of loop" ); bwb_debug( bwb_ebuf ); #endif #ifdef OLD_WAY l->next->position = 0; return l->next; #else return bwb_zline( l ); #endif } } else /* if step is negative */ { if ( (int) var_getnval( CURTASK excs[ CURTASK exsc ].local_variable ) < CURTASK excs[ CURTASK exsc ].for_target ) { bwb_decexec(); bwb_setexec( l->next, 0, CURTASK excs[ CURTASK exsc ].code ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_next(): end of loop" ); bwb_debug( bwb_ebuf ); #endif #ifdef OLD_WAY l->next->position = 0; return l->next; #else return bwb_zline( l ); #endif } } /* Target not reached: return to the top of the FOR loop */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_next(): resetting code to EXEC_FOR", l->position ); bwb_debug( bwb_ebuf ); #endif #if MULTISEG_LINES CURTASK excs[ CURTASK exsc ].for_line->position = CURTASK excs[ CURTASK exsc ].for_position; bwb_setexec( CURTASK excs[ CURTASK exsc ].for_line, CURTASK excs[ CURTASK exsc ].for_position, EXEC_FOR ); return CURTASK excs[ CURTASK exsc ].for_line; /* Added (JBV) */ #else bwb_setexec( CURTASK excs[ CURTASK exsc - 1 ].line, CURTASK excs[ CURTASK exsc - 1 ].position, EXEC_FOR ); return CURTASK excs[ CURTASK exsc - 1 ].line; /* Relocated (JBV) */ #endif } #if STRUCT_CMDS /*************************************************************** FUNCTION: bwb_exitfor() DESCRIPTION: This function handles the BASIC EXIT FOR statement. This is a structured programming command compatible with ANSI BASIC. It is called from the bwb_exit() subroutine. SYNTAX: EXIT FOR ***************************************************************/ #if ANSI_C struct bwb_line * bwb_exitfor( struct bwb_line *l ) #else struct bwb_line * bwb_exitfor( l ) struct bwb_line *l; #endif { struct bwb_line *next_line; int found; register int level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exitfor(): entered subroutine" ); bwb_debug( bwb_ebuf ); #endif /* Check the integrity of the FOR statement */ found = FALSE; level = CURTASK exsc; do { if ( CURTASK excs[ level ].code == EXEC_FOR ) { next_line = CURTASK excs[ CURTASK level ].wend_line; found = TRUE; } else { --level; } } while ( ( level >= 0 ) && ( found == FALSE ) ); if ( found != TRUE ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_exitfor(): EXIT FOR without FOR" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exitfor(): level found is <%d>, current <%d>", level, CURTASK exsc ); bwb_debug( bwb_ebuf ); #endif /* decrement below the level of the NEXT statement */ while( CURTASK exsc >= level ) { bwb_decexec(); } /* set the next line in the exec stack */ next_line->position = 0; /* bwb_setexec( next_line, 0, EXEC_NORM ); */ /* WRONG (JBV) */ bwb_setexec( next_line, 0, CURTASK excs[ CURTASK exsc ].code ); /* JBV */ return next_line; } /*************************************************************** FUNCTION: find_next() DESCRIPTION: This function searches for a line containing a NEXT statement corresponding to a previous FOR statement. ***************************************************************/ #if ANSI_C static struct bwb_line * find_next( struct bwb_line *l ) #else static struct bwb_line * find_next( l ) struct bwb_line *l; #endif { struct bwb_line *current; register int w_level; int position; w_level = 1; for ( current = l->next; current != &CURTASK bwb_end; current = current->next ) { position = 0; if ( current->marked != TRUE ) { line_start( current->buffer, &position, &( current->lnpos ), &( current->lnum ), &( current->cmdpos ), &( current->cmdnum ), &( current->startpos ) ); } current->position = current->startpos; if ( current->cmdnum > -1 ) { if ( bwb_cmdtable[ current->cmdnum ].vector == bwb_for ) { ++w_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in find_next(): found FOR at line %d, level %d", current->number, w_level ); bwb_debug( bwb_ebuf ); #endif } else if ( bwb_cmdtable[ current->cmdnum ].vector == bwb_next ) { --w_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in find_next(): found NEXT at line %d, level %d", current->number, w_level ); bwb_debug( bwb_ebuf ); #endif if ( w_level == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in find_next(): found returning line <%d>", current->next->number ); bwb_debug( bwb_ebuf ); #endif return current->next; } } } } #if PROG_ERRORS sprintf( bwb_ebuf, "FOR without NEXT" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return NULL; } #endif /* STRUCT_CMDS for EXIT FOR */ /*************************************************************** FUNCTION: cnd_tostep() DESCRIPTION: This function searches through the beginning at point and attempts to find positions of TO and STEP statements. ***************************************************************/ #if ANSI_C static int cnd_tostep( char *buffer, int position, int *to, int *step ) #else static int cnd_tostep( buffer, position, to, step ) char *buffer; int position; int *to; int *step; #endif { int loop, t_pos, b_pos, p_word; char tbuf[ MAXSTRINGSIZE + 1 ]; /* set then and els to FALSE initially */ *to = *step = FALSE; /* loop to find words */ p_word = b_pos = position; t_pos = 0; tbuf[ 0 ] = '\0'; loop = TRUE; while ( loop == TRUE ) { switch( buffer[ b_pos ] ) { case '\0': /* end of string */ case ':': /* end of line segment */ return TRUE; case ' ': /* whitespace = end of word */ case '\t': #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in cnd_tostep(): word is <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif if ( strncmp( tbuf, CMD_TO, (size_t) strlen( CMD_TO ) ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in cnd_tostep(): TO found at position <%d>.", p_word ); bwb_debug( bwb_ebuf ); #endif *to = p_word; } else if ( strncmp( tbuf, CMD_STEP, (size_t) strlen( CMD_STEP ) ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in cnd_tostep(): STEP found at position <%d>.", p_word ); bwb_debug( bwb_ebuf ); #endif *step = p_word; } ++b_pos; p_word = b_pos; t_pos = 0; tbuf[ 0 ] = '\0'; break; default: if ( islower( buffer[ b_pos ] ) != FALSE ) { tbuf[ t_pos ] = (char) toupper( buffer[ b_pos ] ); } else { tbuf[ t_pos ] = buffer[ b_pos ]; } ++b_pos; ++t_pos; tbuf[ t_pos ] = '\0'; break; } } return TRUE; } /*************************************************************** FUNCTION: var_setnval() DESCRIPTION: This function sets the value of numerical variable v to the value of i. ***************************************************************/ #if ANSI_C extern int var_setnval( struct bwb_variable *v, bnumber i ) #else int var_setnval( v, i ) struct bwb_variable *v; bnumber i; #endif { switch( v->type ) { case NUMBER: * var_findnval( v, v->array_pos ) = i; break; default: #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in var_setnval(): variable <%s> is not a number", v->name ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif } /* successful assignment */ return TRUE; } bwbasic-2.20pl2.orig/bwb_dio.c100644 0 0 126355 6473161677 14351 0ustar rootroot/*************************************************************** bwb_dio.c Device Input/Output Routines 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). */ /*---------------------------------------------------------------*/ #include #include "bwbasic.h" #include "bwb_mes.h" #if HAVE_SYSSTAT #include #endif #ifndef SEEK_SET #define SEEK_SET 0 #endif #if INTENSIVE_DEBUG #define RANDOM_FILLCHAR 'X' #else #define RANDOM_FILLCHAR ' ' #endif #if COMMON_CMDS struct dev_element *dev_table; /* table of devices */ #endif static struct bwb_variable *v; static int pos; static int req_devnumber; static int rlen; static int mode; #if ANSI_C static struct bwb_line *dio_lrset( struct bwb_line *l, int rset ); static int dio_flush( int dev_number ); #else static struct bwb_line *dio_lrset(); static int dio_flush(); #endif #if COMMON_CMDS /*************************************************************** FUNCTION: bwb_open() DESCRIPTION: This function implements the BASIC OPEN command to open a stream for device input/output. SYNTAX: 1. OPEN "I"|"O"|"R", [#]n, filename [,rlen] 2. OPEN filename [FOR INPUT|OUTPUT|APPEND|] AS [#]n [LEN=n] ***************************************************************/ #if ANSI_C struct bwb_line * bwb_open( struct bwb_line *l ) #else struct bwb_line * bwb_open( l ) struct bwb_line *l; #endif { FILE *fp; struct exp_ese *e; int previous_buffer; char atbuf[ MAXSTRINGSIZE + 1 ]; char first[ MAXSTRINGSIZE + 1 ]; char devname[ MAXSTRINGSIZE + 1 ]; /* initialize */ mode = req_devnumber = rlen = -1; previous_buffer = FALSE; /* get the first expression element up to comma or whitespace */ adv_element( l->buffer, &( l->position ), atbuf ); /* parse the first expression element */ pos = 0; e = bwb_exp( atbuf, FALSE, &pos ); str_btoc( first, exp_getsval( e ) ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_open(): first element is <%s>", first ); bwb_debug( bwb_ebuf ); #endif /* test for syntactical form: if a comma follows the first element, then the syntax is form 1 (the old CP/M BASIC format); otherwise we presume form 2 */ adv_ws( l->buffer, &( l->position ) ); /* Parse syntax Form 1 (OPEN "x",#n, devname...) */ if ( l->buffer[ l->position ] == ',' ) { /* parse the next element to get the device number */ ++( l->position ); /* advance beyond comma */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == '#' ) { ++( l->position ); adv_ws( l->buffer, &( l->position ) ); } adv_element( l->buffer, &( l->position ), atbuf ); pos = 0; e = bwb_exp( atbuf, FALSE, &pos ); if ( e->type == STRING ) { #if PROG_ERRORS bwb_error( "String where number was expected for device number" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } req_devnumber = (int) exp_getnval( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_open(): syntax 1, req dev number is %d", req_devnumber ); bwb_debug( bwb_ebuf ); #endif /* parse the next element to get the devname */ adv_ws( l->buffer, &( l->position ) ); /* advance past whitespace */ ++( l->position ); /* advance past comma */ adv_element( l->buffer, &( l->position ), atbuf ); pos = 0; e = bwb_exp( atbuf, FALSE, &pos ); if ( e->type != STRING ) { #if PROG_ERRORS bwb_error( "in bwb_open(): number where string was expected for devname" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } str_btoc( devname, exp_getsval( e ) ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_open(): syntax 1, devname <%s>", devname ); bwb_debug( bwb_ebuf ); #endif /* see if there is another element; if so, parse it to get the record length */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == ',' ) { ++( l->position ); /* advance beyond comma */ adv_element( l->buffer, &( l->position ), atbuf ); pos = 0; e = bwb_exp( atbuf, FALSE, &pos ); if ( e->type == STRING ) { #if PROG_ERRORS bwb_error( "String where number was expected for record length" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } rlen = (int) exp_getnval( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_open(): syntax 1, record length is %d", rlen ); bwb_debug( bwb_ebuf ); #endif } /* the first letter of the first should indicate the type of file opening requested: test this letter, then parse accordingly */ /* open file for sequential INPUT */ if ( ( first[ 0 ] == 'i' ) || ( first[ 0 ] == 'I' )) { mode = DEVMODE_INPUT; } /* open file for sequential OUTPUT */ else if ( ( first[ 0 ] == 'o' ) || ( first[ 0 ] == 'O' )) { mode = DEVMODE_OUTPUT; } /* open file for RANDOM access input and output */ else if ( ( first[ 0 ] == 'r' ) || ( first[ 0 ] == 'R' )) { mode = DEVMODE_RANDOM; } /* error: none of the appropriate modes found */ else { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_open(): invalid mode" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_open(): syntax 1, mode is %d", mode ); bwb_debug( bwb_ebuf ); #endif } /* Parse syntax Form 2 (OPEN devname FOR mode AS#n ... ) */ else { /* save the devname from first */ strcpy( devname, first ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_open(): syntax 2, devname <%s>", devname ); bwb_debug( bwb_ebuf ); #endif /* get the next element */ adv_element( l->buffer, &( l->position ), atbuf ); /* check for "FOR mode" statement */ bwb_strtoupper( atbuf ); if ( strcmp( atbuf, "FOR" ) == 0 ) { adv_element( l->buffer, &( l->position ), atbuf ); bwb_strtoupper( atbuf ); if ( strcmp( atbuf, "INPUT" ) == 0 ) { mode = DEVMODE_INPUT; } else if ( strcmp( atbuf, "OUTPUT" ) == 0 ) { mode = DEVMODE_OUTPUT; } else if ( strcmp( atbuf, "APPEND" ) == 0 ) { mode = DEVMODE_RANDOM; } else { #if PROG_ERRORS bwb_error( "in bwb_open(): Invalid device i/o mode specified" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } /* get the next element */ adv_element( l->buffer, &( l->position ), atbuf ); } else { mode = DEVMODE_RANDOM; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_open(): syntax 2, mode is %d", mode ); bwb_debug( bwb_ebuf ); #endif /* This leaves us with the next element in the atbuf: it should read "AS" */ bwb_strtoupper( atbuf ); if ( strcmp( atbuf, "AS" ) != 0 ) { #if PROG_ERRORS bwb_error( "in bwb_open(): expected AS statement" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } /* get the next element */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == '#' ) { ++( l->position ); } adv_element( l->buffer, &( l->position ), atbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_open(): string to parse for req dev number <%s>", atbuf ); bwb_debug( bwb_ebuf ); #endif pos = 0; e = bwb_exp( atbuf, FALSE, &pos ); if ( e->type == STRING ) { #if PROG_ERRORS bwb_error( "String where number was expected for dev number" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } req_devnumber = (int) exp_getnval( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_open(): syntax 2, req dev number is %d", req_devnumber ); bwb_debug( bwb_ebuf ); #endif /* Check for LEN = n statement */ adv_element( l->buffer, &( l->position ), atbuf ); bwb_strtoupper( atbuf ); if ( strncmp( atbuf, "LEN", (size_t) 3 ) == 0 ) { pos = l->position - strlen( atbuf ); while( ( l->buffer[ pos ] != '=' ) && ( l->buffer[ pos ] != '\0' )) { ++pos; } if ( l->buffer[ pos ] == '\0' ) { #if PROG_ERRORS bwb_error( "Failed to find equals sign after LEN element" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } ++pos; /* advance past equal sign */ e = bwb_exp( l->buffer, FALSE, &pos ); if ( e->type == STRING ) { #if PROG_ERRORS bwb_error( "String where number was expected for record length" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } rlen = (int) exp_getnval( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_open(): syntax 2, record length is %d", rlen ); bwb_debug( bwb_ebuf ); #endif } } /* end of syntax 2 */ /* check for valid requested device number */ if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES )) { #if PROG_ERRORS bwb_error( "in bwb_open(): Requested device number is out of range." ); #else bwb_error( err_devnum ); #endif return bwb_zline( l ); } if ( dev_table[ req_devnumber ].mode == DEVMODE_CLOSED ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_open(): using previously closed file (and buffer)" ); bwb_debug( bwb_ebuf ); #endif previous_buffer = TRUE; } if ( ( dev_table[ req_devnumber ].mode != DEVMODE_CLOSED ) && ( dev_table[ req_devnumber ].mode != DEVMODE_AVAILABLE ) ) { #if PROG_ERRORS bwb_error( "in bwb_open(): Requested device number is already in use." ); #else bwb_error( err_devnum ); #endif return bwb_zline( l ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_open(): ready to open device <%s> mode <%d>", devname, mode ); bwb_debug( bwb_ebuf ); #endif /* attempt to open the file */ switch( mode ) { case DEVMODE_OUTPUT: fp = fopen( devname, "w" ); break; case DEVMODE_INPUT: fp = fopen( devname, "r" ); break; case DEVMODE_APPEND: fp = fopen( devname, "a" ); break; case DEVMODE_RANDOM: fp = fopen( devname, "r+" ); if ( fp == NULL ) { fp = fopen( devname, "w" ); fclose( fp ); fp = fopen( devname, "r+" ); } break; } /* check for valid file opening */ if ( fp == NULL ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Failed to open device <%s>", devname ); bwb_error( bwb_ebuf ); #else bwb_error( err_dev ); #endif return bwb_zline( l ); } /* assign values to device table */ /* Random mode has a default record length (JBV) */ if (mode == DEVMODE_RANDOM && rlen == -1) rlen = 128; dev_table[ req_devnumber ].mode = mode; dev_table[ req_devnumber ].cfp = fp; dev_table[ req_devnumber ].reclen = rlen; dev_table[ req_devnumber ].next_record = 1; dev_table[ req_devnumber ].loc = 0; strcpy( dev_table[ req_devnumber ].filename, devname ); /* File length finding routine, added by JBV */ fseek( dev_table[ req_devnumber ].cfp, 0, SEEK_END ); dev_table[ req_devnumber ].lof = ftell( dev_table[ req_devnumber ].cfp ); fseek( dev_table[ req_devnumber ].cfp, 0, SEEK_SET ); /* allocate a character buffer for random access */ if (( mode == DEVMODE_RANDOM ) && ( previous_buffer != TRUE )) { /* Revised to CALLOC pass-thru call by JBV */ if ( ( dev_table[ req_devnumber ].buffer = CALLOC( rlen + 1, 1, "bwb_open" )) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_open(): failed to find memory for device buffer" ); #else bwb_error( err_getmem ); #endif return bwb_zline( l ); } dio_flush( req_devnumber ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_open(): allocated new random-access buffer" ); bwb_debug( bwb_ebuf ); #endif } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_open(): file is open now; end of function" ); bwb_debug( bwb_ebuf ); #endif /* return next line number in sequence */ return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_close() DESCRIPTION: This function implements the BASIC CLOSE command to close a stream for device input/output. SYNTAX: CLOSE [#]n [,[#]n...] ***************************************************************/ #if ANSI_C struct bwb_line * bwb_close( struct bwb_line *l ) #else struct bwb_line * bwb_close( l ) struct bwb_line *l; #endif { struct exp_ese *e; char atbuf[ MAXSTRINGSIZE + 1 ]; int blanket_close; /* JBV */ register int n; /* JBV */ blanket_close = -1; /* JBV */ req_devnumber = 0; /* JBV */ /* loop to get device numbers to close */ do { if ( l->buffer[ l->position ] == ',' && blanket_close == 0) ++( l->position); /* JBV */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == '#') { ++( l->position ); } adv_element( l->buffer, &( l->position ), atbuf ); pos = 0; e = bwb_exp( atbuf, FALSE, &pos ); if ( e->type == STRING ) { #if PROG_ERRORS bwb_error( "String where number was expected for device number" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } /*-------------------------------------------------------------*/ /* Added the following section for blanket close feature (JBV) */ /*-------------------------------------------------------------*/ if (blanket_close == -1) if (strlen(atbuf) != 0) blanket_close = 0; else blanket_close = 1; if (blanket_close == 0) req_devnumber = (int) exp_getnval( e ); else { ++req_devnumber; /* Find the next device in use */ for (n = req_devnumber; n < DEF_DEVICES; ++n) { req_devnumber = -1; if (( dev_table[ n ].mode != DEVMODE_CLOSED ) && ( dev_table[ n ].mode != DEVMODE_AVAILABLE ) ) { req_devnumber = n; break; } } if (req_devnumber == -1) break; /* Skidoo if no more to close */ } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_close(): requested device number <%d>", req_devnumber ); bwb_debug( bwb_ebuf ); #endif /* check for valid requested device number */ if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES )) { #if PROG_ERRORS bwb_error( "in bwb_close(): Requested device number is out if range." ); #else bwb_error( err_devnum ); #endif return bwb_zline( l ); } if (( dev_table[ req_devnumber ].mode == DEVMODE_CLOSED ) || ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) ) { #if PROG_ERRORS bwb_error( "in bwb_close(): Requested device number is not in use." ); #else bwb_error( err_devnum ); #endif return bwb_zline( l ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_close(): closing device# <%d>", req_devnumber ); bwb_debug( bwb_ebuf ); #endif /* attempt to close the file */ if ( fclose( dev_table[ req_devnumber ].cfp ) != 0 ) { #if PROG_ERRORS bwb_error( "in bwb_close(): Failed to close the device" ); #else bwb_error( err_dev ); #endif return bwb_zline( l ); } /* mark the device in the table as unavailable */ dev_table[ req_devnumber ].mode = DEVMODE_CLOSED; /* Revised to FREE pass-thru call by JBV */ if ( dev_table[ req_devnumber ].buffer != NULL ) { FREE( dev_table[ req_devnumber ].buffer, "bwb_close" ); /* JBV */ dev_table[ req_devnumber ].buffer = NULL; /* JBV */ } /* eat up any remaining whitespace */ adv_ws( l->buffer, &( l->position ) ); } while ( l->buffer[ l->position ] == ',' || blanket_close == 1); /* JBV */ /* return next line number in sequence */ return bwb_zline( l ); } #endif /* COMMON_CMDS */ /*************************************************************** FUNCTION: bwb_chdir() DESCRIPTION: This function implements the BASIC CHDIR command to switch logged directories. SYNTAX: CHDIR pathname$ ***************************************************************/ #if UNIX_CMDS #if ANSI_C struct bwb_line * bwb_chdir( struct bwb_line *l ) #else struct bwb_line * bwb_chdir( l ) struct bwb_line *l; #endif { int r; static int position; struct exp_ese *e; static char *atbuf; static int init = FALSE; /* get memory for temporary buffers if necessary */ if ( init == FALSE ) { init = TRUE; /* Revised to CALLOC pass-thru call by JBV */ if ( ( atbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "bwb_chdir" )) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_chdir(): failed to find memory for atbuf" ); #else bwb_error( err_getmem ); #endif } } /* get the next element in atbuf */ adv_element( l->buffer, &( l->position ), atbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_chdir(): argument is <%s>", atbuf ); bwb_debug( bwb_ebuf ); #endif /* interpret the argument */ position = 0; e = bwb_exp( atbuf, FALSE, &position ); if ( e->type != STRING ) { bwb_error( err_argstr ); return bwb_zline( l ); } /* try to chdir to the requested directory */ str_btoc( atbuf, &( e->sval ) ); r = chdir( atbuf ); /* detect error */ if ( r == -1 ) { bwb_error( err_opsys ); return bwb_zline( l ); } return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_rmdir() DESCRIPTION: This function implements the BASIC CHDIR command to remove a subdirectory. SYNTAX: RMDIR pathname$ ***************************************************************/ #if ANSI_C struct bwb_line * bwb_rmdir( struct bwb_line *l ) #else struct bwb_line * bwb_rmdir( l ) struct bwb_line *l; #endif { int r; static int position; struct exp_ese *e; static char *atbuf; static int init = FALSE; /* get memory for temporary buffers if necessary */ if ( init == FALSE ) { init = TRUE; /* Revised to CALLOC pass-thru call by JBV */ if ( ( atbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "bwb_rmdir" )) == NULL ) { #if PROG_ERRORS bwb_error( "in rmdir(): failed to find memory for atbuf" ); #else bwb_error( err_getmem ); #endif } } /* get the next element in atbuf */ adv_element( l->buffer, &( l->position ), atbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_rmdir(): argument is <%s>", atbuf ); bwb_debug( bwb_ebuf ); #endif /* interpret the argument */ position = 0; e = bwb_exp( atbuf, FALSE, &position ); if ( e->type != STRING ) { bwb_error( err_argstr ); return bwb_zline( l ); } /* try to remove the requested directory */ str_btoc( atbuf, &( e->sval ) ); r = rmdir( atbuf ); /* detect error */ if ( r == -1 ) { bwb_error( err_opsys ); } return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_mkdir() DESCRIPTION: This function implements the BASIC MKDIR command to create a new subdirectory. SYNTAX: MKDIR pathname$ ***************************************************************/ #if ANSI_C struct bwb_line * bwb_mkdir( struct bwb_line *l ) #else struct bwb_line * bwb_mkdir( l ) struct bwb_line *l; #endif { int r; static int position; struct exp_ese *e; static char *atbuf; static int init = FALSE; /* get memory for temporary buffers if necessary */ if ( init == FALSE ) { init = TRUE; /* Revised to CALLOC pass-thru call by JBV */ if ( ( atbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "bwb_mkdir" )) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_mkdir(): failed to find memory for atbuf" ); #else bwb_error( err_getmem ); #endif } } /* get the next element in atbuf */ adv_element( l->buffer, &( l->position ), atbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_mkdir(): argument is <%s>", atbuf ); bwb_debug( bwb_ebuf ); #endif /* interpret the argument */ position = 0; e = bwb_exp( atbuf, FALSE, &position ); if ( e->type != STRING ) { bwb_error( err_argstr ); return bwb_zline( l ); } /* try to make the requested directory */ str_btoc( atbuf, &( e->sval ) ); #if MKDIR_ONE_ARG r = mkdir( atbuf ); #else r = mkdir( atbuf, PERMISSIONS ); #endif /* detect error */ if ( r == -1 ) { bwb_error( err_opsys ); } return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_kill() DESCRIPTION: This function implements the BASIC KILL command to erase a disk file. SYNTAX: KILL filename ***************************************************************/ #if ANSI_C struct bwb_line * bwb_kill( struct bwb_line *l ) #else struct bwb_line * bwb_kill( l ) struct bwb_line *l; #endif { int r; static int position; struct exp_ese *e; static char *atbuf; static int init = FALSE; /* get memory for temporary buffers if necessary */ if ( init == FALSE ) { init = TRUE; /* Revised to CALLOC pass-thru call by JBV */ if ( ( atbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "bwb_kill" )) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_kill(): failed to find memory for atbuf" ); #else bwb_error( err_getmem ); #endif } } /* get the next element in atbuf */ adv_element( l->buffer, &( l->position ), atbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_kill(): argument is <%s>", atbuf ); bwb_debug( bwb_ebuf ); #endif /* interpret the argument */ position = 0; e = bwb_exp( atbuf, FALSE, &position ); if ( e->type != STRING ) { bwb_error( err_argstr ); return bwb_zline( l ); } /* try to delete the specified file */ str_btoc( atbuf, &( e->sval ) ); r = unlink( atbuf ); /* detect error */ if ( r == -1 ) { bwb_error( err_opsys ); } return bwb_zline( l ); } #endif /* UNIX_CMDS */ #if COMMON_CMDS /*************************************************************** FUNCTION: bwb_name() DESCRIPTION: This function implements the BASIC NAME command to rename a disk file. SYNTAX: NAME old_filename AS new_filename ***************************************************************/ #if ANSI_C struct bwb_line * bwb_name( struct bwb_line *l ) #else struct bwb_line * bwb_name( l ) struct bwb_line *l; #endif { int r; static int position; struct exp_ese *e; static char *atbuf; static char *btbuf; static int init = FALSE; /* get memory for temporary buffers if necessary */ if ( init == FALSE ) { init = TRUE; /* Revised to CALLOC pass-thru call by JBV */ if ( ( atbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "bwb_name" )) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_name(): failed to find memory for atbuf" ); #else bwb_error( err_getmem ); #endif } /* Revised to CALLOC pass-thru call by JBV */ if ( ( btbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "bwb_name" )) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_name(): failed to find memory for btbuf" ); #else bwb_error( err_getmem ); #endif } } /* get the first argument in atbuf */ adv_element( l->buffer, &( l->position ), atbuf ); /* interpret the first argument */ position = 0; e = bwb_exp( atbuf, FALSE, &position ); if ( e->type != STRING ) { bwb_error( err_argstr ); return bwb_zline( l ); } /* this argument must be copied back to atbuf, else the next call to bwb_exp() will overwrite the structure to which e refers */ str_btoc( atbuf, &( e->sval ) ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_name(): old name is <%s>", atbuf ); bwb_debug( bwb_ebuf ); #endif /* get the second argument in btbuf */ adv_element( l->buffer, &( l->position ), btbuf ); bwb_strtoupper( btbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_name(): AS string is <%s>", btbuf ); bwb_debug( bwb_ebuf ); #endif if ( strcmp( btbuf, "AS" ) != 0 ) { bwb_error( err_syntax ); return bwb_zline( l ); } /* get the third argument in btbuf */ adv_element( l->buffer, &( l->position ), btbuf ); /* interpret the third argument */ position = 0; e = bwb_exp( btbuf, FALSE, &position ); if ( e->type != STRING ) { bwb_error( err_argstr ); return bwb_zline( l ); } str_btoc( btbuf, &( e->sval ) ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_name(): new name is <%s>", btbuf ); bwb_debug( bwb_ebuf ); #endif /* try to rename the file */ r = rename( atbuf, btbuf ); /* detect error */ if ( r != 0 ) { bwb_error( err_opsys ); } return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_field() DESCRIPTION: This C function implements the BASIC FIELD command. ***************************************************************/ #if ANSI_C struct bwb_line * bwb_field( struct bwb_line *l ) #else struct bwb_line * bwb_field( l ) struct bwb_line *l; #endif { int dev_number; int length; struct exp_ese *e; struct bwb_variable *v; bstring *b; int current_pos; char atbuf[ MAXSTRINGSIZE + 1 ]; current_pos = 0; /* first read device number */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] =='#' ) { ++( l->position ); } adv_element( l->buffer, &( l->position ), atbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_field(): device# buffer <%s>", atbuf ); bwb_debug( bwb_ebuf ); #endif pos = 0; e = bwb_exp( atbuf, FALSE, &pos ); if ( e->type != NUMBER ) { #if PROG_ERRORS bwb_error( "in bwb_field(): Number was expected for device number" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } dev_number = (int) exp_getnval( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_field(): device <%d>", dev_number ); bwb_debug( bwb_ebuf ); #endif /* be sure that the requested device is open */ if (( dev_table[ dev_number ].mode == DEVMODE_CLOSED ) || ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) ) { #if PROG_ERRORS bwb_error( "in bwb_field(): Requested device number is not in use." ); #else bwb_error( err_devnum ); #endif return bwb_zline( l ); } /* loop to read variables */ do { /* read the comma and advance beyond it */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] ==',' ) { ++( l->position ); } /* first find the size of the field */ adv_element( l->buffer, &( l->position ), atbuf ); /* get element */ pos = 0; e = bwb_exp( atbuf, FALSE, &pos ); if ( e->type != NUMBER ) { #if PROG_ERRORS bwb_error( "in bwb_field(): number value for field size not found" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } length = (int) exp_getnval( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_field(): device <%d> length <%d> buf <%s>", dev_number, length, &( l->buffer[ l->position ] ) ); bwb_debug( bwb_ebuf ); #endif /* read the AS */ adv_element( l->buffer, &( l->position ), atbuf ); /* get element */ bwb_strtoupper( atbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_field(): AS element <%s>", atbuf ); bwb_debug( bwb_ebuf ); #endif if ( strncmp( atbuf, "AS", 2 ) != 0 ) { #if PROG_ERRORS bwb_error( "in bwb_field(): AS statement not found" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } /* read the string variable name */ adv_element( l->buffer, &( l->position ), atbuf ); /* get element */ v = var_find( atbuf ); if ( v->type != STRING ) { #if PROG_ERRORS bwb_error( "in bwb_field(): string variable name not found" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_field(): device <%d> var <%s> length <%d>", dev_number, v->name, length ); bwb_debug( bwb_ebuf ); #endif /* check for overflow of record length */ if ( ( current_pos + length ) > dev_table[ dev_number ].reclen ) { #if PROG_ERRORS bwb_error( "in bwb_field(): record length exceeded" ); #else bwb_error( err_overflow ); #endif return bwb_zline( l ); } /* set buffer */ b = var_findsval( v, v->array_pos ); #if DONTDOTHIS if ( b->sbuffer != NULL ) { /* Revised to FREE pass-thru call by JBV */ FREE( b->sbuffer, "bwb_field" ); b->sbuffer = NULL; /* JBV */ } #endif b->sbuffer = dev_table[ dev_number ].buffer + current_pos; b->length = (unsigned int) length; /* Was unsigned char (JBV 9/4/97) */ b->rab = TRUE; current_pos += length; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_field(): buffer <%lXh> var <%s> buffer <%lXh>", (long) dev_table[ dev_number ].buffer, v->name, (long) b->sbuffer ); bwb_debug( bwb_ebuf ); #endif /* eat up any remaining whitespace */ adv_ws( l->buffer, &( l->position ) ); } while ( l->buffer[ l->position ] == ',' ); /* return */ return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_lset() DESCRIPTION: This C function implements the BASIC LSET command. SYNTAX: LSET string-variable$ = expression ***************************************************************/ #if ANSI_C struct bwb_line * bwb_lset( struct bwb_line *l ) #else struct bwb_line * bwb_lset( l ) struct bwb_line *l; #endif { return dio_lrset( l, FALSE ); } /*************************************************************** FUNCTION: bwb_rset() DESCRIPTION: This C function implements the BASIC RSET command. SYNTAX: RSET string-variable$ = expression ***************************************************************/ #if ANSI_C struct bwb_line * bwb_rset( struct bwb_line *l ) #else struct bwb_line * bwb_rset( l ) struct bwb_line *l; #endif { return dio_lrset( l, TRUE ); } /*************************************************************** FUNCTION: dio_lrset() DESCRIPTION: This C function implements the BASIC RSET and LSET commands. ***************************************************************/ #if ANSI_C static struct bwb_line * dio_lrset( struct bwb_line *l, int rset ) #else static struct bwb_line * dio_lrset( l, rset ) struct bwb_line *l; int rset; #endif { char varname[ MAXVARNAMESIZE + 1 ]; bstring *d, *s; int *pp; int n_params; int p; register int n, i; int startpos; struct exp_ese *e; /* find the variable name */ bwb_getvarname( l->buffer, varname, &( l->position )); v = var_find( varname ); if ( v == NULL ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in dio_lrset(): failed to find variable" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif } if ( v->type != STRING ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in dio_lrset(): assignment must be to string variable" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif } /* read subscripts */ pos = 0; if ( ( v->dimensions == 1 ) && ( v->array_sizes[ 0 ] == 1 )) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in dio_lrset(): variable <%s> has 1 dimension", v->name ); bwb_debug( bwb_ebuf ); #endif n_params = 1; pp = &p; pp[ 0 ] = dim_base; } else { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in dio_lrset(): variable <%s> has > 1 dimensions", v->name ); bwb_debug( bwb_ebuf ); #endif dim_getparams( l->buffer, &( l->position ), &n_params, &pp ); } CURTASK exps[ CURTASK expsc ].pos_adv = pos; for ( n = 0; n < v->dimensions; ++n ) { v->array_pos[ n ] = pp[ n ]; } /* get bstring pointer */ d = var_findsval( v, pp ); /* find equals sign */ adv_ws( l->buffer, &( l->position )); if ( l->buffer[ l->position ] != '=' ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in dio_lrset(): failed to find equal sign" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif } ++( l->position ); adv_ws( l->buffer, &( l->position )); /* read remainder of line to get value */ e = bwb_exp( l->buffer, FALSE, &( l->position ) ); s = exp_getsval( e ); /* set starting position */ startpos = 0; if ( rset == TRUE ) { if ( s->length < d->length ) { startpos = d->length - s->length; } } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in dio_lrset(): startpos <%d> buffer <%lX>", startpos, (long) d->sbuffer ); bwb_debug( bwb_ebuf ); #endif /* write characters to new position */ i = 0; for ( n = startpos; ( i < (int) s->length ) && ( n < (int) d->length ); ++n ) { d->sbuffer[ n ] = s->sbuffer[ i ]; ++i; } /* return */ return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_get() DESCRIPTION: This C function implements the BASIC GET command. SYNTAX: GET [#] device-number [, record-number] ***************************************************************/ #if ANSI_C struct bwb_line * bwb_get( struct bwb_line *l ) #else struct bwb_line * bwb_get( l ) struct bwb_line *l; #endif { int dev_number; int rec_number; register int i; struct exp_ese *e; char atbuf[ MAXSTRINGSIZE + 1 ]; long offset; /* JBV */ /* first read device number */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] =='#' ) { ++( l->position ); } adv_element( l->buffer, &( l->position ), atbuf ); pos = 0; e = bwb_exp( atbuf, FALSE, &pos ); if ( e->type != NUMBER ) { #if PROG_ERRORS bwb_error( "in bwb_get(): Number was expected for device number" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } dev_number = (int) exp_getnval( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_get(): device <%d>", dev_number ); bwb_debug( bwb_ebuf ); #endif /* be sure that the requested device is open */ if ( ( dev_table[ dev_number ].mode == DEVMODE_CLOSED ) || ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) ) { #if PROG_ERRORS bwb_error( "in bwb_get(): Requested device number is not in use." ); #else bwb_error( err_devnum ); #endif return bwb_zline( l ); } /* see if there is a comma (and record number) */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == ',' ) /* yes, there is a comma */ { ++( l->position ); /* get the record number element */ adv_element( l->buffer, &( l->position ), atbuf ); pos = 0; e = bwb_exp( atbuf, FALSE, &pos ); rec_number = (int) exp_getnval( e ); } else /* no record number given */ { rec_number = dev_table[ dev_number ].next_record; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_get(): record number <%d>", rec_number ); bwb_debug( bwb_ebuf ); #endif /* wind the c file up to the proper point */ /* Added by JBV */ offset = (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen); if ( fseek( dev_table[ dev_number ].cfp, offset, SEEK_SET ) != 0 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_get(): fseek() failed, rec number <%d> offset <%ld>", rec_number, (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ) ); bwb_error( bwb_ebuf ); #else bwb_error( err_dev ); #endif return bwb_zline( l ); } /* read the requested bytes into the buffer */ dev_table[ dev_number ].loc = offset; /* Slight bug fix (JBV) */ for ( i = 0; i < dev_table[ dev_number ].reclen; ++i ) { dev_table[ dev_number ].buffer[ i ] = (char) fgetc( dev_table[ dev_number ].cfp ); ++( dev_table[ dev_number ].loc ); } /* increment (or reset) the current record */ dev_table[ dev_number ].next_record = rec_number + 1; return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_put() DESCRIPTION: This C function implements the BASIC PUT command. SYNTAX: PUT [#] device-number [, record-number] ***************************************************************/ #if ANSI_C struct bwb_line * bwb_put( struct bwb_line *l ) #else struct bwb_line * bwb_put( l ) struct bwb_line *l; #endif { int dev_number; int rec_number; register int i; struct exp_ese *e; char atbuf[ MAXSTRINGSIZE + 1 ]; long offset; /* JBV */ /* first read device number */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] =='#' ) { ++( l->position ); } adv_element( l->buffer, &( l->position ), atbuf ); /* dev_number = atoi( atbuf ); */ /* Not quite right (JBV) */ /* Added by JBV */ pos = 0; e = bwb_exp( atbuf, FALSE, &pos ); if ( e->type != NUMBER ) { #if PROG_ERRORS bwb_error( "in bwb_put(): Number was expected for device number" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } dev_number = (int) exp_getnval( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_put(): device <%d>", dev_number ); bwb_debug( bwb_ebuf ); #endif /* be sure that the requested device is open */ if ( ( dev_table[ dev_number ].mode == DEVMODE_CLOSED ) || ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) ) { #if PROG_ERRORS bwb_error( "in bwb_put(): Requested device number is not in use." ); #else bwb_error( err_devnum ); #endif return bwb_zline( l ); } /* see if there is a comma (and record number) */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == ',' ) /* yes, there is a comma */ { ++( l->position ); /* get the record number element */ adv_element( l->buffer, &( l->position ), atbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_put(): rec no buffer <%s>", atbuf ); bwb_debug( bwb_ebuf ); #endif pos = 0; e = bwb_exp( atbuf, FALSE, &pos ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_put(): return type <%c>", e->type ); bwb_debug( bwb_ebuf ); #endif rec_number = (int) exp_getnval( e ); } else /* no record number given */ { rec_number = dev_table[ dev_number ].next_record; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_put(): record number <%d>", rec_number ); bwb_debug( bwb_ebuf ); #endif /* wind the c file up to the proper point */ /* Added by JBV */ offset = (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen); if ( fseek( dev_table[ dev_number ].cfp, offset, SEEK_SET ) != 0 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_get(): fseek() failed, rec number <%d> offset <%ld>", rec_number, (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ) ); bwb_error( bwb_ebuf ); #else bwb_error( err_dev ); #endif return bwb_zline( l ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_put(): ready to write to file, buffer <%lXh>", (long) dev_table[ dev_number ].buffer ); bwb_debug( bwb_ebuf ); prn_xprintf( stderr, "Buffer: <" ); #endif /* write the requested bytes to the file */ dev_table[ dev_number ].loc = offset; /* Slight bug fix (JBV) */ for ( i = 0; i < dev_table[ dev_number ].reclen; ++i ) { fputc( dev_table[ dev_number ].buffer[ i ], dev_table[ dev_number ].cfp ); #if INTENSIVE_DEBUG xputc( stderr, dev_table[ dev_number ].buffer[ i ] ); #endif ++( dev_table[ dev_number ].loc ); } #if INTENSIVE_DEBUG prn_xprintf( stderr, ">\n" ); sprintf( bwb_ebuf, "in bwb_put(): write to file complete" ); bwb_debug( bwb_ebuf ); #endif /* flush the buffer */ dio_flush( dev_number ); /* increment (or reset) the current record */ dev_table[ dev_number ].next_record = rec_number + 1; return bwb_zline( l ); } /*************************************************************** FUNCTION: dio_flush() DESCRIPTION: This C function flushes the random-access buffer associated with file dev_number. ***************************************************************/ #if ANSI_C static int dio_flush( int dev_number ) #else static int dio_flush( dev_number ) int dev_number; #endif { register int n; if ( dev_table[ dev_number ].mode != DEVMODE_RANDOM ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in dio_flush(): only random-access buffers can be flushed" ); bwb_error( bwb_ebuf ); #else bwb_error( err_dev ); #endif } /* fill buffer with blanks (or 'X' for test) */ for ( n = 0; n < dev_table[ req_devnumber ].reclen; ++n ) { dev_table[ req_devnumber ].buffer[ n ] = RANDOM_FILLCHAR; } return TRUE; } #endif /* COMMON_CMDS */ bwbasic-2.20pl2.orig/bwb_elx.c100644 0 0 114270 6473161677 14357 0ustar rootroot/**************************************************************** bwb_elx.c Parse Elements of Expressions 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). */ /*---------------------------------------------------------------*/ #include #include #include #include "bwbasic.h" #include "bwb_mes.h" /*************************************************************** FUNCTION: exp_paren() DESCRIPTION: This function interprets a parenthetical expression, calling bwb_exp() (recursively) to resolve the internal expression. ***************************************************************/ #if ANSI_C int exp_paren( char *expression ) #else int exp_paren( expression ) char *expression; #endif { struct exp_ese *e; int s_pos; /* position in build buffer */ int loop; int paren_level; /* find a string enclosed by parentheses */ CURTASK exps[ CURTASK expsc ].pos_adv = 1; /* start beyond open paren */ s_pos = 0; loop = TRUE; paren_level = 1; CURTASK exps[ CURTASK expsc ].string[ 0 ] = '\0'; while( loop == TRUE ) { /* check the current character */ switch( expression[ CURTASK exps[ CURTASK expsc ].pos_adv ] ) { case '\r': /* these tests added v1.11 */ case '\n': case '\0': bwb_error( err_incomplete ); loop = FALSE; break; case '(': ++paren_level; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ CURTASK exps[ CURTASK expsc ].pos_adv ]; ++s_pos; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; break; case ')': --paren_level; if ( paren_level == 0 ) { loop = FALSE; } else { CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ CURTASK exps[ CURTASK expsc ].pos_adv ]; ++s_pos; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; } break; case '\"': /* embedded string constant */ ++CURTASK exps[ CURTASK expsc ].pos_adv; while ( ( expression[ CURTASK exps[ CURTASK expsc ].pos_adv ] != '\"' ) && ( expression[ CURTASK exps[ CURTASK expsc ].pos_adv ] != '\0' ) ) { CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ CURTASK exps[ CURTASK expsc ].pos_adv ]; ++s_pos; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; ++CURTASK exps[ CURTASK expsc ].pos_adv; } break; default: CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ CURTASK exps[ CURTASK expsc ].pos_adv ]; ++s_pos; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; break; } /* advance the counter */ ++CURTASK exps[ CURTASK expsc ].pos_adv; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_paren() found internal string <%s>", CURTASK exps[ CURTASK expsc ].string ); bwb_debug( bwb_ebuf ); #endif /* call bwb_exp() recursively to interpret this expression */ CURTASK exps[ CURTASK expsc ].rec_pos = 0; e = bwb_exp( CURTASK exps[ CURTASK expsc ].string, FALSE, &( CURTASK exps[ CURTASK expsc ].rec_pos ) ); /* assign operation and value at this level */ CURTASK exps[ CURTASK expsc ].type = e->type; switch ( e->type ) { case STRING: CURTASK exps[ CURTASK expsc ].operation = CONST_STRING; str_btob( exp_getsval( &( CURTASK exps[ CURTASK expsc ] )), exp_getsval( e ) ); break; default: CURTASK exps[ CURTASK expsc ].operation = NUMBER; CURTASK exps[ CURTASK expsc ].nval = exp_getnval( e ); break; } return TRUE; } /*************************************************************** FUNCTION: exp_strconst() DESCRIPTION: This function interprets a string constant. ***************************************************************/ #if ANSI_C int exp_strconst( char *expression ) #else int exp_strconst( expression ) char *expression; #endif { int e_pos, s_pos; /* assign values to structure */ CURTASK exps[ CURTASK expsc ].type = STRING; CURTASK exps[ CURTASK expsc ].operation = CONST_STRING; /* set counters */ s_pos = 0; CURTASK exps[ CURTASK expsc ].pos_adv = e_pos = 1; CURTASK exps[ CURTASK expsc ].string[ 0 ] = '\0'; /* read the string up until the next double quotation mark */ /* While yer at it, check for a null terminator too (JBV, found by DD) */ while(( expression[ e_pos ] != '\"') && ( expression[ e_pos ] != '\0' )) { CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ e_pos ]; ++e_pos; ++s_pos; ++CURTASK exps[ CURTASK expsc ].pos_adv; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; if ( s_pos >= ( MAXSTRINGSIZE - 1 ) ) { #if PROG_ERRORS sprintf( bwb_ebuf, "string <%s> exceeds maximum size (%d) for string constant.", expression, MAXSTRINGSIZE ); bwb_error( bwb_ebuf ); #else bwb_error( err_overflow ); #endif return OP_NULL; } } /* now write string over to bstring */ str_ctob( &( CURTASK exps[ CURTASK expsc ].sval ), CURTASK exps[ CURTASK expsc ].string ); /* advance past last double quotation mark */ /*-------------------------------------------------------------*/ /* Of course, it doesn't hurt to make sure it's really a quote */ /* (JBV, found by DD) */ /*-------------------------------------------------------------*/ if ( expression[ e_pos ] == '\"' ) ++CURTASK exps[ CURTASK expsc ].pos_adv; /* return */ return TRUE; } /*************************************************************** FUNCTION: exp_numconst() DESCRIPTION: This function interprets a numerical constant. ***************************************************************/ #if ANSI_C int exp_numconst( char *expression ) #else int exp_numconst( expression ) char *expression; #endif { int base; /* numerical base for the constant */ static struct bwb_variable mantissa; /* mantissa of floating-point number */ static int init = FALSE; /* is mantissa variable initialized? */ int exponent; /* exponent for floating point number */ int man_start; /* starting point of mantissa */ int s_pos; /* position in build string */ int build_loop; int need_pm; int i; bnumber d; #if CHECK_RECURSION static int in_use = FALSE; /* boolean: is function in use? */ /* check recursion status */ if ( in_use == TRUE ) { sprintf( bwb_ebuf, "Recursion error in bwb_exp.c:exp_findop(): recursion violation." ); bwb_error( bwb_ebuf ); } /* reset recursion status indicator */ else { in_use = TRUE; } #endif /* initialize the variable if necessary */ #if INTENSIVE_DEBUG strcpy( mantissa.name, "(mantissa)" ); #endif if ( init == FALSE ) { init = TRUE; var_make( &mantissa, NUMBER ); } /* be sure that the array_pos[ 0 ] for mantissa is set to dim_base; this is necessary because mantissa might be used before dim_base is set */ mantissa.array_pos[ 0 ] = dim_base; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_numconst(): received <%s>, eval <%c>", expression, expression[ 0 ] ); bwb_debug( bwb_ebuf ); #endif need_pm = FALSE; CURTASK exps[ CURTASK expsc ].nval = (bnumber) 0; /* check the first character(s) to determine numerical base and starting point of the mantissa */ switch( expression[ 0 ] ) { case '-': case '+': case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case '.': base = 10; /* decimal constant */ man_start = 0; /* starts at position 0 */ need_pm = FALSE; break; case '&': /* hex or octal constant */ if ( ( expression[ 1 ] == 'H' ) || ( expression[ 1 ] == 'h' )) { base = 16; /* hexadecimal constant */ man_start = 2; /* starts at position 2 */ } else { base = 8; /* octal constant */ if ( ( expression[ 1 ] == 'O' ) || ( expression[ 1 ] == 'o' )) { man_start = 2; /* starts at position 2 */ } else { man_start = 1; /* starts at position 1 */ } } break; default: #if PROG_ERRORS sprintf( bwb_ebuf, "expression <%s> is not a numerical constant.", expression ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return OP_NULL; } /* now build the mantissa according to the numerical base */ switch( base ) { case 10: /* decimal constant */ /* initialize counters */ CURTASK exps[ CURTASK expsc ].pos_adv = man_start; CURTASK exps[ CURTASK expsc ].type = NUMBER; CURTASK exps[ CURTASK expsc ].string[ 0 ] = '\0'; s_pos = 0; exponent = OP_NULL; build_loop = TRUE; /* loop to build the string */ while ( build_loop == TRUE ) { switch( expression[ CURTASK exps[ CURTASK expsc ].pos_adv ] ) { case '-': /* prefixed plus or minus */ case '+': /* in the first position, a plus or minus sign can be added to the beginning of the string to be scanned */ if ( CURTASK exps[ CURTASK expsc ].pos_adv == man_start ) { CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ CURTASK exps[ CURTASK expsc ].pos_adv ]; ++CURTASK exps[ CURTASK expsc ].pos_adv; /* advance to next character */ ++s_pos; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; } /* but in any other position, the plus or minus sign must be taken as an operator and thus as terminating the string to be scanned */ else { build_loop = FALSE; } break; case '.': /* note at least single precision */ case '0': /* or ordinary digit */ case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ CURTASK exps[ CURTASK expsc ].pos_adv ]; ++CURTASK exps[ CURTASK expsc ].pos_adv; /* advance to next character */ ++s_pos; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; break; case '#': /* Microsoft-type precision indicator; ignored but terminates */ case '!': /* Microsoft-type precision indicator; ignored but terminates */ ++CURTASK exps[ CURTASK expsc ].pos_adv; /* advance to next character */ CURTASK exps[ CURTASK expsc ].type = NUMBER; exponent = FALSE; build_loop = FALSE; break; case 'E': /* exponential, single precision */ case 'e': ++CURTASK exps[ CURTASK expsc ].pos_adv; /* advance to next character */ CURTASK exps[ CURTASK expsc ].type = NUMBER; exponent = TRUE; build_loop = FALSE; break; case 'D': /* exponential, double precision */ case 'd': ++CURTASK exps[ CURTASK expsc ].pos_adv; /* advance to next character */ CURTASK exps[ CURTASK expsc ].type = NUMBER; exponent = TRUE; build_loop = FALSE; break; default: /* anything else, terminate */ build_loop = FALSE; break; } } /* assign the value to the mantissa variable */ #if NUMBER_DOUBLE sscanf( CURTASK exps[ CURTASK expsc ].string, "%lf", var_findnval( &mantissa, mantissa.array_pos )); #else sscanf( CURTASK exps[ CURTASK expsc ].string, "%f", var_findnval( &mantissa, mantissa.array_pos )); #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_numconst(): read mantissa, string <%s> val <%lf>", CURTASK exps[ CURTASK expsc ].string, var_getnval( &mantissa ) ); bwb_debug( bwb_ebuf ); #endif /* test if integer bounds have been exceeded */ if ( CURTASK exps[ CURTASK expsc ].type == NUMBER ) { i = (int) var_getnval( &mantissa ); d = (bnumber) i; if ( d != var_getnval( &mantissa )) { CURTASK exps[ CURTASK expsc ].type = NUMBER; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_numconst(): integer bounds violated, promote to NUMBER" ); bwb_debug( bwb_ebuf ); #endif } } /* read the exponent if there is one */ if ( exponent == TRUE ) { /* allow a plus or minus once at the beginning */ need_pm = TRUE; /* initialize counters */ CURTASK exps[ CURTASK expsc ].string[ 0 ] = '\0'; s_pos = 0; build_loop = TRUE; /* loop to build the string */ while ( build_loop == TRUE ) { switch( expression[ CURTASK exps[ CURTASK expsc ].pos_adv ] ) { case '-': /* prefixed plus or minus */ case '+': if ( need_pm == TRUE ) /* only allow once */ { CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ CURTASK exps[ CURTASK expsc ].pos_adv ]; ++CURTASK exps[ CURTASK expsc ].pos_adv; /* advance to next character */ ++s_pos; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; } else { build_loop = FALSE; } break; case '0': /* or ordinary digit */ case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ CURTASK exps[ CURTASK expsc ].pos_adv ]; ++CURTASK exps[ CURTASK expsc ].pos_adv; /* advance to next character */ ++s_pos; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; need_pm = FALSE; break; default: /* anything else, terminate */ build_loop = FALSE; break; } } /* end of build loop for exponent */ /* assign the value to the user variable */ #if NUMBER_DOUBLE sscanf( CURTASK exps[ CURTASK expsc ].string, "%lf", &( CURTASK exps[ CURTASK expsc ].nval ) ); #else sscanf( CURTASK exps[ CURTASK expsc ].string, "%f", &( CURTASK exps[ CURTASK expsc ].nval ) ); #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_numconst(): exponent is <%d>", (int) CURTASK exps[ CURTASK expsc ].nval ); bwb_debug( bwb_ebuf ); #endif } /* end of exponent search */ if ( CURTASK exps[ CURTASK expsc ].nval == (bnumber) 0 ) { CURTASK exps[ CURTASK expsc ].nval = var_getnval( &mantissa ); } else { CURTASK exps[ CURTASK expsc ].nval = var_getnval( &mantissa ) * pow( (bnumber) 10.0, (bnumber) CURTASK exps[ CURTASK expsc ].nval ); } break; case 8: /* octal constant */ /* initialize counters */ CURTASK exps[ CURTASK expsc ].pos_adv = man_start; CURTASK exps[ CURTASK expsc ].type = NUMBER; CURTASK exps[ CURTASK expsc ].string[ 0 ] = '\0'; s_pos = 0; exponent = OP_NULL; build_loop = TRUE; /* loop to build the string */ while ( build_loop == TRUE ) { switch( expression[ CURTASK exps[ CURTASK expsc ].pos_adv ] ) { case '0': /* or ordinary digit */ case '1': case '2': case '3': case '4': case '5': case '6': case '7': CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ CURTASK exps[ CURTASK expsc ].pos_adv ]; ++CURTASK exps[ CURTASK expsc ].pos_adv; /* advance to next character */ ++s_pos; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; break; default: /* anything else, terminate */ build_loop = FALSE; break; } } /* now scan the string to determine the number */ sscanf( CURTASK exps[ CURTASK expsc ].string, "%o", &i ); CURTASK exps[ CURTASK expsc ].nval = (bnumber) i; break; case 16: /* hexadecimal constant */ /* initialize counters */ CURTASK exps[ CURTASK expsc ].pos_adv = man_start; CURTASK exps[ CURTASK expsc ].type = NUMBER; CURTASK exps[ CURTASK expsc ].string[ 0 ] = '\0'; s_pos = 0; exponent = OP_NULL; build_loop = TRUE; /* loop to build the string */ while ( build_loop == TRUE ) { switch( expression[ CURTASK exps[ CURTASK expsc ].pos_adv ] ) { case '0': /* or ordinary digit */ case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case 'A': case 'a': case 'B': case 'b': case 'C': case 'c': case 'D': case 'd': case 'E': case 'e': case 'F': /* Don't forget these! (JBV) */ case 'f': CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ CURTASK exps[ CURTASK expsc ].pos_adv ]; ++CURTASK exps[ CURTASK expsc ].pos_adv; /* advance to next character */ ++s_pos; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; break; default: /* anything else, terminate */ build_loop = FALSE; break; } } /* now scan the string to determine the number */ sscanf( CURTASK exps[ CURTASK expsc ].string, "%x", &i ); CURTASK exps[ CURTASK expsc ].nval = (bnumber) i; break; } /* note that the operation at this level is now a determined NUMBER */ CURTASK exps[ CURTASK expsc ].operation = NUMBER; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_numconst(): exit level <%d> precision <%c> value <%lf>", CURTASK expsc, CURTASK exps[ CURTASK expsc ].type, exp_getnval( &( CURTASK exps[ CURTASK expsc ] ) ) ); bwb_debug( bwb_ebuf ); #endif #if CHECK_RECURSION in_use = FALSE; #endif return TRUE; } /*************************************************************** FUNCTION: exp_function() DESCRIPTION: This function interprets a function, calling bwb_exp() (recursively) to resolve any arguments to the function. ***************************************************************/ #if ANSI_C int exp_function( char *expression ) #else int exp_function( expression ) char *expression; #endif { struct exp_ese *e; int s_pos; /* position in build buffer */ int loop; int paren_level; int n_args; struct bwb_variable *v; /* struct bwb_variable argv[ MAX_FARGS ]; */ /* Removed by JBV */ struct bwb_variable *argv; /* Added by JBV */ bstring *b; register int i, j; /* JBV */ #if INTENSIVE_DEBUG char tbuf[ MAXSTRINGSIZE + 1 ]; sprintf( bwb_ebuf, "in exp_function(): entered function, expression <%s>", expression ); bwb_debug( bwb_ebuf ); #endif /*-----------------------------------------------------------*/ /* Added by JBV */ /* Required because adding a simple "static" modifier in the */ /* argv declaration doesn't work for recursive calls! */ /*-----------------------------------------------------------*/ if ( ( argv = (struct bwb_variable *) CALLOC( MAX_FARGS, sizeof( struct bwb_variable ), "exp_function" )) == NULL ) { bwb_error( err_getmem ); return NULL; } /* assign pointers to argument stack */ /* get the function name */ exp_getvfname( expression, CURTASK exps[ CURTASK expsc ].string ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_function(): name is <%s>.", CURTASK exps[ CURTASK expsc ].string ); bwb_debug( bwb_ebuf ); #endif /* now find the function itself */ CURTASK exps[ CURTASK expsc ].function = fnc_find( CURTASK exps[ CURTASK expsc ].string ); /* check to see if it is valid */ if ( CURTASK exps[ CURTASK expsc ].function == NULL ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Failed to find function <%s>.", CURTASK exps[ CURTASK expsc ].string ); bwb_error( bwb_ebuf ); #else bwb_error( err_uf ); #endif return OP_ERROR; } /* note that this level is a function */ CURTASK exps[ CURTASK expsc ].operation = FUNCTION; CURTASK exps[ CURTASK expsc ].pos_adv = strlen( CURTASK exps[ CURTASK expsc ].string ); /* check for begin parenthesis */ loop = TRUE; while( loop == TRUE ) { switch( expression[ CURTASK exps[ CURTASK expsc ].pos_adv ] ) { case ' ': /* whitespace */ case '\t': ++CURTASK exps[ CURTASK expsc ].pos_adv; /* advance */ break; case '(': /* begin paren */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_function(): found begin parenthesis." ); bwb_debug( bwb_ebuf ); #endif ++CURTASK exps[ CURTASK expsc ].pos_adv; /* advance beyond it */ paren_level = 1; /* set paren_level */ loop = FALSE; /* and break out */ break; default: /* anything else */ loop = FALSE; paren_level = 0; /* do not look for arguments */ break; } } /* find arguments within parentheses */ /* for each argument, find a string ending with ',' or with end parenthesis */ n_args = 0; s_pos = 0; CURTASK exps[ CURTASK expsc ].string[ 0 ] = '\0'; while( paren_level > 0 ) { /* check the current character */ switch( expression[ CURTASK exps[ CURTASK expsc ].pos_adv ] ) { case ',': /* end of an argument */ if ( paren_level == 1 ) /* ignore ',' within parentheses */ { /* call bwb_exp() recursively to resolve the argument */ if ( exp_validarg( CURTASK exps[ CURTASK expsc ].string ) == TRUE ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_function(): valid argument (not last)." ); bwb_debug( bwb_ebuf ); #endif CURTASK exps[ CURTASK expsc ].rec_pos = 0; e = bwb_exp( CURTASK exps[ CURTASK expsc ].string, FALSE, &( CURTASK exps[ CURTASK expsc ].rec_pos ) ); /* assign operation and value at this level */ var_make( &( argv[ n_args ] ), e->type ); switch( argv[ n_args ].type ) { case NUMBER: * var_findnval( &( argv[ n_args ] ), argv[ n_args ].array_pos ) = exp_getnval( e ); break; case STRING: str_btob( var_findsval( &( argv[ n_args ] ), argv[ n_args ].array_pos ), exp_getsval( e ) ); break; } ++n_args; /* increment number of arguments */ } s_pos = 0; /* reset counter */ CURTASK exps[ CURTASK expsc ].string[ 0 ] = '\0'; } else { CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ CURTASK exps[ CURTASK expsc ].pos_adv ]; ++s_pos; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; } break; case '(': ++paren_level; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ CURTASK exps[ CURTASK expsc ].pos_adv ]; ++s_pos; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; break; case ')': --paren_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_function(): hit close parenthesis." ); bwb_debug( bwb_ebuf ); #endif if ( paren_level == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_function(): paren level 0." ); bwb_debug( bwb_ebuf ); #endif /* call bwb_exp() recursively to resolve the argument */ if ( exp_validarg( CURTASK exps[ CURTASK expsc ].string ) == TRUE ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_function(): valid argument (last)." ); bwb_debug( bwb_ebuf ); #endif CURTASK exps[ CURTASK expsc ].rec_pos = 0; e = bwb_exp( CURTASK exps[ CURTASK expsc ].string, FALSE, &( CURTASK exps[ CURTASK expsc ].rec_pos ) ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_function(): return from bwb_exp(), last arg, type <%c> op <%d>", e->type, e->operation ); bwb_debug( bwb_ebuf ); #endif /* assign operation and value at this level */ var_make( &( argv[ n_args ] ), e->type ); switch( argv[ n_args ].type ) { case NUMBER: * var_findnval( &( argv[ n_args ] ), argv[ n_args ].array_pos ) = exp_getnval( e ); break; case STRING: str_btob( var_findsval( &( argv[ n_args ] ), argv[ n_args ].array_pos ), exp_getsval( e ) ); break; } ++n_args; /* increment number of arguments */ } s_pos = 0; /* reset counter */ CURTASK exps[ CURTASK expsc ].string[ 0 ] = '\0'; } else { CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ CURTASK exps[ CURTASK expsc ].pos_adv ]; ++s_pos; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; } break; case '\"': /* embedded string constant */ /* add the initial quotation mark */ CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ CURTASK exps[ CURTASK expsc ].pos_adv ]; ++s_pos; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; ++CURTASK exps[ CURTASK expsc ].pos_adv; /* add intervening characters */ while ( ( expression[ CURTASK exps[ CURTASK expsc ].pos_adv ] != '\"' ) && ( expression[ CURTASK exps[ CURTASK expsc ].pos_adv ] != '\0' ) ) { CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ CURTASK exps[ CURTASK expsc ].pos_adv ]; ++s_pos; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; ++CURTASK exps[ CURTASK expsc ].pos_adv; } /* add the concluding quotation mark */ CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ CURTASK exps[ CURTASK expsc ].pos_adv ]; ++s_pos; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; /* the following bracketed out 14 July 1992; since this counter */ /* incremented at the end of the switch statement, this may */ /* increment it past the next character needed */ /* ++CURTASK exps[ CURTASK expsc ].pos_adv; */ break; default: CURTASK exps[ CURTASK expsc ].string[ s_pos ] = expression[ CURTASK exps[ CURTASK expsc ].pos_adv ]; ++s_pos; CURTASK exps[ CURTASK expsc ].string[ s_pos ] = '\0'; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_function(): new char <%d>=<%c>", expression[ CURTASK exps[ CURTASK expsc ].pos_adv ], expression[ CURTASK exps[ CURTASK expsc ].pos_adv ] ); bwb_debug( bwb_ebuf ); sprintf( bwb_ebuf, "in exp_function(): building <%s>.", CURTASK exps[ CURTASK expsc ].string ); bwb_debug( bwb_ebuf ); #endif break; } /* advance the counter */ ++CURTASK exps[ CURTASK expsc ].pos_adv; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_function(): ready to call function vector" ); bwb_debug( bwb_ebuf ); #endif /* call the function vector */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_function(): calling preset function" ); bwb_debug( bwb_ebuf ); #endif v = CURTASK exps[ CURTASK expsc ].function->vector ( n_args, &( argv[ 0 ] ), CURTASK exps[ CURTASK expsc ].function->id ); /*-------------------------------------------------*/ /* Now free the argv memory */ /* (some other less fortunate routine may need it) */ /* JBV, 10/95 */ /*-------------------------------------------------*/ /* First kleanup the joint (JBV) */ for ( i = 0; i < n_args; ++i ) { if ( argv[ i ].memnum != NULL ) { /* Revised to FREE pass-thru call by JBV */ FREE(argv[ i ].memnum, "exp_function"); argv[ i ].memnum = NULL; } if ( argv[ i ].memstr != NULL ) { /* Remember to deallocate those far-flung branches! (JBV) */ for ( j = 0; j < (int) argv[ i ].array_units; ++j ) { if ( argv[ i ].memstr[ j ].sbuffer != NULL ) { /* Revised to FREE pass-thru call by JBV */ FREE( argv[ i ].memstr[ j ].sbuffer, "exp_function" ); argv[ i ].memstr[ j ].sbuffer = NULL; } argv[ i ].memstr[ j ].rab = FALSE; argv[ i ].memstr[ j ].length = 0; } /* Revised to FREE pass-thru call by JBV */ FREE( argv[ i ].memstr, "exp_function" ); argv[ i ].memstr = NULL; } /* Revised to FREE pass-thru calls by JBV */ if (argv[ i ].array_sizes != NULL) { FREE( argv[ i ].array_sizes, "exp_function" ); argv[ i ].array_sizes = NULL; /* JBV */ } if (argv[ i ].array_pos != NULL) { FREE( argv[ i ].array_pos, "exp_function" ); argv[ i ].array_pos = NULL; /* JBV */ } } FREE( argv, "exp_function" ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_function(): return from function vector, type <%c>", v->type ); bwb_debug( bwb_ebuf ); #endif /* assign the value at this level */ CURTASK exps[ CURTASK expsc ].type = (char) v->type; switch( v->type ) { case STRING: CURTASK exps[ CURTASK expsc ].operation = CONST_STRING; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_function(): ready to assign STRING" ); bwb_debug( bwb_ebuf ); #endif b = var_findsval( v, v->array_pos ); str_btob( exp_getsval( &( CURTASK exps[ CURTASK expsc ] )), b ); #if INTENSIVE_DEBUG str_btoc( tbuf, b ); sprintf( bwb_ebuf, "in exp_function(): string assigned <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif break; default: CURTASK exps[ CURTASK expsc ].operation = NUMBER; CURTASK exps[ CURTASK expsc ].nval = var_getnval( v ); break; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_function(): end of function" ); bwb_debug( bwb_ebuf ); #endif /* return */ return TRUE; } /*************************************************************** FUNCTION: exp_variable() DESCRIPTION: This function interprets a variable. ***************************************************************/ #if ANSI_C int exp_variable( char *expression ) #else int exp_variable( expression ) char *expression; #endif { int pos; int *pp; int n_params; register int n; struct bwb_variable *v; bstring *b; int p; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_variable(): entered function." ); bwb_debug( bwb_ebuf ); #endif /* get the variable name */ exp_getvfname( expression, CURTASK exps[ CURTASK expsc ].string ); /* now find the variable itself */ v = CURTASK exps[ CURTASK expsc ].xvar = var_find( CURTASK exps[ CURTASK expsc ].string ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_variable(): level <%d>, found variable name <%s>", CURTASK expsc, CURTASK exps[ CURTASK expsc ].xvar->name ); bwb_debug( bwb_ebuf ); #endif /* note that this level is a variable */ CURTASK exps[ CURTASK expsc ].operation = VARIABLE; /* read subscripts */ pos = strlen( CURTASK exps[ CURTASK expsc ].string ); if ( ( v->dimensions == 1 ) && ( v->array_sizes[ 0 ] == 1 )) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_variable(): variable <%s> has 1 dimension", CURTASK exps[ CURTASK expsc ].xvar->name ); bwb_debug( bwb_ebuf ); #endif pos = strlen( v->name ); n_params = 1; pp = &p; pp[ 0 ] = dim_base; } else { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_variable(): variable <%s> has > 1 dimensions", CURTASK exps[ CURTASK expsc ].xvar->name ); bwb_debug( bwb_ebuf ); #endif dim_getparams( expression, &pos, &n_params, &pp ); } CURTASK exps[ CURTASK expsc ].pos_adv = pos; for ( n = 0; n < v->dimensions; ++n ) { CURTASK exps[ CURTASK expsc ].array_pos[ n ] = v->array_pos[ n ] = pp[ n ]; } #if INTENSIVE_DEBUG for ( n = 0; n < v->dimensions; ++ n ) { sprintf( bwb_ebuf, "in exp_variable(): var <%s> array_pos element <%d> is <%d>.", v->name, n, v->array_pos[ n ] ); bwb_debug( bwb_ebuf ); } #endif /* assign the type and value at this level */ CURTASK exps[ CURTASK expsc ].type = (char) v->type; switch( v->type ) { case STRING: b = var_findsval( v, v->array_pos ); #if TEST_BSTRING sprintf( bwb_ebuf, "in exp_variable(): b string name is <%s>", b->name ); bwb_debug( bwb_ebuf ); #endif #if OLDWAY CURTASK exps[ CURTASK expsc ].sval.length = b->length; CURTASK exps[ CURTASK expsc ].sval.sbuffer = b->sbuffer; #endif str_btob( &( CURTASK exps[ CURTASK expsc ].sval ), b ); break; default: CURTASK exps[ CURTASK expsc ].nval = var_getnval( v ); break; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_variable(): exit, name <%s>, level <%d>, op <%d>", v->name, CURTASK expsc, CURTASK exps[ CURTASK expsc ].operation ); bwb_debug( bwb_ebuf ); #endif /* return */ return TRUE; } bwbasic-2.20pl2.orig/bwb_exp.c100644 0 0 110260 6055714562 14347 0ustar rootroot/**************************************************************** bwb_exp.c Expression Parser 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). */ /*---------------------------------------------------------------*/ #include #include #include #include "bwbasic.h" #include "bwb_mes.h" /*************************************************************** FUNCTION: bwb_exp() DESCRIPTION: This is the function by which the expression parser is called. ***************************************************************/ #if ANSI_C struct exp_ese * bwb_exp( char *expression, int assignment, int *position ) #else struct exp_ese * bwb_exp( expression, assignment, position ) char *expression; int assignment; int *position; #endif { struct exp_ese *rval; /* return value */ int entry_level, main_loop, err_condition; char *e; /* pointer to current string */ int r; /* return value from functions */ register int c; /* quick counter */ #if OLD_WAY int adv_loop; #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "entered bwb_exp(): expression <%s> assignment <%d> level <%d>", & ( expression[ *position ] ), assignment, CURTASK expsc ); bwb_debug( bwb_ebuf ); #endif /* save the entry level of the expression stack in order to check it at the end of this function */ entry_level = CURTASK expsc; err_condition = FALSE; /* advance past whitespace or beginning of line segment */ #if MULTISEG_LINES if ( expression[ *position ] == ':' ) { ++( *position ); } #endif adv_ws( expression, position ); #if MULTISEG_LINES if ( expression[ *position ] == ':' ) { ++( *position ); adv_ws( expression, position ); } #endif /* increment the expression stack counter to get a new level */ inc_esc(); /* check to be sure there is a legitimate expression and set initial parameters for the main loop */ if ( is_eol( expression, position ) == TRUE ) { main_loop = FALSE; /* break out of loop */ } else { main_loop = TRUE; CURTASK exps[ CURTASK expsc ].pos_adv = 0; } #if OLDWAY adv_loop = TRUE; while( adv_loop == TRUE ) { switch( expression[ *position ] ) { case ' ': /* whitespace */ case '\t': ++(*position); break; case '\0': /* end of string */ case '\r': case '\n': main_loop = adv_loop = FALSE; /* break out of loop */ break; default: adv_loop = FALSE; main_loop = TRUE; CURTASK exps[ CURTASK expsc ].pos_adv = 0; break; } } #endif /* main parsing loop */ while ( main_loop == TRUE ) { /* set variable to the start of the expression */ e = &( expression[ *position ] ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exp(): main loop, level <%d> element <%s> ", CURTASK expsc, e ); bwb_debug( bwb_ebuf ); #endif /* detect the operation required at this level */ CURTASK exps[ CURTASK expsc ].operation = exp_findop( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exp(): exp_findop() returned <%d>", CURTASK exps[ CURTASK expsc ].operation ); bwb_debug( bwb_ebuf ); #endif /* perform actions specific to the operation */ switch( CURTASK exps[ CURTASK expsc ].operation ) { case OP_ERROR: main_loop = FALSE; err_condition = TRUE; break; case OP_TERMINATE: /* terminate at THEN, ELSE, TO */ #if INTENSIVE_DEBUG bwb_debug( "in bwb_exp(): Found OP_TERMINATE" ); #endif case OP_STRJOIN: /* string join or tab */ case OP_STRTAB: main_loop = FALSE; err_condition = FALSE; dec_esc(); break; case OP_ADD: /* in the case of any numerical operation, */ case OP_SUBTRACT: case OP_MULTIPLY: case OP_DIVIDE: case OP_MODULUS: case OP_EXPONENT: case OP_INTDIVISION: case OP_GREATERTHAN: case OP_LESSTHAN: case OP_GTEQ: case OP_LTEQ: case OP_NOTEQUAL: case OP_NOT: case OP_AND: case OP_OR: case OP_XOR: case OP_IMPLIES: case OP_EQUIV: case OP_NEGATION: /* JBV */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exp(): operator detected." ); bwb_debug( bwb_ebuf ); #endif CURTASK exps[ CURTASK expsc ].pos_adv = -1; /* set to strange number */ /* cycle through operator table to find match */ for ( c = 0; c < N_OPERATORS; ++c ) { if ( exp_ops[ c ].operation == CURTASK exps[ CURTASK expsc ].operation ) { CURTASK exps[ CURTASK expsc ].pos_adv = strlen( exp_ops[ c ].symbol ); } } if ( CURTASK exps[ CURTASK expsc ].pos_adv == -1 ) /* was a match found? */ { CURTASK exps[ CURTASK expsc ].pos_adv = 0; /* no -- set to 0 */ } break; /* and move on */ case OP_EQUALS: #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exp(): equal sign detected." ); bwb_debug( bwb_ebuf ); #endif if ( assignment == TRUE ) { CURTASK exps[ CURTASK expsc ].operation = OP_ASSIGN; } CURTASK exps[ CURTASK expsc ].pos_adv = 1; break; case PARENTHESIS: r = exp_paren( e ); break; case CONST_STRING: r = exp_strconst( e ); break; case CONST_NUMERICAL: r = exp_numconst( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exp(): return from exp_numconst(), r = <%d>", r ); bwb_debug( bwb_ebuf ); #endif break; case FUNCTION: #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exp(): calling exp_function(), expression <%s>", e ); bwb_debug( bwb_ebuf ); #endif r = exp_function( e ); break; case OP_USERFNC: #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exp(): calling exp_ufnc(), expression <%s>", e ); bwb_debug( bwb_ebuf ); #endif r = exp_ufnc( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exp(): return from exp_ufnc(), buffer <%s>", &( expression[ *position ] ) ); bwb_debug( bwb_ebuf ); #endif break; case VARIABLE: r = exp_variable( e ); break; default: err_condition = TRUE; main_loop = FALSE; #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_exp.c:bwb_exp(): unidentified operation (%d).", CURTASK exps[ CURTASK expsc ].operation ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif break; } /* increment *position counter based on previous actions */ *position += CURTASK exps[ CURTASK expsc ].pos_adv; CURTASK exps[ CURTASK expsc ].pos_adv = 0; /* reset advance counter */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exp(): advanced position; r <%d> err_c <%d>", r, err_condition ); bwb_debug( bwb_ebuf ); #endif #if INTENSIVE_DEBUG if ( CURTASK exps[ CURTASK expsc ].operation == OP_EQUALS ) { sprintf( bwb_ebuf, "in bwb_exp(): with OP_EQUALS: finished case" ); bwb_debug( bwb_ebuf ); } #endif /* check for end of string */ if ( is_eol( expression, position ) == TRUE ) { main_loop = FALSE; /* break out of loop */ } #if OLDWAY adv_loop = TRUE; while( adv_loop == TRUE ) { switch( expression[ *position ] ) { case ' ': /* whitespace */ case '\t': ++(*position); break; case '\0': /* end of string */ case '\r': case '\n': case ':': main_loop = adv_loop = FALSE; /* break out of loop */ break; default: adv_loop = FALSE; break; } } #endif /* get a new stack level before looping */ if ( main_loop == TRUE ) { r = inc_esc(); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exp(): increment esc, r <%d>, err_c <%d>", r, err_condition ); bwb_debug( bwb_ebuf ); #endif } /* check for error return */ if ( r == OP_ERROR ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exp(): found r == OP_ERROR." ); bwb_debug( bwb_ebuf ); #endif main_loop = FALSE; err_condition = TRUE; } else { r = TRUE; } } /* end of main parsing loop */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exp(): breakout from main parsing loop, r <%d> err_c <%d>", r, err_condition ); bwb_debug( bwb_ebuf ); #endif /* check error condition */ if ( err_condition == TRUE ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "error detected in expression parser" ); bwb_debug( bwb_ebuf ); #endif /* decrement the expression stack counter until it matches entry_level */ while( CURTASK expsc > entry_level ) { dec_esc(); } #if PROG_ERRORS bwb_error( "in bwb_exp(): Error detected in parsing expression" ); #else bwb_error( err_syntax ); #endif } /* no error; normal exit from function */ else { /* are any more operations needed? if we are still at entry level, then they are not */ /* try operations */ exp_operation( entry_level ); /* see what is on top of the stack */ if ( CURTASK expsc > ( entry_level + 1 )) { switch( CURTASK exps[ CURTASK expsc ].operation ) { case OP_STRJOIN: if ( CURTASK expsc != ( entry_level + 2 )) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_exp(): OP_STRJOIN in wrong position." ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif } break; default: #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_exp(): incomplete expression." ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif break; } /* decrement the expression stack counter */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exp(): before dec_esc type is <%c>", CURTASK exps[ CURTASK expsc ].type ); bwb_debug( bwb_ebuf ); #endif dec_esc(); } /* assign rvar to the variable for the current level */ rval = &( CURTASK exps[ CURTASK expsc ] ); /* decrement the expression stack counter */ dec_esc(); /* check the current level before exit */ if ( entry_level != CURTASK expsc ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_exp(): exit stack level (%d) does not match entry stack level (%d)", CURTASK expsc, entry_level ); bwb_error( bwb_ebuf ); #else bwb_error( err_overflow ); #endif } } /* return a pointer to the last stack level */ return rval; } /*************************************************************** FUNCTION: exp_findop() DESCRIPTION: This function reads the expression to find what operation is required at its stack level. ***************************************************************/ #if ANSI_C int exp_findop( char *expression ) #else int exp_findop( expression ) char *expression; #endif { register int c; /* character counter */ int carry_on; /* boolean: control while loop */ int rval; /* return value */ char cbuf[ MAXSTRINGSIZE + 1 ]; /* capitalized expression */ char nbuf[ MAXSTRINGSIZE + 1 ]; /* non-capitalized expression */ int position; /* position in the expression */ int adv_loop; /* control loop to build expression */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_findop(): received <%s>", expression ); bwb_debug( bwb_ebuf ); #endif /* set return value to OP_NULL initially */ rval = OP_NULL; /* assign local pointer to expression to begin reading */ position = 0; /* advance to the first significant character */ adv_ws( expression, &position ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_findop(): expression after advance <%s>", &( expression[ position ] ) ); bwb_debug( bwb_ebuf ); #endif /* we now have the first significant character and can begin parsing */ /* check the first character for an indication of a parenthetical expression, a string constant, or a numerical constant that begins with a digit (numerical constants beginning with a plus or minus sign or hex/octal/binary constants will have to be detected by exp_isnc() */ carry_on = TRUE; switch ( expression[ position ] ) { case '\"': /* this should indicate a string constant */ rval = CONST_STRING; break; case '(': /* this will indicate a simple parenthetical expression */ rval = PARENTHESIS; break; #if MULTISEG_LINES case ':': /* terminate processing */ #endif case ')': /* end of argument list? */ rval = OP_TERMINATE; break; case '0': /* these will indicate a numerical constant */ case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case '.': case '&': /* designator for hex or octal constant */ rval = CONST_NUMERICAL; break; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_findop(): rval pos 1 is <%d>", rval ); bwb_debug( bwb_ebuf ); #endif /* String constants, numerical constants, open parentheses, and the plus and minus operators have been checked at this point; but if the return value is still OP_NULL, other possibilities must be checked, namely, other operators, function names, and variable names. The function adv_element cannot be used here because it will stop, e.g., with certain operators and not include them in the returned element. */ /* get a character string to be interpreted */ adv_loop = TRUE; cbuf[ 0 ] = '\0'; nbuf[ 0 ] = '\0'; c = 0; while ( adv_loop == TRUE ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_findop() loop position <%d> char 0x%x", c, expression[ position ] ); bwb_debug( bwb_ebuf ); #endif switch( expression[ position ] ) { case ' ': /* whitespace */ case '\t': case '\r': /* end of line */ case '\n': case '\0': /* end of string */ case '(': /* parenthesis terminating function name */ adv_loop = FALSE; break; default: nbuf[ c ] = cbuf[ c ] = expression[ position ]; ++c; nbuf[ c ] = cbuf[ c ] = '\0'; ++position; break; } if ( c >= MAXSTRINGSIZE ) { adv_loop = FALSE; } } bwb_strtoupper( cbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_findop(): cbuf element is <%s>", cbuf ); bwb_debug( bwb_ebuf ); #endif /* check for numerical constant */ if ( rval == OP_NULL ) { rval = exp_isnc( cbuf ); } /* check for other operators */ if ( rval == OP_NULL ) { rval = exp_isop( cbuf ); } /* check for user-defined function */ if ( rval == OP_NULL ) { rval = exp_isufn( nbuf ); } /* check for function name */ if ( rval == OP_NULL ) { rval = exp_isfn( nbuf ); } /* check for a BASIC command, esp. to catch THEN or ELSE */ if ( rval == OP_NULL ) { rval = exp_iscmd( cbuf ); } /* last: check for variable name, and assign it if there is not already one */ if ( rval == OP_NULL ) { rval = exp_isvn( nbuf ); } /* return the value assigned (or OP_ERROR if none assigned) */ if ( rval == OP_NULL ) { return OP_ERROR; } else { return rval; } } /*************************************************************** FUNCTION: exp_isnc() DESCRIPTION: This function reads the expression to find if a numerical constant is present at this point. ***************************************************************/ #if ANSI_C int exp_isnc( char *expression ) #else int exp_isnc( expression ) char *expression; #endif { char tbuf[ MAXVARNAMESIZE + 1 ]; /* JBV */ switch( expression[ 0 ] ) { case '0': /* these will indicate a numerical constant */ case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case '&': /* indicator for hex or octal constant */ return CONST_NUMERICAL; case '+': case '-': /* if the previous stack level was a numerical value or a string, then this is certainly not one; return OP_NULL here and let the next function call to exp_isop() determine the (plus or minus) operator */ if ( ( CURTASK exps[ CURTASK expsc - 1 ].operation == NUMBER ) || ( CURTASK exps[ CURTASK expsc - 1 ].operation == VARIABLE ) || ( CURTASK exps[ CURTASK expsc - 1 ].operation == CONST_STRING ) ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_isnc(): previous function is a number or string" ); bwb_debug( bwb_ebuf ); #endif return OP_NULL; } /* similarly, if the previous stack level was a variable with a numerical value (not a string), then this level must be an operator, not a numerical constant */ if ( ( CURTASK exps[ CURTASK expsc - 1 ].operation == VARIABLE ) && ( CURTASK exps[ CURTASK expsc - 1 ].type != STRING )) { return OP_NULL; } /*--------------------------------------------------------*/ /* Check for unary minus sign added by JBV. */ /* Could be prefixing a parenthetical expression or a */ /* variable name. */ /* But parentheses won't show up in expression (cbuf), so */ /* just check for expression and variable name lengths. */ /*--------------------------------------------------------*/ if (expression[0] == '-') { if (strlen(expression) == 1) return OP_NEGATION; exp_getvfname(&expression[1], tbuf); if (strlen(tbuf) != 0) return OP_NEGATION; } /* failing these tests, the argument must be a numerical constant preceded by a plus or minus sign */ return CONST_NUMERICAL; default: return OP_NULL; } } /*************************************************************** FUNCTION: exp_isop() DESCRIPTION: This function reads the expression to find if a logical or mathematical operation is required at this point. This function presupposes that a numerical constant with affixed plus or minus sign has been ruled out. ***************************************************************/ #if ANSI_C int exp_isop( char *expression ) #else int exp_isop( expression ) char *expression; #endif { register int c; /* counter */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_isop(): expression is <%s>", expression ); bwb_debug( bwb_ebuf ); #endif /* compare the initial characters of the string with the table of operators */ for ( c = 0; c < N_OPERATORS; ++c ) { if ( strncmp( expression, exp_ops[ c ].symbol, (size_t) strlen( exp_ops[ c ].symbol ) ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_isop(): match <%s>, number <%d>.", exp_ops[ c ].symbol, c ); bwb_debug( bwb_ebuf ); #endif return exp_ops[ c ].operation; } } /* search failed; return OP_NULL */ return OP_NULL; } /*************************************************************** FUNCTION: exp_iscmd() DESCRIPTION: This function reads the expression to find if a BASIC command name is present; if so, it returns OP_TERMINATE to terminate expression parsing. This is critical, for example, in parsing a conditional following IF where THEN, ELSE, and other BASIC commands may follow. ***************************************************************/ #if ANSI_C int exp_iscmd( char *expression ) #else int exp_iscmd( expression ) char *expression; #endif { register int n; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_iscmd(): expression received <%s>", expression ); bwb_debug( bwb_ebuf ); #endif /* first check for THEN or ELSE statements */ if ( strcmp( expression, CMD_THEN ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_iscmd(): match found, <%s>", expression ); bwb_debug( bwb_ebuf ); #endif return OP_TERMINATE; } #if STRUCT_CMDS if ( strcmp( expression, CMD_TO ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_iscmd(): match found, <%s>", expression ); bwb_debug( bwb_ebuf ); #endif return OP_TERMINATE; } #endif if ( strcmp( expression, CMD_ELSE ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_iscmd(): match found, <%s>", expression ); bwb_debug( bwb_ebuf ); #endif return OP_TERMINATE; } /* run through the command table and search for a match */ for ( n = 0; n < COMMANDS; ++n ) { if ( strcmp( expression, bwb_cmdtable[ n ].name ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_iscmd(): match found, <%s>", expression ); bwb_debug( bwb_ebuf ); #endif return OP_TERMINATE; } #if INTENSIVE_DEBUG else { sprintf( bwb_ebuf, "in exp_iscmd(): No match, <%s> and <%s>; returns %d", expression, bwb_cmdtable[ n ].name, strcmp( expression, bwb_cmdtable[ n ].name ) ); bwb_debug( bwb_ebuf ); } #endif } /* search failed, return NULL */ return OP_NULL; } /*************************************************************** FUNCTION: exp_isufn() DESCRIPTION: This function reads the expression to find if a user-defined function name is present at this point. ***************************************************************/ #if ANSI_C int exp_isufn( char *expression ) #else int exp_isufn( expression ) char *expression; #endif { struct fslte *f; char tbuf[ MAXVARNAMESIZE + 1 ]; exp_getvfname( expression, tbuf ); for ( f = CURTASK fslt_start.next; f != &CURTASK fslt_end; f = f->next ) { if ( strcmp( f->name, tbuf ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_isufn(): found user function <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif /* a user function name was found: but is it the local variable name for the user function? If so, return OP_NULL and the name will be read as a variable */ if ( var_islocal( tbuf ) != NULL ) { return OP_NULL; } else { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_isufn(): found function <%s> not a local variable, EXEC level <%d>", tbuf, CURTASK exsc ); bwb_debug( bwb_ebuf ); getchar(); #endif return OP_USERFNC; } } } return OP_NULL; } /*************************************************************** FUNCTION: exp_isfn() DESCRIPTION: This function reads the expression to find if a function name is present at this point. ***************************************************************/ #if ANSI_C int exp_isfn( char *expression ) #else int exp_isfn( expression ) char *expression; #endif { /* Block out the call to exp_getvfname() if exp_isvn() is called after exp_isfn() */ exp_getvfname( expression, CURTASK exps[ CURTASK expsc ].string ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_isfn(): search for function <%s>", expression ); bwb_debug( bwb_ebuf ); #endif if ( fnc_find( CURTASK exps[ CURTASK expsc ].string ) == NULL ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_isfn(): failed to find function <%s>", expression ); bwb_debug( bwb_ebuf ); #endif return OP_NULL; } else { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_isfn(): found function <%s>", expression ); bwb_debug( bwb_ebuf ); #endif return FUNCTION; } } /*************************************************************** FUNCTION: exp_isvn() DESCRIPTION: This function reads the expression to find if a variable name at this point. ***************************************************************/ #if ANSI_C int exp_isvn( char *expression ) #else int exp_isvn( expression ) char *expression; #endif { /* Block out the call to exp_getvfname() if exp_isfn() is called after exp_isvn() */ /* exp_getvfname( expression, CURTASK exps[ CURTASK expsc ].string ); */ /* rule out null name */ if ( strlen( CURTASK exps[ CURTASK expsc ].string ) == 0 ) { return OP_NULL; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_isvn(): search for variable <%s>", CURTASK exps[ CURTASK expsc ].string ); bwb_debug( bwb_ebuf ); #endif if ( var_find( CURTASK exps[ CURTASK expsc ].string ) == NULL ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_isvn(): failed to find variable <%s>", expression ); bwb_debug( bwb_ebuf ); #endif return OP_NULL; } else { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_isvn(): found variable <%s>", CURTASK exps[ CURTASK expsc ].string ); bwb_debug( bwb_ebuf ); #endif return VARIABLE; } } /*************************************************************** FUNCTION: exp_getvfname() DESCRIPTION: This function reads the expression to find a variable or function name at this point. ***************************************************************/ #if ANSI_C int exp_getvfname( char *source, char *destination ) #else int exp_getvfname( source, destination ) char *source; char *destination; #endif { int s_pos, d_pos; /* source, destination positions */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_getvfname(): source buffer <%s>", source ); bwb_debug( bwb_ebuf ); #endif s_pos = d_pos = 0; destination[ 0 ] = '\0'; while( source[ s_pos ] != '\0' ) { /* all alphabetical characters are acceptable */ if ( isalpha( source[ s_pos ] ) != 0 ) { destination[ d_pos ] = source[ s_pos ]; ++d_pos; ++s_pos; destination[ d_pos ] = '\0'; } /* numerical characters are acceptable but not in the first position */ else if (( isdigit( source[ s_pos ] ) != 0 ) && ( d_pos != 0 )) { destination[ d_pos ] = source[ s_pos ]; ++d_pos; ++s_pos; destination[ d_pos ] = '\0'; } /* other characters will have to be tried on their own merits */ else { switch( source[ s_pos ] ) { case '.': /* tolerated non-alphabetical characters */ case '_': destination[ d_pos ] = source[ s_pos ]; ++d_pos; ++s_pos; destination[ d_pos ] = '\0'; break; case STRING: /* terminating characters */ case '#': /* Microsoft-type double precision */ case '!': /* Microsoft-type single precision */ destination[ d_pos ] = source[ s_pos ]; ++d_pos; ++s_pos; destination[ d_pos ] = '\0'; return TRUE; case '(': /* begin function/sub name */ return TRUE; default: /* anything else is non-tolerated */ return FALSE; } } } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_getvfname(): found name <%s>", destination ); bwb_debug( bwb_ebuf ); #endif return TRUE; /* exit after coming to the end */ } /*************************************************************** FUNCTION: exp_validarg() DESCRIPTION: This function reads the expression to determine whether it is a valid argument (to be read recursively by bwb_exp() and passed to a function. ***************************************************************/ #if ANSI_C int exp_validarg( char *expression ) #else int exp_validarg( expression ) char *expression; #endif { register int c; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_validarg(): expression <%s>.", expression ); bwb_debug( bwb_ebuf ); #endif c = 0; while ( TRUE ) { switch( expression[ c ] ) { case ' ': case '\t': ++c; break; case '\0': return FALSE; default: return TRUE; } } } /*************************************************************** FUNCTION: exp_getnval() DESCRIPTION: This function returns the numerical value contain in the expression-stack element pointed to by 'e'. ***************************************************************/ #if ANSI_C bnumber exp_getnval( struct exp_ese *e ) #else bnumber exp_getnval( e ) struct exp_ese *e; #endif { /* check for variable */ if ( e->operation == VARIABLE ) { switch( e->type ) { case NUMBER: return (* var_findnval( e->xvar, e->array_pos )); default: bwb_error( err_mismatch ); return (bnumber) 0.0; } } /* must be a numerical value */ if ( e->operation != NUMBER ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in exp_getnval(): operation <%d> is not a number", e->operation ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return (bnumber) 0.0; } /* return specific values */ switch( e->type ) { case NUMBER: return e->nval; default: #if PROG_ERRORS sprintf( bwb_ebuf, "in exp_getnval(): type is <%c>", e->type ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return (bnumber) 0.0; } } /*************************************************************** FUNCTION: exp_getsval() DESCRIPTION: This function returns a pointer to the BASIC string structure pointed to by expression-stack element 'e'. ***************************************************************/ #if ANSI_C bstring * exp_getsval( struct exp_ese *e ) #else bstring * exp_getsval( e ) struct exp_ese *e; #endif { static bstring b; #if TEST_BSTRING static int init = FALSE; if ( init == FALSE ) { sprintf( b.name, "" ); } #endif b.rab = FALSE; /* return based on operation type */ switch( e->operation ) { case CONST_STRING: case OP_STRJOIN: return &( e->sval ); case VARIABLE: switch( e->type ) { case STRING: return var_findsval( e->xvar, e->array_pos ); case NUMBER: sprintf( bwb_ebuf, "%lf ", (double) exp_getnval( e ) ); str_ctob( &b, bwb_ebuf ); return &b; default: #if PROG_ERRORS sprintf( bwb_ebuf, "in exp_getsval(): type <%c> inappropriate for NUMBER", e->type ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return NULL; } break; case NUMBER: switch( e->type ) { case NUMBER: sprintf( bwb_ebuf, "%lf ", (double) exp_getnval( e ) ); str_ctob( &b, bwb_ebuf ); return &b; default: #if PROG_ERRORS sprintf( bwb_ebuf, "in exp_getsval(): type <%c> inappropriate for NUMBER", e->type ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return NULL; } break; default: #if PROG_ERRORS sprintf( bwb_ebuf, "in exp_getsval(): operation <%d> inappropriate", e->operation ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return NULL; } /* this point may not be reached */ return NULL; } /*************************************************************** FUNCTION: inc_esc() DESCRIPTION: This function increments the expression stack counter. ***************************************************************/ #if ANSI_C int inc_esc( void ) #else int inc_esc() #endif { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in inc_esc(): prev level <%d>", CURTASK expsc ); bwb_debug ( bwb_ebuf ); #endif ++CURTASK expsc; if ( CURTASK expsc >= ESTACKSIZE ) { --CURTASK expsc; #if PROG_ERRORS sprintf( bwb_ebuf, "in inc_esc(): Maximum expression stack exceeded <%d>", CURTASK expsc ); bwb_error( bwb_ebuf ); #else bwb_error( err_overflow ); #endif return OP_NULL; } #if INTENSIVE_DEBUG sprintf( CURTASK exps[ CURTASK expsc ].string, "New Expression Stack Level %d", CURTASK expsc ); #endif CURTASK exps[ CURTASK expsc ].type = NUMBER; CURTASK exps[ CURTASK expsc ].operation = OP_NULL; CURTASK exps[ CURTASK expsc ].pos_adv = 0; return TRUE; } /*************************************************************** FUNCTION: dec_esc() DESCRIPTION: This function decrements the expression stack counter. ***************************************************************/ #if ANSI_C int dec_esc( void ) #else int dec_esc() #endif { --CURTASK expsc; if ( CURTASK expsc < 0 ) { CURTASK expsc = 0; #if PROG_ERRORS sprintf( bwb_ebuf, "in dec_esc(): Expression stack counter < 0." ); bwb_error( bwb_ebuf ); #else bwb_error( err_overflow ); #endif return OP_NULL; } return TRUE; } bwbasic-2.20pl2.orig/bwb_fnc.c100644 0 0 130543 6473161677 14336 0ustar rootroot/**************************************************************** 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). */ /*---------------------------------------------------------------*/ #define FSTACKSIZE 32 #include #include #include #include #include "bwbasic.h" #include "bwb_mes.h" #if UNIX_CMDS #include #endif #ifndef RAND_MAX /* added in v1.11 */ #define RAND_MAX 32767 #endif static time_t t; static struct tm *lt; /*************************************************************** FUNCTION: fnc_init() DESCRIPTION: This command initializes the function linked list, placing all predefined functions in the list. ***************************************************************/ #if ANSI_C int fnc_init( int task ) #else int fnc_init( task ) int task; #endif { register int n; struct bwb_function *f; strcpy( LOCALTASK fnc_start.name, "FNC_START" ); LOCALTASK fnc_start.type = 'X'; LOCALTASK fnc_start.vector = fnc_null; strcpy( LOCALTASK fnc_end.name, "FNC_END" ); LOCALTASK fnc_end.type = 'x'; LOCALTASK fnc_end.vector = fnc_null; LOCALTASK fnc_end.next = &LOCALTASK fnc_end; f = &LOCALTASK fnc_start; /* now go through each of the preestablished functions and set up links between them; from this point the program address the functions only as a linked list (not as an array) */ for ( n = 0; n < FUNCTIONS; ++n ) { f->next = &( bwb_prefuncs[ n ] ); f = f->next; } /* link the last pointer to the end; this completes the list */ f->next = &LOCALTASK fnc_end; return TRUE; } /*************************************************************** FUNCTION: fnc_find() DESCRIPTION: This C function attempts to locate a BASIC function with the specified name. If successful, it returns a pointer to the C structure for the BASIC function, if not successful, it returns NULL. ***************************************************************/ #if ANSI_C struct bwb_function * fnc_find( char *buffer ) #else struct bwb_function * fnc_find( buffer ) char *buffer; #endif { struct bwb_function * f; register int n; static char *tbuf; static int init = FALSE; if ( strlen( buffer ) == 0 ) { return NULL; } /* get memory for temporary buffer if necessary */ if ( init == FALSE ) { init = TRUE; /* Revised to CALLOC pass-thru call by JBV */ if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "fnc_find" )) == NULL ) { #if PROG_ERRORS bwb_error( "in fnc_find(): failed to find memory for tbuf" ); #else bwb_error( err_getmem ); #endif } } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_find(): called for <%s> ", buffer ); bwb_debug( bwb_ebuf ); #endif strcpy( tbuf, buffer ); bwb_strtoupper( tbuf ); for ( f = CURTASK fnc_start.next; f != &CURTASK fnc_end; f = f->next ) { if ( strcmp( f->name, tbuf ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_find(): found <%s> ", f->name ); bwb_debug( bwb_ebuf ); #endif return f; } } /* search has failed: return NULL */ return NULL; } /*************************************************************** FUNCTION: fnc_null() DESCRIPTION: This is a null function that can be used to fill in a required function-structure pointer when needed. ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_null( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_null( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } return &nvar; } /*************************************************************** FUNCTION: fnc_tab() DESCRIPTION: This C function implements the BASIC TAB() function, adding tab spaces to a specified column. TAB is a core function, i.e., required for ANSI Minimal BASIC. SYNTAX: TAB( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_tab( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_tab( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; static char t_string[ 4 ]; bstring *b; /* initialize nvar if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, (int) STRING ); } /* check for correct number of parameters */ if ( argc < 1 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Not enough parameters (%d) to function TAB().", argc ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif break_handler(); return NULL; } else if ( argc > 1 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Too many parameters (%d) to function TAB().", argc ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif break_handler(); return NULL; } t_string[ 0 ] = PRN_TAB; t_string[ 1 ] = (char) var_getnval( &( argv[ 0 ] )); t_string[ 2 ] = '\0'; b = var_getsval( &nvar ); str_ctob( b, t_string ); return &nvar; } #if COMMON_FUNCS /*************************************************************** FUNCTION: fnc_date() DESCRIPTION: This C function implements the BASIC predefined DATE$ function, returning a string containing the year, month, and day of the month. SYNTAX: DATE$ ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_date( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_date( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; static char *tbuf; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, STRING ); /* Revised to CALLOC pass-thru call by JBV */ if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "fnc_date" )) == NULL ) { #if PROG_ERRORS bwb_error( "in fnc_date(): failed to get memory for tbuf" ); #else bwb_error( err_getmem ); #endif } } time( &t ); lt = localtime( &t ); sprintf( tbuf, "%02d-%02d-%04d", lt->tm_mon + 1, lt->tm_mday, 1900 + lt->tm_year ); str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf ); return &nvar; } /*************************************************************** FUNCTION: fnc_time() DESCRIPTION: This C function implements the BASIC predefined TIME$ function, returning a string containing the hour, minute, and second count. SYNTAX: TIME$ ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_time( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_time( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static char *tbuf; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, STRING ); /* Revised to CALLOC pass-thru call by JBV */ if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "fnc_time" )) == NULL ) { #if PROG_ERRORS bwb_error( "in fnc_time(): failed to get memory for tbuf" ); #else bwb_error( err_getmem ); #endif } } time( &t ); lt = localtime( &t ); sprintf( tbuf, "%02d:%02d:%02d", lt->tm_hour, lt->tm_min, lt->tm_sec ); str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf ); return &nvar; } /*************************************************************** FUNCTION: fnc_chr() DESCRIPTION: This C function implements the BASIC predefined CHR$ function, returning a string containing the single character whose ASCII value is the argument to this function. SYNTAX: CHR$( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_chr( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_chr( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; char tbuf[ MAXSTRINGSIZE + 1 ]; static int init = FALSE; #if TEST_BSTRING bstring *b; #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_chr(): entered function, argc <%d>", argc ); bwb_debug( bwb_ebuf ); #endif /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, STRING ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_chr(): entered function, initialized nvar" ); bwb_debug( bwb_ebuf ); #endif } /* check arguments */ #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough arguments to function CHR$()" ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function CHR$().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_chr(): entered function, checkargs ok" ); bwb_debug( bwb_ebuf ); #endif tbuf[ 0 ] = (char) var_getnval( &( argv[ 0 ] ) ); tbuf[ 1 ] = '\0'; str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf ); #if TEST_BSTRING b = var_findsval( &nvar, nvar.array_pos ); sprintf( bwb_ebuf, "in fnc_chr(): bstring name is <%s>", b->name ); bwb_debug( bwb_ebuf ); #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_chr(): tbuf[ 0 ] is <%c>", tbuf[ 0 ] ); bwb_debug( bwb_ebuf ); #endif return &nvar; } /*************************************************************** FUNCTION: fnc_len() DESCRIPTION: This C function implements the BASIC LEN() function, returning the length of a specified string in bytes. SYNTAX: LEN( string$ ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_len( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_len( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; static char *tbuf; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); /* Revised to CALLOC pass-thru call by JBV */ if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "fnc_len" )) == NULL ) { #if PROG_ERRORS bwb_error( "in fnc_len(): failed to get memory for tbuf" ); #else bwb_error( err_getmem ); #endif } } /* check parameters */ #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function LEN().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function LEN().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* return length as an integer */ str_btoc( tbuf, var_getsval( &( argv[ 0 ] )) ); * var_findnval( &nvar, nvar.array_pos ) = (bnumber) strlen( tbuf ); return &nvar; } /*************************************************************** FUNCTION: fnc_pos() DESCRIPTION: This C function implements the BASIC POS() function, returning the current column position for the output device. SYNTAX: POS ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_pos( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_pos( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; /* initialize nvar if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, (int) NUMBER ); } * var_findnval( &nvar, nvar.array_pos ) = (bnumber) prn_col; return &nvar; } #endif /* COMMON_FUNCS */ #if MS_FUNCS /*************************************************************** FUNCTION: fnc_timer() DESCRIPTION: This C function implements the BASIC predefined TIMER function SYNTAX: TIMER ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_timer( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_timer( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static time_t now; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } time( &now ); /* Following statement was (bnumber) (JBV) */ * var_findnval( &nvar, nvar.array_pos ) = (float) fmod( (double) now, (double) (60*60*24)); return &nvar; } /*************************************************************** FUNCTION: fnc_mid() DESCRIPTION: This C function implements the BASIC predefined MID$ function SYNTAX: MID$( string$, start-position-in-string[, number-of-spaces ] ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_mid( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_mid( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; register int c; char target_string[ MAXSTRINGSIZE + 1 ]; int target_counter, num_spaces; char tbuf[ MAXSTRINGSIZE + 1 ]; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, STRING ); } /* check arguments */ #if PROG_ERRORS if ( argc < 2 ) { sprintf( bwb_ebuf, "Not enough arguments to function MID$()" ); bwb_error( bwb_ebuf ); return &nvar; } if ( argc > 3 ) { sprintf( bwb_ebuf, "Two many arguments to function MID$()" ); bwb_error( bwb_ebuf ); return &nvar; } #else if ( fnc_checkargs( argc, argv, 2, 3 ) == FALSE ) { return NULL; } #endif /* get arguments */ str_btoc( target_string, var_getsval( &( argv[ 0 ] ) )); target_counter = (int) var_getnval( &( argv[ 1 ] ) ) - 1; if ( target_counter > (int) strlen( target_string )) { tbuf[ 0 ] = '\0'; str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf ); return &nvar; } if ( argc == 3 ) { num_spaces = (int) var_getnval( &( argv[ 2 ] )); } else { num_spaces = MAXSTRINGSIZE; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_mid() string <%s> startpos <%d> spaces <%d>", target_string, target_counter, num_spaces ); bwb_debug( bwb_ebuf ); #endif c = 0; tbuf[ c ] = '\0'; while ( ( c < num_spaces ) && ( target_string[ target_counter ] != '\0' )) { tbuf[ c ] = target_string[ target_counter ]; ++c; tbuf[ c ] = '\0'; ++target_counter; } str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf ); return &nvar; } /*************************************************************** FUNCTION: fnc_left() DESCRIPTION: This C function implements the BASIC predefined LEFT$ function SYNTAX: LEFT$( string$, number-of-spaces ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_left( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_left( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; register int c; char target_string[ MAXSTRINGSIZE + 1 ]; int target_counter, num_spaces; char tbuf[ MAXSTRINGSIZE + 1 ]; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, STRING ); } /* check arguments */ #if PROG_ERRORS if ( argc < 2 ) { sprintf( bwb_ebuf, "Not enough arguments to function LEFT$()" ); bwb_error( bwb_ebuf ); return &nvar; } if ( argc > 2 ) { sprintf( bwb_ebuf, "Two many arguments to function LEFT$()" ); bwb_error( bwb_ebuf ); return &nvar; } #else if ( fnc_checkargs( argc, argv, 2, 2 ) == FALSE ) { return NULL; } #endif /* get arguments */ str_btoc( tbuf, var_getsval( &( argv[ 0 ] ) )); target_counter = 0; num_spaces = (int) var_getnval( &( argv[ 1 ] )); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_left() string <%s> startpos <%d> spaces <%d>", tbuf, target_counter, num_spaces ); bwb_debug( bwb_ebuf ); #endif c = 0; target_string[ 0 ] = '\0'; while (( c < num_spaces ) && ( tbuf[ c ] != '\0' )) { target_string[ target_counter ] = tbuf[ c ]; ++target_counter; target_string[ target_counter ] = '\0'; ++c; } str_ctob( var_findsval( &nvar, nvar.array_pos ), target_string ); return &nvar; } /*************************************************************** FUNCTION: fnc_right() DESCRIPTION: This C function implements the BASIC predefined RIGHT$ function SYNTAX: RIGHT$( string$, number-of-spaces ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_right( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_right( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; register int c; char target_string[ MAXSTRINGSIZE + 1 ]; int target_counter, num_spaces; char tbuf[ MAXSTRINGSIZE + 1 ]; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, STRING ); } /* check arguments */ #if PROG_ERRORS if ( argc < 2 ) { sprintf( bwb_ebuf, "Not enough arguments to function RIGHT$()" ); bwb_error( bwb_ebuf ); return &nvar; } if ( argc > 2 ) { sprintf( bwb_ebuf, "Two many arguments to function RIGHT$()" ); bwb_error( bwb_ebuf ); return &nvar; } #else if ( fnc_checkargs( argc, argv, 2, 2 ) == FALSE ) { return NULL; } #endif /* get arguments */ str_btoc( target_string, var_getsval( &( argv[ 0 ] ) )); target_counter = strlen( target_string ) - (int) var_getnval( &( argv[ 1 ] )); num_spaces = MAXSTRINGSIZE; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_right() string <%s> startpos <%d> spaces <%d>", target_string, target_counter, num_spaces ); bwb_debug( bwb_ebuf ); #endif c = 0; tbuf[ c ] = '\0'; while ( ( c < num_spaces ) && ( target_string[ target_counter ] != '\0' )) { tbuf[ c ] = target_string[ target_counter ]; ++c; tbuf[ c ] = '\0'; ++target_counter; } str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf ); return &nvar; } /*************************************************************** FUNCTION: fnc_asc() DESCRIPTION: This function implements the predefined BASIC ASC() function, returning the ASCII number associated with the first character in the string argument. SYNTAX: ASC( string$ ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_asc( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_asc( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static char *tbuf; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); /* Revised to CALLOC pass-thru call by JBV */ if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "fnc_asc" )) == NULL ) { #if PROG_ERRORS bwb_error( "in fnc_asc(): failed to get memory for tbuf" ); #else bwb_error( err_getmem ); #endif } } /* check parameters */ #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function ASC().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function ASC().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif if ( argv[ 0 ].type != STRING ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Argument to function ASC() must be a string." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif return NULL; } /* assign ASCII value of first character in the buffer */ str_btoc( tbuf, var_findsval( &( argv[ 0 ] ), argv[ 0 ].array_pos ) ); * var_findnval( &nvar, nvar.array_pos ) = (bnumber) tbuf[ 0 ]; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_asc(): string is <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif return &nvar; } /*************************************************************** FUNCTION: fnc_string() DESCRIPTION: This C function implements the BASIC STRING$() function. SYNTAX: STRING$( number, ascii-value|string$ ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_string( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_string( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; int length; register int i; char c; static char *tbuf; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, STRING ); /* Revised to CALLOC pass-thru call by JBV */ if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "fnc_string" )) == NULL ) { #if PROG_ERRORS bwb_error( "in fnc_string(): failed to get memory for tbuf" ); #else bwb_error( err_getmem ); #endif } } /* check for correct number of parameters */ #if PROG_ERRORS if ( argc < 2 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function STRING$().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 2 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function STRING$().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 2, 2 ) == FALSE ) { return NULL; } #endif strcpy( nvar.name, "(string$)!" ); nvar.type = STRING; tbuf[ 0 ] = '\0'; length = (int) var_getnval( &( argv[ 0 ] )); if ( argv[ 1 ].type == STRING ) { str_btoc( tbuf, var_getsval( &( argv[ 1 ] ))); c = tbuf[ 0 ]; } else { c = (char) var_getnval( &( argv[ 1 ] ) ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_string(): argument <%s> arg type <%c>, length <%d>", tbuf, argv[ 1 ].type, length ); bwb_debug( bwb_ebuf ); sprintf( bwb_ebuf, "in fnc_string(): type <%c>, c <0x%x>=<%c>", argv[ 1 ].type, c, c ); bwb_debug( bwb_ebuf ); #endif /* add characters to the string */ for ( i = 0; i < length; ++i ) { tbuf[ i ] = c; tbuf[ i + 1 ] = '\0'; } str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf ); return &nvar; } /*************************************************************** FUNCTION: fnc_instr() DESCRIPTION: This C function implements the BASIC INSTR() function, returning the position in string string-searched$ at which string-pattern$ occurs. SYNTAX: INSTR( [start-position,] string-searched$, string-pattern$ ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_instr( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_instr( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; int n_pos, x_pos, y_pos; int start_pos; register int n; char xbuf[ MAXSTRINGSIZE + 1 ]; char ybuf[ MAXSTRINGSIZE + 1 ]; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } /* check for correct number of parameters */ #if PROG_ERRORS if ( argc < 2 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function INSTR().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 3 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function INSTR().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 2, 3 ) == FALSE ) { return NULL; } #endif /* determine argument positions */ if ( argc == 3 ) { n_pos = 0; x_pos = 1; y_pos = 2; } else { n_pos = -1; x_pos = 0; y_pos = 1; } /* determine starting position */ if ( n_pos == 0 ) { start_pos = (int) var_getnval( &( argv[ n_pos ] ) ) - 1; } else { start_pos = 0; } /* get x and y strings */ str_btoc( xbuf, var_getsval( &( argv[ x_pos ] ) ) ); str_btoc( ybuf, var_getsval( &( argv[ y_pos ] ) ) ); /* now search for match */ for ( n = start_pos; n < (int) strlen( xbuf ); ++n ) { if ( strncmp( &( xbuf[ n ] ), ybuf, strlen( ybuf ) ) == 0 ) { * var_findnval( &nvar, nvar.array_pos ) = (bnumber) n + 1; return &nvar; } } /* match not found */ * var_findnval( &nvar, nvar.array_pos ) = (bnumber) 0; return &nvar; } /*************************************************************** FUNCTION: fnc_spc() DESCRIPTION: This C function implements the BASIC SPC() function, returning a string containing a specified number of (blank) spaces. SYNTAX: SPC( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_spc( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_spc( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { return fnc_space( argc, argv, unique_id ); } /*************************************************************** FUNCTION: fnc_space() DESCRIPTION: This C function implements the BASIC SPACE() function, returning a string containing a specified number of (blank) spaces. SYNTAX: SPACE$( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_space( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_space( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static char *tbuf; static int init = FALSE; int spaces; register int i; bstring *b; /* check for correct number of parameters */ if ( argc < 1 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Not enough parameters (%d) to function SPACE$().", argc ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif break_handler(); return NULL; } else if ( argc > 1 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Too many parameters (%d) to function SPACE$().", argc ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif break_handler(); return NULL; } /* initialize nvar if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, (int) STRING ); /* Revised to CALLOC pass-thru call by JBV */ if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "fnc_space" )) == NULL ) { #if PROG_ERRORS bwb_error( "in fnc_space(): failed to get memory for tbuf" ); #else bwb_error( err_getmem ); #endif } } tbuf[ 0 ] = '\0'; spaces = (int) var_getnval( &( argv[ 0 ] )); /* add spaces to the string */ for ( i = 0; i < spaces; ++i ) { tbuf[ i ] = ' '; tbuf[ i + 1 ] = '\0'; } b = var_getsval( &nvar ); str_ctob( b, tbuf ); return &nvar; } /*************************************************************** FUNCTION: fnc_environ() DESCRIPTION: This C function implements the BASIC ENVIRON$() function, returning the value of a specified environment string. SYNTAX: ENVIRON$( variable-string ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_environ( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_environ( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; char tmp[ MAXSTRINGSIZE + 1 ]; static struct bwb_variable nvar; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, STRING ); } /* check for correct number of parameters */ #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function ENVIRON$().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function ENVIRON$().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* resolve the argument and place string value in tbuf */ str_btoc( tbuf, var_getsval( &( argv[ 0 ] ))); /* call getenv() then write value to string */ /*--------------------------------------------------------------------*/ /* Added check for getenv return value to prevent segmentation faults */ /* JBV 3/15/96 */ /*--------------------------------------------------------------------*/ if (getenv( tbuf ) != NULL) strcpy( tmp, getenv( tbuf )); else strcpy( tmp, "" ); str_ctob( var_findsval( &nvar, nvar.array_pos ), tmp ); /* return address of nvar */ return &nvar; } /*************************************************************** FUNCTION: fnc_err() DESCRIPTION: This C function implements the BASIC ERR function, returning the error number for the most recent error. Please note that as of revision level 2.10, bwBASIC does not utilize a standard list of error numbers, so numbers returned by this function will not be those found in either ANSI or Microsoft or other BASIC error tables. SYNTAX: ERR ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_err( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_err( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; /* initialize nvar if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, (int) NUMBER ); } * var_findnval( &nvar, nvar.array_pos ) = (bnumber) err_number; return &nvar; } /*************************************************************** FUNCTION: fnc_erl() DESCRIPTION: This C function implements the BASIC ERL function, returning the line number for the most recent error. SYNTAX: ERL ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_erl( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_erl( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; /* initialize nvar if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, (int) NUMBER ); } * var_findnval( &nvar, nvar.array_pos ) = (bnumber) err_line; return &nvar; } /*************************************************************** FUNCTION: fnc_loc() DESCRIPTION: This C function implements the BASIC LOC() function. As implemented here, this only works for random-acess files. SYNTAX: LOC( device-number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_loc( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_loc( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; int dev_number; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_loc(): received f_arg <%f> ", var_getnval( &( argv[ 0 ] ) ) ); bwb_debug( bwb_ebuf ); #endif if ( argc < 1 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Not enough parameters (%d) to function LOC().", argc ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return NULL; } else if ( argc > 1 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Too many parameters (%d) to function LOC().", argc ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return NULL; } dev_number = (int) var_getnval( &( argv[ 0 ] ) ); if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } /* note if this is the very beginning of the file */ if ( dev_table[ dev_number ].loc == 0 ) { * var_findnval( &nvar, nvar.array_pos ) = (bnumber) 0; } else { * var_findnval( &nvar, nvar.array_pos ) = (bnumber) dev_table[ dev_number ].next_record; } return &nvar; } /*************************************************************** FUNCTION: fnc_eof() DESCRIPTION: This C function implements the BASIC EOF() function. SYNTAX: EOF( device-number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_eof( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_eof( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; int dev_number; int cur_pos, end_pos; /* JBV */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_loc(): received f_arg <%f> ", var_getnval( &( argv[ 0 ] ) ) ); bwb_debug( bwb_ebuf ); #endif if ( argc < 1 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Not enough parameters (%d) to function EOF().", argc ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return NULL; } else if ( argc > 1 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Too many parameters (%d) to function EOF().", argc ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return NULL; } dev_number = (int) var_getnval( &( argv[ 0 ] ) ); if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } /* note if this is the very beginning of the file */ if ( dev_table[ dev_number ].mode == DEVMODE_AVAILABLE ) { bwb_error( err_devnum ); * var_findnval( &nvar, nvar.array_pos ) = (bnumber) TRUE; } else if ( dev_table[ dev_number ].mode == DEVMODE_CLOSED ) { bwb_error( err_devnum ); * var_findnval( &nvar, nvar.array_pos ) = (bnumber) TRUE; } /*------------------------------------------------------*/ /* feof() finds EOF when you read past the end of file. */ /* This is not how BASIC works, at least not GWBASIC. */ /* The EOF function should return an EOF indication */ /* when you are the end of the file, not past it. */ /* This routine was modified to reflect this. */ /* (JBV, 10/15/95) */ /*------------------------------------------------------*/ /* else if ( feof( dev_table[ dev_number ].cfp ) == 0 ) */ else if ( ftell( dev_table[ dev_number ].cfp ) != dev_table [ dev_number ].lof ) { * var_findnval( &nvar, nvar.array_pos ) = (bnumber) FALSE; } else { * var_findnval( &nvar, nvar.array_pos ) = (bnumber) TRUE; } return &nvar; } /*************************************************************** FUNCTION: fnc_lof() DESCRIPTION: This C function implements the BASIC LOF() function. SYNTAX: LOF( device-number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_lof( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_lof( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; int dev_number; /* Following section no longer needed, removed by JBV */ /* #if UNIX_CMDS static struct stat statbuf; int r; #endif */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_lof(): received f_arg <%f> ", var_getnval( &( argv[ 0 ] ) ) ); bwb_debug( bwb_ebuf ); #endif if ( argc < 1 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Not enough parameters (%d) to function LOF().", argc ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return NULL; } else if ( argc > 1 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Too many parameters (%d) to function LOF().", argc ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return NULL; } dev_number = (int) var_getnval( &( argv[ 0 ] ) ); if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } /* stat the file */ /* Following section no longer needed, removed by JBV */ /* #if UNIX_CMDS r = stat( dev_table[ dev_number ].filename, &statbuf ); if ( r != 0 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in fnc_lof(): failed to find file <%s>", dev_table[ dev_number ].filename ); bwb_error( bwb_ebuf ); #else sprintf( bwb_ebuf, ERR_OPENFILE, dev_table[ dev_number ].filename ); bwb_error( bwb_ebuf ); #endif return NULL; } * var_findnval( &nvar, nvar.array_pos ) = (bnumber) statbuf.st_size; */ /* #else */ /* Removed by JBV, no longer needed */ /* * var_findnval( &nvar, nvar.array_pos ) = (bnumber) FALSE; */ * var_findnval( &nvar, nvar.array_pos ) = (bnumber) dev_table[ dev_number ].lof; /* JBV */ /* #endif */ /* Removed by JBV, no longer needed */ return &nvar; } #endif /* MS_FUNCS */ /*************************************************************** FUNCTION: fnc_test() DESCRIPTION: This is a test function, developed in order to test argument passing to BASIC functions. ***************************************************************/ #if INTENSIVE_DEBUG #if ANSI_C struct bwb_variable * fnc_test( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_test( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { register int c; static struct bwb_variable rvar; static char *tbuf; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &rvar, NUMBER ); /* Revised to CALLOC pass-thru call by JBV */ if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "fnc_test" )) == NULL ) { #if PROG_ERRORS bwb_error( "in fnc_test(): failed to get memory for tbuf" ); #else bwb_error( err_getmem ); #endif } } sprintf( bwb_ebuf, "TEST function: received %d arguments: \n", argc ); prn_xprintf( stderr, bwb_ebuf ); for ( c = 0; c < argc; ++c ) { str_btoc( tbuf, var_getsval( &argv[ c ] ) ); sprintf( bwb_ebuf, " arg %d (%c): <%s> \n", c, argv[ c ].type, tbuf ); prn_xprintf( stderr, bwb_ebuf ); } return &rvar; } #endif /*************************************************************** FUNCTION: fnc_checkargs() DESCRIPTION: This C function checks the arguments to functions. ***************************************************************/ #if PROG_ERRORS #else #if ANSI_C int fnc_checkargs( int argc, struct bwb_variable *argv, int min, int max ) #else int fnc_checkargs( argc, argv, min, max ) int argc; struct bwb_variable *argv; int min; int max; #endif { if ( argc < min ) { bwb_error( err_syntax ); return FALSE; } if ( argc > max ) { bwb_error( err_syntax ); return FALSE; } return TRUE; } #endif /*************************************************************** FUNCTION: fnc_fncs() DESCRIPTION: This C function is used for debugging purposes; it prints a list of all defined functions. SYNTAX: FNCS ***************************************************************/ #if PERMANENT_DEBUG #if ANSI_C struct bwb_line * bwb_fncs( struct bwb_line *l ) #else struct bwb_line * bwb_fncs( l ) struct bwb_line *l; #endif { struct bwb_function *f; for ( f = CURTASK fnc_start.next; f != &CURTASK fnc_end; f = f->next ) { sprintf( bwb_ebuf, "%s\t%c \n", f->name, f->type ); prn_xprintf( stderr, bwb_ebuf ); } return bwb_zline( l ); } #endif bwbasic-2.20pl2.orig/bwb_inp.c100644 0 0 140144 6473161677 14354 0ustar rootroot/*************************************************************** bwb_inp.c Input Routines for Bywater BASIC Interpreter Commands: DATA READ RESTORE INPUT LINE INPUT 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). */ /*---------------------------------------------------------------*/ #include #include #include #include "bwbasic.h" #include "bwb_mes.h" /* Declarations of functions visible to this file only */ #if ANSI_C static struct bwb_line *bwb_xinp( struct bwb_line *l, FILE *f ); static struct bwb_line *inp_str( struct bwb_line *l, char *buffer, char *var_list, int *position ); static int inp_const( char *m_buffer, char *s_buffer, int *position ); static int inp_assign( char *b, struct bwb_variable *v ); static int inp_advws( FILE *f ); static int inp_xgetc( FILE *f, int is_string ); static int inp_eatcomma( FILE *f ); static bnumber inp_numconst( char *expression ); /* JBV */ #else static struct bwb_line *bwb_xinp(); static struct bwb_line *inp_str(); static int inp_const(); static int inp_assign(); static int inp_advws(); static int inp_xgetc(); static int inp_eatcomma(); static bnumber inp_numconst(); /* JBV */ #endif static char_saved = FALSE; static cs; static int last_inp_adv_rval = FALSE; /* JBV */ /*************************************************************** FUNCTION: bwb_read() DESCRIPTION: This function implements the BASIC READ statement. SYNTAX: READ variable[, variable...] ***************************************************************/ #if ANSI_C struct bwb_line * bwb_read( struct bwb_line *l ) #else struct bwb_line * bwb_read( l ) struct bwb_line *l; #endif { int pos; register int n; int main_loop, adv_loop; struct bwb_variable *v; int n_params; /* number of parameters */ int *pp; /* pointer to parameter values */ char tbuf[ MAXSTRINGSIZE + 1 ]; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_read(): buffer <%s>", &( l->buffer[ l->position ])); bwb_debug( bwb_ebuf ); #endif /* Process each variable read from the READ statement */ main_loop = TRUE; while ( main_loop == TRUE ) { /* first check position in l->buffer and advance beyond whitespace */ adv_loop = TRUE; while( adv_loop == TRUE ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_read() adv_loop char <%d> = <%c>", l->buffer[ l->position ], l->buffer[ l->position ] ); bwb_debug( bwb_ebuf ); #endif switch ( l->buffer[ l->position ] ) { case ',': /* comma delimiter */ case ' ': /* whitespace */ case '\t': ++l->position; break; case ':': /* end of line segment */ case '\n': /* end of line */ case '\r': case '\0': adv_loop = FALSE; /* break out of advance loop */ main_loop = FALSE; /* break out of main loop */ break; default: /* anything else */ adv_loop = FALSE; /* break out of advance loop */ break; } } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_read(): end of adv_loop <%d> main_loop <%d>", adv_loop, main_loop ); bwb_debug( bwb_ebuf ); #endif /* be sure main_loop id still valid after checking the line */ if ( main_loop == TRUE ) { /* Read a variable name */ bwb_getvarname( l->buffer, tbuf, &( l->position ) ); inp_adv( l->buffer, &( l->position ) ); v = var_find( tbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_read(): line <%d> variable <%s>", l->number, v->name ); bwb_debug( bwb_ebuf ); sprintf( bwb_ebuf, "in bwb_read(): remaining line <%s>", &( l->buffer[ l->position ] ) ); bwb_debug( bwb_ebuf ); #endif /* advance beyond whitespace or comma in data buffer */ inp_adv( CURTASK data_line->buffer, &CURTASK data_pos ); /* Advance to next line if end of buffer */ switch( CURTASK data_line->buffer[ CURTASK data_pos ] ) { case '\0': /* end of buffer */ case '\n': case '\r': CURTASK data_line = CURTASK data_line->next; /* advance farther to line with DATA statement if necessary */ pos = 0; line_start( CURTASK data_line->buffer, &pos, &( CURTASK data_line->lnpos ), &( CURTASK data_line->lnum ), &( CURTASK data_line->cmdpos ), &( CURTASK data_line->cmdnum ), &( CURTASK data_line->startpos ) ); CURTASK data_pos = CURTASK data_line->startpos; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_read(): current data line: <%s>", CURTASK data_line->buffer ); bwb_debug( bwb_ebuf ); #endif break; } while ( bwb_cmdtable[ CURTASK data_line->cmdnum ].vector != bwb_data ) { if ( CURTASK data_line == &CURTASK bwb_end ) { CURTASK data_line = CURTASK bwb_start.next; } else { CURTASK data_line = CURTASK data_line->next; } pos = 0; line_start( CURTASK data_line->buffer, &pos, &( CURTASK data_line->lnpos ), &( CURTASK data_line->lnum ), &( CURTASK data_line->cmdpos ), &( CURTASK data_line->cmdnum ), &( CURTASK data_line->startpos ) ); CURTASK data_pos = CURTASK data_line->startpos; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_read(): advance to data line: <%s>", CURTASK data_line->buffer ); bwb_debug( bwb_ebuf ); #endif } /* advance beyond whitespace in data buffer */ adv_loop = TRUE; while ( adv_loop == TRUE ) { switch( CURTASK data_line->buffer[ CURTASK data_pos ] ) { case '\0': /* end of buffer */ case '\n': case '\r': bwb_error( err_od ); return bwb_zline( l ); case ' ': /* whitespace */ case '\t': ++CURTASK data_pos; break; default: adv_loop = FALSE; /* carry on */ break; } } /* now at last we have a variable in v that needs to be assigned data from the data_buffer at position CURTASK data_pos. What remains to be done is to get one single bit of data, a string constant or numerical constant, into the small buffer */ inp_const( CURTASK data_line->buffer, tbuf, &CURTASK data_pos ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_read(): data constant is <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif /* get parameters if the variable is dimensioned */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == '(' ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_read(): variable <%s> is dimensioned", v->name ); bwb_debug( bwb_ebuf ); #endif dim_getparams( l->buffer, &( l->position ), &n_params, &pp ); for ( n = 0; n < v->dimensions; ++n ) { v->array_pos[ n ] = pp[ n ]; } } #if INTENSIVE_DEBUG else { sprintf( bwb_ebuf, "in bwb_read(): variable <%s> is NOT dimensioned", v->name ); bwb_debug( bwb_ebuf ); sprintf( bwb_ebuf, "in bwb_read(): remaining line <%s>", &( l->buffer[ l->position ] ) ); bwb_debug( bwb_ebuf ); } #endif /* finally assign the data to the variable */ inp_assign( tbuf, v ); } /* end of remainder of main loop */ } /* end of main_loop */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_read(): exiting function, line <%s> ", &( l->buffer[ l->position ] ) ); bwb_debug( bwb_ebuf ); #endif return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_data() DESCRIPTION: This function implements the BASIC DATA statement, although at the point at which DATA statements are encountered, no processing is done. All actual processing of DATA statements is accomplished by READ (bwb_read()). SYNTAX: DATA constant[, constant]... ***************************************************************/ #if ANSI_C struct bwb_line * bwb_data( struct bwb_line *l ) #else struct bwb_line * bwb_data( l ) struct bwb_line *l; #endif { #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_restore() DESCRIPTION: This function implements the BASIC RESTORE statement. SYNTAX: RESTORE [line number] ***************************************************************/ #if ANSI_C struct bwb_line * bwb_restore( struct bwb_line *l ) #else struct bwb_line * bwb_restore( l ) struct bwb_line *l; #endif { struct bwb_line *r; struct bwb_line *r_line; int n; int pos; char tbuf[ MAXSTRINGSIZE + 1 ]; /* get the first element beyond the starting position */ adv_element( l->buffer, &( l->position ), tbuf ); /* if the line is not a numerical constant, then there is no argument; set the current line to the first in the program */ if ( is_numconst( tbuf ) != TRUE ) { CURTASK data_line = &CURTASK bwb_start; CURTASK data_pos = 0; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_restore(): RESTORE w/ no argument " ); bwb_debug( bwb_ebuf ); #endif return bwb_zline( l ); } /* find the line */ n = atoi( tbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_restore(): line for restore is <%d>", n ); bwb_debug( bwb_ebuf ); #endif r_line = NULL; for ( r = CURTASK bwb_start.next; r != &CURTASK bwb_end; r = r->next ) { if ( r->number == n ) { r_line = r; } } if ( r_line == NULL ) { #if PROG_ERRORS sprintf( bwb_ebuf, "at line %d: Can't find line number for RESTORE.", l->number ); bwb_error( bwb_ebuf ); #else sprintf( bwb_ebuf, err_lnnotfound, n ); bwb_error( bwb_ebuf ); #endif return bwb_zline( l ); } /* initialize variables for the line */ pos = 0; line_start( r_line->buffer, &pos, &( r_line->lnpos ), &( r_line->lnum ), &( r_line->cmdpos ), &( r_line->cmdnum ), &( r_line->startpos ) ); /* verify that line is a data statement */ if ( bwb_cmdtable[ r_line->cmdnum ].vector != bwb_data ) { #if PROG_ERRORS sprintf( bwb_ebuf, "at line %d: Line %d is not a DATA statement.", l->number, r_line->number ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } /* reassign CURTASK data_line */ CURTASK data_line = r_line; CURTASK data_pos = CURTASK data_line->startpos; return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_input() DESCRIPTION: This function implements the BASIC INPUT statement. SYNTAX: INPUT [;][prompt$;]variable[$,variable]... INPUT#n variable[$,variable]... ***************************************************************/ #if ANSI_C struct bwb_line * bwb_input( struct bwb_line *l ) #else struct bwb_line * bwb_input( l ) struct bwb_line *l; #endif { FILE *fp; int pos; int req_devnumber; struct exp_ese *v; int is_prompt; int suppress_qm; static char tbuf[ MAXSTRINGSIZE + 1 ]; static char pstring[ MAXSTRINGSIZE + 1 ]; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_input(): enter function" ); bwb_debug( bwb_ebuf ); #endif pstring[ 0 ] = '\0'; #if COMMON_CMDS /* advance beyond whitespace and check for the '#' sign */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == '#' ) { ++( l->position ); adv_element( l->buffer, &( l->position ), tbuf ); pos = 0; v = bwb_exp( tbuf, FALSE, &pos ); adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == ',' ) { ++( l->position ); } else { #if PROG_ERRORS bwb_error( "in bwb_input(): no comma after#n" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } req_devnumber = (int) exp_getnval( v ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_input(): requested device number <%d>", req_devnumber ); bwb_debug( bwb_ebuf ); #endif /* check the requested device number */ if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES )) { #if PROG_ERRORS bwb_error( "in bwb_input(): Requested device number is out if range." ); #else bwb_error( err_devnum ); #endif return bwb_zline( l ); } if ( ( dev_table[ req_devnumber ].mode == DEVMODE_CLOSED ) || ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) ) { #if PROG_ERRORS bwb_error( "in bwb_input(): Requested device number is not open." ); #else bwb_error( err_devnum ); #endif return bwb_zline( l ); } if ( dev_table[ req_devnumber ].mode != DEVMODE_INPUT ) { #if PROG_ERRORS bwb_error( "in bwb_input(): Requested device is not open for INPUT." ); #else bwb_error( err_devnum ); #endif return bwb_zline( l ); } /* look up the requested device in the device table */ fp = dev_table[ req_devnumber ].cfp; } else { fp = stdin; } #else fp = stdin; #endif /* COMMON_CMDS */ /* if input is not from stdin, then branch to bwb_xinp() */ if ( fp != stdin ) { return bwb_xinp( l, fp ); } /* from this point we presume that input is from stdin */ /* check for a semicolon or a quotation mark, not in first position: this should indicate a prompt string */ suppress_qm = is_prompt = FALSE; adv_ws( l->buffer, &( l->position ) ); switch( l->buffer[ l->position ] ) { case '\"': is_prompt = TRUE; break; case ';': /* AGENDA: add code to suppress newline if a semicolon is used here; this may not be possible using ANSI C alone, since it has not functions for unechoed console input. */ is_prompt = TRUE; ++l->position; break; case ',': /* QUERY: why is this code here? the question mark should be suppressed if a comma the prompt string. */ #if INTENSIVE_DEBUG bwb_debug( "in bwb_input(): found initial comma" ); #endif suppress_qm = TRUE; ++l->position; break; } /* get prompt string and print it */ if ( is_prompt == TRUE ) { /* get string element */ inp_const( l->buffer, tbuf, &( l->position ) ); /* advance past semicolon to beginning of variable */ /*--------------------------------------------------------*/ /* Since inp_const was just called and inp_adv is called */ /* within that, it will have already noted and passed the */ /* comma by the time it gets here. Therefore one must */ /* refer instead to the last returned value for inp_adv! */ /* (JBV, 10/95) */ /*--------------------------------------------------------*/ /* suppress_qm = inp_adv( l->buffer, &( l->position ) ); */ suppress_qm = last_inp_adv_rval; /* print the prompt string */ strncpy( pstring, tbuf, MAXSTRINGSIZE ); } /* end condition: prompt string */ /* print out the question mark delimiter unless it has been suppressed */ if ( suppress_qm != TRUE ) { strncat( pstring, "? ", MAXSTRINGSIZE ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_input(): ready to get input line" ); bwb_debug( bwb_ebuf ); #endif /* read a line into the input buffer */ bwx_input( pstring, tbuf ); bwb_stripcr( tbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_input(): received line <%s>", tbuf ); bwb_debug( bwb_ebuf ); bwb_debug( "Press RETURN: " ); getchar(); #endif /* reset print column to account for LF at end of fgets() */ * prn_getcol( stdout ) = 1; return inp_str( l, tbuf, l->buffer, &( l->position ) ); } /*************************************************************** FUNCTION: bwb_xinp() DESCRIPTION: This function does the bulk of processing for INPUT#, and so is file independent. ***************************************************************/ #if ANSI_C static struct bwb_line * bwb_xinp( struct bwb_line *l, FILE *f ) #else static struct bwb_line * bwb_xinp( l, f ) struct bwb_line *l; FILE *f; #endif { int loop; struct bwb_variable *v; char c; register int n; int *pp; int n_params; char tbuf[ MAXSTRINGSIZE + 1 ]; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xinp(): buffer <%s>", &( l->buffer[ l->position ] ) ); bwb_debug( bwb_ebuf ); #endif /* loop through elements required */ loop = TRUE; while ( loop == TRUE ) { /* read a variable from the list */ bwb_getvarname( l->buffer, tbuf, &( l->position ) ); v = var_find( tbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xinp(): found variable name <%s>", v->name ); bwb_debug( bwb_ebuf ); #endif /* read subscripts */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == '(' ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xinp(): variable <%s> has dimensions", v->name ); bwb_debug( bwb_ebuf ); #endif dim_getparams( l->buffer, &( l->position ), &n_params, &pp ); for ( n = 0; n < v->dimensions; ++n ) { v->array_pos[ n ] = pp[ n ]; } } inp_advws( f ); /* perform type-specific input */ switch( v->type ) { case STRING: if ( inp_xgetc( f, TRUE ) != '\"' ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_xinp(): expected quotation mark" ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif } n = 0; while ( ( c = (char) inp_xgetc( f, TRUE )) != '\"' ) { tbuf[ n ] = c; ++n; tbuf[ n ] = '\0'; } str_ctob( var_findsval( v, v->array_pos ), tbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xinp(): read STRING <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif inp_eatcomma( f ); break; default: n = 0; while ( ( c = (char) inp_xgetc( f, FALSE )) != ',' ) { tbuf[ n ] = c; ++n; tbuf[ n ] = '\0'; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xinp(): read NUMBER <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif /*------------------------------------------------------------*/ /* atof call replaced by inp_numconst, gets all input formats */ /* (JBV, 10/95) */ /*------------------------------------------------------------*/ /* * var_findnval( v, v->array_pos ) = (bnumber) atof( tbuf ); */ * var_findnval( v, v->array_pos ) = inp_numconst( tbuf ); break; } /* end of switch for type-specific input */ /* check for comma */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == ',' ) { ++( l->position ); } else { loop = FALSE; } } /* return */ return bwb_zline( l ); } /*************************************************************** FUNCTION: inp_advws() DESCRIPTION: This C function advances past whitespace input from a particular file or device. ***************************************************************/ #if ANSI_C static int inp_advws( FILE *f ) #else static int inp_advws( f ) FILE *f; #endif { register int c; int loop; loop = TRUE; while ( loop == TRUE ) { c = (char) inp_xgetc( f, TRUE ); switch( c ) { case '\n': case '\r': case ' ': case '\t': break; default: char_saved = TRUE; cs = c; loop = FALSE; break; } } return TRUE; } /*************************************************************** FUNCTION: inp_xgetc() DESCRIPTION: This C function reads in a character from a specified file or device. ***************************************************************/ #if ANSI_C static int inp_xgetc( FILE *f, int is_string ) #else static int inp_xgetc( f, is_string ) FILE *f; int is_string; #endif { register int c; static int prev_eof = FALSE; if ( char_saved == TRUE ) { char_saved = FALSE; return cs; } if ( feof( f ) != 0 ) { if ( prev_eof == TRUE ) { bwb_error( err_od ); } else { prev_eof = TRUE; return (int) ','; } } prev_eof = FALSE; c = fgetc( f ); if ( is_string == TRUE ) { return c; } switch( c ) { case ' ': case '\n': case ',': case '\r': return ','; } return c; } /*************************************************************** FUNCTION: inp_eatcomma() DESCRIPTION: This C function advances beyond a comma input from a specified file or device. ***************************************************************/ #if ANSI_C static int inp_eatcomma( FILE *f ) #else static int inp_eatcomma( f ) FILE *f; #endif { char c; while ( ( c = (char) inp_xgetc( f, TRUE ) ) == ',' ) { } char_saved = TRUE; cs = c; return TRUE; } /*************************************************************** FUNCTION: inp_str() DESCRIPTION: This function does INPUT processing from a determined string of input data and a determined variable list (both in memory). This presupposes that input has been taken from stdin, not from a disk file or device. ***************************************************************/ #if ANSI_C static struct bwb_line * inp_str( struct bwb_line *l, char *input_buffer, char *var_list, int *vl_position ) #else static struct bwb_line * inp_str( l, input_buffer, var_list, vl_position ) struct bwb_line *l; char *input_buffer; char *var_list; int *vl_position; #endif { int i; register int n; struct bwb_variable *v; int loop; int *pp; int n_params; char ttbuf[ MAXSTRINGSIZE + 1 ]; /* build element */ char varname[ MAXSTRINGSIZE + 1 ]; /* build element */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in inp_str(): received line <%s>", l->buffer ); bwb_debug( bwb_ebuf ); sprintf( bwb_ebuf, "in inp_str(): received variable list <%s>.", &( var_list[ *vl_position ] ) ); bwb_debug( bwb_ebuf ); sprintf( bwb_ebuf, "in inp_str(): received input buffer <%s>.", input_buffer ); bwb_debug( bwb_ebuf ); #endif /* Read elements, and assign them to variables */ i = 0; loop = TRUE; while ( loop == TRUE ) { /* get a variable name from the list */ bwb_getvarname( var_list, varname, vl_position ); /* get name */ v = var_find( varname ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in inp_str(): found variable buffer <%s> name <%s>", varname, v->name ); bwb_debug( bwb_ebuf ); #endif /* read subscripts if appropriate */ adv_ws( var_list, vl_position ); if ( var_list[ *vl_position ] == '(' ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in inp_str(): variable <%s> has dimensions", v->name ); bwb_debug( bwb_ebuf ); #endif dim_getparams( var_list, vl_position, &n_params, &pp ); for ( n = 0; n < v->dimensions; ++n ) { v->array_pos[ n ] = pp[ n ]; } } /* build string from input buffer in ttbuf */ n = 0; ttbuf[ 0 ] = '\0'; while ( ( input_buffer[ i ] != ',' ) && ( input_buffer[ i ] != '\0' )) { ttbuf[ n ] = input_buffer[ i ]; ++n; ++i; ttbuf[ n ] = '\0'; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in inp_str(): string for input <%s>", ttbuf ); bwb_debug( bwb_ebuf ); #endif /* perform type-specific input */ inp_assign( ttbuf, v ); /* check for commas in variable list and input list and advance */ adv_ws( var_list, vl_position ); switch( var_list[ *vl_position ] ) { case '\n': case '\r': case '\0': case ':': loop = FALSE; break; case ',': ++( *vl_position ); break; } adv_ws( var_list, vl_position ); adv_ws( input_buffer, &i ); switch ( input_buffer[ i ] ) { case '\n': case '\r': case '\0': case ':': loop = FALSE; break; case ',': ++i; break; } adv_ws( input_buffer, &i ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in inp_str(): exit, line buffer <%s>", &( l->buffer[ l->position ] ) ); bwb_debug( bwb_ebuf ); #endif /* return */ return bwb_zline( l ); } /*************************************************************** FUNCTION: inp_assign() DESCRIPTION: This function assigns the value of a numerical or string constant to a variable. ***************************************************************/ #if ANSI_C static int inp_assign( char *b, struct bwb_variable *v ) #else static int inp_assign( b, v ) char *b; struct bwb_variable *v; #endif { switch( v->type ) { case STRING: str_ctob( var_findsval( v, v->array_pos ), b ); break; case NUMBER: if ( strlen( b ) == 0 ) { *( var_findnval( v, v->array_pos )) = (bnumber) 0.0; } else { /*------------------------------------------------------------*/ /* atof call replaced by inp_numconst, gets all input formats */ /* (JBV, 10/95) */ /*------------------------------------------------------------*/ /* *( var_findnval( v, v->array_pos )) = (bnumber) atof( b ); */ *( var_findnval( v, v->array_pos )) = inp_numconst( b ); } break; default: #if PROG_ERRORS sprintf( bwb_ebuf, "in inp_assign(): variable <%s> of unknown type", v->name ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif return FALSE; } return FALSE; } /*************************************************************** FUNCTION: inp_adv() DESCRIPTION: This function advances the string pointer past whitespace and the item delimiter (comma). ***************************************************************/ #if ANSI_C int inp_adv( char *b, int *c ) #else int inp_adv( b, c ) char *b; int *c; #endif { int rval; rval = FALSE; while( TRUE ) { switch( b[ *c ] ) { case ' ': /* whitespace */ case '\t': case ';': /* semicolon, end of prompt string */ ++*c; break; case ',': /* comma, variable delimiter */ rval = TRUE; ++*c; break; case '\0': /* end of line */ case ':': /* end of line segment */ rval = TRUE; last_inp_adv_rval = rval; /* JBV */ return rval; default: last_inp_adv_rval = rval; /* JBV */ return rval; } } } /*************************************************************** FUNCTION: inp_const() DESCRIPTION: This function reads a numerical or string constant from into , incrementing appropriately. ***************************************************************/ #if ANSI_C static int inp_const( char *m_buffer, char *s_buffer, int *position ) #else static int inp_const( m_buffer, s_buffer, position ) char *m_buffer; char *s_buffer; int *position; #endif { int string; int s_pos; int loop; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in inp_const(): received argument <%s>.", &( m_buffer[ *position ] ) ); bwb_debug( bwb_ebuf ); #endif string = FALSE; /* first detect string constant */ if ( m_buffer[ *position ] == '\"' ) { string = TRUE; ++( *position ); } else { string = FALSE; } /* build the constant string */ s_buffer[ 0 ] = '\0'; s_pos = 0; loop = TRUE; while ( loop == TRUE ) { switch ( m_buffer[ *position ] ) { case '\0': /* end of string */ case '\n': case '\r': return TRUE; case ' ': /* whitespace */ case '\t': case ',': /* or end of argument */ if ( string == FALSE ) { return TRUE; } else { s_buffer[ s_pos ] = m_buffer[ *position ]; ++( *position ); ++s_buffer; s_buffer[ s_pos ] = '\0'; } break; case '\"': if ( string == TRUE ) { ++( *position ); /* advance beyond quotation mark */ inp_adv( m_buffer, position ); return TRUE; } else { #if PROG_ERRORS sprintf( bwb_ebuf, "Unexpected character in numerical constant." ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return FALSE; } default: s_buffer[ s_pos ] = m_buffer[ *position ]; ++( *position ); ++s_buffer; s_buffer[ s_pos ] = '\0'; break; } } return FALSE; } #if COMMON_CMDS /*************************************************************** FUNCTION: bwb_line() DESCRIPTION: This function implements the BASIC LINE INPUT statement. SYNTAX: LINE INPUT [[#] device-number,]["prompt string";] string-variable$ ***************************************************************/ #if ANSI_C struct bwb_line * bwb_line( struct bwb_line *l ) #else struct bwb_line * bwb_line( l ) struct bwb_line *l; #endif { int dev_no; struct bwb_variable *v; FILE *inp_device; char tbuf[ MAXSTRINGSIZE + 1 ]; char pstring[ MAXSTRINGSIZE + 1 ]; struct exp_ese *e; /* JBV */ int pos; /* JBV */ /* assign default values */ inp_device = stdin; pstring[ 0 ] = '\0'; /* advance to first element (INPUT statement) */ adv_element( l->buffer, &( l->position ), tbuf ); bwb_strtoupper( tbuf ); if ( strcmp( tbuf, "INPUT" ) != 0 ) { bwb_error( err_syntax ); return bwb_zline( l ); } adv_ws( l->buffer, &( l->position ) ); /* check for semicolon in first position */ if ( l->buffer[ l->position ] == ';' ) { ++l->position; adv_ws( l->buffer, &( l->position ) ); } /* else check for# for file number in first position */ else if ( l->buffer[ l->position ] == '#' ) { ++l->position; adv_element( l->buffer, &( l->position ), tbuf ); adv_ws( l->buffer, &( l->position )); /* dev_no = atoi( tbuf ); */ /* We really need more, added next (JBV) */ pos = 0; e = bwb_exp( tbuf, FALSE, &pos ); dev_no = (int) exp_getnval( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_line(): file number requested <%d>", dev_no ); bwb_debug( bwb_ebuf ); #endif if ( dev_table[ dev_no ].cfp == NULL ) { bwb_error( err_dev ); return bwb_zline( l ); } else { inp_device = dev_table[ dev_no ].cfp; } } /* check for comma */ if ( l->buffer[ l->position ] == ',' ) { ++( l->position ); adv_ws( l->buffer, &( l->position )); } /* check for quotation mark indicating prompt */ if ( l->buffer[ l->position ] == '\"' ) { inp_const( l->buffer, pstring, &( l->position ) ); } /* read the variable for assignment */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_line(): tbuf <%s>", tbuf ); bwb_debug( bwb_ebuf ); sprintf( bwb_ebuf, "in bwb_line(): line buffer <%s>", &( l->buffer[ l->position ] ) ); bwb_debug( bwb_ebuf ); #endif adv_element( l->buffer, &( l->position ), tbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_line(): variable buffer <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif v = var_find( tbuf ); if ( v->type != STRING ) { #if PROG_ERRORS bwb_error( "in bwb_line(): String variable required" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_line(): variable for assignment <%s>", v->name ); bwb_debug( bwb_ebuf ); #endif /* read a line of text into the bufffer */ if ( inp_device == stdin ) { bwx_input( pstring, tbuf ); } else { /* Was MAXSTRINGSIZE (JBV 9/8/97) */ fgets( tbuf, MAXSTRINGSIZE + 2, inp_device ); } bwb_stripcr( tbuf ); str_ctob( var_findsval( v, v->array_pos ), tbuf ); /* end: return next line */ return bwb_zline( l ); } #endif /* COMMON_CMDS */ /*************************************************************** FUNCTION: inp_numconst() DESCRIPTION: This function interprets a numerical constant. Added by JBV 10/95 ***************************************************************/ #if ANSI_C bnumber inp_numconst( char *expression ) #else bnumber inp_numconst( expression ) char *expression; #endif { int base; /* numerical base for the constant */ static struct bwb_variable mantissa; /* mantissa of floating-point number */ static int init = FALSE; /* is mantissa variable initialized? */ int exponent; /* exponent for floating point number */ int man_start; /* starting point of mantissa */ int s_pos; /* position in build string */ int build_loop; int need_pm; int i; bnumber d; /* Expression stack stuff */ char type; bnumber nval; char string[ MAXSTRINGSIZE + 1 ]; int pos_adv; /* initialize the variable if necessary */ #if INTENSIVE_DEBUG strcpy( mantissa.name, "(mantissa)" ); #endif if ( init == FALSE ) { init = TRUE; var_make( &mantissa, NUMBER ); } /* be sure that the array_pos[ 0 ] for mantissa is set to dim_base; this is necessary because mantissa might be used before dim_base is set */ mantissa.array_pos[ 0 ] = dim_base; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in inp_numconst(): received <%s>, eval <%c>", expression, expression[ 0 ] ); bwb_debug( bwb_ebuf ); #endif need_pm = FALSE; nval = (bnumber) 0; /* check the first character(s) to determine numerical base and starting point of the mantissa */ switch( expression[ 0 ] ) { case '-': case '+': case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case '.': base = 10; /* decimal constant */ man_start = 0; /* starts at position 0 */ need_pm = FALSE; break; case '&': /* hex or octal constant */ if ( ( expression[ 1 ] == 'H' ) || ( expression[ 1 ] == 'h' )) { base = 16; /* hexadecimal constant */ man_start = 2; /* starts at position 2 */ } else { base = 8; /* octal constant */ if ( ( expression[ 1 ] == 'O' ) || ( expression[ 1 ] == 'o' )) { man_start = 2; /* starts at position 2 */ } else { man_start = 1; /* starts at position 1 */ } } break; default: #if PROG_ERRORS sprintf( bwb_ebuf, "expression <%s> is not a numerical constant.", expression ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return (bnumber) 0; } /* now build the mantissa according to the numerical base */ switch( base ) { case 10: /* decimal constant */ /* initialize counters */ pos_adv = man_start; type = NUMBER; string[ 0 ] = '\0'; s_pos = 0; exponent = 0; build_loop = TRUE; /* loop to build the string */ while ( build_loop == TRUE ) { switch( expression[ pos_adv ] ) { case '-': /* prefixed plus or minus */ case '+': /* in the first position, a plus or minus sign can be added to the beginning of the string to be scanned */ if ( pos_adv == man_start ) { string[ s_pos ] = expression[ pos_adv ]; ++pos_adv; /* advance to next character */ ++s_pos; string[ s_pos ] = '\0'; } /* but in any other position, the plus or minus sign must be taken as an operator and thus as terminating the string to be scanned */ else { build_loop = FALSE; } break; case '.': /* note at least single precision */ case '0': /* or ordinary digit */ case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': string[ s_pos ] = expression[ pos_adv ]; ++pos_adv; /* advance to next character */ ++s_pos; string[ s_pos ] = '\0'; break; case '#': /* Microsoft-type precision indicator; ignored but terminates */ case '!': /* Microsoft-type precision indicator; ignored but terminates */ ++pos_adv; /* advance to next character */ type = NUMBER; exponent = FALSE; build_loop = FALSE; break; case 'E': /* exponential, single precision */ case 'e': ++pos_adv; /* advance to next character */ type = NUMBER; exponent = TRUE; build_loop = FALSE; break; case 'D': /* exponential, double precision */ case 'd': ++pos_adv; /* advance to next character */ type = NUMBER; exponent = TRUE; build_loop = FALSE; break; default: /* anything else, terminate */ build_loop = FALSE; break; } } /* assign the value to the mantissa variable */ #if NUMBER_DOUBLE sscanf( string, "%lf", var_findnval( &mantissa, mantissa.array_pos )); #else sscanf( string, "%f", var_findnval( &mantissa, mantissa.array_pos )); #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in inp_numconst(): read mantissa, string <%s> val <%lf>", string, var_getnval( &mantissa ) ); bwb_debug( bwb_ebuf ); #endif /* test if integer bounds have been exceeded */ if ( type == NUMBER ) { i = (int) var_getnval( &mantissa ); d = (bnumber) i; if ( d != var_getnval( &mantissa )) { type = NUMBER; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in inp_numconst(): integer bounds violated, promote to NUMBER" ); bwb_debug( bwb_ebuf ); #endif } } /* read the exponent if there is one */ if ( exponent == TRUE ) { /* allow a plus or minus once at the beginning */ need_pm = TRUE; /* initialize counters */ string[ 0 ] = '\0'; s_pos = 0; build_loop = TRUE; /* loop to build the string */ while ( build_loop == TRUE ) { switch( expression[ pos_adv ] ) { case '-': /* prefixed plus or minus */ case '+': if ( need_pm == TRUE ) /* only allow once */ { string[ s_pos ] = expression[ pos_adv ]; ++pos_adv; /* advance to next character */ ++s_pos; string[ s_pos ] = '\0'; } else { build_loop = FALSE; } break; case '0': /* or ordinary digit */ case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': string[ s_pos ] = expression[ pos_adv ]; ++pos_adv; /* advance to next character */ ++s_pos; string[ s_pos ] = '\0'; need_pm = FALSE; break; default: /* anything else, terminate */ build_loop = FALSE; break; } } /* end of build loop for exponent */ /* assign the value to the user variable */ #if NUMBER_DOUBLE sscanf( string, "%lf", &nval ); #else sscanf( string, "%f", &nval ); #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in inp_numconst(): exponent is <%d>", (int) nval ); bwb_debug( bwb_ebuf ); #endif } /* end of exponent search */ if ( nval == (bnumber) 0 ) { nval = var_getnval( &mantissa ); } else { nval = var_getnval( &mantissa ) * pow( (bnumber) 10.0, (bnumber) nval ); } break; case 8: /* octal constant */ /* initialize counters */ pos_adv = man_start; type = NUMBER; string[ 0 ] = '\0'; s_pos = 0; exponent = 0; build_loop = TRUE; /* loop to build the string */ while ( build_loop == TRUE ) { switch( expression[ pos_adv ] ) { case '0': /* or ordinary digit */ case '1': case '2': case '3': case '4': case '5': case '6': case '7': string[ s_pos ] = expression[ pos_adv ]; ++pos_adv; /* advance to next character */ ++s_pos; string[ s_pos ] = '\0'; break; default: /* anything else, terminate */ build_loop = FALSE; break; } } /* now scan the string to determine the number */ sscanf( string, "%o", &i ); nval = (bnumber) i; break; case 16: /* hexadecimal constant */ /* initialize counters */ pos_adv = man_start; type = NUMBER; string[ 0 ] = '\0'; s_pos = 0; exponent = 0; build_loop = TRUE; /* loop to build the string */ while ( build_loop == TRUE ) { switch( expression[ pos_adv ] ) { case '0': /* or ordinary digit */ case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case 'A': case 'a': case 'B': case 'b': case 'C': case 'c': case 'D': case 'd': case 'E': case 'e': case 'F': /* Don't forget these! (JBV) */ case 'f': string[ s_pos ] = expression[ pos_adv ]; ++pos_adv; /* advance to next character */ ++s_pos; string[ s_pos ] = '\0'; break; default: /* anything else, terminate */ build_loop = FALSE; break; } } /* now scan the string to determine the number */ sscanf( string, "%x", &i ); nval = (bnumber) i; break; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in inp_numconst(): precision <%c> value <%lf>", type, nval ); bwb_debug( bwb_ebuf ); #endif return nval; } bwbasic-2.20pl2.orig/bwb_int.c100644 0 0 53152 6055714562 14333 0ustar rootroot/***************************************************************f bwb_int.c Line Interpretation Routines 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). */ /*---------------------------------------------------------------*/ #include #include #include "bwbasic.h" #include "bwb_mes.h" /*************************************************************** FUNCTION: adv_element() DESCRIPTION: This function reads characters in beginning at and advances past a line element, incrementing appropri- ately and returning the line element in . ***************************************************************/ #if ANSI_C int adv_element( char *buffer, int *pos, char *element ) #else int adv_element( buffer, pos, element ) char *buffer; int *pos; char *element; #endif { int loop; /* control loop */ int e_pos; /* position in element buffer */ int str_const; /* boolean: building a string constant */ /* advance beyond any initial whitespace */ adv_ws( buffer, pos ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in adv_element(): receieved <%s>.", &( buffer[ *pos ] )); bwb_debug( bwb_ebuf ); #endif /* now loop while building an element and looking for an element terminator */ loop = TRUE; e_pos = 0; element[ e_pos ] = '\0'; str_const = FALSE; while ( loop == TRUE ) { switch( buffer[ *pos ] ) { case ',': /* element terminators */ case ';': #if MULTISEG_LINES case ':': #endif case '=': case ' ': case '\t': /* case '\0': */ /* Removed by JBV (found by DD) */ case '\n': case '\r': if ( str_const == TRUE ) { element[ e_pos ] = buffer[ *pos ]; ++e_pos; ++( *pos ); element[ e_pos ] = '\0'; } else { return TRUE; } break; case '\0': /* Added by JBV (found by DD) */ if ( str_const == TRUE ) /* termination of string constant */ { element[ e_pos ] = '\"'; element[ ++e_pos ] = '\0'; } return TRUE; break; case '\"': /* string constant */ element[ e_pos ] = buffer[ *pos ]; ++e_pos; ++( *pos ); element[ e_pos ] = '\0'; if ( str_const == TRUE ) /* termination of string constant */ { return TRUE; } else /* beginning of string constant */ { str_const = TRUE; } break; default: element[ e_pos ] = buffer[ *pos ]; ++e_pos; ++( *pos ); element[ e_pos ] = '\0'; break; } } /* This should not happen */ return FALSE; } /*************************************************************** FUNCTION: adv_ws() DESCRIPTION: This function reads characters in beginning at and advances past any whitespace, incrementing appropri- ately. ***************************************************************/ #if ANSI_C int adv_ws( char *buffer, int *pos ) #else int adv_ws( buffer, pos ) char *buffer; int *pos; #endif { int loop; loop = TRUE; while ( loop == TRUE ) { switch( buffer[ *pos ] ) { case ' ': case '\t': ++( *pos ); break; default: return TRUE; } } /* This should not happen */ return FALSE; } /*************************************************************** FUNCTION: adv_eos() DESCRIPTION: This function reads characters in beginning at and advances to the end of a segment delimited by ':', incrementing appropriately. ***************************************************************/ #if MULTISEG_LINES #if ANSI_C int adv_eos( char *buffer, int *pos ) #else int adv_eos( buffer, pos ) char *buffer; int *pos; #endif { int loop; loop = TRUE; while ( loop == TRUE ) { if ( is_eol( buffer, pos ) == TRUE ) { return FALSE; } switch( buffer[ *pos ] ) { case ':': /* end of segment marker */ ++( *pos ); return TRUE; case '\"': /* begin quoted string */ ++( *pos ); while ( buffer[ *pos ] != '\"' ) { if ( is_eol( buffer, pos ) == TRUE ) { return FALSE; } else { ++( *pos ); } } break; default: ++( *pos ); } } /* This should not happen */ return FALSE; } #endif /* MULTISEG_LINES */ /*************************************************************** FUNCTION: bwb_strtoupper() DESCRIPTION: This function converts the string in to upper-case characters. ***************************************************************/ #if ANSI_C int bwb_strtoupper( char *buffer ) #else int bwb_strtoupper( buffer ) char *buffer; #endif { char *p; p = buffer; while ( *p != '\0' ) { if ( islower( *p ) != FALSE ) { *p = (char) toupper( *p ); } ++p; } return TRUE; } /*************************************************************** FUNCTION: line_start() DESCRIPTION: This function reads a line buffer in beginning at the position and attempts to determine (a) the position of the line number in the buffer (returned in ), (b) the line number at this position (returned in ), (c) the position of the BASIC command in the buffer (returned in ), (d) the position of this BASIC command in the command table (returned in ), and (e) the position of the beginning of the rest of the line (returned in ). Although must be returned as a positive integer, the other searches may fail, in which case FALSE will be returned in their positions. is not incremented. ***************************************************************/ #if ANSI_C int line_start( char *buffer, int *pos, int *lnpos, int *lnum, int *cmdpos, int *cmdnum, int *startpos ) #else int line_start( buffer, pos, lnpos, lnum, cmdpos, cmdnum, startpos ) char *buffer; int *pos; int *lnpos; int *lnum; int *cmdpos; int *cmdnum; int *startpos; #endif { static int position; static char *tbuf; static int init = FALSE; /* get memory for temporary buffer if necessary */ if ( init == FALSE ) { init = TRUE; /* Revised to CALLOC pass-thru call by JBV */ if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "line_start")) == NULL ) { #if PROG_ERRORS bwb_error( "in line_start(): failed to get memory for tbuf" ); #else bwb_error( err_getmem ); #endif } } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in line_start(): pos <%d> buffer <%s>", *pos, buffer ); bwb_debug( bwb_ebuf ); #endif /* set initial values */ *startpos = position = *pos; *cmdpos = *lnpos = *pos; *cmdnum = *lnum = -1; /* check for null line */ adv_ws( buffer, &position ); if ( buffer[ position ] == '\0' ) { #if INTENSIVE_DEBUG bwb_debug( "in line_start(): found NULL line" ); #endif *cmdnum = getcmdnum( CMD_REM ); return TRUE; } /* advance beyond the first element */ *lnpos = position; scan_element( buffer, &position, tbuf ); adv_ws( buffer, &position ); /* test for a line number in the first element */ if ( is_numconst( tbuf ) == TRUE ) /* a line number */ { *lnum = atoi( tbuf ); *startpos = position; /* temp */ *cmdpos = position; scan_element( buffer, &position, tbuf ); /* advance past next element */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in line_start(): new element is <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif #if STRUCT_CMDS if ( is_label( tbuf ) == TRUE ) { *cmdnum = getcmdnum( CMD_LABEL ); adv_ws( buffer, &position ); *startpos = position; } else if ( is_cmd( tbuf, cmdnum ) == TRUE ) #else if ( is_cmd( tbuf, cmdnum ) == TRUE ) #endif { adv_ws( buffer, &position ); *startpos = position; } else if ( is_let( &( buffer[ *cmdpos ] ), cmdnum ) == TRUE ) { *cmdpos = -1; } else { *cmdpos = *cmdnum = -1; } } /* not a line number */ else { *lnum = -1; *lnpos = -1; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in line_start(): no line number, element <%s>.", tbuf ); bwb_debug( bwb_ebuf ); #endif #if STRUCT_CMDS if ( is_label( tbuf ) == TRUE ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in line_start(): label detected <%s>.", tbuf ); bwb_debug( bwb_ebuf ); #endif *cmdnum = getcmdnum( CMD_LABEL ); adv_ws( buffer, &position ); *startpos = position; } else if ( is_cmd( tbuf, cmdnum ) == TRUE ) #else if ( is_cmd( tbuf, cmdnum ) == TRUE ) #endif { adv_ws( buffer, &position ); *startpos = position; } else if ( is_let( &( buffer[ position ] ), cmdnum ) == TRUE ) { adv_ws( buffer, &position ); *cmdpos = -1; } else { *cmdpos = *cmdnum = -1; } } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in line_start(): lnpos <%d> lnum <%d>", *lnpos, *lnum ); bwb_debug( bwb_ebuf ); sprintf( bwb_ebuf, "in line_start(): cmdpos <%d> cmdnum <%d> startpos <%d>", *cmdpos, *cmdnum, *startpos ); bwb_debug( bwb_ebuf ); #endif /* return */ return TRUE; } /*************************************************************** FUNCTION: is_cmd() DESCRIPTION: This function determines whether the string in 'buffer' is a BASIC command statement, returning TRUE or FALSE, and if TRUE returning the command number in the command lookup table in the integer pointed to by 'cmdnum'. ***************************************************************/ #if ANSI_C int is_cmd( char *buffer, int *cmdnum ) #else int is_cmd( buffer, cmdnum ) char *buffer; int *cmdnum; #endif { register int n; /* Convert the command name to upper case */ bwb_strtoupper( buffer ); /* Go through the command table and search for a match. */ for ( n = 0; n < COMMANDS; ++n ) { if ( strcmp( bwb_cmdtable[ n ].name, buffer ) == 0 ) { *cmdnum = n; return TRUE; } } /* No command name was found */ *cmdnum = -1; return FALSE; } /*************************************************************** FUNCTION: is_let() DESCRIPTION: This function tries to determine if the expression in is a LET statement without the LET command specified. ***************************************************************/ #if ANSI_C int is_let( char *buffer, int *cmdnum ) #else int is_let( buffer, cmdnum ) char *buffer; int *cmdnum; #endif { register int n, i; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in is_let(): buffer <%s>", buffer ); bwb_debug( bwb_ebuf ); #endif /* Go through the expression and search for an assignment operator. */ for ( n = 0; buffer[ n ] != '\0'; ++n ) { switch( buffer[ n ] ) { case '\"': /* string constant */ ++n; while( buffer[ n ] != '\"' ) { ++n; if ( buffer[ n ] == '\0' ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Incomplete string constant" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif *cmdnum = -1; return FALSE; } } ++n; break; case '=': #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in is_let(): implied LET found." ); bwb_debug( bwb_ebuf ); #endif for ( i = 0; i < COMMANDS; ++i ) { if ( strncmp( bwb_cmdtable[ i ].name, "LET", (size_t) 3 ) == 0 ) { *cmdnum = i; } } return TRUE; } } /* No command name was found */ *cmdnum = -1; return FALSE; } /*************************************************************** FUNCTION: bwb_stripcr() DESCRIPTION: This function strips the carriage return or line-feed from the end of a string. ***************************************************************/ #if ANSI_C int bwb_stripcr( char *s ) #else int bwb_stripcr( s ) char *s; #endif { char *p; p = s; while ( *p != 0 ) { switch( *p ) { case '\r': case '\n': *p = 0; return TRUE; } ++p; } *p = 0; return TRUE; } /*************************************************************** FUNCTION: is_numconst() DESCRIPTION: This function reads the string in and returns TRUE if it is a numerical constant and FALSE if it is not. At this point, only decimal (base 10) constants are detected. ***************************************************************/ #if ANSI_C int is_numconst( char *buffer ) #else int is_numconst( buffer ) char *buffer; #endif { char *p; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in is_numconst(): received string <%s>.", buffer ); bwb_debug( bwb_ebuf ); #endif /* Return FALSE for empty buffer */ if ( buffer[ 0 ] == '\0' ) { return FALSE; } /* else check digits */ p = buffer; while( *p != '\0' ) { switch( *p ) { case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': break; default: return FALSE; } ++p; } /* only numerical characters detected */ return TRUE; } /*************************************************************** FUNCTION: bwb_numseq() DESCRIPTION: This function reads in a sequence of numbers (e.g., "10-120"), returning the first and last numbers in the sequence in the integers pointed to by 'start' and 'end'. ***************************************************************/ #if ANSI_C int bwb_numseq( char *buffer, int *start, int *end ) #else int bwb_numseq( buffer, start, end ) char *buffer; int *start; int *end; #endif { register int b, n; int numbers; static char *tbuf; static int init = FALSE; /* get memory for temporary buffer if necessary */ if ( init == FALSE ) { init = TRUE; /* Revised to CALLOC pass-thru call by JBV */ if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "bwb_numseq")) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_numseq(): failed to find memory for tbuf" ); #else bwb_error( err_getmem ); #endif } } if ( buffer[ 0 ] == 0 ) { *start = *end = 0; return FALSE; } numbers = n = b = 0; tbuf[ 0 ] = 0; while( TRUE ) { switch( buffer[ b ] ) { case 0: /* end of string */ case '\n': case '\r': if ( n > 0 ) { if ( numbers == 0 ) { *end = 0; *start = atoi( tbuf ); ++numbers; } else { *end = atoi( tbuf ); return TRUE; } } else { if ( numbers == 0 ) { *start = *end = 0; } else if ( numbers == 1 ) { *end = 0; } else if ( ( numbers == 2 ) && ( tbuf[ 0 ] == 0 )) { *end = 0; } } return TRUE; #ifdef ALLOWWHITESPACE case ' ': /* whitespace */ case '\t': #endif case '-': /* or skip to next number */ if ( n > 0 ) { if ( numbers == 0 ) { *start = atoi( tbuf ); ++numbers; } else { *end = atoi( tbuf ); return TRUE; } } ++b; n = 0; break; case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': tbuf[ n ] = buffer[ b ]; ++n; tbuf[ n ] = 0; ++b; break; default: #if PROG_ERRORS sprintf( bwb_ebuf, "ERROR: character <%c> unexpected in numerical sequence", buffer[ b ] ); ++b; bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif break; } } } /*************************************************************** FUNCTION: bwb_freeline() DESCRIPTION: This function frees memory associated with a program line in memory. ***************************************************************/ #if ANSI_C int bwb_freeline( struct bwb_line *l ) #else int bwb_freeline( l ) struct bwb_line *l; #endif { /* free arguments if there are any */ /* Revised to FREE pass-thru calls by JBV */ if (l->buffer != NULL) { FREE( l->buffer, "bwb_freeline" ); l->buffer = NULL; /* JBV */ } FREE( l, "bwb_freeline" ); l = NULL; /* JBV */ return TRUE; } /*************************************************************** FUNCTION: int_qmdstr() DESCRIPTION: This function returns a string delimited by quotation marks. ***************************************************************/ #if ANSI_C int int_qmdstr( char *buffer_a, char *buffer_b ) #else int int_qmdstr( buffer_a, buffer_b ) char *buffer_a; char *buffer_b; #endif { char *a, *b; a = buffer_a; ++a; /* advance beyond quotation mark */ b = buffer_b; while( *a != '\"' ) { *b = *a; ++a; ++b; *b = '\0'; } return TRUE; } /*************************************************************** FUNCTION: is_eol() DESCRIPTION: This function determines whether the buffer is at the end of a line. ***************************************************************/ #if ANSI_C extern int is_eol( char *buffer, int *position ) #else int is_eol( buffer, position ) char *buffer; int *position; #endif { adv_ws( buffer, position ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in is_eol(): character is <0x%x> = <%c>", buffer[ *position ], buffer[ *position ] ); bwb_debug( bwb_ebuf ); #endif switch( buffer[ *position ] ) { case '\0': case '\n': case '\r': #if MULTISEG_LINES case ':': #endif return TRUE; default: return FALSE; } } bwbasic-2.20pl2.orig/bwb_mes.h100644 0 0 51631 6473161677 14341 0ustar rootroot/*************************************************************** bwb_mes.h Header File for Natural-Language-Specific Text Messages 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). */ /*---------------------------------------------------------------*/ #ifndef TRUE #define TRUE 1 #define FALSE 0 #endif /**************************************************************** The following Latin conventions are used: LATIN ENGLISH acies datorum array (of data) crusta shell litteras (character) string memoria mutabilis RAM organum device ordo line praeceptum command praecepta program (commands) praecepta interna operating system praeceptellum function tabula file ****************************************************************/ #if LATIN #define MES_SIGNON "Interpres ad linguam BASIC, versionis" #define MES_COPYRIGHT "Iure proprio scriptoris (c) 1993, Eduardi de Campobello" #define MES_COPYRIGHT_2 "Iure proprio scriptoris (c) 1995-1997, Jon B. Volkoff" #define MES_LANGUAGE "Cum nuntiis latinis ab ipso E. de C." #define PROMPT "bwBASIC: " #define ERROR_HEADER "ERRANT praecepta in ordine" #define ERRD_HEADER "ERRANT praecepta" #define MATHERR_HEADER "ERRANT praecepta" #define MES_BREAK "Intermittuntur praecepta in ordine" #define ERR_OPENFILE "Non patet tabula quod <%s> vocatur" #define ERR_GETMEM "Deest memoria mutabilis" #define ERR_LINENO "Non adicitur novus ordo praeceptorum" #define ERR_LNNOTFOUND "Non invenitur ordo praeceptorum <%d>" #define ERR_LOADNOFN "LOAD requirit nomen ad tabulam" #define ERR_NOLN "Non invenitur ordo praeceptorum" #define ERR_NOFN "Non invenitur nomen ad tabulam" #define ERR_RETNOGOSUB "RETURN sine GOSUB" #define ERR_INCOMPLETE "Praeceptum imcompletum" #define ERR_ONNOGOTO "ON sine GOTO sive GOSUB" #define ERR_VALOORANGE "Numerus in praeceptis excedit fines" #define ERR_SYNTAX "Non sequunter praecepta" #define ERR_DEVNUM "Numerus ad organum invalidum est" #define ERR_DEV "Errat organum" #define ERR_OPSYS "Errant praecepta interna" #define ERR_ARGSTR "Praeceptum requirit litteras" #define ERR_DEFCHAR "ad varium definiendum" #define ERR_MISMATCH "Non congruunt typus" #define ERR_DIMNOTARRAY "Praeceptum requirit nomen ad aciem datorum" #define ERR_OD "Desunt data" #define ERR_OVERFLOW "Data excedunt fines" #define ERR_NF "NEXT sine FOR" #define ERR_UF "Non definitur praeceptellum" #define ERR_DBZ "Non licet divisio ab nihilo" #define ERR_REDIM "Non licet varium iterum definiendum" #define ERR_OBDIM "Debet OPTION BASE procedere DIM" #define ERR_UC "Praeceptum incognitum est" #define ERR_NOPROGFILE "Tabula praeceptorum non invenitur" #endif #if POL_ENGLISH #define MES_SIGNON "Bywater BASIC Interpreter/Shell, version" #define MES_COPYRIGHT "Copyright (c) 1993, Ted A. Campbell" #define MES_COPYRIGHT_2 "Copyright (c) 1995-1997, Jon B. Volkoff" #define MES_LANGUAGE "Polite English messages courtesy of t.a.c." #define PROMPT "How may we help you? " #define ERROR_HEADER "Very sorry. There is a problem in line" #define ERRD_HEADER "Very sorry. There is a problem" #define MATHERR_HEADER "We have a small problem" #define MES_BREAK "At your request, the program has been interrupted at line" #define ERR_OPENFILE "I'm afraid we have failed \nto open file %s." #define ERR_GETMEM "I'm afraid we have failed \nto find sufficient memory." #define ERR_LINENO "I'm afraid we have failed \nto link line number." #define ERR_LNNOTFOUND "I'm afraid that we \ncannot find line number %d." #define ERR_LOADNOFN "Could you perhaps specify \nwhich file you wish to be loaded?" #define ERR_NOLN "It would help greatly \nif there were a line number here." #define ERR_NOFN "It would help greatly \nif there were a file name here." #define ERR_RETNOGOSUB "Is it possible \nthat there is a RETURN without a GOSUB here?" #define ERR_INCOMPLETE "I'm afraid that the statement\nappears to be incomplete." #define ERR_ONNOGOTO "It appears that there is an ON \nwithout a corresponding GOTO or GOSUB statement." #define ERR_VALOORANGE "A value given here \nseems to be out of range." #define ERR_SYNTAX "Could it be \nthat there is a syntax error at this point?" #define ERR_DEVNUM "The device or file \nnumber here does not seem to be correct." #define ERR_DEV "There appears \nto have been an error addressing the file or device \nwhich you requested." #define ERR_OPSYS "A most unfortunate error \nseems to have been generated by the computer's operating system." #define ERR_ARGSTR "Could you perhaps \nsupply a string argument at this point?" #define ERR_DEFCHAR "The variable definition \nat this point appears to have an improper argument." #define ERR_MISMATCH "It would appear \nthat something in this statement is rather seriously mismatched." #define ERR_DIMNOTARRAY "Could you perhaps \nsupply an array name for the argument at this point?" #define ERR_OD "Oh dear, we seem to have no more data to read now." #define ERR_OVERFLOW "Subhuman devices \ndo have their limits, and we're afraid that at this point \nthe limits of Bywater BASIC have been exceeded." #define ERR_NF "There seems to be \na NEXT statement without a corresponding FOR statement. Could you check on it?" #define ERR_UF "It would appear \nthat the function named at this point has not been defined." #define ERR_DBZ "Unfortunately, \ndivision by zero can cause dreadful problems in a computer." #define ERR_REDIM "We're very sorry \nto say that a variable such as this cannot be redimensioned." #define ERR_OBDIM "It would be ever so helpful \nif the OPTION BASE statement were to be called prior to the DIM statement." #define ERR_UC "I'm afraid that \nwe are unable to recognize the command you have given here." #define ERR_NOPROGFILE "Very sorry, but \nwe simply must have a program file to interpret." #endif #if IMP_ENGLISH #define MES_SIGNON "Bywater BASIC Interpreter/Shell, version" #define MES_COPYRIGHT "Watch it: Copyright (c) 1993, Ted A. Campbell" #define MES_COPYRIGHT_2 "This means you: Copyright (c) 1995-1997, Jon B. Volkoff" #define MES_LANGUAGE "Impolite English messages courtesy of Oscar the Grouch" #define PROMPT "(*sigh) What now? " #define ERROR_HEADER "YOU SCREWED UP at line" #define ERRD_HEADER "YOU SCREWED UP" #define MATHERR_HEADER "ANOTHER SCREWUP!" #define MES_BREAK "Only a geek like you would interrupt this program at line" #define ERR_OPENFILE "Ha ha! I can't open file %s. Too bad, sucker." #define ERR_GETMEM "There isn't near enough memory \nfor this lunacy." #define ERR_LINENO "You jerk: \nyou entered a non-existent line number." #define ERR_LNNOTFOUND "You total idiot. \nLine number %d isn't there. HA!" #define ERR_LOADNOFN "Get out of here. \nNo way to load that file." #define ERR_NOLN "Dumb bozo: you need to put \na LINE NUMBER here. Hint: Can you count?" #define ERR_NOFN "Nerd of the year. \nYou forgot to enter a file name. \nWhy don't you learn BASIC and come back in a year?" #define ERR_RETNOGOSUB "Oh come on, total amateur. \nYou've got a RETURN without a GOSUB" #define ERR_INCOMPLETE "Dimwit. Why don't you \ncomplete the statement here for a change." #define ERR_ONNOGOTO "You failed again: \nON without a GOTO or GOSUB." #define ERR_VALOORANGE "Go home, beginner. \nThe value here is way out of range." #define ERR_SYNTAX "Sure sign of a fourth-rate programmer: \nThis makes no sense at all." #define ERR_DEVNUM "Way to go, space cadet. \nThe device (or file) number here is totally in orbit." #define ERR_DEV "HO! The file or device \n you requested says: DROP DEAD." #define ERR_OPSYS "You obviously don't know \nwhat this computer can or can't do." #define ERR_ARGSTR "Do you have big ears? \n(Like Dumbo?) You obviously need a string argument at this point." #define ERR_DEFCHAR "Amazing. Surely children \nknow how to form a corrent argument here." #define ERR_MISMATCH "No way, turkey. \nThe statement here is TOTALLY mismatched." #define ERR_DIMNOTARRAY "Incredible. Why don't you \nsuppy an ARRAY NAME where the prograqm calls for an ARRAY NAME? (Or just go home.)" #define ERR_OD "Have you ever studied BASIC before? \nYou've run out of data." #define ERR_OVERFLOW "Congratulations on writing a program \nthat totally exceeds all limits." #define ERR_NF "Go back to kindergarten: \nYou have a NEXT statement FOR." #define ERR_UF "Trash. Total trash. \nDefine your stupid functions before calling them." #define ERR_DBZ "Obviously, you'll never be a programmer. \nYou've tried division by zero here." #define ERR_REDIM "You just don't understand: \nyou cannot redimension this variable." #define ERR_OBDIM "Dork. You called OPTION BASE after DIM. \nLeave me alone." #define ERR_UC "What do you think this is? \nTry entering a BASIC command here." #define ERR_NOPROGFILE "Idiot. No way this will run without a program file." #endif #if STD_RUSSIAN #define MES_SIGNON "iNTERPRETATOR Bywater BASIC, WERSIQ" #define MES_COPYRIGHT "Copyright (c) 1993, Ted A. Campbell" #define MES_COPYRIGHT_2 "Copyright (c) 1995-1997, Jon B. Volkoff" #define MES_LANGUAGE "" #define PROMPT "gOTOWO" #define ERROR_HEADER "o{ibka W STROKE" #define MATHERR_HEADER "o{ibka" #define MES_BREAK "pROGRAMMA PRERWANA W STROKE" #define ERR_OPENFILE "nE MOGU OTKRYTX FAJL %s" #define ERR_GETMEM "mALO PAMQTI" #define ERR_LINENO "nEWERNYJ NOMER STROKI" #define ERR_LNNOTFOUND "sTROKA %d NE NAJDENA" #define ERR_LOADNOFN "LOAD: NE ZADANO IMQ FAJLA" #define ERR_NOLN "oTSUTSTWUET NOMER STROKI" #define ERR_NOFN "oTSUTSTWUET IMQ FAJLA" #define ERR_RETNOGOSUB "RETURN BEZ GOSUB" #define ERR_INCOMPLETE "nEWER[ENNYJ OPERATOR" #define ERR_ONNOGOTO "ON BEZ GOTO ILI GOSUB" #define ERR_VALOORANGE "zNA^ENIE WNE DIAPAZONA" #define ERR_SYNTAX "sINTAKSI^ESKAQ O[IBKA" #define ERR_DEVNUM "nEWERNYJ NOMER USTROJSTWA" #define ERR_DEV "o[IBKA USTROJSTWA" #define ERR_OPSYS "o[IBKA W KOMANDE OPERACIONNOJ SISTEMY" #define ERR_ARGSTR "aRGUMENT DOLVEN BYTX STROKOJ" #define ERR_DEFCHAR "nEWERNYJ ARGUMENT W OPREDELENII PEREMENNOJ" #define ERR_MISMATCH "nESOOTWETSTWIE TIPOW" #define ERR_DIMNOTARRAY "aRGUMENT NE IMQ MASSIWA" #define ERR_OD "nET DANNYH" #define ERR_OVERFLOW "pEREPOLNENIE" #define ERR_NF "NEXT BEZ FOR" #define ERR_UF "nEOPREDELENNAQ FUNKCIQ" #define ERR_DBZ "dELENIE NA NOLX" #define ERR_REDIM "nELXZQ MENQTX RAZMERNOSTX PEREMENNOJ" #define ERR_OBDIM "OPTION BASE DOLVNA BYTX WYZWANA DO DIM" #define ERR_UC "nEWERNAQ KOMANDA" #define ERR_NOPROGFILE "Program file not specified" #endif /* STD_GERMAN */ #if STD_GERMAN #define MES_SIGNON "Bywater BASIC Interpreter/Shell, version" #define MES_COPYRIGHT "Copyright (c) 1993, Ted A. Campbell" #define MES_COPYRIGHT_2 "Copyright (c) 1995-1997, Jon B. Volkoff" #define MES_LANGUAGE "Ausgegeben auf Deutsch von Joerg Rieger" #define PROMPT "bwBASIC: " #define ERROR_HEADER "Irrtum in Zeile" #define ERRD_HEADER "IRRTUM" #define MATHERR_HEADER "IRRTUM" #define MES_BREAK "Programm unterbrochen in Zeile" #define ERR_OPENFILE "Datei %s kann nict geoeffnet werden" #define ERR_GETMEM "Speicher kann nicht gefunden werden" #define ERR_LINENO "Zeilennummer kann nicht verbunden werden" #define ERR_LNNOTFOUND "Zeilennummer %d nicht gefunden" #define ERR_LOADNOFN "LOAD: Keine Dateiname angegeben" #define ERR_NOLN "Keine Zeilennummer" #define ERR_NOFN "Keine Dateiname" #define ERR_RETNOGOSUB "RETURN ohne GOSUB" #define ERR_INCOMPLETE "Angabe nicht vollstaendig" #define ERR_ONNOGOTO "ON ohne GOTO oder GOSUB" #define ERR_VALOORANGE "Wert is ausserhalb des Grenzbereits" #define ERR_SYNTAX "Syntax-fehler" #define ERR_DEVNUM "Ungueltige Geraetnummer" #define ERR_DEV "Geraet irrtum" #define ERR_OPSYS "Irrtum in Anwenden des System-Befehls" #define ERR_ARGSTR "Das Argument muss geradlinig sein" #define ERR_DEFCHAR "Falsches Argument fuer eine Variable Definition" #define ERR_MISMATCH "Type verwechselt" #define ERR_DIMNOTARRAY "Das Argument ist kein Feldname" #define ERR_OD "Keine Daten mehr vorhanden" #define ERR_OVERFLOW "Ueberflutung" #define ERR_NF "NEXT ohne FOR" #define ERR_UF "Funktion nicht definiert" #define ERR_DBZ "Teile durch Null" #define ERR_REDIM "Die Variable kann nicht neu dimensioniert werdern" #define ERR_OBDIM "OPTION BASE muss vor DIM aufgerufen werden" #define ERR_UC "Befehl unbekannt" #define ERR_NOPROGFILE "Programm Datei nicht angegeben" #endif /* ESPERANTO */ #if ESPERANTO #define MES_SIGNON "Bywater BASIC Tradukilo/SXelo, vario" #define MES_COPYRIGHT "Kopirajtita (c) 1993, Ted A. Campbell" #define MES_COPYRIGHT_2 "Kopirajtita (c) 1995-1997, Jon B. Volkoff" #define MES_LANGUAGE "Esperanta traduko farigxi per Ricxjo Muelisto." #define PROMPT "bwBASIC: " #define ERROR_HEADER "ERARO en vico" #define ERRD_HEADER "ERARO" #define MATHERR_HEADER "ERARO" #define MES_BREAK "Programo interrompita cxe vico" #define ERR_OPENFILE "Malsukcesis malfermi dosieron %s" #define ERR_GETMEM "Malsukcesis trovi memorajxo" #define ERR_LINENO "Malsukcesis ligi vicnumero" #define ERR_LNNOTFOUND "Vicnumero %d ne trovita" #define ERR_LOADNOFN "LOAD: dosiernomo ne specifita" #define ERR_NOLN "Ne estas vicnumero" #define ERR_NOFN "Ne estas dosiernomo" #define ERR_RETNOGOSUB "RETURN sen GOSUB" #define ERR_INCOMPLETE "Necompleta deklaro" #define ERR_ONNOGOTO "ON sen GOTO aux GOSUB" #define ERR_VALOORANGE "Valorajxo estas eksteretenda" #define ERR_SYNTAX "Sintakseraro" #define ERR_DEVNUM "Nevalida aparatnumero" #define ERR_DEV "Aparateraro" #define ERR_OPSYS "Eraro en funkcisistema ordono" #define ERR_ARGSTR "Argumento devas esti serio" #define ERR_DEFCHAR "Erara argumento por varianto difinajxo" #define ERR_MISMATCH "Tipa misparo" #define ERR_DIMNOTARRAY "Argumento ne estas kolektonomo" #define ERR_OD "Ne havas pli da informoj" #define ERR_OVERFLOW "Ektroajxo" #define ERR_NF "NEXT sen FOR" #define ERR_UF "Nedifininta funkcio" #define ERR_DBZ "Dividu per nulo" #define ERR_REDIM "Varianto ne eble esti redimensigxinta" #define ERR_OBDIM "OPTION BASE devas uzigxi antaux ol DIM" #define ERR_UC "Nekonata ordono" #define ERR_NOPROGFILE "Programa dosiero ne specifita" #endif /* Standard English is taken as a default: if MES_SIGNON is not defined by this time (i.e., by some other language definition), then the following standard English definitions are utilized. */ #ifndef MES_SIGNON #define MES_SIGNON "Bywater BASIC Interpreter/Shell, version" #define MES_COPYRIGHT "Copyright (c) 1993, Ted A. Campbell" #define MES_COPYRIGHT_2 "Copyright (c) 1995-1997, Jon B. Volkoff" #define MES_LANGUAGE " " #define PROMPT "bwBASIC: " #define ERROR_HEADER "ERROR in line" #define ERRD_HEADER "ERROR" #define MATHERR_HEADER "ERROR" #define MES_BREAK "Program interrupted at line" #define ERR_OPENFILE "Failed to open file %s" #define ERR_GETMEM "Failed to find memory" #define ERR_LINENO "Failed to link line number" #define ERR_LNNOTFOUND "Line number %d not found" #define ERR_LOADNOFN "LOAD: no filename specified" #define ERR_NOLN "No line number" #define ERR_NOFN "No file name" #define ERR_RETNOGOSUB "RETURN without GOSUB" #define ERR_INCOMPLETE "Incomplete statement" #define ERR_ONNOGOTO "ON without GOTO or GOSUB" #define ERR_VALOORANGE "Value is out of range" #define ERR_SYNTAX "Syntax error" #define ERR_DEVNUM "Invalid device number" #define ERR_DEV "Device error" #define ERR_OPSYS "Error in operating system command" #define ERR_ARGSTR "Argument must be a string" #define ERR_DEFCHAR "Incorrect argument for variable definition" #define ERR_MISMATCH "Type mismatch" #define ERR_DIMNOTARRAY "Argument is not an array name" #define ERR_OD "Out of data" #define ERR_OVERFLOW "Overflow" #define ERR_NF "NEXT without FOR" #define ERR_UF "Undefined function" #define ERR_DBZ "Divide by zero" #define ERR_REDIM "Variable cannot be redimensioned" #define ERR_OBDIM "OPTION BASE must be called prior to DIM" #define ERR_UC "Unknown command" #define ERR_NOPROGFILE "Program file not specified" #endif /**************************************************************** BASIC Command Name Definitions The following definitions of command names are given in order to allow users to redefine BASIC command names. No alternatives are supplied. ****************************************************************/ #ifndef CMD_SYSTEM #define CMD_SYSTEM "SYSTEM" #define CMD_QUIT "QUIT" #define CMD_REM "REM" #define CMD_LET "LET" #define CMD_PRINT "PRINT" #define CMD_INPUT "INPUT" #define CMD_GO "GO" #define CMD_GOTO "GOTO" #define CMD_GOSUB "GOSUB" #define CMD_RETURN "RETURN" #define CMD_ON "ON" #define CMD_IF "IF" #define CMD_WHILE "WHILE" #define CMD_WEND "WEND" #define CMD_WRITE "WRITE" #define CMD_END "END" #define CMD_FOR "FOR" #define CMD_NEXT "NEXT" #define CMD_STOP "STOP" #define CMD_DATA "DATA" #define CMD_READ "READ" #define CMD_RESTORE "RESTORE" #define CMD_DIM "DIM" #define CMD_OPTION "OPTION" #define CMD_OPEN "OPEN" #define CMD_CLOSE "CLOSE" #define CMD_GET "GET" #define CMD_PUT "PUT" #define CMD_LSET "LSET" #define CMD_RSET "RSET" #define CMD_FIELD "FIELD" #define CMD_LINE "LINE" #define CMD_DEF "DEF" #define CMD_VARS "VARS" #define CMD_CMDS "CMDS" #define CMD_FNCS "FNCS" #define CMD_CHDIR "CHDIR" #define CMD_MKDIR "MKDIR" #define CMD_RMDIR "RMDIR" #define CMD_KILL "KILL" #define CMD_ENVIRON "ENVIRON" #define CMD_LIST "LIST" #define CMD_LOAD "LOAD" #define CMD_RUN "RUN" #define CMD_SAVE "SAVE" #define CMD_DELETE "DELETE" #define CMD_NEW "NEW" #define CMD_DEFDBL "DEFDBL" #define CMD_DEFINT "DEFINT" #define CMD_DEFSNG "DEFSNG" #define CMD_DEFSTR "DEFSTR" #define CMD_MID "MID$" #define CMD_CALL "CALL" #define CMD_SUB "SUB" #define CMD_FUNCTION "FUNCTION" #define CMD_LABEL "lAbEl" /* not really used: set to an unlikely combination */ #define CMD_ELSE "ELSE" #define CMD_ELSEIF "ELSEIF" #define CMD_SELECT "SELECT" #define CMD_CASE "CASE" #define CMD_MERGE "MERGE" #define CMD_CHAIN "CHAIN" #define CMD_COMMON "COMMON" #define CMD_ERROR "ERROR" #define CMD_WIDTH "WIDTH" #define CMD_TRON "TRON" #define CMD_TROFF "TROFF" #define CMD_RANDOMIZE "RANDOMIZE" #define CMD_FILES "FILES" #define CMD_EDIT "EDIT" #define CMD_RENUM "RENUM" #define CMD_ERASE "ERASE" #define CMD_SWAP "SWAP" #define CMD_NAME "NAME" #define CMD_CLEAR "CLEAR" #define CMD_THEN "THEN" #define CMD_TO "TO" #define CMD_STEP "STEP" #define CMD_DO "DO" #define CMD_LOCATE "LOCATE" #define CMD_CLS "CLS" #define CMD_COLOR "COLOR" #define CMD_LOOP "LOOP" #define CMD_EXIT "EXIT" #define CMD_XUSING "USING" #define CMD_XFOR "FOR" #define CMD_XDO "DO" #define CMD_XUNTIL "UNTIL" #define CMD_XNUM "NUM" #define CMD_XUNNUM "UNNUM" #define CMD_XSUB "SUB" #define CMD_XTO "TO" #define CMD_XERROR "ERROR" #define CMD_XSUB "SUB" #define CMD_XFUNCTION "FUNCTION" #define CMD_XIF "IF" #define CMD_XSELECT "SELECT" #endif /**************************************************************** External Definitions for Error Messages ****************************************************************/ extern char err_openfile[]; extern char err_getmem[]; extern char err_noln[]; extern char err_nofn[]; extern char err_lnnotfound[]; extern char err_incomplete[]; extern char err_valoorange[]; extern char err_syntax[]; extern char err_devnum[]; extern char err_dev[]; extern char err_opsys[]; extern char err_argstr[]; extern char err_defchar[]; extern char err_mismatch[]; extern char err_dimnotarray[]; extern char err_retnogosub[]; extern char err_od[]; extern char err_overflow[]; extern char err_nf[]; extern char err_uf[]; extern char err_dbz[]; extern char err_redim[]; extern char err_obdim[]; extern char err_uc[]; extern char err_noprogfile[]; bwbasic-2.20pl2.orig/bwb_mth.c100644 0 0 132541 6473161700 14343 0ustar rootroot/**************************************************************** bwb_mth.c Mathematical 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). */ /*---------------------------------------------------------------*/ #include #include #include #include #include "bwbasic.h" #include "bwb_mes.h" #ifndef RAND_MAX /* added in v1.11 */ #define RAND_MAX 32767 #endif #if ANSI_C bnumber round_int( bnumber x ); #else bnumber round_int(); #endif #if MS_FUNCS union un_integer { int the_integer; unsigned char the_chars[ sizeof( int ) ]; } an_integer; union un_single { float the_float; unsigned char the_chars[ sizeof( float) ]; } a_float; union un_double { double the_double; unsigned char the_chars[ sizeof( double ) ]; } a_double; #endif #if COMPRESS_FUNCS /*************************************************************** FUNCTION: fnc_core() DESCRIPTION: This C function implements all core BASIC functions if COMPRESS_FUNCS is TRUE. This method saves program space. ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_core( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_core( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; bnumber nval; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_core(): entered function" ); bwb_debug( bwb_ebuf ); #endif /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; strncpy( nvar.name, "(core var)", MAXVARNAMESIZE ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_core(): ready to make local variable <%s>", nvar.name ); bwb_debug( bwb_ebuf ); #endif var_make( &nvar, NUMBER ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_core(): received f_arg <%f> nvar type <%c>", var_getnval( &( argv[ 0 ] ) ), nvar.type ); bwb_debug( bwb_ebuf ); #endif /* check for number of arguments as appropriate */ switch ( unique_id ) { case F_RND: /* no arguments necessary for RND */ break; default: #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to core function.", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to core function.", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif } /* assign values */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_core(): nvar type <%c>; calling findnval()", nvar.type ); bwb_debug( bwb_ebuf ); #endif switch( unique_id ) { case F_ABS: /* Added double recast here (JBV) */ * var_findnval( &nvar, nvar.array_pos ) = (bnumber) fabs( (double) var_getnval( &( argv[ 0 ] ) ) ); break; case F_ATN: * var_findnval( &nvar, nvar.array_pos ) = (bnumber) atan( (double) var_getnval( &( argv[ 0 ] ) ) ); break; case F_COS: * var_findnval( &nvar, nvar.array_pos ) = (bnumber) cos( (double) var_getnval( &( argv[ 0 ] ) ) ); break; case F_EXP: /* Added double recast here (JBV) */ * var_findnval( &nvar, nvar.array_pos ) = (bnumber) exp( (double) var_getnval( &( argv[ 0 ] ) ) ); break; case F_INT: * var_findnval( &nvar, nvar.array_pos ) = (bnumber) floor( (double) var_getnval( &( argv[ 0 ] ) ) ); break; case F_LOG: * var_findnval( &nvar, nvar.array_pos ) = (bnumber) log( (double) var_getnval( &( argv[ 0 ] ) ) ); break; case F_RND: /* Added bnumber recast here (JBV) */ * var_findnval( &nvar, nvar.array_pos ) = (bnumber) ( (float) rand() / RAND_MAX ); break; case F_SGN: nval = var_getnval( &( argv[ 0 ] )); if ( nval == (bnumber) 0.0 ) { * var_findnval( &nvar, nvar.array_pos ) = (bnumber) 0; } else if ( nval > (bnumber) 0.0 ) { * var_findnval( &nvar, nvar.array_pos ) = (bnumber) 1; } else { * var_findnval( &nvar, nvar.array_pos ) = (bnumber) -1; } break; case F_SIN: * var_findnval( &nvar, nvar.array_pos ) = (bnumber) sin( (double) var_getnval( &( argv[ 0 ] ) ) ); break; case F_SQR: * var_findnval( &nvar, nvar.array_pos ) = (bnumber) sqrt( (double) var_getnval( &( argv[ 0 ] ) ) ); break; case F_TAN: * var_findnval( &nvar, nvar.array_pos ) = (bnumber) tan( (double) var_getnval( &( argv[ 0 ] ) ) ); break; } return &nvar; } #else /*************************************************************** FUNCTION: fnc_abs() DESCRIPTION: This C function implements the BASIC predefined ABS function, returning the absolute value of the argument. SYNTAX: ABS( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_abs( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_abs( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_abs(): entered function" ); bwb_debug( bwb_ebuf ); #endif /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; strncpy( nvar.name, "(abs var)", MAXVARNAMESIZE ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_abs(): ready to make local variable <%s>", nvar.name ); bwb_debug( bwb_ebuf ); #endif var_make( &nvar, NUMBER ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_abs(): received f_arg <%f> nvar type <%c>", var_getnval( &( argv[ 0 ] ) ), nvar.type ); bwb_debug( bwb_ebuf ); #endif #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function ABS().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function ABS().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* assign values */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_abs(): nvar type <%c>; calling finnval()", nvar.type ); bwb_debug( bwb_ebuf ); #endif /* Added double recast here (JBV) */ * var_findnval( &nvar, nvar.array_pos ) = (bnumber) fabs( (double) var_getnval( &( argv[ 0 ] ) ) ); return &nvar; } /*************************************************************** FUNCTION: fnc_rnd() DESCRIPTION: This C function implements the BASIC predefined RND function, returning a pseudo-random number in the range 0 to 1. It is affected by the RANDOMIZE command statement. SYNTAX: RND( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_rnd( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_rnd( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } /* Added bnumber recast here (JBV) */ * var_findnval( &nvar, nvar.array_pos ) = (bnumber) ( (float) rand() / RAND_MAX ); return &nvar; } /*************************************************************** FUNCTION: fnc_atn() DESCRIPTION: This C function implements the BASIC predefined ATN function, returning the arctangent of the argument. SYNTAX: ATN( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_atn( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_atn( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_atn(): received f_arg <%f> ", var_getnval( &( argv[ 0 ] ) ) ); bwb_debug( bwb_ebuf ); #endif #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function ATN().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function ATN().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* assign values */ * var_findnval( &nvar, nvar.array_pos ) = (bnumber) atan( (double) var_getnval( &( argv[ 0 ] ) ) ); return &nvar; } /*************************************************************** FUNCTION: fnc_cos() DESCRIPTION: This C function implements the BASIC predefined COS function, returning the cosine of the argument. SYNTAX: COS( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_cos( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_cos( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_cos(): received f_arg <%f> ", var_getnval( &( argv[ 0 ] ) ) ); bwb_debug( bwb_ebuf ); #endif #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function COS().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function COS().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* assign values */ * var_findnval( &nvar, nvar.array_pos ) = (bnumber) cos( (double) var_getnval( &( argv[ 0 ] ) ) ); return &nvar; } /*************************************************************** FUNCTION: fnc_log() DESCRIPTION: This C function implements the BASIC predefined LOG function, returning the natural logarithm of the argument. SYNTAX: LOG( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_log( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_log( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_log(): received f_arg <%f> ", var_getnval( &( argv[ 0 ] ) ) ); bwb_debug( bwb_ebuf ); #endif #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function LOG().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function LOG().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* assign values */ * var_findnval( &nvar, nvar.array_pos ) = (bnumber) log( (double) var_getnval( &( argv[ 0 ] ) ) ); return &nvar; } /*************************************************************** FUNCTION: fnc_sin() DESCRIPTION: This C function implements the BASIC predefined SIN function, returning the sine of the argument. SYNTAX: SIN( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_sin( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_sin( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_sin(): received f_arg <%f> ", var_getnval( &( argv[ 0 ] ) ) ); bwb_debug( bwb_ebuf ); #endif #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function SIN().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function SIN().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* assign values */ * var_findnval( &nvar, nvar.array_pos ) = (bnumber) sin( (double) var_getnval( &( argv[ 0 ] ) ) ); return &nvar; } /*************************************************************** FUNCTION: fnc_sqr() DESCRIPTION: This C function implements the BASIC predefined SQR function, returning the square root of the argument. SYNTAX: SQR( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_sqr( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_sqr( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_sqr(): received f_arg <%f> ", var_getnval( &( argv[ 0 ] ) ) ); bwb_debug( bwb_ebuf ); #endif #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function SQR().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function SQR().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* assign values */ * var_findnval( &nvar, nvar.array_pos ) = (bnumber) sqrt( (double) var_getnval( &( argv[ 0 ] ) ) ); return &nvar; } /*************************************************************** FUNCTION: fnc_tan() DESCRIPTION: This C function implements the BASIC predefined TAN function, returning the tangent of the argument. SYNTAX: TAN( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_tan( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_tan( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_tan(): received f_arg <%f> ", var_getnval( &( argv[ 0 ] ) ) ); bwb_debug( bwb_ebuf ); #endif #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function TAN().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function TAN().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* assign values */ * var_findnval( &nvar, nvar.array_pos ) = (bnumber) tan( (double) var_getnval( &( argv[ 0 ] ) ) ); return &nvar; } /*************************************************************** FUNCTION: fnc_sgn() DESCRIPTION: This C function implements the BASIC predefined SGN function, returning 0 if the argument is 0, -1 if the argument is less than 0, or 1 if the argument is more than 0. SYNTAX: SGN( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_sgn( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_sgn( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; bnumber nval; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_sgn(): received f_arg <%f> ", var_getnval( &( argv[ 0 ] ) ) ); bwb_debug( bwb_ebuf ); #endif #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function SGN().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function SGN().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* assign values */ nval = var_getnval( &( argv[ 0 ] )); if ( nval == (bnumber) 0.0 ) { * var_findnval( &nvar, nvar.array_pos ) = (bnumber) 0; } else if ( nval > (bnumber) 0.0 ) { * var_findnval( &nvar, nvar.array_pos ) = (bnumber) 1; } else { * var_findnval( &nvar, nvar.array_pos ) = (bnumber) -1; } return &nvar; } /*************************************************************** FUNCTION: fnc_int() DESCRIPTION: This C function implements the BASIC predefined INT function, returning an integer value less then or equal to the argument. SYNTAX: INT( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_int( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_int( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_int(): received f_arg <%f> ", var_getnval( &( argv[ 0 ] ) ) ); bwb_debug( bwb_ebuf ); #endif #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function INT().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function INT().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* assign values */ * var_findnval( &nvar, nvar.array_pos ) = (bnumber) floor( (double) var_getnval( &( argv[ 0 ] ) ) ); return &nvar; } /*************************************************************** FUNCTION: fnc_exp() DESCRIPTION: This C function implements the BASIC EXP() function, returning the exponential value of the argument. SYNTAX: EXP( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_exp( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_exp( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function EXP().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function EXP().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* assign values */ /* Added double recast here (JBV) */ * var_findnval( &nvar, nvar.array_pos ) = (bnumber) exp( (double) var_getnval( &( argv[ 0 ] ) ) ); return &nvar; } #endif /* COMPRESS_FUNCS */ #if COMMON_FUNCS /*************************************************************** FUNCTION: fnc_val() DESCRIPTION: This C function implements the BASIC VAL() function, returning the numerical value of its string argument. SYNTAX: VAL( string$ ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_val( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_val( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static char *tbuf; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); /* Revised to CALLOC pass-thru call by JBV */ if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "fnc_val" )) == NULL ) { #if PROG_ERRORS bwb_error( "in fnc_val(): failed to get memory for tbuf" ); #else bwb_error( err_getmem ); #endif } } /* check arguments */ #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough arguments to function VAL()" ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function VAL().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif if ( argv[ 0 ].type != STRING ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Argument to function VAL() must be a string." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif return NULL; } /* read the value */ str_btoc( tbuf, var_getsval( &( argv[ 0 ] ) )); *var_findnval( &nvar, nvar.array_pos ) = (bnumber) 0; /* JBV 1/97 */ if ( strlen( tbuf ) != 0 ) /* JBV 1/97 (was == 0 with else) */ #if NUMBER_DOUBLE sscanf( tbuf, "%lf", var_findnval( &nvar, nvar.array_pos ) ); #else sscanf( tbuf, "%f", var_findnval( &nvar, nvar.array_pos ) ); #endif return &nvar; } /*************************************************************** FUNCTION: fnc_str() DESCRIPTION: This C function implements the BASIC STR$() function, returning an ASCII string with the decimal value of the numerical argument. SYNTAX: STR$( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_str( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_str( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static char *tbuf; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, STRING ); /* Revised to CALLOC pass-thru call by JBV */ if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "fnc_str" )) == NULL ) { #if PROG_ERRORS bwb_error( "in fnc_str(): failed to get memory for tbuf" ); #else bwb_error( err_getmem ); #endif } } /* check parameters */ #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function STR$().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function STR$().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* format as decimal number */ sprintf( tbuf, " %.*f", prn_precision( &( argv[ 0 ] ) ), var_getnval( &( argv[ 0 ] ) ) ); str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf ); return &nvar; } #endif /* COMMON_FUNCS */ #if MS_FUNCS /*************************************************************** FUNCTION: fnc_hex() DESCRIPTION: This C function implements the BASIC HEX$() function, returning a string containing the hexadecimal value of the numerical argument. SYNTAX: HEX$( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_hex( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_hex( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static char *tbuf; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, STRING ); /* Revised to CALLOC pass-thru call by JBV */ if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "fnc_hex" )) == NULL ) { #if PROG_ERRORS bwb_error( "in fnc_hex(): failed to get memory for tbuf" ); #else bwb_error( err_getmem ); #endif } } /* check parameters */ #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function HEX$().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function HEX$().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* format as hex integer */ sprintf( tbuf, "%X", (int) trnc_int( (bnumber) var_getnval( &( argv[ 0 ] )) ) ); str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf ); return &nvar; } /*************************************************************** FUNCTION: fnc_oct() DESCRIPTION: This C function implements the BASIC OCT$() function, returning a string with the octal value of the numerical argument. SYNTAX: OCT$( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_oct( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_oct( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static char *tbuf; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, STRING ); /* Revised to CALLOC pass-thru call by JBV */ if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "fnc_oct" )) == NULL ) { #if PROG_ERRORS bwb_error( "in fnc_oct(): failed to get memory for tbuf" ); #else bwb_error( err_getmem ); #endif } } /* check parameters */ #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function OCT$().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function OCT$().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* format as octal integer */ /* Revised by JBV */ /* sprintf( tbuf, "%o", (int) var_getnval( &( argv[ 0 ] ) ) ); */ sprintf( tbuf, "%o", (int) trnc_int( (bnumber) var_getnval( &( argv[ 0 ] )) ) ); str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf ); return &nvar; } /*************************************************************** FUNCTION: fnc_mki() DESCRIPTION: This C function implements the BASIC predefined MKI$() function. NOTE: As implemented in bwBASIC, this is a pseudo-function, since bwBASIC does not recognize precision levels. SYNTAX: MKI$( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_mki( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_mki( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { register int i; static struct bwb_variable nvar; bstring *b; static char tbuf[ sizeof( int ) ]; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, STRING ); } #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function MKI$().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function MKI$().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* assign values */ an_integer.the_integer = (int) var_getnval( &( argv[ 0 ] ) ); for ( i = 0; i < sizeof( int ); ++i ) { tbuf[ i ] = an_integer.the_chars[ i ]; tbuf[ i + 1 ] = '\0'; } b = var_getsval( &nvar ); b->length = sizeof( int ); b->sbuffer = tbuf; b->rab = FALSE; return &nvar; } /*************************************************************** FUNCTION: fnc_mkd() DESCRIPTION: This C function implements the BASIC predefined MKD$() function. NOTE: As implemented in bwBASIC, this is a pseudo-function, since bwBASIC does not recognize precision levels. SYNTAX: MKD$( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_mkd( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_mkd( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { register int i; static struct bwb_variable nvar; bstring *b; static char tbuf[ sizeof ( double ) ]; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, STRING ); } #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function MKD$().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function MKD$().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* assign values */ a_double.the_double = var_getnval( &( argv[ 0 ] ) ); for ( i = 0; i < sizeof ( double ); ++i ) { tbuf[ i ] = a_double.the_chars[ i ]; tbuf[ i + 1 ] = '\0'; } b = var_getsval( &nvar ); b->length = sizeof( double ); b->sbuffer = tbuf; b->rab = FALSE; return &nvar; } /*************************************************************** FUNCTION: fnc_mks() DESCRIPTION: This C function implements the BASIC predefined MKS$() function. NOTE: As implemented in bwBASIC, this is a pseudo-function, since bwBASIC does not recognize precision levels. SYNTAX: MKS$( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_mks( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_mks( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { register int i; static struct bwb_variable nvar; static char tbuf[ 5 ]; bstring *b; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, STRING ); } #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function MKS$().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function MKS$().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* assign values */ a_float.the_float = var_getnval( &( argv[ 0 ] ) ); for ( i = 0; i < sizeof( float ); ++i ) { tbuf[ i ] = a_float.the_chars[ i ]; tbuf[ i + 1 ] = '\0'; } b = var_getsval( &nvar ); b->length = sizeof( float ); b->sbuffer = tbuf; b->rab = FALSE; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_mks(): string <%s> hex vals <%X><%X><%X><%X>", tbuf, tbuf[ 0 ], tbuf[ 1 ], tbuf[ 2 ], tbuf[ 3 ] ); bwb_debug( bwb_ebuf ); #endif return &nvar; } /*************************************************************** FUNCTION: fnc_cvi() DESCRIPTION: This C function implements the BASIC predefined CVI() function. NOTE: As implemented in bwBASIC, this is a pseudo-function, since bwBASIC does not recognize precision levels. SYNTAX: CVI( string$ ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_cvi( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_cvi( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { register int i; struct bwb_variable *v; bstring *b; static struct bwb_variable nvar; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function CVI().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function CVI().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* assign values */ v = &( argv[ 0 ] ); b = var_findsval( v, v->array_pos ); for ( i = 0; i < sizeof( int ); ++i ) { an_integer.the_chars[ i ] = b->sbuffer[ i ]; } * var_findnval( &nvar, nvar.array_pos ) = (bnumber) an_integer.the_integer; return &nvar; } /*************************************************************** FUNCTION: fnc_cvd() DESCRIPTION: This C function implements the BASIC predefined CVD() function. NOTE: As implemented in bwBASIC, this is a pseudo-function, since bwBASIC does not recognize precision levels. SYNTAX: CVD( string$ ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_cvd( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_cvd( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { register int i; struct bwb_variable *v; bstring *b; static struct bwb_variable nvar; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function CVD().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function CVD().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* assign values */ v = &( argv[ 0 ] ); b = var_findsval( v, v->array_pos ); for ( i = 0; i < sizeof( double ); ++i ) { a_double.the_chars[ i ] = b->sbuffer[ i ]; } * var_findnval( &nvar, nvar.array_pos ) = (bnumber) a_double.the_double; return &nvar; } /*************************************************************** FUNCTION: fnc_cvs() DESCRIPTION: This C function implements the BASIC predefined CVS() function. NOTE: As implemented in bwBASIC, this is a pseudo-function, since bwBASIC does not recognize precision levels. SYNTAX: CVS( string$ ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_cvs( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_cvs( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { register int i; struct bwb_variable *v; bstring *b; static struct bwb_variable nvar; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function CVS().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function CVS().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* assign values */ v = &( argv[ 0 ] ); b = var_findsval( v, v->array_pos ); for ( i = 0; i < sizeof( float ); ++i ) { a_float.the_chars[ i ] = b->sbuffer[ i ]; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fnc_cvs(): string <%s> hex vals <%X><%X><%X><%X>", a_float.the_chars, a_float.the_chars[ 0 ], a_float.the_chars[ 1 ], a_float.the_chars[ 2 ], a_float.the_chars[ 3 ] ); bwb_debug( bwb_ebuf ); #endif * var_findnval( &nvar, nvar.array_pos ) = a_float.the_float; return &nvar; } /*************************************************************** FUNCTION: fnc_csng() DESCRIPTION: This C function implements the BASIC function CSNG(). As implemented, this is a pseudo-function, since all bwBASIC numerical values have the same precision. SYNTAX: CSNG( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_csng( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_csng( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } /* check parameters */ #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function CINT().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function CINT().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* get truncated integer value */ * var_findnval( &nvar, nvar.array_pos ) = (bnumber) var_getnval( &( argv[ 0 ] ) ); return &nvar; } /*************************************************************** FUNCTION: fnc_cint() DESCRIPTION: This C function returns the truncated rounded integer value of its numerical argument. SYNTAX: CINT( number ) ***************************************************************/ #if ANSI_C struct bwb_variable * fnc_cint( int argc, struct bwb_variable *argv, int unique_id ) #else struct bwb_variable * fnc_cint( argc, argv, unique_id ) int argc; struct bwb_variable *argv; int unique_id; #endif { static struct bwb_variable nvar; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } /* check parameters */ #if PROG_ERRORS if ( argc < 1 ) { sprintf( bwb_ebuf, "Not enough parameters (%d) to function CINT().", argc ); bwb_error( bwb_ebuf ); return NULL; } else if ( argc > 1 ) { sprintf( bwb_ebuf, "Too many parameters (%d) to function CINT().", argc ); bwb_error( bwb_ebuf ); return NULL; } #else if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE ) { return NULL; } #endif /* get rounded integer value */ * var_findnval( &nvar, nvar.array_pos ) = round_int( var_getnval( &( argv[ 0 ] ) )); return &nvar; } #endif /* MS_FUNCS */ /*************************************************************** FUNCTION: trnc_int() DESCRIPTION: This function returns the truncated truncated integer value of its numerical argument. ***************************************************************/ #if ANSI_C bnumber trnc_int( bnumber x ) #else bnumber trnc_int( x ) bnumber x; #endif { double sign; /* Was bnumber (JBV) */ if ( x < (bnumber) 0.0 ) { sign = (double) -1.0; /* Was bnumber (JBV) */ } else { sign = (double) 1.0; /* Was bnumber (JBV) */ } /* Added double recast here (JBV) */ return (bnumber) ( floor( fabs( (double) x )) * sign ); } /*************************************************************** FUNCTION: round_int() DESCRIPTION: This function returns the truncated rounded integer value of its numerical argument. ***************************************************************/ #if ANSI_C bnumber round_int( bnumber x ) #else bnumber round_int( x ) bnumber x; #endif { if ( x < (bnumber) 0.00 ) { /* Added double recasts here (JBV) */ if ( (bnumber) fabs( (bnumber) floor( (double) x ) - x ) < (bnumber) 0.500 ) { return (bnumber) floor( (double) x ); } else { return (bnumber) ceil( (double) x ); } } else { if ( ( x - (bnumber) floor( (double) x )) < (bnumber) 0.500 ) { return (bnumber) floor( (double) x ); } else { return (bnumber) ceil( (double) x ); } } } bwbasic-2.20pl2.orig/bwb_ops.c100644 0 0 142133 6055714562 14360 0ustar rootroot/**************************************************************** bwb_ops.c Expression Parsing Operations 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). */ /*---------------------------------------------------------------*/ #include #include #include #include "bwbasic.h" #include "bwb_mes.h" /* declarations for functions visible in this file only */ #if ANSI_C static int op_oplevel( int level ); static int op_add( int level, int precision ); static int op_subtract( int level, int precision ); static int op_multiply( int level, int precision ); static int op_divide( int level, int precision ); static int op_assign( int level, int precision ); static int op_equals( int level, int precision ); static int op_lessthan( int level, int precision ); static int op_greaterthan( int level, int precision ); static int op_lteq( int level, int precision ); static int op_gteq( int level, int precision ); static int op_notequal( int level, int precision ); static int op_modulus( int level, int precision ); static int op_exponent( int level, int precision ); static int op_intdiv( int level, int precision ); static int op_or( int level, int precision ); static int op_and( int level, int precision ); static int op_not( int level, int precision ); static int op_xor( int level, int precision ); static int op_negation( int level, int precision ); /* JBV */ static int op_islevelstr( int level ); static int op_getprecision( int level ); static int op_isoperator( int operation ); static int op_pulldown( int how_far ); #else static int op_oplevel(); static int op_add(); static int op_subtract(); static int op_multiply(); static int op_divide(); static int op_assign(); static int op_equals(); static int op_lessthan(); static int op_greaterthan(); static int op_lteq(); static int op_gteq(); static int op_notequal(); static int op_modulus(); static int op_exponent(); static int op_intdiv(); static int op_or(); static int op_and(); static int op_not(); static int op_xor(); static int op_negation(); /* JBV */ static int op_islevelstr(); static int op_getprecision(); static int op_isoperator(); static int op_pulldown(); #endif /* ANSI_C for prototypes */ static int op_level; /*************************************************************** FUNCTION: exp_operation() DESCRIPTION: This function performs whatever operations are necessary at the end of function bwb_exp() (i.e., the end of the parsing of an expression; see file bwb_exp.c). ***************************************************************/ #if ANSI_C int exp_operation( int entry_level ) #else int exp_operation( entry_level ) int entry_level; #endif { register int precedence; int operator; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_operation(): entered function." ); bwb_debug( bwb_ebuf ); #endif /* cycle through all levels of precedence and perform required operations */ for ( precedence = 0; precedence <= MAX_PRECEDENCE; ++precedence ) { /* Operation loop: cycle through every level above entry level and perform required operations as needed */ op_level = entry_level + 1; while( ( op_level < CURTASK expsc ) && ( op_isoperator( CURTASK exps[ op_level ].operation ) == FALSE )) { ++op_level; } while ( ( op_level > entry_level ) && ( op_level < CURTASK expsc ) ) { /* see if the operation at this level is an operator with the appropriate precedence level by running through the table of operators */ for ( operator = 0; operator < N_OPERATORS; ++operator ) { if ( exp_ops[ operator ].operation == CURTASK exps[ op_level ].operation ) { /* check for appropriate level of precedence */ if ( exp_ops[ operator ].precedence == precedence ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_operation(): level <%d> operation <%d>", op_level, CURTASK exps[ op_level ].operation ); bwb_debug( bwb_ebuf ); #endif op_oplevel( op_level ); /* perform the operation */ } } } /* advance level if appropriate; one must check, however, since the op_oplevel() function may have decremented CURTASK expsc */ if ( op_level < CURTASK expsc ) { ++op_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_operation() first increment op_level to <%d>", op_level ); bwb_debug( bwb_ebuf ); #endif while ( ( op_isoperator( CURTASK exps [ op_level ].operation ) == FALSE ) && ( op_level < CURTASK expsc ) ) { ++op_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_operation() further increment op_level to <%d>", op_level ); bwb_debug( bwb_ebuf ); #endif } } /* end of increment of op_level */ } /* end of for loop for stack levels */ } /* end of for loop for precedence levels */ return TRUE; } /* end of function exp_operation() */ /*************************************************************** FUNCTION: op_oplevel() DESCRIPTION: This function performs a specific operation at a specific level as the expression parser resolves its arguments. ***************************************************************/ #if ANSI_C static int op_oplevel( int level ) #else static int op_oplevel( level ) int level; #endif { int precision; /* set the precision */ if ( ( precision = op_getprecision( level ) ) == OP_ERROR ) { #if PROG_ERRORS sprintf( bwb_ebuf, "exp_operation(): failed to set precision." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); /*** ??? ***/ #endif op_pulldown( 2 ); } /* precision is set correctly */ else { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_oplevel(): level <%d>, precision <%c>", level, precision ); bwb_debug( bwb_ebuf ); #endif switch ( CURTASK exps[ level ].operation ) { case OP_ADD: op_add( level, precision ); break; case OP_SUBTRACT: op_subtract( level, precision ); break; case OP_MULTIPLY: op_multiply( level, precision ); break; case OP_DIVIDE: op_divide( level, precision ); break; case OP_ASSIGN: op_assign( level, precision ); break; case OP_EQUALS: op_equals( level, precision ); break; case OP_LESSTHAN: op_lessthan( level, precision ); break; case OP_GREATERTHAN: op_greaterthan( level, precision ); break; case OP_LTEQ: op_lteq( level, precision ); break; case OP_GTEQ: op_gteq( level, precision ); break; case OP_NOTEQUAL: op_notequal( level, precision ); break; case OP_MODULUS: op_modulus( level, precision ); break; case OP_INTDIVISION: op_intdiv( level, precision ); break; case OP_OR: op_or( level, precision ); break; case OP_AND: op_and( level, precision ); break; case OP_NOT: op_not( level, precision ); break; case OP_XOR: op_xor( level, precision ); break; case OP_EXPONENT: op_exponent( level, precision ); break; case OP_NEGATION: /* JBV */ op_negation( level, precision ); break; default: #if PROG_ERRORS sprintf( bwb_ebuf, "PROGRAMMING ERROR: operator <%d> not (yet) supported.", CURTASK exps[ level ].operation ); op_pulldown( 2 ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif break; } /* end of case statement for operators */ } /* end of else statement, precision set */ return TRUE; } /* end of function op_oplevel() */ /*************************************************************** FUNCTION: op_isoperator() DESCRIPTION: This function detects whether its argument is an operator. ***************************************************************/ #if ANSI_C static int op_isoperator( int operation ) #else static int op_isoperator( operation ) int operation; #endif { register int c; for( c = 0; c < N_OPERATORS; ++c ) { if ( operation == exp_ops[ c ].operation ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_isoperator(): found match <%s>", exp_ops[ c ].symbol ); bwb_debug( bwb_ebuf ); #endif return TRUE; } } /* test failed; return FALSE */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_isoperator(): no match found for operation <%d>", operation ); bwb_debug( bwb_ebuf ); #endif return FALSE; } /*************************************************************** FUNCTION: op_add() DESCRIPTION: This function adds two numbers or concatenates two strings. ***************************************************************/ #if ANSI_C static int op_add( int level, int precision ) #else static int op_add( level, precision ) int level; int precision; #endif { int error_condition; static bstring b; /* JBV */ error_condition = FALSE; b.rab = FALSE; /* JBV */ switch( precision ) { case STRING: /* both sides of the operation should be strings for string addition; if not, report an error */ if ( ( op_islevelstr( level - 1 ) != TRUE ) || ( op_islevelstr( level + 1 ) != TRUE ) ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in op_add(): Type mismatch in string addition." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif error_condition = TRUE; } /* concatenate the two strings */ if ( error_condition == FALSE ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_add(): try exp_getsval(), level <%d> op <%d> type <%c>:", level - 1, CURTASK exps[ level - 1 ].operation, CURTASK exps[ level - 1 ].type ); bwb_debug( bwb_ebuf ); exp_getsval( &( CURTASK exps[ level - 1 ] )); sprintf( bwb_ebuf, "in op_add(): try exp_getsval(), level <%d> op <%d> type <%c>:", level + 1, CURTASK exps[ level + 1 ].operation, CURTASK exps[ level + 1 ].type ); bwb_debug( bwb_ebuf ); exp_getsval( &( CURTASK exps[ level + 1 ] )); sprintf( bwb_ebuf, "in op_add(): string addition, exp_getsval()s completed" ); bwb_debug( bwb_ebuf ); #endif /* Removed by JBV (incomplete, modifies wrong string variable!) */ /* str_cat( exp_getsval( &( CURTASK exps[ level - 1 ] ) ), exp_getsval( &( CURTASK exps[ level + 1 ] ) ) ); */ /* Added by JBV */ str_btob( &b, exp_getsval( &( CURTASK exps[ level - 1 ] ) ) ); str_cat( &b, exp_getsval( &( CURTASK exps[ level + 1 ] ) ) ); str_btob( &( CURTASK exps[ level - 1 ].sval ), &b ); CURTASK exps[ level - 1 ].operation = CONST_STRING; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_add(): str_cat() returns <%d>-byte string to level <%d>", exp_getsval( &( CURTASK exps[ level - 1 ] ) )->length, level - 1 ); bwb_debug( bwb_ebuf ); #endif } break; case NUMBER: CURTASK exps[ level - 1 ].nval = exp_getnval( &( CURTASK exps[ level - 1 ] )) + exp_getnval( &( CURTASK exps[ level + 1 ] )); CURTASK exps[ level - 1 ].operation = NUMBER; break; } /* set variable to requested precision */ CURTASK exps[ level - 1 ].type = (char) precision; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_add() returns with operation <%d> type <%c>", CURTASK exps[ level - 1 ].operation, CURTASK exps[ level - 1 ].type ); bwb_debug( bwb_ebuf ); #endif /* decrement the stack twice */ op_pulldown( 2 ); return TRUE; } /*************************************************************** FUNCTION: op_subtract() DESCRIPTION: This function subtracts the number on the left from the number on the right. ***************************************************************/ #if ANSI_C static int op_subtract( int level, int precision ) #else static int op_subtract( level, precision ) int level; int precision; #endif { switch( precision ) { case STRING: /* both sides of the operation should be numbers for string addition; if not, report an error */ #if PROG_ERRORS sprintf( bwb_ebuf, "Strings cannot be subtracted." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif break; case NUMBER: CURTASK exps[ level - 1 ].nval = exp_getnval( &( CURTASK exps[ level - 1 ] )) - exp_getnval( &( CURTASK exps[ level + 1 ] )); break; } /* set variable to requested precision */ CURTASK exps[ level - 1 ].type = (char) precision; CURTASK exps[ level - 1 ].operation = NUMBER; /* decrement the stack twice */ op_pulldown( 2 ); return TRUE; } /*************************************************************** FUNCTION: op_multiply() DESCRIPTION: This function multiplies the number on the left by the number on the right. ***************************************************************/ #if ANSI_C static int op_multiply( int level, int precision ) #else static int op_multiply( level, precision ) int level; int precision; #endif { switch( precision ) { case STRING: /* both sides of the operation should be numbers for string addition; if not, report an error */ #if PROG_ERRORS sprintf( bwb_ebuf, "Strings cannot be multiplied." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif break; case NUMBER: CURTASK exps[ level - 1 ].nval = exp_getnval( &( CURTASK exps[ level - 1 ] )) * exp_getnval( &( CURTASK exps[ level + 1 ] )); break; } /* set variable to requested precision */ CURTASK exps[ level - 1 ].type = (char) precision; CURTASK exps[ level - 1 ].operation = NUMBER; /* decrement the stack twice */ op_pulldown( 2 ); return TRUE; } /*************************************************************** FUNCTION: op_divide() DESCRIPTION: This function divides the number on the left by the number on the right. ***************************************************************/ #if ANSI_C static int op_divide( int level, int precision ) #else static int op_divide( level, precision ) int level; int precision; #endif { switch( precision ) { case STRING: /* both sides of the operation should be numbers for division; if not, report an error */ #if PROG_ERRORS sprintf( bwb_ebuf, "Strings cannot be divided." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif break; case NUMBER: if ( exp_getnval( &( CURTASK exps[ level + 1 ] )) == (bnumber) 0 ) { CURTASK exps[ level - 1 ].nval = (bnumber) -1.0; op_pulldown( 2 ); #if PROG_ERRORS sprintf( bwb_ebuf, "Divide by 0." ); bwb_error( bwb_ebuf ); #else bwb_error( err_dbz ); #endif return FALSE; } CURTASK exps[ level - 1 ].nval = exp_getnval( &( CURTASK exps[ level - 1 ] )) / exp_getnval( &( CURTASK exps[ level + 1 ] )); break; } /* set variable to requested precision */ CURTASK exps[ level - 1 ].type = (char) precision; CURTASK exps[ level - 1 ].operation = NUMBER; /* decrement the stack twice */ op_pulldown( 2 ); return TRUE; } /*************************************************************** FUNCTION: op_assign() DESCRIPTION: This function assigns the value in the right hand side to the variable in the left hand side. ***************************************************************/ #if ANSI_C static int op_assign( int level, int precision ) #else static int op_assign( level, precision ) int level; int precision; #endif { /* Make sure the position one level below is a variable */ if ( CURTASK exps[ level - 1 ].operation != VARIABLE ) { op_pulldown( 2 ); #if PROG_ERRORS sprintf( bwb_ebuf, "in op_assign(): Assignment must be to variable: level -1 <%d> op <%d>", level - 1, CURTASK exps[ level - 1 ].operation ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return FALSE; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_assign(): entered function level <%d>", level ); bwb_debug( bwb_ebuf ); #endif /* if the assignment is numerical, then the precision should be set to that of the variable on the left-hand side of the assignment */ if ( precision != STRING ) { precision = (int) CURTASK exps[ level - 1 ].type; } switch( precision ) { case STRING: #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_assign(): try exp_getsval(), level <%d> op <%d> type <%c>:", level - 1, CURTASK exps[ level - 1 ].operation, CURTASK exps[ level - 1 ].type ); bwb_debug( bwb_ebuf ); exp_getsval( &( CURTASK exps[ level - 1 ] )); sprintf( bwb_ebuf, "in op_assign(): try exp_getsval(), level <%d> op <%d> type <%c>:", level + 1, CURTASK exps[ level + 1 ].operation, CURTASK exps[ level + 1 ].type ); bwb_debug( bwb_ebuf ); exp_getsval( &( CURTASK exps[ level + 1 ] )); sprintf( bwb_ebuf, "in op_assign(): string addition, exp_getsval()s completed" ); bwb_debug( bwb_ebuf ); #endif str_btob( exp_getsval( &( CURTASK exps[ level - 1 ] )), exp_getsval( &( CURTASK exps[ level + 1 ] )) ); break; case NUMBER: * var_findnval( CURTASK exps[ level - 1 ].xvar, CURTASK exps[ level - 1 ].array_pos ) = CURTASK exps[ level - 1 ].nval = exp_getnval( &( CURTASK exps[ level + 1 ] ) ); break; default: #if PROG_ERRORS sprintf( bwb_ebuf, "in op_assign(): Variable before assignment operator has unidentified type." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif return FALSE; } /* set variable to requested precision */ CURTASK exps[ level - 1 ].type = (char) precision; /* decrement the stack twice */ op_pulldown( 2 ); return TRUE; } /*************************************************************** FUNCTION: op_equals() DESCRIPTION: This function compares two values and returns an integer value: TRUE if they are the same and FALSE if they are not. ***************************************************************/ #if ANSI_C static int op_equals( int level, int precision ) #else static int op_equals( level, precision ) int level; int precision; #endif { int error_condition; static bstring b; bstring *bp; error_condition = FALSE; b.rab = FALSE; switch( precision ) { case STRING: /* both sides of the operation should be strings for string addition; if not, report an error */ if ( ( op_islevelstr( level - 1 ) != TRUE ) || ( op_islevelstr( level + 1 ) != TRUE ) ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in op_equals(): Type mismatch in string comparison." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif error_condition = TRUE; } /* compare the two strings */ if ( error_condition == FALSE ) { bp = exp_getsval( &( CURTASK exps[ level - 1 ] )); #if OLDWAY b.length = bp->length; b.sbuffer = bp->sbuffer; #endif str_btob( &b, bp ); if ( str_cmp( &b, exp_getsval( &( CURTASK exps[ level + 1 ] )) ) == 0 ) { CURTASK exps[ level - 1 ].nval = (bnumber) TRUE; } else { CURTASK exps[ level - 1 ].nval = (bnumber) FALSE; } } break; case NUMBER: if ( exp_getnval( &( CURTASK exps[ level - 1 ] )) == exp_getnval( &( CURTASK exps[ level + 1 ] )) ) { CURTASK exps[ level - 1 ].nval = (bnumber) TRUE; } else { CURTASK exps[ level - 1 ].nval = (bnumber) FALSE; } break; } /* set variable to integer and operation to NUMBER: this must be done at the end, since at the beginning it might cause op_islevelstr() to return a false error */ CURTASK exps[ level - 1 ].type = NUMBER; CURTASK exps[ level - 1 ].operation = NUMBER; /* decrement the stack */ op_pulldown( 2 ); return TRUE; } /*************************************************************** FUNCTION: op_lessthan() DESCRIPTION: This function compares two values and returns an integer value: TRUE if the left hand value is less than the right, and FALSE if it is not. ***************************************************************/ #if ANSI_C static int op_lessthan( int level, int precision ) #else static int op_lessthan( level, precision ) int level; int precision; #endif { int error_condition; error_condition = FALSE; switch( precision ) { case STRING: /* both sides of the operation should be numbers for string addition; if not, report an error */ if ( ( op_islevelstr( level - 1 ) != TRUE ) || ( op_islevelstr( level + 1 ) != TRUE ) ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Type mismatch in string comparison." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif error_condition = TRUE; } /* compare the two strings */ if ( error_condition == FALSE ) { if ( str_cmp( exp_getsval( &( CURTASK exps[ level - 1 ] )), exp_getsval( &( CURTASK exps[ level + 1 ] )) ) < 0 ) { CURTASK exps[ level - 1 ].nval = (bnumber) TRUE; } else { CURTASK exps[ level - 1 ].nval = (bnumber) FALSE; } } break; case NUMBER: if ( exp_getnval( &( CURTASK exps[ level - 1 ] )) < exp_getnval( &( CURTASK exps[ level + 1 ] )) ) { CURTASK exps[ level - 1 ].nval = (bnumber) TRUE; } else { CURTASK exps[ level - 1 ].nval = (bnumber) FALSE; } break; } /* set variable to integer and operation to NUMBER: this must be done at the end, since at the beginning it might cause op_islevelstr() to return a false error */ CURTASK exps[ level - 1 ].type = NUMBER; CURTASK exps[ level - 1 ].operation = NUMBER; /* decrement the stack */ op_pulldown( 2 ); return TRUE; } /*************************************************************** FUNCTION: op_greaterthan() DESCRIPTION: This function compares two values and returns an integer value: TRUE if the left hand value is greater than the right, and FALSE if it is not. ***************************************************************/ #if ANSI_C static int op_greaterthan( int level, int precision ) #else static int op_greaterthan( level, precision ) int level; int precision; #endif { int error_condition; error_condition = FALSE; switch( precision ) { case STRING: /* both sides of the operation should be numbers for string addition; if not, report an error */ if ( ( op_islevelstr( level - 1 ) != TRUE ) || ( op_islevelstr( level + 1 ) != TRUE ) ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Type mismatch in string comparison." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif error_condition = TRUE; } /* compare the two strings */ if ( error_condition == FALSE ) { if ( str_cmp( exp_getsval( &( CURTASK exps[ level - 1 ] )), exp_getsval( &( CURTASK exps[ level + 1 ] )) ) > 0 ) { CURTASK exps[ level - 1 ].nval = (bnumber) TRUE; } else { CURTASK exps[ level - 1 ].nval = (bnumber) FALSE; } } break; case NUMBER: if ( exp_getnval( &( CURTASK exps[ level - 1 ] )) > exp_getnval( &( CURTASK exps[ level + 1 ] )) ) { CURTASK exps[ level - 1 ].nval = (bnumber) TRUE; } else { CURTASK exps[ level - 1 ].nval = (bnumber) FALSE; } break; } /* set variable to integer and operation to NUMBER: this must be done at the end, since at the beginning it might cause op_islevelstr() to return a false error */ CURTASK exps[ level - 1 ].type = NUMBER; CURTASK exps[ level - 1 ].operation = NUMBER; /* decrement the stack */ op_pulldown( 2 ); return TRUE; } /*************************************************************** FUNCTION: op_lteq() DESCRIPTION: This function compares two values and returns an integer value: TRUE if the left hand value is less than or equal to the right, and FALSE if it is not. ***************************************************************/ #if ANSI_C static int op_lteq( int level, int precision ) #else static int op_lteq( level, precision ) int level; int precision; #endif { int error_condition; error_condition = FALSE; switch( precision ) { case STRING: /* both sides of the operation should be numbers for string addition; if not, report an error */ if ( ( op_islevelstr( level - 1 ) != TRUE ) || ( op_islevelstr( level + 1 ) != TRUE ) ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Type mismatch in string comparison." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif error_condition = TRUE; } /* compare the two strings */ if ( error_condition == FALSE ) { if ( str_cmp( exp_getsval( &( CURTASK exps[ level - 1 ] )), exp_getsval( &( CURTASK exps[ level + 1 ] )) ) <= 0 ) { CURTASK exps[ level - 1 ].nval = (bnumber) TRUE; } else { CURTASK exps[ level - 1 ].nval = (bnumber) FALSE; } } break; case NUMBER: if ( exp_getnval( &( CURTASK exps[ level - 1 ] )) <= exp_getnval( &( CURTASK exps[ level + 1 ] )) ) { CURTASK exps[ level - 1 ].nval = (bnumber) TRUE; } else { CURTASK exps[ level - 1 ].nval = (bnumber) FALSE; } break; } /* set variable to integer and operation to NUMBER: this must be done at the end, since at the beginning it might cause op_islevelstr() to return a false error */ CURTASK exps[ level - 1 ].type = NUMBER; CURTASK exps[ level - 1 ].operation = NUMBER; /* decrement the stack */ op_pulldown( 2 ); return TRUE; } /*************************************************************** FUNCTION: op_gteq() DESCRIPTION: This function compares two values and returns an integer value: TRUE if the left hand value is greater than or equal to the right, and FALSE if it is not. ***************************************************************/ #if ANSI_C static int op_gteq( int level, int precision ) #else static int op_gteq( level, precision ) int level; int precision; #endif { int error_condition; error_condition = FALSE; switch( precision ) { case STRING: /* both sides of the operation should be numbers for string addition; if not, report an error */ if ( ( op_islevelstr( level - 1 ) != TRUE ) || ( op_islevelstr( level + 1 ) != TRUE ) ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Type mismatch in string comparison." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif error_condition = TRUE; } /* compare the two strings */ if ( error_condition == FALSE ) { if ( str_cmp( exp_getsval( &( CURTASK exps[ level - 1 ] )), exp_getsval( &( CURTASK exps[ level + 1 ] )) ) >= 0 ) { CURTASK exps[ level - 1 ].nval = (bnumber) TRUE; } else { CURTASK exps[ level - 1 ].nval = (bnumber) FALSE; } } break; case NUMBER: if ( exp_getnval( &( CURTASK exps[ level - 1 ] )) >= exp_getnval( &( CURTASK exps[ level + 1 ] )) ) { CURTASK exps[ level - 1 ].nval = (bnumber) TRUE; } else { CURTASK exps[ level - 1 ].nval = (bnumber) FALSE; } break; } /* set variable to integer and operation to NUMBER: this must be done at the end, since at the beginning it might cause op_islevelstr() to return a false error */ CURTASK exps[ level - 1 ].type = NUMBER; CURTASK exps[ level - 1 ].operation = NUMBER; /* decrement the stack */ op_pulldown( 2 ); return TRUE; } /*************************************************************** FUNCTION: op_notequal() DESCRIPTION: This function compares two values and returns an integer value: TRUE if they are not the same and FALSE if they are. ***************************************************************/ #if ANSI_C static int op_notequal( int level, int precision ) #else static int op_notequal( level, precision ) int level; int precision; #endif { int error_condition; error_condition = FALSE; switch( precision ) { case STRING: /* both sides of the operation should be numbers for string addition; if not, report an error */ if ( ( op_islevelstr( level - 1 ) != TRUE ) || ( op_islevelstr( level + 1 ) != TRUE ) ) { #if PROG_ERRORS sprintf( bwb_ebuf, "Type mismatch in string comparison." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif error_condition = TRUE; } /* compare the two strings */ if ( error_condition == FALSE ) { if ( str_cmp( exp_getsval( &( CURTASK exps[ level - 1 ] )), exp_getsval( &( CURTASK exps[ level + 1 ] )) ) != 0 ) { CURTASK exps[ level - 1 ].nval = (bnumber) TRUE; } else { CURTASK exps[ level - 1 ].nval = (bnumber) FALSE; } } break; case NUMBER: if ( exp_getnval( &( CURTASK exps[ level - 1 ] )) != exp_getnval( &( CURTASK exps[ level + 1 ] )) ) { CURTASK exps[ level - 1 ].nval = (bnumber) TRUE; } else { CURTASK exps[ level - 1 ].nval = (bnumber) FALSE; } break; } /* set variable to integer and operation to NUMBER: this must be done at the end, since at the beginning it might cause op_islevelstr() to return a false error */ CURTASK exps[ level - 1 ].type = NUMBER; CURTASK exps[ level - 1 ].operation = NUMBER; /* decrement the stack */ op_pulldown( 2 ); return TRUE; } /*************************************************************** FUNCTION: op_modulus() DESCRIPTION: This function divides the number on the left by the number on the right and returns the remainder. ***************************************************************/ #if ANSI_C static int op_modulus( int level, int precision ) #else static int op_modulus( level, precision ) int level; int precision; #endif { static double iportion; switch( precision ) { case STRING: /* both sides of the operation should be numbers for string addition; if not, report an error */ #if PROG_ERRORS sprintf( bwb_ebuf, "Strings cannot be divided." ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif break; case NUMBER: if ( exp_getnval( &( CURTASK exps[ level + 1 ] )) == (bnumber) 0 ) { CURTASK exps[ level - 1 ].nval = (bnumber) -1; op_pulldown( 2 ); #if PROG_ERRORS sprintf( bwb_ebuf, "Divide by 0." ); bwb_error( bwb_ebuf ); #else bwb_error( err_dbz ); #endif return FALSE; } CURTASK exps[ level ].nval = exp_getnval( &( CURTASK exps[ level - 1 ] )) / exp_getnval( &( CURTASK exps[ level + 1 ] )); modf( (double) CURTASK exps[ level ].nval, &iportion ); CURTASK exps[ level - 1 ].nval = exp_getnval( &( CURTASK exps[ level - 1 ] )) - ( exp_getnval( &( CURTASK exps[ level + 1 ] )) * iportion ); break; } /* set variable to requested precision */ CURTASK exps[ level - 1 ].type = (char) precision; CURTASK exps[ level - 1 ].operation = NUMBER; /* decrement the stack twice */ op_pulldown( 2 ); return TRUE; } /*************************************************************** FUNCTION: op_exponent() DESCRIPTION: This function finds the exponential value of a number (on the left) to the power indicated on the right-hand side. ***************************************************************/ #if ANSI_C static int op_exponent( int level, int precision ) #else static int op_exponent( level, precision ) int level; int precision; #endif { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_exponent(): entered function level <%d>.", level ); bwb_debug ( bwb_ebuf ); #endif switch( precision ) { case STRING: /* both sides of the operation should be numbers for string addition; if not, report an error */ #if PROG_ERRORS sprintf( bwb_ebuf, "Strings cannot be taken as exponents." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif break; case NUMBER: CURTASK exps[ level - 1 ].nval = (bnumber) pow( (double) exp_getnval( &( CURTASK exps[ level - 1 ] )), (double) exp_getnval( &( CURTASK exps[ level + 1 ] )) ); break; } /* set variable to requested precision */ CURTASK exps[ level - 1 ].type = (char) precision; CURTASK exps[ level - 1 ].operation = NUMBER; /* decrement the stack twice */ op_pulldown( 2 ); return TRUE; } /*************************************************************** FUNCTION: op_intdiv() DESCRIPTION: This function divides the number on the left by the number on the right, returning the result as an integer. ***************************************************************/ #if ANSI_C static int op_intdiv( int level, int precision ) #else static int op_intdiv( level, precision ) int level; int precision; #endif { switch( precision ) { case STRING: /* both sides of the operation should be numbers for string addition; if not, report an error */ #if PROG_ERRORS sprintf( bwb_ebuf, "Strings cannot be divided." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif break; default: if ( exp_getnval( &( CURTASK exps[ level + 1 ] )) == (bnumber) 0 ) { CURTASK exps[ level - 1 ].nval = (bnumber) -1; op_pulldown( 2 ); #if PROG_ERRORS sprintf( bwb_ebuf, "Divide by 0." ); bwb_error( bwb_ebuf ); #else bwb_error( err_dbz ); #endif return FALSE; } CURTASK exps[ level - 1 ].nval = exp_getnval( &( CURTASK exps[ level - 1 ] )) / exp_getnval( &( CURTASK exps[ level + 1 ] )); break; } /* set variable to requested precision */ CURTASK exps[ level - 1 ].type = NUMBER; CURTASK exps[ level - 1 ].operation = NUMBER; /* decrement the stack twice */ op_pulldown( 2 ); return TRUE; } /*************************************************************** FUNCTION: op_or() DESCRIPTION: This function compares two integers and performs a logical OR on them. ***************************************************************/ #if ANSI_C static int op_or( int level, int precision ) #else static int op_or( level, precision ) int level; int precision; #endif { switch( precision ) { case STRING: /* both sides of the operation should be numbers for logical comparison; if not, report an error */ #if PROG_ERRORS sprintf( bwb_ebuf, "Strings cannot be compared logically." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif break; case NUMBER: CURTASK exps[ level - 1 ].nval = (bnumber) ((int) exp_getnval( &( CURTASK exps[ level - 1 ] )) | (int) exp_getnval( &( CURTASK exps[ level + 1 ] ))); break; } /* set variable type to integer */ CURTASK exps[ level - 1 ].type = NUMBER; CURTASK exps[ level - 1 ].operation = NUMBER; /* decrement the stack twice */ op_pulldown( 2 ); return TRUE; } /*************************************************************** FUNCTION: op_and() DESCRIPTION: This function compares two integers and performs a logical AND on them. ***************************************************************/ #if ANSI_C static int op_and( int level, int precision ) #else static int op_and( level, precision ) int level; int precision; #endif { switch( precision ) { case STRING: /* both sides of the operation should be numbers for logical comparison; if not, report an error */ #if PROG_ERRORS sprintf( bwb_ebuf, "Strings cannot be compared logically." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif break; case NUMBER: CURTASK exps[ level - 1 ].nval = (bnumber) ((int) exp_getnval( &( CURTASK exps[ level - 1 ] )) & (int) exp_getnval( &( CURTASK exps[ level + 1 ] ))); break; } /* set variable type to integer */ CURTASK exps[ level - 1 ].type = NUMBER; CURTASK exps[ level - 1 ].operation = NUMBER; /* decrement the stack twice */ op_pulldown( 2 ); return TRUE; } /*************************************************************** FUNCTION: op_not() DESCRIPTION: This function performs a logical NOT on the integer to the right. ***************************************************************/ #if ANSI_C static int op_not( int level, int precision ) #else static int op_not( level, precision ) int level; int precision; #endif { switch( precision ) { case STRING: /* both sides of the operation should be numbers for logical comparison; if not, report an error */ #if PROG_ERRORS sprintf( bwb_ebuf, "Strings cannot be compared logically." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif break; default: #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_not(): argument is <%d>, precision <%c>", (unsigned int) exp_getnval( &( CURTASK exps[ level + 1 ] )), precision ); bwb_debug( bwb_ebuf ); #endif CURTASK exps[ level ].nval = (bnumber) ~( (int) exp_getnval( &( CURTASK exps[ level + 1 ] )) ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_not(): result is <%d>, precision <%c>", (unsigned int) exp_getnval( &( CURTASK exps[ level ] )), precision ); bwb_debug( bwb_ebuf ); #endif break; } /* set variable type to integer */ CURTASK exps[ level ].type = NUMBER; CURTASK exps[ level ].operation = NUMBER; /* decrement the stack once */ op_pulldown( 1 ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_not(): CURTASK expsc <%d>, level <%d> result <%d>", CURTASK expsc, level, CURTASK exps[ CURTASK expsc ].nval ); bwb_debug( bwb_ebuf ); #endif return TRUE; } /*************************************************************** FUNCTION: op_xor() DESCRIPTION: This function compares two integers and performs a logical XOR on them. ***************************************************************/ #if ANSI_C static int op_xor( int level, int precision ) #else static int op_xor( level, precision ) int level; int precision; #endif { switch( precision ) { case STRING: /* both sides of the operation should be numbers for logical comparison; if not, report an error */ #if PROG_ERRORS sprintf( bwb_ebuf, "Strings cannot be compared logically." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif break; case NUMBER: CURTASK exps[ level - 1 ].nval = (bnumber) ((int) exp_getnval( &( CURTASK exps[ level - 1 ] )) ^ (int) exp_getnval( &( CURTASK exps[ level + 1 ] ))); break; } /* set variable type to integer */ CURTASK exps[ level - 1 ].type = NUMBER; CURTASK exps[ level - 1 ].operation = NUMBER; /* decrement the stack twice */ op_pulldown( 2 ); return TRUE; } /*************************************************************** FUNCTION: op_negation() DESCRIPTION: This function performs a negation on the element to the right. Added by JBV 10/95 ***************************************************************/ #if ANSI_C static int op_negation( int level, int precision ) #else static int op_negation( level, precision ) int level; int precision; #endif { switch( precision ) { case STRING: /* both sides of the operation should be numbers for logical comparison; if not, report an error */ #if PROG_ERRORS sprintf( bwb_ebuf, "Strings cannot be compared logically." ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif break; default: #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_negation(): argument is <%f>, precision <%c>", exp_getnval( &( CURTASK exps[ level + 1 ] )), precision ); bwb_debug( bwb_ebuf ); #endif CURTASK exps[ level ].nval = (bnumber) -( exp_getnval( &( CURTASK exps[ level + 1 ] )) ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_negation(): result is <%f>, precision <%c>", exp_getnval( &( CURTASK exps[ level ] )), precision ); bwb_debug( bwb_ebuf ); #endif break; } /* set variable type to requested precision (JBV) */ CURTASK exps[ level ].type = (char) precision; CURTASK exps[ level ].operation = NUMBER; /* decrement the stack once */ op_pulldown( 1 ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_negation(): CURTASK expsc <%d>, level <%d> result <%f>", CURTASK expsc, level, CURTASK exps[ CURTASK expsc ].nval ); bwb_debug( bwb_ebuf ); #endif return TRUE; } /*************************************************************** FUNCTION: op_islevelstr() DESCRIPTION: This function determines whether the operation at a specified level involves a string constant or variable. ***************************************************************/ #if ANSI_C static int op_islevelstr( int level ) #else static int op_islevelstr( level ) int level; #endif { /* first see if the level holds a string constant */ if ( CURTASK exps[ level ].operation == CONST_STRING ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_islevelstr(): string detected at level <%d>.", level ); bwb_debug( bwb_ebuf ); #endif return TRUE; } /* see if the level holds a string variable */ if ( CURTASK exps[ level ].operation == VARIABLE ) { if ( CURTASK exps[ level ].xvar->type == STRING ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_islevelstr(): string detected at level <%d>.", level ); bwb_debug( bwb_ebuf ); #endif return TRUE; } } /* test has failed, return FALSE */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_islevelstr(): string not detected at level <%d>.", level ); bwb_debug( bwb_ebuf ); #endif return FALSE; } /*************************************************************** FUNCTION: op_getprecision() DESCRIPTION: This function finds the precision for an operation by comparing the precision at this level and that two levels below. ***************************************************************/ #if ANSI_C static int op_getprecision( int level ) #else static int op_getprecision( level ) int level; #endif { /* first test for string value */ if ( ( CURTASK exps[ level + 1 ].type == STRING ) || ( CURTASK exps[ level - 1 ].type == STRING ) ) { return STRING; } /* Both are numbers, so we should be able to find a suitable precision level by starting with the top and moving down; check first for double precision */ else { return NUMBER; } } /*************************************************************** FUNCTION: op_pulldown() DESCRIPTION: This function pulls the expression stack down a specified number of levels, decrementing the expression stack counter (bycalling dec_esc()) and decrementing the current "level" of operation processing. ***************************************************************/ #if ANSI_C static int op_pulldown( int how_far ) #else static int op_pulldown( how_far ) int how_far; #endif { int level; register int c; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in op_pulldown(): pull down e stack <%d> place(s)", how_far ); bwb_debug( bwb_ebuf ); #endif /* first pull down the actual variables themselves */ level = op_level + ( 2 - how_far ); while ( CURTASK expsc >= ( level + how_far ) ) { /*------------------------------------------------------*/ /* But before memcpy, deallocate sbuffer for level, and */ /* afterwards, set sbuffer for level + how_far to NULL! */ /* Else konfusion reigns the next time around... (JBV) */ /*------------------------------------------------------*/ if( CURTASK exps[ level ].sval.sbuffer != NULL ) /* JBV */ FREE( CURTASK exps[ level ].sval.sbuffer, "op_pulldown" ); memcpy( &CURTASK exps[ level ], &CURTASK exps[ level + how_far ], (size_t) ( sizeof( struct exp_ese )) ); CURTASK exps[ level + how_far ].sval.sbuffer = NULL; /* JBV */ ++level; } /* decrement the expression stack counter */ for ( c = 0; c < how_far; ++c ) { if ( dec_esc() == TRUE ) { --op_level; } else { return FALSE; } } return TRUE; } bwbasic-2.20pl2.orig/bwb_par.c100644 0 0 6745 6055714562 14311 0ustar rootroot/*************************************************************** bwb_par.c Parallel Action (Multitasking) Routines for Bywater BASIC Interpreter Currently UNDER CONSTRUCTION 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). */ /*---------------------------------------------------------------*/ #include #include "bwbasic.h" #include "bwb_mes.h" #if PARACT /* this whole file ignored if FALSE */ /*************************************************************** FUNCTION: bwb_newtask() DESCRIPTION: This C function allocates and initializes memory for a new task. ***************************************************************/ #if ANSI_C int bwb_newtask( int task_requested ) #else int bwb_newtask( task_requested ) int task_requested; #endif { static char start_buf[] = "\0"; static char end_buf[] = "\0"; register int c; /* find if requested task slot is available */ if ( bwb_tasks[ task_requested ] != NULL ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_newtask(): Slot requested is already in use" ); bwb_error( bwb_ebuf ); #else bwb_error( err_overflow ); return -1; #endif } /* get memory for task structure */ /* Revised to CALLOC pass-thru call by JBV */ if ( ( bwb_tasks[ task_requested ] = CALLOC( 1, sizeof( struct bwb_task ), "bwb_newtask" ) ) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_newtask(): failed to find memory for task structure" ); #else bwb_error( err_getmem ); #endif } /* set some initial variables */ bwb_tasks[ task_requested ]->bwb_start.number = 0; bwb_tasks[ task_requested ]->bwb_start.next = &bwb_tasks[ task_requested ]->bwb_end; bwb_tasks[ task_requested ]->bwb_end.number = MAXLINENO + 1; bwb_tasks[ task_requested ]->bwb_end.next = &bwb_tasks[ task_requested ]->bwb_end; bwb_tasks[ task_requested ]->bwb_start.buffer = start_buf; bwb_tasks[ task_requested ]->bwb_end.buffer = end_buf; bwb_tasks[ task_requested ]->data_line = &bwb_tasks[ task_requested ]->bwb_start; bwb_tasks[ task_requested ]->data_pos = 0; bwb_tasks[ task_requested ]->rescan = TRUE; bwb_tasks[ task_requested ]->exsc = -1; bwb_tasks[ task_requested ]->expsc = 0; bwb_tasks[ task_requested ]->xtxtsc = 0; /* Variable and function table initializations */ var_init( task_requested ); /* initialize variable chain */ fnc_init( task_requested ); /* initialize function chain */ fslt_init( task_requested ); /* initialize funtion-sub chain */ return task_requested; } #endif bwbasic-2.20pl2.orig/bwb_prn.c100644 0 0 132432 6473161700 14351 0ustar rootroot/*************************************************************** bwb_prn.c Print and Error-Handling Commands 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). */ /*---------------------------------------------------------------*/ #include #include #include #include "bwbasic.h" #include "bwb_mes.h" /* Prototypes for functions visible only to this file */ int prn_col = 1; static int prn_width = 80; /* default width for stdout */ struct prn_fmt { int type; /* STRING, NUMBER, SINGLE, or NUMBER */ int exponential; /* TRUE = use exponential notation */ int right_justified; /* TRUE = right justified else left justified */ int width; /* width of main section */ int precision; /* width after decimal point */ int commas; /* use commas every three steps */ int sign; /* prefix sign to number */ int money; /* prefix money sign to number */ int fill; /* ASCII value for fill character, normally ' ' */ int minus; /* postfix minus sign to number */ }; #if ANSI_C static int prn_cr( char *buffer, FILE *f ); static struct prn_fmt *get_prnfmt( char *buffer, int *position, FILE *f ); static int bwb_xerror( char *message ); static int xxputc( FILE *f, char c ); static int xxxputc( FILE *f, char c ); static struct bwb_variable * bwb_esetovar( struct exp_ese *e ); #else static int prn_cr(); static struct prn_fmt *get_prnfmt(); static int bwb_xerror(); static int xxputc(); static int xxxputc(); static struct bwb_variable * bwb_esetovar(); #endif /*************************************************************** FUNCTION: bwb_print() DESCRIPTION: This function implements the BASIC PRINT command. SYNTAX: PRINT [# device-number,][USING format-string$;] expressions... ***************************************************************/ #if ANSI_C struct bwb_line * bwb_print( struct bwb_line *l ) #else struct bwb_line * bwb_print( l ) struct bwb_line *l; #endif { FILE *fp; static int pos; int req_devnumber; struct exp_ese *v; static char *s_buffer; /* small, temporary buffer */ static int init = FALSE; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_print(): enter function" ); bwb_debug( bwb_ebuf ); #endif /* initialize buffers if necessary */ if ( init == FALSE ) { init = TRUE; /* Revised to CALLOC pass-thru call by JBV */ if ( ( s_buffer = CALLOC( MAXSTRINGSIZE + 1, sizeof(char), "bwb_print") ) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_print(): failed to get memory for s_buffer" ); #else bwb_error( err_getmem ); #endif } } /* advance beyond whitespace and check for the '#' sign */ adv_ws( l->buffer, &( l->position ) ); #if COMMON_CMDS if ( l->buffer[ l->position ] == '#' ) { ++( l->position ); adv_element( l->buffer, &( l->position ), s_buffer ); pos = 0; v = bwb_exp( s_buffer, FALSE, &pos ); adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == ',' ) { ++( l->position ); } else { #if PROG_ERRORS bwb_error( "in bwb_print(): no comma after #n" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } req_devnumber = (int) exp_getnval( v ); /* check the requested device number */ if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES )) { #if PROG_ERRORS bwb_error( "in bwb_input(): Requested device number is out of range." ); #else bwb_error( err_devnum ); #endif return bwb_zline( l ); } if (( dev_table[ req_devnumber ].mode == DEVMODE_CLOSED ) || ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE )) { #if PROG_ERRORS bwb_error( "in bwb_input(): Requested device number is not open." ); #else bwb_error( err_devnum ); #endif return bwb_zline( l ); } if ( dev_table[ req_devnumber ].mode != DEVMODE_OUTPUT ) { #if PROG_ERRORS bwb_error( "in bwb_print(): Requested device is not open for OUTPUT." ); #else bwb_error( err_devnum ); #endif return bwb_zline( l ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_print(): device number is <%d>", req_devnumber ); bwb_debug( bwb_ebuf ); #endif /* look up the requested device in the device table */ fp = dev_table[ req_devnumber ].cfp; } else { fp = stdout; } #else fp = stdout; #endif /* COMMON_CMDS */ bwb_xprint( l, fp ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_xprint() DESCRIPTION: This function implements the BASIC PRINT command, utilizing a specified file our output device. ***************************************************************/ #if ANSI_C int bwb_xprint( struct bwb_line *l, FILE *f ) #else int bwb_xprint( l, f ) struct bwb_line *l; FILE *f; #endif { struct exp_ese *e; int loop; static int p; static int fs_pos; struct prn_fmt *format; static char *format_string; static char *output_string; static char *element; static char *prnbuf; static int init = FALSE; register int i, j; /* JBV */ int dig_pos, dec_pos; /* JBV */ char tbuf[ MAXSTRINGSIZE + 1 ]; /* JBV */ #if INTENSIVE_DEBUG || TEST_BSTRING bstring *b; #endif /* initialize buffers if necessary */ if ( init == FALSE ) { init = TRUE; /* Revised to CALLOC pass-thru call by JBV */ if ( ( format_string = CALLOC( MAXSTRINGSIZE + 1, sizeof(char), "bwb_xprint") ) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_xprint(): failed to get memory for format_string" ); #else bwb_error( err_getmem ); #endif } /* Revised to CALLOC pass-thru call by JBV */ if ( ( output_string = CALLOC( MAXSTRINGSIZE + 1, sizeof(char), "bwb_xprint") ) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_xprint(): failed to get memory for output_string" ); #else bwb_error( err_getmem ); #endif } /* Revised to CALLOC pass-thru call by JBV */ if ( ( element = CALLOC( MAXSTRINGSIZE + 1, sizeof(char), "bwb_xprint") ) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_xprint(): failed to get memory for element buffer" ); #else bwb_error( err_getmem ); #endif } /* Revised to CALLOC pass-thru call by JBV */ if ( ( prnbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof(char), "bwb_xprint") ) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_xprint(): failed to get memory for prnbuf" ); #else bwb_error( err_getmem ); #endif } } /* Detect USING Here */ fs_pos = -1; /* get "USING" in format_string */ p = l->position; adv_element( l->buffer, &p, format_string ); bwb_strtoupper( format_string ); #if COMMON_CMDS /* check to be sure */ if ( strcmp( format_string, CMD_XUSING ) == 0 ) { l->position = p; adv_ws( l->buffer, &( l->position ) ); /* now get the format string in format_string */ e = bwb_exp( l->buffer, FALSE, &( l->position ) ); if ( e->type == STRING ) { /* copy the format string to buffer */ str_btoc( format_string, exp_getsval( e ) ); /* look for ';' after format string */ fs_pos = 0; adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == ';' ) { ++l->position; adv_ws( l->buffer, &( l->position ) ); } else { #if PROG_ERRORS bwb_error( "Failed to find \";\" after format string in PRINT USING" ); #else bwb_error( err_syntax ); #endif return FALSE; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xprint(): Found USING, format string <%s>", format_string ); bwb_debug( bwb_ebuf ); #endif } else { #if PROG_ERRORS bwb_error( "Failed to find format string after PRINT USING" ); #else bwb_error( err_syntax ); #endif return FALSE; } } #endif /* COMMON_CMDS */ /* if no arguments, simply print CR and return */ adv_ws( l->buffer, &( l->position ) ); switch( l->buffer[ l->position ] ) { case '\0': case '\n': case '\r': case ':': prn_xprintf( f, "\n" ); return TRUE; default: break; } /* LOOP THROUGH PRINT ELEMENTS */ loop = TRUE; while( loop == TRUE ) { /* resolve the string */ e = bwb_exp( l->buffer, FALSE, &( l->position ) ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xprint(): op <%d> type <%d>", e->operation, e->type ); bwb_debug( bwb_ebuf ); #endif /* an OP_NULL probably indicates a terminating ';', but this will be detected later, so we can ignore it for now */ if ( e->operation != OP_NULL ) { #if TEST_BSTRING b = exp_getsval( e ); sprintf( bwb_ebuf, "in bwb_xprint(): bstring name is <%s>", b->name ); bwb_debug( bwb_ebuf ); #endif str_btoc( element, exp_getsval( e ) ); } else { element[ 0 ] = '\0'; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xprint(): element <%s>", element ); bwb_debug( bwb_ebuf ); #endif /* print with format if there is one */ if (( fs_pos > -1 ) && ( strlen( element ) > 0 )) { #if COMMON_CMDS format = get_prnfmt( format_string, &fs_pos, f ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xprint(): format type <%d> width <%d>", format->type, format->width ); bwb_debug( bwb_ebuf ); #endif switch( format->type ) { case STRING: if ( e->type != STRING ) { #if PROG_ERRORS bwb_error( "Type mismatch in PRINT USING" ); #else bwb_error( err_mismatch ); #endif } if ( format->width == -1 ) /* JBV */ sprintf( output_string, "%s", element ); else sprintf( output_string, "%.*s", format->width, element ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xprint(): output string <%s>", output_string ); bwb_debug( bwb_ebuf ); #endif prn_xxprintf( f, output_string ); /* Was prn_xprintf (JBV) */ break; case NUMBER: if ( e->type == STRING ) { #if PROG_ERRORS bwb_error( "Type mismatch in PRINT USING" ); #else bwb_error( err_mismatch ); #endif } if ( format->exponential == TRUE ) { /*------------------------------------------------------*/ /* NOTE: Width and fill have no effect on C exponential */ /* format (JBV) */ /*------------------------------------------------------*/ if ( format->sign == TRUE ) /* Added by JBV */ sprintf( output_string, "%+e", exp_getnval( e ) ); else sprintf( output_string, "%e", exp_getnval( e ) ); } else { /*---------------------------------------------------*/ /* NOTE: Minus, commas, and money are only valid for */ /* floating point format (JBV) */ /*---------------------------------------------------*/ if ( format->sign == TRUE ) /* Added by JBV */ sprintf( output_string, "%+*.*f", format->width, format->precision, exp_getnval( e ) ); else if ( format->minus == TRUE ) /* Added by JBV */ { sprintf( output_string, "%*.*f", format->width, format->precision, exp_getnval( e ) ); for (i = 0; i < strlen( output_string ); ++i ) { if ( output_string[ i ] != ' ' ) { if ( output_string[ i ] == '-' ) { output_string[ i ] = ' '; strcat( output_string, "-" ); } else strcat( output_string, " " ); break; } } } else sprintf( output_string, "%*.*f", format->width, format->precision, exp_getnval( e ) ); if ( format->commas == TRUE ) /* Added by JBV */ { dig_pos = -1; dec_pos = -1; for ( i = 0; i < strlen( output_string ); ++i ) { if ( ( isdigit( output_string[ i ] ) != 0 ) && ( dig_pos == -1 ) ) dig_pos = i; if ( ( output_string[ i ] == '.' ) && ( dec_pos == -1 ) ) dec_pos = i; if ( ( dig_pos != -1 ) && ( dec_pos != -1 ) ) break; } if ( dec_pos == -1 ) dec_pos = strlen( output_string ); j = 0; for ( i = 0; i < strlen( output_string ); ++i ) { if ( ( ( dec_pos - i ) % 3 == 0 ) && ( i > dig_pos ) && ( i < dec_pos ) ) { tbuf[ j ] = ','; ++j; tbuf[ j ] = '\0'; } tbuf[ j ] = output_string[ i ]; ++j; tbuf[ j ] = '\0'; } strcpy( output_string, &tbuf[ strlen( tbuf ) - strlen( output_string ) ] ); } if ( format->money == TRUE ) /* Added by JBV */ { for ( i = 0; i < strlen( output_string ); ++i ) { if ( output_string[ i ] != ' ' ) { if ( i > 0 ) { if ( isdigit( output_string[ i ] ) == 0 ) { output_string[ i - 1 ] = output_string[ i ]; output_string[ i ] = '$'; } else output_string[ i - 1 ] = '$'; } break; } } } } if ( format->fill == '*' ) /* Added by JBV */ for ( i = 0; i < strlen( output_string ); ++i ) { if ( output_string[ i ] != ' ' ) break; output_string[ i ] = '*'; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xprint(): output number <%f> string <%s>", exp_getnval( e ), output_string ); bwb_debug( bwb_ebuf ); #endif prn_xxprintf( f, output_string ); /* Was prn_xprintf (JBV) */ break; default: #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_xprint(): get_prnfmt() returns unknown type <%c>", format->type ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif break; } #endif /* COMMON_CMDS */ } /* not a format string: use defaults */ else if ( strlen( element ) > 0 ) { switch( e->type ) { case STRING: prn_xprintf( f, element ); break; default: #if NUMBER_DOUBLE sprintf( prnbuf, " %.*lf", prn_precision( bwb_esetovar( e )), exp_getnval( e ) ); #else sprintf( prnbuf, " %.*f", prn_precision( bwb_esetovar( e )), exp_getnval( e ) ); #endif prn_xprintf( f, prnbuf ); break; } } /* check the position to see if the loop should continue */ adv_ws( l->buffer, &( l->position ) ); switch( l->buffer[ l->position ] ) { #if OLDSTUFF case ':': /* end of line segment */ loop = FALSE; break; case '\0': /* end of buffer */ case '\n': case '\r': loop = FALSE; break; #endif case ',': /* tab over */ /* Tab only if there's no format specification! (JBV) */ if (( fs_pos == -1 ) || ( strlen( element ) == 0 )) xputc( f, '\t' ); ++l->position; adv_ws( l->buffer, &( l->position ) ); break; case ';': /* concatenate strings */ ++l->position; adv_ws( l->buffer, &( l->position ) ); break; default: loop = FALSE; break; } } /* end of loop through print elements */ if (( fs_pos > -1 ) && ( strlen( element ) > 0 )) format = get_prnfmt( format_string, &fs_pos, f ); /* Finish up (JBV) */ /* call prn_cr() to print a CR if it is not overridden by a concluding ';' mark */ prn_cr( l->buffer, f ); return TRUE; } /* end of function bwb_xprint() */ #if COMMON_CMDS /*************************************************************** FUNCTION: get_prnfmt() DESCRIPTION: This function gets the PRINT USING format string, returning a structure to the format. ***************************************************************/ #if ANSI_C static struct prn_fmt * get_prnfmt( char *buffer, int *position, FILE *f ) #else static struct prn_fmt * get_prnfmt( buffer, position, f ) char *buffer; int *position; FILE *f; #endif { static struct prn_fmt retstruct; int loop; /* set some defaults */ retstruct.precision = 0; retstruct.type = FALSE; retstruct.exponential = FALSE; retstruct.right_justified = FALSE; retstruct.commas = FALSE; retstruct.sign = FALSE; retstruct.money = FALSE; retstruct.fill = ' '; retstruct.minus = FALSE; retstruct.width = 0; /* check for negative position */ if ( *position < 0 ) { return &retstruct; } /* advance past whitespace */ /* adv_ws( buffer, position ); */ /* Don't think we want this (JBV) */ /* check first character: a lost can be decided right here */ loop = TRUE; while( loop == TRUE ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in get_prnfmt(): loop, buffer <%s>", &( buffer[ *position ] ) ); bwb_debug( bwb_ebuf ); #endif switch( buffer[ *position ] ) { case ' ': /* end of this format segment */ xxputc( f, buffer[ *position ] ); /* Gotta output it (JBV) */ ++( *position ); /* JBV */ if (retstruct.type != FALSE) loop = FALSE; /* JBV */ break; case '\0': /* end of format string */ case '\n': case '\r': *position = -1; return &retstruct; case '_': /* print next character as literal */ ++( *position ); xxputc( f, buffer[ *position ] ); /* Not xputc, no tabs (JBV) */ ++( *position ); break; case '!': retstruct.type = STRING; retstruct.width = 1; ++( *position ); /* JBV */ return &retstruct; case '&': /* JBV */ retstruct.type = STRING; retstruct.width = -1; ++( *position ); return &retstruct; case '\\': #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in get_prnfmt(): found \\" ); bwb_debug( bwb_ebuf ); #endif retstruct.type = STRING; ++retstruct.width; ++( *position ); for ( ; buffer[ *position ] == ' '; ++( *position ) ) { ++retstruct.width; } if ( buffer[ *position ] == '\\' ) { ++retstruct.width; ++( *position ); } return &retstruct; case '$': ++retstruct.width; /* JBV */ ++( *position ); retstruct.money = TRUE; if ( buffer[ *position ] == '$' ) { ++retstruct.width; /* JBV */ ++( *position ); } break; case '*': ++retstruct.width; /* JBV */ ++( *position ); retstruct.fill = '*'; if ( buffer[ *position ] == '*' ) { ++retstruct.width; /* JBV */ ++( *position ); } break; case '+': ++( *position ); retstruct.sign = TRUE; break; case '#': retstruct.type = NUMBER; /* for now */ /* ++( *position ); */ /* Removed by JBV */ /* The initial condition shouldn't be retstruct.width = 1 (JBV) */ for ( ; buffer[ *position ] == '#'; ++( *position ) ) { ++retstruct.width; } if ( buffer[ *position ] == ',' ) { retstruct.commas = TRUE; ++retstruct.width; /* JBV */ ++( *position ); /* JBV */ } if ( buffer[ *position ] == '.' ) { retstruct.type = NUMBER; ++retstruct.width; ++( *position ); for ( retstruct.precision = 0; buffer[ *position ] == '#'; ++( *position ) ) { ++retstruct.precision; ++retstruct.width; } } if ( buffer[ *position ] == '-' ) { retstruct.minus = TRUE; ++( *position ); } return &retstruct; case '^': retstruct.type = NUMBER; retstruct.exponential = TRUE; for ( retstruct.width = 1; buffer[ *position ] == '^'; ++( *position ) ) { ++retstruct.width; } return &retstruct; default: /* JBV */ xxputc( f, buffer[ *position ] ); /* Gotta output it (JBV) */ ++( *position ); break; } } /* end of loop */ return &retstruct; } #endif /*************************************************************** FUNCTION: prn_cr() DESCRIPTION: This function outputs a carriage-return to a specified file or output device. ***************************************************************/ #if ANSI_C static int prn_cr( char *buffer, FILE *f ) #else static int prn_cr( buffer, f ) char *buffer; FILE *f; #endif { register int c; int loop; /* find the end of the buffer */ for ( c = 0; buffer[ c ] != '\0'; ++c ) { } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in prn_cr(): initial c is <%d>", c ); bwb_debug( bwb_ebuf ); #endif /* back up through any whitespace */ loop = TRUE; while ( loop == TRUE ) { switch( buffer[ c ] ) { case ' ': /* if whitespace */ case '\t': case 0: #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in prn_cr(): backup: c is <%d>, char <%c>[0x%x]", c, buffer[ c ], buffer[ c ] ); bwb_debug( bwb_ebuf ); #endif --c; /* back up */ if ( c < 0 ) /* check position */ { loop = FALSE; } break; default: /* else break out */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in prn_cr(): breakout: c is <%d>, char <%c>[0x%x]", c, buffer[ c ], buffer[ c ] ); bwb_debug( bwb_ebuf ); #endif loop = FALSE; break; } } if ( buffer[ c ] == ';' ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in prn_cr(): concluding <;> detected." ); bwb_debug( bwb_ebuf ); #endif return FALSE; } else { prn_xprintf( f, "\n" ); return TRUE; } } /*************************************************************** FUNCTION: prn_xprintf() DESCRIPTION: This function outputs a null-terminated string to a specified file or output device. ***************************************************************/ #if ANSI_C int prn_xprintf( FILE *f, char *buffer ) #else int prn_xprintf( f, buffer ) FILE *f; char *buffer; #endif { char *p; /* DO NOT try anything so stupid as to run bwb_debug() from here, because it will create an endless loop. And don't ask how I know. */ for ( p = buffer; *p != '\0'; ++p ) { xputc( f, *p ); } return TRUE; } /*************************************************************** FUNCTION: prn_xxprintf() DESCRIPTION: This function outputs a null-terminated string to a specified file or output device without expanding tabs. Added by JBV 10/95 ***************************************************************/ #if ANSI_C int prn_xxprintf( FILE *f, char *buffer ) #else int prn_xxprintf( f, buffer ) FILE *f; char *buffer; #endif { char *p; /* DO NOT try anything so stupid as to run bwb_debug() from here, because it will create an endless loop. And don't ask how I know. */ for ( p = buffer; *p != '\0'; ++p ) { xxputc( f, *p ); } return TRUE; } /*************************************************************** FUNCTION: xputc() DESCRIPTION: This function outputs a character to a specified file or output device, expanding TABbed output approriately. ***************************************************************/ #if ANSI_C int xputc( FILE *f, char c ) #else int xputc( f, c ) FILE *f; char c; #endif { static int tab_pending = FALSE; /*--------------------------------------------------------------------*/ /* Don't expand tabs if not printing to stdout or stderr (JBV 9/4/97) */ /*--------------------------------------------------------------------*/ if (( f != stdout ) && ( f != stderr )) { xxputc( f, c ); return TRUE; } /* check for pending TAB */ if ( tab_pending == TRUE ) { if ( (int) c < ( * prn_getcol( f ) ) ) { xxputc( f, '\n' ); } while( ( * prn_getcol( f )) < (int) c ) { xxputc( f, ' ' ); } tab_pending = FALSE; return TRUE; } /* check c for specific output options */ switch( c ) { case PRN_TAB: tab_pending = TRUE; break; case '\t': while( ( (* prn_getcol( f )) % 14 ) != 0 ) { xxputc( f, ' ' ); } break; default: xxputc( f, c ); break; } return TRUE; } /*************************************************************** FUNCTION: xxputc() DESCRIPTION: This function outputs a character to a specified file or output device, checking to be sure the PRINT width is within the bounds specified for that device. ***************************************************************/ #if ANSI_C static int xxputc( FILE *f, char c ) #else static int xxputc( f, c ) FILE *f; char c; #endif { /*--------------------------------------------------------------------*/ /* Don't check width if not printing to stdout or stderr (JBV 9/4/97) */ /*--------------------------------------------------------------------*/ if (( f != stdout ) && ( f != stderr )) { return xxxputc( f, c ); } /* check to see if width has been exceeded */ if ( * prn_getcol( f ) >= prn_getwidth( f )) { xxxputc( f, '\n' ); /* output LF */ * prn_getcol( f ) = 1; /* and reset */ } /* adjust the column counter */ if ( c == '\n' ) { * prn_getcol( f ) = 1; } else { ++( * prn_getcol( f )); } /* now output the character */ return xxxputc( f, c ); } /*************************************************************** FUNCTION: xxxputc() DESCRIPTION: This function sends a character to a specified file or output device. ***************************************************************/ #if ANSI_C static int xxxputc( FILE *f, char c ) #else static int xxxputc( f, c ) FILE *f; char c; #endif { if (( f == stdout ) || ( f == stderr )) { return bwx_putc( c ); } else { return fputc( c, f ); } } /*************************************************************** FUNCTION: prn_getcol() DESCRIPTION: This function returns a pointer to an integer containing the current PRINT column for a specified file or device. ***************************************************************/ #if ANSI_C int * prn_getcol( FILE *f ) #else int * prn_getcol( f ) FILE *f; #endif { register int n; static int dummy_pos; if (( f == stdout ) || ( f == stderr )) { return &prn_col; } #if COMMON_CMDS for ( n = 0; n < DEF_DEVICES; ++n ) { if ( dev_table[ n ].cfp == f ) { return &( dev_table[ n ].col ); } } #endif /* search failed */ #if PROG_ERRORS bwb_error( "in prn_getcol(): failed to find file pointer" ); #else bwb_error( err_devnum ); #endif return &dummy_pos; } /*************************************************************** FUNCTION: prn_getwidth() DESCRIPTION: This function returns the PRINT width for a specified file or output device. ***************************************************************/ #if ANSI_C int prn_getwidth( FILE *f ) #else int prn_getwidth( f ) FILE *f; #endif { register int n; if (( f == stdout ) || ( f == stderr )) { return prn_width; } #if COMMON_CMDS for ( n = 0; n < DEF_DEVICES; ++n ) { if ( dev_table[ n ].cfp == f ) { return dev_table[ n ].width; } } #endif /* search failed */ #if PROG_ERRORS bwb_error( "in prn_getwidth(): failed to find file pointer" ); #else bwb_error( err_devnum ); #endif return 1; } /*************************************************************** FUNCTION: prn_precision() DESCRIPTION: This function returns the level of precision required for a specified numerical value. ***************************************************************/ #if ANSI_C int prn_precision( struct bwb_variable *v ) #else int prn_precision( v ) struct bwb_variable *v; #endif { int max_precision = 6; bnumber nval, d; int r; /* check for double value */ if ( v->type == NUMBER ) { max_precision = 12; } /* get the value in nval */ nval = (bnumber) fabs( (double) var_getnval( v ) ); /* cycle through until precision is found */ d = (bnumber) 1; for ( r = 0; r < max_precision; ++r ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in prn_precision(): fmod( %f, %f ) = %.12f", nval, d, fmod( (double) nval, (double) d ) ); bwb_debug( bwb_ebuf ); #endif if ( fmod( (double) nval, (double) d ) < 0.0000001 ) /* JBV */ { return r; } d /= 10; } /* return */ return r; } /*************************************************************** FUNCTION: bwb_debug() DESCRIPTION: This function is called to display debugging messages in Bywater BASIC. It does not break out at the current point (as bwb_error() does). ***************************************************************/ #if PERMANENT_DEBUG #if ANSI_C int bwb_debug( char *message ) #else int bwb_debug( message ) char *message; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; fflush( stdout ); fflush( errfdevice ); if ( prn_col != 1 ) { prn_xprintf( errfdevice, "\n" ); } sprintf( tbuf, "DEBUG %s\n", message ); prn_xprintf( errfdevice, tbuf ); return TRUE; } #endif #if COMMON_CMDS /*************************************************************** FUNCTION: bwb_lerror() DESCRIPTION: This function implements the BASIC ERROR command. ***************************************************************/ #if ANSI_C struct bwb_line * bwb_lerror( struct bwb_line *l ) #else struct bwb_line * bwb_lerror( l ) struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; int n; struct exp_ese *e; /* JBV */ int pos; /* JBV */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_lerror(): entered function " ); bwb_debug( bwb_ebuf ); #endif /* Check for argument */ adv_ws( l->buffer, &( l->position ) ); switch( l->buffer[ l->position ] ) { case '\0': case '\n': case '\r': case ':': bwb_error( err_incomplete ); return bwb_zline( l ); default: break; } /* get the variable name or numerical constant */ adv_element( l->buffer, &( l->position ), tbuf ); /* n = atoi( tbuf ); */ /* Removed by JBV */ /* Added by JBV */ pos = 0; e = bwb_exp( tbuf, FALSE, &pos ); n = (int) exp_getnval( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_lerror(): error number is <%d> ", n ); bwb_debug( bwb_ebuf ); #endif /* check the line number value */ if ( ( n < 0 ) || ( n >= N_ERRORS )) { sprintf( bwb_ebuf, "Error number %d is out of range", n ); bwb_xerror( bwb_ebuf ); return bwb_zline( l ); } bwb_xerror( err_table[ n ] ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_width() DESCRIPTION: This C function implements the BASIC WIDTH command, setting the maximum output width for a specified file or output device. SYNTAX: WIDTH [# device-number,] number ***************************************************************/ #if ANSI_C struct bwb_line * bwb_width( struct bwb_line *l ) #else struct bwb_line * bwb_width( l ) struct bwb_line *l; #endif { int req_devnumber; int req_width; struct exp_ese *e; char tbuf[ MAXSTRINGSIZE + 1 ]; int pos; /* detect device number if present */ req_devnumber = -1; adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == '#' ) { ++( l->position ); adv_element( l->buffer, &( l->position ), tbuf ); pos = 0; e = bwb_exp( tbuf, FALSE, &pos ); adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == ',' ) { ++( l->position ); } else { #if PROG_ERRORS bwb_error( "in bwb_width(): no comma after#n" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } req_devnumber = (int) exp_getnval( e ); /* check the requested device number */ if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES )) { #if PROG_ERRORS bwb_error( "in bwb_width(): Requested device number is out of range." ); #else bwb_error( err_devnum ); #endif return bwb_zline( l ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_width(): device number is <%d>", req_devnumber ); bwb_debug( bwb_ebuf ); #endif } /* read the width requested */ e = bwb_exp( l->buffer, FALSE, &( l->position )); req_width = (int) exp_getnval( e ); /* check the width */ if ( ( req_width < 1 ) || ( req_width > 255 )) { #if PROG_ERRORS bwb_error( "in bwb_width(): Requested width is out of range (1-255)" ); #else bwb_error( err_valoorange ); #endif } /* assign the width */ if ( req_devnumber == -1 ) { prn_width = req_width; } else { dev_table[ req_devnumber ].width = req_width; } /* return */ return bwb_zline( l ); } #endif /* COMMON_CMDS */ /*************************************************************** FUNCTION: bwb_error() DESCRIPTION: This function is called to handle errors in Bywater BASIC. It displays the error message, then calls the break_handler() routine. ***************************************************************/ #if ANSI_C int bwb_error( char *message ) #else int bwb_error( message ) char *message; #endif { register int e; static char tbuf[ MAXSTRINGSIZE + 1 ]; /* must be permanent */ static struct bwb_line eline; int save_elevel; struct bwb_line *cur_l; int cur_mode; /* try to find the error message to identify the error number */ err_number = -1; /* just for now */ err_line = CURTASK number; /* set error line number */ for ( e = 0; e < N_ERRORS; ++e ) { if ( message == err_table[ e ] ) /* set error number */ { err_number = e; e = N_ERRORS; /* break out of loop quickly */ } } /* set the position in the current line to the end */ while( is_eol( bwb_l->buffer, &( bwb_l->position ) ) != TRUE ) { ++( bwb_l->position ); } /* if err_gosubl is not set, then use xerror routine */ if ( strlen( err_gosubl ) == 0 ) { return bwb_xerror( message ); } #if INTENSIVE_DEBUG fprintf( stderr, "!!!!! USER_CALLED ERROR HANDLER\n" ); #endif /* save line and mode */ cur_l = bwb_l; cur_mode = CURTASK excs[ CURTASK exsc ].code; /* err_gosubl is set; call user-defined error subroutine */ sprintf( tbuf, "%s %s", CMD_GOSUB, err_gosubl ); eline.next = &CURTASK bwb_end; eline.position = 0; eline.marked = FALSE; eline.buffer = tbuf; bwb_setexec( &eline, 0, EXEC_NORM ); /* must be executed now */ save_elevel = CURTASK exsc; bwb_execline(); /* This is a call to GOSUB and will increment the exsc counter above save_elevel */ while ( CURTASK exsc != save_elevel ) /* loop until return from GOSUB loop */ { bwb_execline(); } cur_l->next->position = 0; bwb_setexec( cur_l->next, 0, cur_mode ); return TRUE; } /*************************************************************** FUNCTION: bwb_xerror() DESCRIPTION: This function is called by bwb_error() in Bywater BASIC. It displays the error message, then calls the break_handler() routine. ***************************************************************/ #if ANSI_C static int bwb_xerror( char *message ) #else static int bwb_xerror( message ) char *message; #endif { bwx_errmes( message ); break_handler(); return FALSE; } /*************************************************************** FUNCTION: bwb_esetovar() DESCRIPTION: This function converts the value in expression stack 'e' to a bwBASIC variable structure. ***************************************************************/ #if ANSI_C static struct bwb_variable * bwb_esetovar( struct exp_ese *e ) #else static struct bwb_variable * bwb_esetovar( e ) struct exp_ese *e; #endif { static struct bwb_variable b; var_make( &b, e->type ); switch( e->type ) { case STRING: str_btob( var_findsval( &b, b.array_pos ), exp_getsval( e ) ); break; default: * var_findnval( &b, b.array_pos ) = e->nval; break; } return &b; } #if COMMON_CMDS /*************************************************************** FUNCTION: bwb_write() DESCRIPTION: This C function implements the BASIC WRITE command. SYNTAX: WRITE [# device-number,] element [, element ].... ***************************************************************/ #if ANSI_C struct bwb_line * bwb_write( struct bwb_line *l ) #else struct bwb_line * bwb_write( l ) struct bwb_line *l; #endif { struct exp_ese *e; int req_devnumber; int pos; FILE *fp; char tbuf[ MAXSTRINGSIZE + 1 ]; int loop; static struct bwb_variable nvar; static int init = FALSE; /* initialize variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, NUMBER ); } /* detect device number if present */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == '#' ) { ++( l->position ); adv_element( l->buffer, &( l->position ), tbuf ); pos = 0; e = bwb_exp( tbuf, FALSE, &pos ); adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == ',' ) { ++( l->position ); } else { #if PROG_ERRORS bwb_error( "in bwb_write(): no comma after#n" ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } req_devnumber = (int) exp_getnval( e ); /* check the requested device number */ if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES )) { #if PROG_ERRORS bwb_error( "in bwb_write(): Requested device number is out of range." ); #else bwb_error( err_devnum ); #endif return bwb_zline( l ); } if (( dev_table[ req_devnumber ].mode == DEVMODE_CLOSED ) || ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE )) { #if PROG_ERRORS bwb_error( "in bwb_write(): Requested device number is not open." ); #else bwb_error( err_devnum ); #endif return bwb_zline( l ); } if ( dev_table[ req_devnumber ].mode != DEVMODE_OUTPUT ) { #if PROG_ERRORS bwb_error( "in bwb_write(): Requested device is not open for OUTPUT." ); #else bwb_error( err_devnum ); #endif return bwb_zline( l ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_write(): device number is <%d>", req_devnumber ); bwb_debug( bwb_ebuf ); #endif /* look up the requested device in the device table */ fp = dev_table[ req_devnumber ].cfp; } else { fp = stdout; } /* be sure there is an element to print */ adv_ws( l->buffer, &( l->position ) ); loop = TRUE; switch( l->buffer[ l->position ] ) { case '\n': case '\r': case '\0': case ':': loop = FALSE; break; } /* loop through elements */ while ( loop == TRUE ) { /* get the next element */ e = bwb_exp( l->buffer, FALSE, &( l->position )); /* perform type-specific output */ switch( e->type ) { case STRING: xputc( fp, '\"' ); str_btoc( tbuf, exp_getsval( e ) ); prn_xprintf( fp, tbuf ); xputc( fp, '\"' ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_write(): output string element <\"%s\">", tbuf ); bwb_debug( bwb_ebuf ); #endif break; default: * var_findnval( &nvar, nvar.array_pos ) = exp_getnval( e ); #if NUMBER_DOUBLE sprintf( tbuf, " %.*lf", prn_precision( &nvar ), var_getnval( &nvar ) ); #else sprintf( tbuf, " %.*f", prn_precision( &nvar ), var_getnval( &nvar ) ); #endif prn_xprintf( fp, tbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_write(): output numerical element <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif break; } /* end of case for type-specific output */ /* seek a comma at end of element */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] == ',' ) { xputc( fp, ',' ); ++( l->position ); } /* no comma: end the loop */ else { loop = FALSE; } } /* end of loop through elements */ /* print LF */ xputc( fp, '\n' ); /* return */ return bwb_zline( l ); } #endif bwbasic-2.20pl2.orig/bwb_stc.c100644 0 0 150141 6473161700 14340 0ustar rootroot/*************************************************************** bwb_stc.c Commands Related to Structured Programming for Bywater BASIC Interpreter Commands: CALL SUB FUNCTION END SUB END FUNCTION 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). */ /*---------------------------------------------------------------*/ #include #include #include "bwbasic.h" #include "bwb_mes.h" /* prototypes */ #if ANSI_C static int fslt_clear( void ); static int fslt_add( struct bwb_line *line, int *position, int code ); static struct bwb_line *fslt_findl( char *buffer ); static struct fslte *fslt_findf( char *buffer ); static int scan_getcmd( struct bwb_line *line, int *position ); static int scan_readargs( struct fslte *f, struct bwb_line *line, int *position ); static int call_readargs( struct fslte *f, char *expression, int *position ); static int is_endsub( struct bwb_line *l ); static struct bwb_line *find_endsub( struct bwb_line *l ); static struct bwb_line *bwb_loopuntil( struct bwb_line *l ); struct bwb_variable *bwb_vtov( struct bwb_variable *dst, struct bwb_variable *src ); struct bwb_variable *bwb_etov( struct bwb_variable *dst, struct exp_ese *src ); struct bwb_variable *var_pos( struct bwb_variable *firstvar, int p ); int fslt_addcallvar( struct bwb_variable *v ); int fslt_addlocalvar( struct fslte *f, struct bwb_variable *v ); #else static int fslt_clear(); static int fslt_add(); static struct bwb_line *fslt_findl(); static struct fslte *fslt_findf(); static int scan_getcmd(); static int scan_readargs(); static int call_readargs(); static int is_endsub(); static struct bwb_line *find_endsub(); static struct bwb_line *bwb_loopuntil(); struct bwb_variable *bwb_vtov(); struct bwb_variable *bwb_etov(); struct bwb_variable *var_pos(); int fslt_addcallvar(); int fslt_addlocalvar(); #endif /* ANSI_C for prototypes */ /*************************************************************** 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. ***************************************************************/ #if ANSI_C int bwb_scan( void ) #else int bwb_scan() #endif { struct bwb_line *current; int position; int c; #if PROG_ERRORS if ( CURTASK rescan != TRUE ) { bwb_error( "in bwb_scan(): call to scan while CURTASK rescan != TRUE" ); return FALSE; } #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_scan(): beginning scan..." ); bwb_debug( bwb_ebuf ); #endif /* first run through the FUNCTION - SUB loopkup table and free any existing memory */ fslt_clear(); /* run through the list of lines and identify SUB and FUNCTION statements */ for ( current = CURTASK bwb_start.next; current != &CURTASK bwb_end; current = current->next ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_scan(): scanning line <%d>", current->number ); bwb_debug( bwb_ebuf ); #endif c = scan_getcmd( current, &position ); if ( c == getcmdnum( CMD_SUB )) { fslt_add( current, &position, EXEC_CALLSUB ); } else if ( c == getcmdnum( CMD_FUNCTION )) { fslt_add( current, &position, EXEC_FUNCTION ); } else if ( c == getcmdnum( CMD_DEF )) { fslt_add( current, &position, EXEC_FUNCTION ); } #if STRUCT_CMDS else if ( c == getcmdnum( CMD_LABEL )) { fslt_add( current, &position, EXEC_LABEL ); } #endif } /* return */ CURTASK rescan = FALSE; return TRUE; } /*************************************************************** FUNCTION: fslt_clear() DESCRIPTION: This C function clears all existing memory in the FUNCTION-SUB lookup table. ***************************************************************/ #if ANSI_C static int fslt_clear( void ) #else static int fslt_clear() #endif { struct fslte *current, *next; struct bwb_variable *c, *n; /* run through table and clear memory */ next = CURTASK fslt_start.next; for ( current = CURTASK fslt_start.next; current != &CURTASK fslt_end; current = next ) { /* check for local variables and free them */ c = current->local_variable; while ( c != NULL ) { n = c->next; /* Revised to FREE pass-thru call by JBV */ FREE( c, "fslt_clear" ); c = n; } next = current->next; /* Revised to FREE pass-thru calls by JBV */ if (current->name != NULL) { FREE( current->name, "fslt_clear" ); /* JBV */ current->name = NULL; /* JBV */ } FREE( current, "fslt_clear" ); current = NULL; /* JBV */ } /* reset linkage */ CURTASK fslt_start.next = &CURTASK fslt_end; return TRUE; } /*************************************************************** FUNCTION: scan_getcmd() DESCRIPTION: This command returns the command number for the first BASIC command word encountered in a line. ***************************************************************/ #if ANSI_C static int scan_getcmd( struct bwb_line *line, int *position ) #else static int scan_getcmd( line, position ) struct bwb_line *line; int *position; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; *position = 0; adv_ws( line->buffer, position ); /* check for NULL line */ if ( line->buffer[ *position ] == '\0' ) { return -1; } /* check for line number and advance beyond it */ if ( isdigit( line->buffer[ *position ] )) { scan_element( line->buffer, position, tbuf ); } /* get the command element in the buffer */ scan_element( line->buffer, position, tbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in scan_getcmd(): scanning element <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif #if STRUCT_CMDS if ( is_label( tbuf ) == TRUE ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in scan_getcmd(): found label <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif return getcmdnum( CMD_LABEL ); } #endif bwb_strtoupper( tbuf ); /* return command number */ return getcmdnum( tbuf ); } /*************************************************************** FUNCTION: scan_element() DESCRIPTION: This function reads characters in beginning at and advances past a line element, incrementing appropri- ately and returning the line element in . This function is almost identical to adv_element(), but it will not stop at a full colon. This is necessary to detect a label in the first element position. If MULTISEG_LINES is defined as TRUE, adv_element() will stop at the colon, interpreting it as the end-of-segment marker. ***************************************************************/ #if ANSI_C extern int scan_element( char *buffer, int *pos, char *element ) #else int scan_element( buffer, pos, element ) char *buffer; int *pos; char *element; #endif { int loop; /* control loop */ int e_pos; /* position in element buffer */ int str_const; /* boolean: building a string constant */ /* advance beyond any initial whitespace */ adv_ws( buffer, pos ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in adv_element(): receieved <%s>.", &( buffer[ *pos ] )); bwb_debug( bwb_ebuf ); #endif /* now loop while building an element and looking for an element terminator */ loop = TRUE; e_pos = 0; element[ e_pos ] = '\0'; str_const = FALSE; while ( loop == TRUE ) { switch( buffer[ *pos ] ) { case ',': /* element terminators */ case ';': case '=': case ' ': case '\t': case '\0': case '\n': case '\r': if ( str_const == TRUE ) { element[ e_pos ] = buffer[ *pos ]; ++e_pos; ++( *pos ); element[ e_pos ] = '\0'; } else { return TRUE; } break; case '\"': /* string constant */ element[ e_pos ] = buffer[ *pos ]; ++e_pos; ++( *pos ); element[ e_pos ] = '\0'; if ( str_const == TRUE ) /* termination of string constant */ { return TRUE; } else /* beginning of string constant */ { str_const = TRUE; } break; case '(': /* MID$ command termination (JBV) */ /* If MID$ is here, get out */ if (strcmp(element, CMD_MID) == 0) return TRUE; /* else add it to the accumulation element */ element[ e_pos ] = buffer[ *pos ]; ++e_pos; ++( *pos ); element[ e_pos ] = '\0'; break; default: element[ e_pos ] = buffer[ *pos ]; ++e_pos; ++( *pos ); element[ e_pos ] = '\0'; break; } } /* This should not happen */ return FALSE; } /*************************************************************** FUNCTION: fslt_add() DESCRIPTION: This C function adds an entry to the FUNCTION-SUB lookup table. ***************************************************************/ #if ANSI_C static int fslt_add( struct bwb_line *line, int *position, int code ) #else static int fslt_add( line, position, code ) struct bwb_line *line; int *position; int code; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; char *name; struct bwb_variable *v; struct fslte *f, *n; int p; /* get the element for name */ if ( code == EXEC_LABEL ) { p = 0; scan_element( line->buffer, &p, tbuf ); if ( isdigit( tbuf[ 0 ] )) { scan_element( line->buffer, &p, tbuf ); } tbuf[ strlen( tbuf ) - 1 ] = '\0'; } else { adv_ws( line->buffer, position ); exp_getvfname( &( line->buffer[ *position ] ), tbuf ); *position += strlen( tbuf ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fslt_add(): adding SUB/FUNCTION/LABEL code <%d> name <%s>", code, tbuf ); bwb_debug( bwb_ebuf ); #endif /* get memory for name buffer */ /* Revised to CALLOC pass-thru call by JBV */ if ( ( name = CALLOC( 1, strlen( tbuf ) + 1, "fslt_add" ) ) == NULL ) { #if PROG_ERRORS bwb_error( "in fslt_add(): failed to get memory for name buffer" ); #else bwb_error( err_getmem ); #endif return FALSE; } strcpy( name, tbuf ); /* get memory for fslt structure */ if ( ( f = CALLOC( 1, sizeof( struct fslte ), "fslt_add" ) ) == NULL ) { #if PROG_ERRORS bwb_error( "in fslt_add(): failed to get memory for fslt structure" ); #else bwb_error( err_getmem ); #endif return FALSE; } /* fill in structure */ f->line = line; f->name = name; f->code = code; f->local_variable = NULL; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fslt_add(): current buffer <%s>", &( line->buffer[ *position ] ) ); bwb_debug( bwb_ebuf ); #endif /* read arguments */ adv_ws( line->buffer, position ); if ( line->buffer[ *position ] == '(' ) { scan_readargs( f, line, position ); } /* if function, add one more local variable expressing the name of the function */ if ( code == EXEC_FUNCTION ) { v = var_new( tbuf ); fslt_addlocalvar( f, v ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fslt_add(): added function-name variable <%s>", v->name ); bwb_debug( bwb_ebuf ); getchar(); #endif } /* establish linkages */ n = CURTASK fslt_start.next; CURTASK fslt_start.next = f; f->next = n; return TRUE; } /*************************************************************** FUNCTION: scan_readargs() DESCRIPTION: This C function reads arguments (variable names for an entry added to the FUNCTION- SUB lookup table. ***************************************************************/ #if ANSI_C static int scan_readargs( struct fslte *f, struct bwb_line *line, int *position ) #else static int scan_readargs( f, line, position ) struct fslte *f; struct bwb_line *line; int *position; #endif { int control_loop; struct bwb_variable *v; char tbuf[ MAXSTRINGSIZE + 1 ]; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in scan_readargs(): reading arguments, buffer <%s>", &( line->buffer[ *position ] ) ); bwb_debug( bwb_ebuf ); #endif /* if we are at begin paren, advance */ if ( line->buffer[ *position ] == '(' ) { ++( *position ); } /* loop through looking for arguments */ control_loop = TRUE; adv_ws( line->buffer, position ); while ( control_loop == TRUE ) { switch( line->buffer[ *position ] ) { case '\n': /* premature end of line */ case '\r': case '\0': control_loop = FALSE; f->startpos = *position; bwb_error( err_syntax ); return FALSE; case ')': /* end of argument list */ ++( *position ); control_loop = FALSE; f->startpos = *position; return TRUE; default: /* presume beginning of argument == variable name */ exp_getvfname( &( line->buffer[ *position ] ), tbuf ); *position += strlen( tbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in scan_readargs(): read argument <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif /* initialize the variable and add it to local chain */ v = var_new( tbuf ); fslt_addlocalvar( f, v ); /* advance past the comma */ if ( line->buffer[ *position ] == ',' ) { ++( *position ); } break; } adv_ws( line->buffer, position ); } return TRUE; } /*************************************************************** FUNCTION: call_readargs() DESCRIPTION: This C function reads arguments (variable names for a subroutine CALL or function call. ***************************************************************/ #if ANSI_C static int call_readargs( struct fslte *f, char *expression, int *position ) #else static int call_readargs( f, expression, position ) struct fslte *f; char *expression; int *position; #endif { int control_loop; struct bwb_variable *v, *c; char tbuf[ MAXSTRINGSIZE + 1 ]; int argument_counter; int local_pos, single_var; struct exp_ese *e; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in call_readargs(): reading arguments, buffer <%s>", &( expression[ *position ] ) ); bwb_debug( bwb_ebuf ); #endif /* if we are at begin paren, advance */ if ( expression[ *position ] == '(' ) { ++( *position ); } /* loop through looking for arguments */ control_loop = TRUE; argument_counter = 0; while ( control_loop == TRUE ) { adv_ws( expression, position ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in call_readargs(): in loop, buffer <%s>", &( expression[ *position ] ) ); bwb_debug( bwb_ebuf ); #endif switch( expression[ *position ] ) { case '\n': /* end of line */ case '\r': case '\0': #if MULTISEG_LINES case ':': /* end of segment */ #endif control_loop = FALSE; return FALSE; case ')': /* end of argument list */ ++( *position ); control_loop = FALSE; return TRUE; default: /* presume beginning of argument */ /* read the first word to see if it is a single variable name */ single_var = FALSE; exp_getvfname( &( expression[ *position ] ), tbuf ); local_pos = *position + strlen( tbuf ); adv_ws( expression, &local_pos ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in call_readargs(): in loop, tbuf <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif /* check now for the single variable name */ if ( strlen( tbuf ) == 0 ) { single_var = FALSE; } else { switch ( expression[ local_pos ] ) { case ')': /* end of argument list */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in call_readargs(): detected end of argument list" ); bwb_debug( bwb_ebuf ); #endif ++local_pos; /* and fall through */ case '\n': /* end of line */ case '\r': case '\0': #if MULTISEG_LINES case ':': /* end of segment */ #endif control_loop = FALSE; /* and fall through */ /* added 1993-06-16 */ case ',': /* end of argument */ single_var = TRUE; /* look for variable from previous (calling) level */ -- CURTASK exsc; v = var_find( tbuf ); /* find variable there */ ++ CURTASK exsc; c = var_pos( CURTASK excs[ CURTASK exsc ].local_variable, argument_counter ); /* find local equivalent */ bwb_vtov( c, v ); /* assign calling value to local variable */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in call_readargs(): variable name is <%s>, local name <%s>", v->name, c->name ); bwb_debug( bwb_ebuf ); #endif *position = local_pos; break; default: single_var = FALSE; break; } } if ( single_var == FALSE ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in call_readargs(): in loop, parse expression <%s>", &( expression[ *position ] ) ); bwb_debug( bwb_ebuf ); #endif e = bwb_exp( expression, FALSE, position ); /* parse */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in call_readargs(): in loop, parsed expression, buffer <%s>", &( expression[ *position ] ) ); bwb_debug( bwb_ebuf ); #endif v = var_pos( CURTASK excs[ CURTASK exsc ].local_variable, argument_counter ); /* assign to variable */ bwb_etov( v, e ); /* assign value */ } /* add the variable to the calling variable chain */ fslt_addcallvar( v ); #if INTENSIVE_DEBUG str_btoc( tbuf, var_getsval( v )); if ( single_var == TRUE ) { sprintf( bwb_ebuf, "in call_readargs(): added arg <%d> (single) name <%s> value <%s>", argument_counter, v->name, tbuf ); } else { sprintf( bwb_ebuf, "in call_readargs(): added arg <%d> (expression) name <%s> value <%s>", argument_counter, v->name, tbuf ); } bwb_debug( bwb_ebuf ); getchar(); #endif /* advance past comma if present */ adv_ws( expression, position ); if ( expression[ *position ] == ',' ) { ++( *position ); } break; } ++argument_counter; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in call_readargs(): exiting function" ); bwb_debug( bwb_ebuf ); #endif return TRUE; } /*************************************************************** FUNCTION: fslt_findl() DESCRIPTION: This C function finds a line corresponding to a name in the FUNCTION-SUB lookup table. ***************************************************************/ #if ANSI_C static struct bwb_line * fslt_findl( char *buffer ) #else static struct bwb_line * fslt_findl( buffer ) char *buffer; #endif { struct fslte *r; r = fslt_findf( buffer ); return r->line; } /*************************************************************** FUNCTION: fslt_findf() DESCRIPTION: This C function finds an fslte structure corresponding to a name in the FUNCTION- SUB lookup table. ***************************************************************/ #if ANSI_C static struct fslte * fslt_findf( char *buffer ) #else static struct fslte * fslt_findf( buffer ) char *buffer; #endif { struct fslte *f; register int c; /* remove open-paren from string */ for ( c = 0; buffer[ c ] != '\0'; ++c ) { if ( buffer[ c ] == '(' ) { buffer[ c ] = '\0'; } } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fslt_findf(): search for name <%s>", buffer ); bwb_debug( bwb_ebuf ); #endif /* run through the table */ for ( f = CURTASK fslt_start.next; f != &CURTASK fslt_end; f = f->next ) { if ( strcmp( f->name, buffer ) == 0 ) { return f; } } /* search has failed */ #if PROG_ERRORS sprintf( bwb_ebuf, "in fslt_findf(): failed to find Function/Subroutine <%s>", buffer ); bwb_error( bwb_ebuf ); #else bwb_error( err_lnnotfound ); #endif return NULL; } /*************************************************************** FUNCTION: bwb_def() DESCRIPTION: This C function implements the BASIC DEF statement. Since DEF and FUNCTION are equivalent, it simply passes execution to bwb_function(). SYNTAX: DEF FNname(arg...)] = expression NOTE: It is not a strict requirement that the function name should begin with "FN". ***************************************************************/ #if ANSI_C struct bwb_line * bwb_def( struct bwb_line *l ) #else struct bwb_line * bwb_def( l ) struct bwb_line *l; #endif { #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif return bwb_zline( l ); } #if STRUCT_CMDS /*************************************************************** FUNCTION: bwb_function() DESCRIPTION: This C function implements the BASIC FUNCTION and DEF commands. SYNTAX: FUNCTION function-definition ***************************************************************/ #if ANSI_C struct bwb_line * bwb_function( struct bwb_line *l ) #else struct bwb_line * bwb_function( l ) struct bwb_line *l; #endif { return bwb_def( l ); } /*************************************************************** FUNCTION: bwb_endfnc() DESCRIPTION: This C function implements the BASIC END FUNCTION command, ending a subroutine definition. Because the command END can have multiple meanings, this function should be called from the bwb_xend() function, which should be able to identify an END FUNCTION command. SYNTAX: END FUNCTION ***************************************************************/ #if ANSI_C struct bwb_line * bwb_endfnc( struct bwb_line *l ) #else struct bwb_line * bwb_endfnc( l ) struct bwb_line *l; #endif { struct bwb_variable *local; register int c; /* assign local variable values to calling variables */ local = CURTASK excs[ CURTASK exsc ].local_variable; for ( c = 0; c < CURTASK excs[ CURTASK exsc ].n_cvs; ++c ) { bwb_vtov( CURTASK excs[ CURTASK exsc ].calling_variable[ c ], local ); local = local->next; } /* decrement the EXEC stack counter */ bwb_decexec(); /* and return next from old line */ CURTASK excs[ CURTASK exsc ].line->next->position = 0; return CURTASK excs[ CURTASK exsc ].line->next; } /*************************************************************** FUNCTION: bwb_call() DESCRIPTION: This C function implements the BASIC CALL subroutine command. SYNTAX: CALL subroutine-name ***************************************************************/ #if ANSI_C struct bwb_line * bwb_call( struct bwb_line *l ) #else struct bwb_line * bwb_call( l ) struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; struct bwb_line *call_line; struct fslte *f; adv_element( l->buffer, &( l->position ), tbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_call(): call to subroutine <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif /* find the line to call */ call_line = fslt_findl( tbuf ); f = fslt_findf( tbuf ); if ( call_line == NULL ) { return bwb_zline( l ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_call(): found line <%s>", call_line->buffer ); bwb_debug( bwb_ebuf ); #endif /* save the old position on the EXEC stack */ bwb_setexec( l, l->position, CURTASK excs[ CURTASK exsc ].code ); /* increment and set new EXEC stack */ bwb_incexec(); call_line->position = 0; bwb_setexec( call_line, 0, EXEC_CALLSUB ); /* attach local variables */ CURTASK excs[ CURTASK exsc ].local_variable = f->local_variable; /* read calling variables for this call */ call_readargs( f, l->buffer, &( l->position ) ); return call_line; } /*************************************************************** FUNCTION: bwb_sub() DESCRIPTION: This function implements the BASIC SUB command, introducing a named subroutine. SYNTAX: SUB subroutine-name (followed by subroutine definition ending with END SUB). ***************************************************************/ #if ANSI_C struct bwb_line * bwb_sub( struct bwb_line *l ) #else struct bwb_line * bwb_sub( l ) struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; struct bwb_line *rline; #if MULTISEG_LINES struct fslte *f; #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_sub(): entered function at exec level <%d>", CURTASK exsc ); bwb_debug( bwb_ebuf ); #endif /* check current exec level: if 1 then only MAIN should be executed */ if ( CURTASK exsc == 0 ) { adv_element( l->buffer, &( l->position ), tbuf ); bwb_strtoupper( tbuf ); if ( strcmp( tbuf, "MAIN" ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_sub(): found MAIN function at level 0" ); bwb_debug( bwb_ebuf ); #endif bwb_incexec(); bwb_setexec( l->next, 0, EXEC_MAIN ); return bwb_zline( l ); } /* if a MAIN function was not found at level 0, then skip the subroutine */ else { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_sub(): found non-MAIN function at level 0" ); bwb_debug( bwb_ebuf ); #endif rline = find_endsub( l ); bwb_setexec( rline->next, 0, EXEC_CALLSUB ); rline->next->position = 0; return rline->next; } } /* check for integrity of CALL-SUB sequence if above level 0 */ else if ( CURTASK excs[ CURTASK exsc ].code != EXEC_CALLSUB ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_sub(): SUB without CALL" ); bwb_error( bwb_ebuf ); #else bwb_error( err_retnogosub ); #endif } /* advance position */ #if MULTISEG_LINES adv_ws( l->buffer, &( l->position )); adv_element( l->buffer, &( l->position ), tbuf ); f = fslt_findf( tbuf ); l->position = f->startpos; return bwb_zline( l ); #else return bwb_zline( l ); #endif } /*************************************************************** FUNCTION: find_endsub() DESCRIPTION: This function searches for a line containing an END SUB statement corresponding to a previous SUB statement. ***************************************************************/ #if ANSI_C static struct bwb_line * find_endsub( struct bwb_line *l ) #else static struct bwb_line * find_endsub( l ) struct bwb_line *l; #endif { struct bwb_line *current; register int s_level; int position; s_level = 1; for ( current = l->next; current != &CURTASK bwb_end; current = current->next ) { position = 0; if ( current->marked != TRUE ) { line_start( current->buffer, &position, &( current->lnpos ), &( current->lnum ), &( current->cmdpos ), &( current->cmdnum ), &( current->startpos ) ); } current->position = current->startpos; if ( current->cmdnum > -1 ) { if ( bwb_cmdtable[ current->cmdnum ].vector == bwb_sub ) { ++s_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in find_endsub(): found SUB at line %d, level %d", current->number, s_level ); bwb_debug( bwb_ebuf ); #endif } else if ( is_endsub( current ) == TRUE ) { --s_level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in find_endsub(): found END SUB at line %d, level %d", current->number, s_level ); bwb_debug( bwb_ebuf ); #endif if ( s_level == 0 ) { return current; } } } } #if PROG_ERRORS sprintf( bwb_ebuf, "SUB without END SUB" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return NULL; } /*************************************************************** FUNCTION: is_endsub() DESCRIPTION: This function determines whether the line buffer for line 'l' is positioned at an END SUB statement. ***************************************************************/ #if ANSI_C static int is_endsub( struct bwb_line *l ) #else static int is_endsub( l ) struct bwb_line *l; #endif { int position; char tbuf[ MAXVARNAMESIZE + 1]; if ( bwb_cmdtable[ l->cmdnum ].vector != bwb_xend ) { return FALSE; } position = l->startpos; adv_ws( l->buffer, &position ); adv_element( l->buffer, &position, tbuf ); bwb_strtoupper( tbuf ); if ( strcmp( tbuf, "SUB" ) == 0 ) { return TRUE; } return FALSE; } /*************************************************************** FUNCTION: bwb_endsub() DESCRIPTION: This C function implements the BASIC END SUB command, ending a subroutine definition. Because the command END can have multiple meanings, this function should be called from the bwb_xend() function, which should be able to identify an END SUB command. SYNTAX: END SUB ***************************************************************/ #if ANSI_C struct bwb_line * bwb_endsub( struct bwb_line *line ) #else struct bwb_line * bwb_endsub( line ) struct bwb_line *line; #endif { struct bwb_variable *l; register int c; /* assign local variable values to calling variables */ l = CURTASK excs[ CURTASK exsc ].local_variable; for ( c = 0; c < CURTASK excs[ CURTASK exsc ].n_cvs; ++c ) { bwb_vtov( CURTASK excs[ CURTASK exsc ].calling_variable[ c ], l ); l = l->next; } /* decrement the EXEC stack counter */ bwb_decexec(); /* if the previous level was EXEC_MAIN, then execution continues from this point */ if ( CURTASK excs[ CURTASK exsc + 1 ].code == EXEC_MAIN ) { return bwb_zline( line ); } /* else return next from old line */ CURTASK excs[ CURTASK exsc ].line->next->position = 0; return CURTASK excs[ CURTASK exsc ].line->next; } /*************************************************************** FUNCTION: find_label() DESCRIPTION: This C function finds a program line that begins with the label included in . ***************************************************************/ #if ANSI_C extern struct bwb_line * find_label( char *buffer ) #else extern struct bwb_line * find_label( buffer ) char *buffer; #endif { struct fslte *f; for ( f = CURTASK fslt_start.next; f != & ( CURTASK fslt_end ); f = f->next ) { if ( strcmp( buffer, f->name ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in find_label(): found label <%s>", buffer ); bwb_debug( bwb_ebuf ); #endif return f->line; } } #if PROG_ERRORS sprintf( bwb_ebuf, "in find_label(): failed to find label <%s>", buffer ); bwb_error( bwb_ebuf ); #else bwb_error( err_lnnotfound ); #endif return NULL; } /*************************************************************** FUNCTION: bwb_doloop() DESCRIPTION: This C function implements the ANSI BASIC DO statement, when DO is not followed by an argument. It is called by bwb_do() in bwb_cmd.c. SYNTAX: DO ***************************************************************/ #if ANSI_C struct bwb_line * bwb_doloop( struct bwb_line *l ) #else struct bwb_line * bwb_doloop( l ) struct bwb_line *l; #endif { /* if this is the first time at this DO statement, note it */ if ( CURTASK excs[ CURTASK exsc ].while_line != l ) { bwb_incexec(); CURTASK excs[ CURTASK exsc ].while_line = l; /* find the LOOP statement */ CURTASK excs[ CURTASK exsc ].wend_line = find_loop( l ); if ( CURTASK excs[ CURTASK exsc ].wend_line == NULL ) { return bwb_zline( l ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_doloop(): initialize DO loop, line <%d>", l->number ); bwb_debug( bwb_ebuf ); #endif } #if INTENSIVE_DEBUG else { sprintf( bwb_ebuf, "in bwb_doloop(): return to DO loop, line <%d>", l->number ); bwb_debug( bwb_ebuf ); } #endif bwb_setexec( l, l->position, EXEC_DO ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_loop() DESCRIPTION: This C function implements the ANSI BASIC LOOP statement. SYNTAX: LOOP [UNTIL expression] ***************************************************************/ #if ANSI_C struct bwb_line * bwb_loop( struct bwb_line *l ) #else struct bwb_line * bwb_loop( l ) struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_loop(): entered subroutine" ); bwb_debug( bwb_ebuf ); #endif /* If the current exec stack is set for EXEC_WHILE, then we presume that this is a LOOP statement ending a DO WHILE loop */ if ( CURTASK excs[ CURTASK exsc ].code == EXEC_WHILE ) { return bwb_wend( l ); } /* check integrity of DO loop */ if ( CURTASK excs[ CURTASK exsc ].code != EXEC_DO ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_loop(): exec stack code != EXEC_DO" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif } if ( CURTASK excs[ CURTASK exsc ].while_line == NULL ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_loop(): exec stack while_line == NULL" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif } /* advance to find the first argument */ adv_element( l->buffer, &( l->position ), tbuf ); bwb_strtoupper( tbuf ); /* detect a LOOP UNTIL structure */ if ( strcmp( tbuf, CMD_XUNTIL ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_loop(): detected LOOP UNTIL" ); bwb_debug( bwb_ebuf ); #endif return bwb_loopuntil( l ); } /* LOOP does not have UNTIL */ else { /* reset to the top of the current DO loop */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_loop() return to line <%d>", CURTASK excs[ CURTASK exsc ].while_line->number ); bwb_debug( bwb_ebuf ); #endif CURTASK excs[ CURTASK exsc ].while_line->position = 0; bwb_setexec( CURTASK excs[ CURTASK exsc ].while_line, 0, EXEC_DO ); return CURTASK excs[ CURTASK exsc ].while_line; } } /*************************************************************** FUNCTION: bwb_loopuntil() DESCRIPTION: This C function implements the ANSI BASIC LOOP UNTIL statement and is called by bwb_loop(). ***************************************************************/ #if ANSI_C static struct bwb_line * bwb_loopuntil( struct bwb_line *l ) #else static struct bwb_line * bwb_loopuntil( l ) struct bwb_line *l; #endif { struct exp_ese *e; struct bwb_line *r; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_loopuntil(): entered subroutine" ); bwb_debug( bwb_ebuf ); #endif /* call bwb_exp() to interpret the expression */ e = bwb_exp( l->buffer, FALSE, &( l->position ) ); if ( (int) exp_getnval( e ) != FALSE ) /* Was == TRUE (JBV 10/1996) */ { CURTASK excs[ CURTASK exsc ].while_line = NULL; r = CURTASK excs[ CURTASK exsc ].wend_line; bwb_setexec( r, 0, CURTASK excs[ CURTASK exsc - 1 ].code ); r->position = 0; bwb_decexec(); return r; } /* condition is false: loop around to DO again */ else { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_loopuntil() return to line <%d>", CURTASK excs[ CURTASK exsc ].while_line->number ); bwb_debug( bwb_ebuf ); #endif CURTASK excs[ CURTASK exsc ].while_line->position = 0; bwb_setexec( CURTASK excs[ CURTASK exsc ].while_line, 0, EXEC_DO ); return CURTASK excs[ CURTASK exsc ].while_line; } } /*************************************************************** FUNCTION: bwb_exit() DESCRIPTION: This C function implements the BASIC EXIT statement, calling subroutines for either EXIT FOR or EXIT DO. SYNTAX: EXIT FOR|DO ***************************************************************/ #if ANSI_C struct bwb_line * bwb_exit( struct bwb_line *l ) #else struct bwb_line * bwb_exit( l ) struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exit(): entered subroutine" ); bwb_debug( bwb_ebuf ); #endif adv_element( l->buffer, &( l->position ), tbuf ); bwb_strtoupper( tbuf ); if ( strcmp( tbuf, CMD_XFOR ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exit(): detected EXIT FOR" ); bwb_debug( bwb_ebuf ); #endif return bwb_exitfor( l ); } if ( strcmp( tbuf, CMD_XDO ) == 0 ) { return bwb_exitdo( l ); } #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_exit(): Nonsense or nothing following EXIT" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_exitdo() DESCRIPTION: This function handles the BASIC EXIT DO statement. This is a structured programming command compatible with ANSI BASIC. It is called from the bwb_exit() subroutine. ***************************************************************/ #if ANSI_C struct bwb_line * bwb_exitdo( struct bwb_line *l ) #else struct bwb_line * bwb_exitdo( l ) struct bwb_line *l; #endif { struct bwb_line *next_line; int found; register int level; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exitdo(): entered subroutine" ); bwb_debug( bwb_ebuf ); #endif /* Check the integrity of the DO statement */ found = FALSE; level = CURTASK exsc; do { if ( CURTASK excs[ level ].code == EXEC_DO ) { next_line = CURTASK excs[ CURTASK level ].wend_line; found = TRUE; } else { --level; } } while ( ( level >= 0 ) && ( found == FALSE ) ); if ( found != TRUE ) { #if PROG_ERRORS /* JBV 1/97 (was "bwb_exitfor") */ sprintf( bwb_ebuf, "in bwb_exitdo(): EXIT DO without DO" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_exitdo(): level found is <%d>, current <%d>", level, CURTASK exsc ); bwb_debug( bwb_ebuf ); #endif /* decrement below the level of the NEXT statement */ while( CURTASK exsc >= level ) { bwb_decexec(); } /* set the next line in the exec stack */ next_line->position = 0; bwb_setexec( next_line, 0, EXEC_NORM ); return next_line; } #endif /* STRUCT_CMDS */ /*************************************************************** FUNCTION: bwb_vtov() DESCRIPTION: This function assigns the value of one bwBASIC variable (src) to the value of another bwBASIC variable (dst). ***************************************************************/ #if ANSI_C struct bwb_variable * bwb_vtov( struct bwb_variable *dst, struct bwb_variable *src ) #else struct bwb_variable * bwb_vtov( dst, src ) struct bwb_variable *dst; struct bwb_variable *src; #endif { if ( dst == src ) { return dst; } if ( src->type != dst->type ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_vtov(): mismatch src <%s> type <%d> dst <%s> type <%d>", src->name, src->type, dst->name, dst->type ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif return NULL; } if ( dst->type == NUMBER ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_vtov(): assigning var <%s> val <%lf> to var <%s>", src->name, var_getnval( src ), dst->name ); bwb_debug( bwb_ebuf ); #endif * var_findnval( dst, dst->array_pos ) = var_getnval( src ); } else { str_btob( var_getsval( dst ), var_getsval( src ) ); } return dst; } /*************************************************************** FUNCTION: bwb_etov() DESCRIPTION: This function assigns the value of a bwBASIC expression stack element (src) to the value of a bwBASIC variable (dst). ***************************************************************/ #if ANSI_C struct bwb_variable * bwb_etov( struct bwb_variable *dst, struct exp_ese *src ) #else struct bwb_variable * bwb_etov( dst, src ) struct bwb_variable *dst; struct exp_ese *src; #endif { if ( (int) src->type != dst->type ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_etov(): mismatch src <%d> dst <%d>", src->type, dst->type ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif return NULL; } if ( dst->type == NUMBER ) { * var_findnval( dst, dst->array_pos ) = exp_getnval( src ); } else { str_btob( var_getsval( dst ), exp_getsval( src ) ); } return dst; } /*************************************************************** FUNCTION: var_pos() DESCRIPTION: This function returns the name of a local variable at a specified position in the local variable list. ***************************************************************/ #if ANSI_C struct bwb_variable * var_pos( struct bwb_variable *firstvar, int p ) #else struct bwb_variable * var_pos( firstvar, p ) struct bwb_variable *firstvar; int p; #endif { register int c; struct bwb_variable *v; v = firstvar; for ( c = 0; c != p; ++c ) { v = v->next; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in var_pos(): returning pos <%d> variable <%s>", p, v->name ); bwb_debug( bwb_ebuf ); #endif return v; } /*************************************************************** FUNCTION: fslt_addcallvar() DESCRIPTION: This function adds a calling variable to the FUNCTION-SUB lookup table at a specific level. ***************************************************************/ #if ANSI_C int fslt_addcallvar( struct bwb_variable *v ) #else int fslt_addcallvar( v ) struct bwb_variable *v; #endif { if ( CURTASK excs[ CURTASK exsc ].n_cvs >= MAX_FARGS ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in fslt_addcallvar(): Maximum number of Function Args Exceeded" ); bwb_error( bwb_ebuf ); #else bwb_error( err_overflow ); #endif } CURTASK excs[ CURTASK exsc ].calling_variable[ CURTASK excs[ CURTASK exsc ].n_cvs ] = v; ++CURTASK excs[ CURTASK exsc ].n_cvs; return TRUE; } /*************************************************************** FUNCTION: exp_ufnc() DESCRIPTION: This C function interprets a user-defined function, returning its value at the current level of the expression stack. ***************************************************************/ #if ANSI_C int exp_ufnc( char *expression ) #else int exp_ufnc( expression ) char *expression; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; struct bwb_line *call_line; struct fslte *f, *c; struct bwb_variable *v, *r; struct exp_ese *e; int save_elevel; int position, epos; #if INTENSIVE_DEBUG register int i; #endif position = 0; /* get the function name in tbuf */ exp_getvfname( expression, tbuf ); /* find the function name in the function-subroutine lookup table */ for ( f = CURTASK fslt_start.next; f != &CURTASK fslt_end; f = f->next ) { if ( strcmp( f->name, tbuf ) == 0 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_ufnc(): found user function <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif c = f; /* current function-subroutine lookup table element */ call_line = f->line; /* line to call for function */ } } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_ufnc(): call to function <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif position += strlen( tbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_ufnc(): found line <%s>", call_line->buffer ); bwb_debug( bwb_ebuf ); #endif /* save the old position on the EXEC stack */ bwb_setexec( CURTASK excs[ CURTASK exsc ].line, position, CURTASK excs[ CURTASK exsc ].code ); save_elevel = CURTASK exsc; /* increment and set new EXEC stack */ bwb_incexec(); call_line->position = 0; bwb_setexec( call_line, 0, EXEC_FUNCTION ); /* attach local variables */ CURTASK excs[ CURTASK exsc ].local_variable = c->local_variable; #if INTENSIVE_DEBUG i = 0; sprintf( bwb_ebuf, "in exp_ufnc(): <%s> attached local variables EXEC level <%d>", tbuf, CURTASK exsc ); bwb_debug( bwb_ebuf ); for ( v = CURTASK excs[ CURTASK exsc ].local_variable; v != NULL; v = v->next ) { sprintf( bwb_ebuf, "in exp_ufnc(): <%s> level <%d> variable <%d> name <%s>", tbuf, CURTASK exsc, i, v->name ); bwb_debug( bwb_ebuf ); ++i; } getchar(); #endif /* read calling variables for this call */ call_readargs( c, expression, &position ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_ufnc(): current buffer <%s>", &( call_line->buffer[ c->startpos ] ) ); bwb_debug( bwb_ebuf ); #endif /* determine if single-line function */ epos = c->startpos; adv_ws( call_line->buffer, &epos ); if ( call_line->buffer[ epos ] == '=' ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_ufnc(): found SINGLE-LINE function" ); bwb_debug( bwb_ebuf ); #endif ++epos; call_line->position = epos; bwb_setexec( call_line, epos, EXEC_FUNCTION ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_ufnc(): single line: parse <%s>", &( call_line->buffer[ epos ] ) ); bwb_debug( bwb_ebuf ); #endif e = bwb_exp( call_line->buffer, FALSE, &epos ); v = var_find( tbuf ); #if INTENSIVE_DEBUG if ( e->type == STRING ) { sprintf( bwb_ebuf, "in exp_ufnc(): expression returns <%d>-byte string", exp_getsval( e )->length ); bwb_debug( bwb_ebuf ); } else { sprintf( bwb_ebuf, "in exp_ufnc(): expression returns number <%lf>", (double) exp_getnval( e ) ); bwb_debug( bwb_ebuf ); } #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_ufnc(): single line after parsing, <%s>", &( call_line->buffer[ epos ] ) ); bwb_debug( bwb_ebuf ); #endif bwb_etov( v, e ); bwb_decexec(); } /* multi-line function must be executed now */ else { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_ufnc(): found MULTI-LINE function" ); bwb_debug( bwb_ebuf ); #endif /* now execute until function is resolved */ bwb_execline(); while( CURTASK exsc > save_elevel ) { bwb_execline(); } /* find the return value */ for ( r = c->local_variable; r != NULL; r = r->next ) { if ( strcmp( r->name, c->name ) == 0 ) { v = r; } } } /* now place value in expression stack */ CURTASK exps[ CURTASK expsc ].type = (char) v->type; CURTASK exps[ CURTASK expsc ].pos_adv = position; switch( v->type ) { case STRING: CURTASK exps[ CURTASK expsc ].operation = CONST_STRING; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in exp_ufnc(): ready to assign <%d>-byte STRING", var_getsval( v )->length ); bwb_debug( bwb_ebuf ); #endif str_btob( exp_getsval( &( CURTASK exps[ CURTASK expsc ] )), var_getsval( v ) ); #if INTENSIVE_DEBUG str_btoc( tbuf, var_getsval( v ) ); sprintf( bwb_ebuf, "in exp_ufnc(): string assigned <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif break; default: CURTASK exps[ CURTASK expsc ].operation = NUMBER; CURTASK exps[ CURTASK expsc ].nval = var_getnval( v ); break; } return TRUE; } /*************************************************************** FUNCTION: fslt_addlocalvar() DESCRIPTION: This function adds a local variable to the FUNCTION-SUB lookup table at a specific level. ***************************************************************/ #if ANSI_C int fslt_addlocalvar( struct fslte *f, struct bwb_variable *v ) #else int fslt_addlocalvar( f, v ) struct fslte *f; struct bwb_variable *v; #endif { struct bwb_variable *c, *p; #if INTENSIVE_DEBUG register int i; #endif /* find end of local chain */ if ( f->local_variable == NULL ) { #if INTENSIVE_DEBUG i = 0; #endif f->local_variable = v; } else { #if INTENSIVE_DEBUG i = 1; #endif p = f->local_variable; for ( c = f->local_variable->next; c != NULL; c = c->next ) { p = c; #if INTENSIVE_DEBUG ++i; #endif } p->next = v; } v->next = NULL; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in fslt_addlocalvar(): added local variable variable <%s> arg number <%d>", v->name, i ); bwb_debug( bwb_ebuf ); getchar(); #endif return TRUE; } /*************************************************************** FUNCTION: fslt_init() DESCRIPTION: This function initializes the FUNCTION-SUB lookup table. ***************************************************************/ #if ANSI_C int fslt_init( int task ) #else int fslt_init( task ) int task; #endif { LOCALTASK fslt_start.next = &(LOCALTASK fslt_end); return TRUE; } /*************************************************************** FUNCTION: is_label() DESCRIPTION: This function determines whether the string pointed to by 'buffer' is a label (i.e., ends with colon). ***************************************************************/ #if ANSI_C extern int is_label( char *buffer ) #else int is_label( buffer ) char *buffer; #endif { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in is_label(): check element <%s>", buffer ); bwb_debug( bwb_ebuf ); #endif if ( buffer[ strlen( buffer ) - 1 ] == ':' ) { return TRUE; } else { return FALSE; } } bwbasic-2.20pl2.orig/bwb_str.c100644 0 0 21705 6473161700 14342 0ustar rootroot/*************************************************************** bwb_str.c String-Management Routines 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). */ /*---------------------------------------------------------------*/ #include #include "bwbasic.h" #include "bwb_mes.h" #if INTENSIVE_DEBUG || TEST_BSTRING static char tbuf[ MAXSTRINGSIZE + 1 ]; #endif /*************************************************************** FUNCTION: str_btob() DESCRIPTION: This C function assigns a bwBASIC string structure to another bwBASIC string structure. ***************************************************************/ #if ANSI_C int str_btob( bstring *d, bstring *s ) #else int str_btob( d, s ) bstring *d; bstring *s; #endif { char *t; register int i; #if TEST_BSTRING sprintf( tbuf, "in str_btob(): entry, source b string name is <%s>", s->name ); bwb_debug( tbuf ); sprintf( tbuf, "in str_btob(): entry, destination b string name is <%s>", d->name ); bwb_debug( tbuf ); #endif /* get memory for new buffer */ /* Following section removed by JBV (no more mass string reallocation) */ /* if ( ( t = (char *) CALLOC( s->length + 1, 1, "str_btob" )) == NULL ) { #if PROG_ERRORS bwb_error( "in str_btob(): failed to get memory for new buffer" ); #else bwb_error( err_getmem ); #endif return FALSE; } */ /* Only one of these two conditions necessitates reallocation (JBV) */ if ( ( d->sbuffer == NULL ) || ( d->rab == TRUE ) ) { if ( ( t = (char *) CALLOC( MAXSTRINGSIZE + 1, 1, "str_btob" )) == NULL ) { #if PROG_ERRORS bwb_error( "in str_btob(): failed to get memory for new buffer" ); #else bwb_error( err_getmem ); #endif return FALSE; } } else t = d->sbuffer; /* Leave well enough alone (JBV) */ /* write the b string to the temp c string */ t[ 0 ] = '\0'; for ( i = 0; i < (int) s->length; ++i ) { t[ i ] = s->sbuffer[ i ]; t[ i + 1 ] = '\0'; /* JBV */ #if INTENSIVE_DEBUG tbuf[ i ] = s->sbuffer[ i ]; tbuf[ i + 1 ] = '\0'; #endif } /* deallocate old memory */ #if INTENSIVE_DEBUG if ( d->rab == TRUE ) { sprintf( bwb_ebuf, "in str_btob(): reallocating RAB" ); bwb_debug( bwb_ebuf ); } #endif /* Following section removed by JBV (no more mass string reallocation) */ /* if (( d->rab != TRUE ) && ( d->sbuffer != NULL )) { #if INTENSIVE_DEBUG sprintf( tbuf, "in str_btob(): deallocating string memory" ); bwb_debug ( tbuf ); #endif FREE( d->sbuffer, "str_btob" ); d->sbuffer = NULL; } else { d->rab = (char) FALSE; } */ d->rab = (char) FALSE; /* JBV */ /* reassign buffer */ d->sbuffer = t; /* reassign length */ d->length = s->length; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in str_btob(): exit length <%d> string <%s>", d->length, tbuf ); bwb_debug( bwb_ebuf ); #endif /* return */ return TRUE; } /*************************************************************** FUNCTION: str_ctob() DESCRIPTION: This C function assigns a null-terminated C string to a bwBASIC string structure. ***************************************************************/ #if ANSI_C int str_ctob( bstring *s, char *buffer ) #else int str_ctob( s, buffer ) bstring *s; char *buffer; #endif { char *t; register int i; #if INTENSIVE_DEBUG sprintf( tbuf, "in str_ctob(): entry, c string is <%s>", buffer ); bwb_debug( tbuf ); #endif #if TEST_BSTRING sprintf( tbuf, "in str_ctob(): entry, b string name is <%s>", s->name ); bwb_debug( tbuf ); #endif /* get memory for new buffer */ /* Following section removed by JBV (no more mass string reallocation) */ /* if ( ( t = (char *) CALLOC( strlen( buffer ) + 1, 1, "str_ctob" )) == NULL ) { #if PROG_ERRORS bwb_error( "in str_ctob(): failed to get memory for new buffer" ); #else bwb_error( err_getmem ); #endif return FALSE; } */ /* Only one of these two conditions necessitates reallocation (JBV) */ if ( ( s->sbuffer == NULL ) || ( s->rab == TRUE ) ) { if ( ( t = (char *) CALLOC( MAXSTRINGSIZE + 1, 1, "str_ctob" )) == NULL ) { #if PROG_ERRORS bwb_error( "in str_ctob(): failed to get memory for new buffer" ); #else bwb_error( err_getmem ); #endif return FALSE; } } else t = s->sbuffer; /* Leave well enough alone (JBV) */ /* write the c string to the temp c string */ t[ 0 ] = '\0'; for ( i = 0; i < (int) strlen( buffer ); ++i ) { t[ i ] = buffer[ i ]; t[ i + 1 ] = '\0'; /* JBV */ #if INTENSIVE_DEBUG tbuf[ i ] = buffer[ i ]; tbuf[ i + 1 ] = '\0'; #endif } /* deallocate old memory */ #if INTENSIVE_DEBUG if ( s->rab == TRUE ) { sprintf( bwb_ebuf, "in str_ctob(): reallocating RAB" ); bwb_debug( bwb_ebuf ); } #endif /* Following section removed by JBV (no more mass string reallocation) */ /* if (( s->rab != TRUE ) && ( s->sbuffer != NULL )) { FREE( s->sbuffer, "str_ctob" ); s->sbuffer = NULL; } else { s->rab = (char) FALSE; } */ s->rab = (char) FALSE; /* JBV */ /* reassign buffer */ s->sbuffer = t; /* reassign length */ /* Was unsigned char (JBV 9/4/97) */ s->length = (unsigned int) strlen( buffer ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in str_ctob(): exit length <%d> string <%s>", s->length, tbuf ); bwb_debug( bwb_ebuf ); #endif /* return */ return TRUE; } /*************************************************************** FUNCTION: str_btoc() DESCRIPTION: This C function assigns a null-terminated C string to a bwBASIC string structure. ***************************************************************/ #if ANSI_C int str_btoc( char *buffer, bstring *s ) #else int str_btoc( buffer, s ) char *buffer; bstring *s; #endif { register int i; #if INTENSIVE_DEBUG sprintf( tbuf, "in str_btoc(): entry, b string length is <%d>", s->length ); bwb_debug( tbuf ); #endif #if TEST_BSTRING sprintf( tbuf, "in str_btoc(): entry, b string name is <%s>", s->name ); bwb_debug( tbuf ); #endif /* write the b string to the c string */ buffer[ 0 ] = '\0'; for ( i = 0; i < (int) s->length; ++i ) { buffer[ i ] = s->sbuffer[ i ]; buffer[ i + 1 ] = '\0'; if ( i >= MAXSTRINGSIZE ) { i = s->length + 1; } } #if INTENSIVE_DEBUG sprintf( tbuf, "in str_btoc(): exit, c string is <%s>", buffer ); bwb_debug( tbuf ); #endif /* return */ return TRUE; } /*************************************************************** FUNCTION: str_cat() DESCRIPTION: This C function performs the equivalent of the C strcat() function, using BASIC strings. ***************************************************************/ #if ANSI_C char * str_cat( bstring *a, bstring *b ) #else char * str_cat( a, b ) bstring *a; bstring *b; #endif { char abuf[ MAXSTRINGSIZE + 1 ]; char bbuf[ MAXSTRINGSIZE + 1 ]; char *r; str_btoc( abuf, a ); str_btoc( bbuf, b ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in str_cat(): a <%s> b <%s>", abuf, bbuf ); bwb_debug( bwb_ebuf ); #endif strcat( abuf, bbuf ); str_ctob( a, abuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in str_cat(): returns <%s>", abuf ); bwb_debug( bwb_ebuf ); #endif return r; } /*************************************************************** FUNCTION: str_cmp() DESCRIPTION: This C function performs the equivalent of the C strcmp() function, using BASIC strings. ***************************************************************/ #if ANSI_C int str_cmp( bstring *a, bstring *b ) #else int str_cmp( a, b ) bstring *a; bstring *b; #endif { char abuf[ MAXSTRINGSIZE + 1 ]; char bbuf[ MAXSTRINGSIZE + 1 ]; str_btoc( abuf, a ); str_btoc( bbuf, b ); return strcmp( abuf, bbuf ); } bwbasic-2.20pl2.orig/bwb_tbl.c100644 0 0 33215 6055714562 14320 0ustar rootroot/*************************************************************** bwb_tbl.c Command, Function, Operator, and Error-Message Tables 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). */ /*---------------------------------------------------------------*/ #include #include "bwbasic.h" #include "bwb_mes.h" int err_line = 0; /* line in which error occurred */ int err_number = 0; /* number of last error */ /*************************************************************** Command Table for Bywater BASIC ***************************************************************/ struct bwb_command bwb_cmdtable[ COMMANDS ] = { #if PERMANENT_DEBUG { CMD_VARS, bwb_vars }, { CMD_CMDS, bwb_cmds }, { CMD_FNCS, bwb_fncs }, #endif #if UNIX_CMDS { CMD_CHDIR, bwb_chdir }, { CMD_MKDIR, bwb_mkdir }, { CMD_RMDIR, bwb_rmdir }, { CMD_KILL, bwb_kill }, { CMD_ENVIRON, bwb_environ }, #endif #if INTERACTIVE { CMD_LIST, bwb_list }, { CMD_LOAD, bwb_load }, { CMD_RUN, bwb_run }, { CMD_SAVE, bwb_save }, { CMD_DELETE, bwb_delete }, { CMD_NEW, bwb_new }, { CMD_QUIT, bwb_system }, { CMD_SYSTEM, bwb_system }, #endif #if MS_CMDS { CMD_DEFDBL, bwb_ddbl }, { CMD_DEFINT, bwb_dint }, { CMD_DEFSNG, bwb_dsng }, { CMD_DEFSTR, bwb_dstr }, { CMD_MID, bwb_mid }, /* Added this extension (JBV) */ #if IMP_CMDCLS { CMD_CLS, bwb_cls }, #endif #if IMP_CMDCOLOR { CMD_COLOR, bwb_color }, #endif #if IMP_CMDLOC { CMD_LOCATE, bwb_locate }, #endif #endif #if STRUCT_CMDS { CMD_CALL, bwb_call }, { CMD_SUB, bwb_sub }, { CMD_FUNCTION, bwb_function }, { CMD_LABEL, bwb_null }, { CMD_ELSE, bwb_else }, { CMD_ELSEIF, bwb_elseif }, { CMD_SELECT, bwb_select }, { CMD_CASE, bwb_case }, { CMD_LOOP, bwb_loop }, { CMD_EXIT, bwb_exit }, #endif #if COMMON_CMDS { CMD_MERGE, bwb_merge }, { CMD_CHAIN, bwb_chain }, { CMD_COMMON, bwb_common }, { CMD_ERROR, bwb_lerror }, { CMD_WIDTH, bwb_width }, { CMD_TRON, bwb_tron }, { CMD_TROFF, bwb_troff }, { CMD_FILES, bwb_files }, { CMD_EDIT, bwb_edit }, { CMD_ERASE, bwb_erase }, { CMD_SWAP, bwb_swap }, { CMD_NAME, bwb_name }, { CMD_CLEAR, bwb_clear }, { CMD_WHILE, bwb_while }, { CMD_WEND, bwb_wend }, { CMD_WRITE, bwb_write }, { CMD_OPEN, bwb_open }, { CMD_CLOSE, bwb_close }, { CMD_GET, bwb_get }, { CMD_PUT, bwb_put }, { CMD_LSET, bwb_lset }, { CMD_RSET, bwb_rset }, { CMD_FIELD, bwb_field }, { CMD_LINE, bwb_line }, { CMD_RENUM, bwb_renum }, /* Added this extension (JBV) */ #endif /* The remainder are the core functions defined for ANSI Minimal BASIC */ { CMD_DATA, bwb_data }, { CMD_DEF, bwb_def }, { CMD_DIM, bwb_dim }, { CMD_END, bwb_xend }, { CMD_FOR, bwb_for }, { CMD_DO, bwb_do }, /* not really core but needed in two different places */ { CMD_GO, bwb_go }, { CMD_GOSUB, bwb_gosub }, { CMD_GOTO, bwb_goto }, { CMD_IF, bwb_if }, { CMD_INPUT, bwb_input }, { CMD_LET, bwb_let }, { CMD_NEXT, bwb_next }, { CMD_ON, bwb_on }, { CMD_OPTION, bwb_option }, { CMD_PRINT, bwb_print }, { CMD_RANDOMIZE, bwb_randomize }, { CMD_READ, bwb_read }, { CMD_REM, bwb_rem }, { CMD_RESTORE, bwb_restore }, { CMD_RETURN, bwb_return }, { CMD_STOP, bwb_stop } }; /*************************************************************** Predefined Function Table for Bywater BASIC ***************************************************************/ struct bwb_function bwb_prefuncs[ FUNCTIONS ] = { #if INTENSIVE_DEBUG { "TEST", NUMBER, 2, fnc_test, (struct bwb_function *) NULL, 0 }, #endif #if MS_FUNCS /* Functions unique to Microsoft GWBASIC (tm) */ { "ASC", NUMBER, 1, fnc_asc, (struct bwb_function *) NULL, 0 }, { "MKD$", STRING, 1, fnc_mkd, (struct bwb_function *) NULL, 0 }, { "MKI$", STRING, 1, fnc_mki, (struct bwb_function *) NULL, 0 }, { "MKS$", STRING, 1, fnc_mks, (struct bwb_function *) NULL, 0 }, { "CVD", NUMBER, 1, fnc_cvd, (struct bwb_function *) NULL, 0 }, { "CVS", NUMBER, 1, fnc_cvs, (struct bwb_function *) NULL, 0 }, { "CVI", NUMBER, 1, fnc_cvi, (struct bwb_function *) NULL, 0 }, { "CINT", NUMBER, 1, fnc_cint, (struct bwb_function *) NULL, 0 }, { "CSNG", NUMBER, 1, fnc_csng, (struct bwb_function *) NULL, 0 }, { "ENVIRON$",STRING, 1, fnc_environ, (struct bwb_function *) NULL, 0 }, { "ERR", NUMBER, 0, fnc_err, (struct bwb_function *) NULL, 0 }, { "ERL", NUMBER, 0, fnc_erl, (struct bwb_function *) NULL, 0 }, { "LOC", NUMBER, 1, fnc_loc, (struct bwb_function *) NULL, 0 }, { "LOF", NUMBER, 1, fnc_lof, (struct bwb_function *) NULL, 0 }, { "EOF", NUMBER, 1, fnc_eof, (struct bwb_function *) NULL, 0 }, { "INSTR", NUMBER, 1, fnc_instr, (struct bwb_function *) NULL, 0 }, { "SPC", STRING, 1, fnc_spc, (struct bwb_function *) NULL, 0 }, { "SPACE$", STRING, 1, fnc_space, (struct bwb_function *) NULL, 0 }, { "STRING$", STRING, 1, fnc_string, (struct bwb_function *) NULL, 0 }, { "MID$", STRING, 3, fnc_mid, (struct bwb_function *) NULL, 0 }, { "LEFT$", STRING, 2, fnc_left, (struct bwb_function *) NULL, 0 }, { "RIGHT$", STRING, 2, fnc_right, (struct bwb_function *) NULL, 0 }, { "TIMER", NUMBER, 0, fnc_timer, (struct bwb_function *) NULL, 0 }, { "HEX$", STRING, 1, fnc_hex, (struct bwb_function *) NULL, 0 }, { "OCT$", STRING, 1, fnc_oct, (struct bwb_function *) NULL, 0 }, #if IMP_FNCINKEY == 1 { "INKEY$", STRING, 1, fnc_inkey, (struct bwb_function *) NULL, 0 }, #endif #endif #if COMMON_FUNCS /* Functions common to GWBASIC and ANSI Full BASIC */ { "CHR$", NUMBER, 0, fnc_chr, (struct bwb_function *) NULL, 0 }, { "LEN", NUMBER, 1, fnc_len, (struct bwb_function *) NULL, 0 }, { "POS", NUMBER, 0, fnc_pos, (struct bwb_function *) NULL, 0 }, { "VAL", NUMBER, 1, fnc_val, (struct bwb_function *) NULL, 0 }, { "STR$", STRING, 1, fnc_str, (struct bwb_function *) NULL, 0 }, { "DATE$", STRING, 0, fnc_date, (struct bwb_function *) NULL, 0 }, { "TIME$", STRING, 0, fnc_time, (struct bwb_function *) NULL, 0 }, #endif #if ANSI_FUNCS /* Functions required for ANSI Full BASIC */ #endif /* The remainder are core functions defined for ANSI Minimal BASIC */ #if COMPRESS_FUNCS { "ABS", NUMBER, 1, fnc_core, (struct bwb_function *) NULL, F_ABS }, { "ATN", NUMBER, 1, fnc_core, (struct bwb_function *) NULL, F_ATN }, { "COS", NUMBER, 1, fnc_core, (struct bwb_function *) NULL, F_COS }, { "EXP", NUMBER, 1, fnc_core, (struct bwb_function *) NULL, F_EXP }, { "INT", NUMBER, 1, fnc_core, (struct bwb_function *) NULL, F_INT }, { "LOG", NUMBER, 1, fnc_core, (struct bwb_function *) NULL, F_LOG }, { "RND", NUMBER, 0, fnc_core, (struct bwb_function *) NULL, F_RND }, { "SGN", NUMBER, 1, fnc_core, (struct bwb_function *) NULL, F_SGN }, { "SIN", NUMBER, 1, fnc_core, (struct bwb_function *) NULL, F_SIN }, { "SQR", NUMBER, 1, fnc_core, (struct bwb_function *) NULL, F_SQR }, { "TAN", NUMBER, 1, fnc_core, (struct bwb_function *) NULL, F_TAN }, #else { "ABS", NUMBER, 1, fnc_abs, (struct bwb_function *) NULL, 0 }, { "ATN", NUMBER, 1, fnc_atn, (struct bwb_function *) NULL, 0 }, { "COS", NUMBER, 1, fnc_cos, (struct bwb_function *) NULL, 0 }, { "EXP", NUMBER, 1, fnc_exp, (struct bwb_function *) NULL, 0 }, { "INT", NUMBER, 1, fnc_int, (struct bwb_function *) NULL, 0 }, { "LOG", NUMBER, 1, fnc_log, (struct bwb_function *) NULL, 0 }, { "RND", NUMBER, 0, fnc_rnd, (struct bwb_function *) NULL, 0 }, { "SGN", NUMBER, 1, fnc_sgn, (struct bwb_function *) NULL, 0 }, { "SIN", NUMBER, 1, fnc_sin, (struct bwb_function *) NULL, 0 }, { "SQR", NUMBER, 1, fnc_sqr, (struct bwb_function *) NULL, 0 }, { "TAN", NUMBER, 1, fnc_tan, (struct bwb_function *) NULL, 0 }, #endif { "TAB", STRING, 1, fnc_tab, (struct bwb_function *) NULL, 0 } }; /*************************************************************** Operator Table for Bywater BASIC ***************************************************************/ struct bwb_op exp_ops[ N_OPERATORS ] = { { "NOT", OP_NOT, 2 }, /* multiple-character operators */ { "AND", OP_AND, 13 }, /* should be tested first because */ { "OR", OP_OR, 14 }, /* e.g. a ">=" would be matched */ { "XOR", OP_XOR, 15 }, /* as "=" if the single-character */ { "IMP", OP_IMPLIES, 16 }, /* operator came first */ { "EQV", OP_EQUIV, 17 }, { "MOD", OP_MODULUS, 5 }, { "<>", OP_NOTEQUAL, 8 }, { "<=", OP_LTEQ, 11 }, { "=<", OP_LTEQ, 11 }, /* allow either form */ { ">=", OP_GTEQ, 12 }, { "=>", OP_GTEQ, 12 }, /* allow either form */ { "<", OP_LESSTHAN, 9 }, { ">", OP_GREATERTHAN, 10 }, { "^", OP_EXPONENT, 0 }, { "*", OP_MULTIPLY, 3 }, { "/", OP_DIVIDE, 3 }, { "\\", OP_INTDIVISION, 4 }, { "+", OP_ADD, 6 }, { "-", OP_SUBTRACT, 6 }, { "=", OP_EQUALS, 7 }, { "=", OP_ASSIGN, 18 }, /* don't worry: OP_EQUALS will be converted to OP_ASSIGN if necessary */ { ";", OP_STRJOIN, 19 }, { ",", OP_STRTAB, 20 }, { "-", OP_NEGATION, 1 } /* Right below exponentiation (JBV) */ }; /* Error messages used more than once */ char err_openfile[] = ERR_OPENFILE; char err_getmem[] = ERR_GETMEM; char err_noln[] = ERR_NOLN; char err_nofn[] = ERR_NOFN; char err_lnnotfound[] = ERR_LNNOTFOUND; char err_incomplete[] = ERR_INCOMPLETE; char err_valoorange[] = ERR_VALOORANGE; char err_syntax[] = ERR_SYNTAX; char err_devnum[] = ERR_DEVNUM; char err_dev[] = ERR_DEV; char err_opsys[] = ERR_OPSYS; char err_argstr[] = ERR_ARGSTR; char err_defchar[] = ERR_DEFCHAR; char err_mismatch[] = ERR_MISMATCH; char err_dimnotarray[] =ERR_DIMNOTARRAY; char err_retnogosub[] = ERR_RETNOGOSUB; char err_od[] = ERR_OD; char err_overflow[] = ERR_OVERFLOW; char err_nf[] = ERR_NF; char err_uf[] = ERR_UF; char err_dbz[] = ERR_DBZ; char err_redim[] = ERR_REDIM; char err_obdim[] = ERR_OBDIM; char err_uc[] = ERR_UC; char err_noprogfile[] = ERR_NOPROGFILE; /*************************************************************** Error Message Table for Bywater BASIC ***************************************************************/ char *err_table[ N_ERRORS ] = { err_openfile, err_getmem, err_noln, err_nofn, err_lnnotfound, err_incomplete, err_valoorange, err_syntax, err_devnum, err_dev, err_opsys, err_argstr, err_defchar, err_mismatch, err_dimnotarray, err_od, err_overflow, err_nf, err_uf, err_dbz, err_redim, err_obdim, err_uc, err_noprogfile }; bwbasic-2.20pl2.orig/bwb_tcc.c100644 0 0 247 5437750044 14245 0ustar rootroot/* This is for Borland Turbo C++ only: it requests the linker to establish a larger-than-usual stack of 8192 bytes for bwBASIC */ extern unsigned _stklen = 8192U; bwbasic-2.20pl2.orig/bwb_var.c100644 0 0 172134 6473161701 14346 0ustar rootroot/*************************************************************** bwb_var.c Variable-Handling Routines for Bywater BASIC Interpreter Commands: DIM COMMON ERASE SWAP CLEAR 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). */ /*---------------------------------------------------------------*/ #include #include #include #include "bwbasic.h" #include "bwb_mes.h" int dim_base = 0; /* set by OPTION BASE */ static int dimmed = FALSE; /* has DIM been called? */ static int first, last; /* first, last for DEFxxx commands */ /* Prototypes for functions visible to this file only */ #if ANSI_C static int dim_check( struct bwb_variable *v, int *pp ); static int var_defx( struct bwb_line *l, int type ); static int var_letseq( char *buffer, int *position, int *start, int *end ); static size_t dim_unit( struct bwb_variable *v, int *pp ); #else static int dim_check(); static int var_defx(); static int var_letseq(); static size_t dim_unit(); #endif /*************************************************************** FUNCTION: var_init() DESCRIPTION: This function initializes the internal linked list of variables. ***************************************************************/ #if ANSI_C int var_init( int task ) #else int var_init( task ) int task; #endif { LOCALTASK var_start.next = &(LOCALTASK var_end); strcpy( LOCALTASK var_start.name, "" ); strcpy( LOCALTASK var_end.name, "" ); return TRUE; } #if COMMON_CMDS /*************************************************************** FUNCTION: bwb_common() DESCRIPTION: This C function implements the BASIC COMMON command. SYNTAX: COMMON variable [, variable...] ***************************************************************/ #if ANSI_C struct bwb_line * bwb_common( struct bwb_line *l ) #else struct bwb_line * bwb_common( l ) struct bwb_line *l; #endif { register int loop; struct bwb_variable *v; char tbuf[ MAXSTRINGSIZE + 1 ]; /* loop while arguments are available */ loop = TRUE; while ( loop == TRUE ) { /* get variable name and find variable */ bwb_getvarname( l->buffer, tbuf, &( l->position ) ); if ( ( v = var_find( tbuf ) ) == NULL ) { bwb_error( err_syntax ); return bwb_zline( l ); } v->common = TRUE; /* set common flag to true */ /* check for comma */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] != ',' ) { return bwb_zline( l ); /* no comma; leave */ } ++( l->position ); adv_ws( l->buffer, &( l->position ) ); } return bwb_zline( l ); } /*********************************************************** FUNCTION: bwb_erase() DESCRIPTION: This C function implements the BASIC ERASE command. SYNTAX: ERASE variable[, variable]... ***********************************************************/ #if ANSI_C struct bwb_line * bwb_erase( struct bwb_line *l ) #else struct bwb_line * bwb_erase( l ) struct bwb_line *l; #endif { register int loop; struct bwb_variable *v; struct bwb_variable *p; /* previous variable in linked list */ char tbuf[ MAXSTRINGSIZE + 1 ]; bstring *sp; /* JBV */ register int n; /* JBV */ /* loop while arguments are available */ loop = TRUE; while ( loop == TRUE ) { /* get variable name and find variable */ bwb_getvarname( l->buffer, tbuf, &( l->position ) ); if ( ( v = var_find( tbuf ) ) == NULL ) { bwb_error( err_syntax ); return bwb_zline( l ); } /* be sure the variable is dimensioned */ if (( v->dimensions < 1 ) || ( v->array_sizes[ 0 ] < 1 )) { bwb_error( err_dimnotarray ); return bwb_zline( l ); } /* find previous variable in chain */ for ( p = &CURTASK var_start; p->next != v; p = p->next ) { ; } /* reassign linkage */ p->next = v->next; /* deallocate memory */ /* Revised to FREE pass-thru calls by JBV */ FREE( v->array_sizes, "bwb_erase" ); v->array_sizes = NULL; /* JBV */ FREE( v->array_pos , "bwb_erase"); v->array_pos = NULL; /* JBV */ if ( v->type == NUMBER ) { /* Revised to FREE pass-thru call by JBV */ FREE( v->memnum, "bwb_erase" ); v->memnum = NULL; /* JBV */ } else { /* Following section added by JBV */ sp = v->memstr; for ( n = 0; n < (int) v->array_units; ++n ) { if ( sp[ n ].sbuffer != NULL ) { /* Revised to FREE pass-thru call by JBV */ FREE( sp[ n ].sbuffer, "bwb_erase" ); sp[ n ].sbuffer = NULL; } sp[ n ].rab = FALSE; sp[ n ].length = 0; } /* Revised to FREE pass-thru call by JBV */ FREE( v->memstr, "bwb_erase" ); v->memstr = NULL; /* JBV */ } /* Revised to FREE pass-thru call by JBV */ FREE( v, "bwb_erase" ); v = NULL; /* JBV */ /* check for comma */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] != ',' ) { return bwb_zline( l ); /* no comma; leave */ } ++( l->position ); adv_ws( l->buffer, &( l->position ) ); } return bwb_zline( l ); } /*********************************************************** FUNCTION: bwb_swap() DESCRIPTION: This C function implements the BASIC SWAP command. SYNTAX: SWAP variable, variable ***********************************************************/ #if ANSI_C struct bwb_line * bwb_swap( struct bwb_line *l ) #else struct bwb_line * bwb_swap( l ) struct bwb_line *l; #endif { struct bwb_variable tmp; /* temp holder */ struct bwb_variable *lhs, *rhs; /* left and right- hand side of swap statement */ char tbuf[ MAXSTRINGSIZE + 1 ]; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_swap(): buffer is <%s>", &( l->buffer[ l->position ] ) ); bwb_debug( bwb_ebuf ); #endif /* get left variable name and find variable */ bwb_getvarname( l->buffer, tbuf, &( l->position ) ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_swap(): tbuf is <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif if ( ( lhs = var_find( tbuf ) ) == NULL ) { bwb_error( err_syntax ); return bwb_zline( l ); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_swap(): lhs variable <%s> found", lhs->name ); bwb_debug( bwb_ebuf ); #endif /* check for comma */ adv_ws( l->buffer, &( l->position ) ); if ( l->buffer[ l->position ] != ',' ) { bwb_error( err_syntax ); return bwb_zline( l ); } ++( l->position ); adv_ws( l->buffer, &( l->position ) ); /* get right variable name */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_swap(): buffer is now <%s>", &( l->buffer[ l->position ] ) ); bwb_debug( bwb_ebuf ); #endif bwb_getvarname( l->buffer, tbuf, &( l->position ) ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_swap(): tbuf is <%s>", tbuf ); bwb_debug( bwb_ebuf ); #endif if ( ( rhs = var_find( tbuf ) ) == NULL ) { bwb_error( err_syntax ); return bwb_zline( l ); } /* check to be sure that both variables are of the same type */ if ( rhs->type != lhs->type ) { bwb_error( err_mismatch ); return bwb_zline( l ); } /* copy lhs to temp, rhs to lhs, then temp to rhs */ if ( lhs->type == NUMBER ) { tmp.memnum = lhs->memnum; } else { tmp.memstr = lhs->memstr; } tmp.array_sizes = lhs->array_sizes; tmp.array_units = lhs->array_units; tmp.array_pos = lhs->array_pos; tmp.dimensions = lhs->dimensions; if ( lhs->type == NUMBER ) { lhs->memnum = rhs->memnum; } else { lhs->memstr = rhs->memstr; } lhs->array_sizes = rhs->array_sizes; lhs->array_units = rhs->array_units; lhs->array_pos = rhs->array_pos; lhs->dimensions = rhs->dimensions; if ( lhs->type = NUMBER ) { rhs->memnum = tmp.memnum; } else { rhs->memstr = tmp.memstr; } rhs->array_sizes = tmp.array_sizes; rhs->array_units = tmp.array_units; rhs->array_pos = tmp.array_pos; rhs->dimensions = tmp.dimensions; /* return */ return bwb_zline( l ); } #endif /* COMMON_CMDS */ /*********************************************************** FUNCTION: bwb_clear() DESCRIPTION: This C function implements the BASIC CLEAR command. SYNTAX: CLEAR ***********************************************************/ #if ANSI_C struct bwb_line * bwb_clear( struct bwb_line *l ) #else struct bwb_line * bwb_clear( l ) struct bwb_line *l; #endif { struct bwb_variable *v; register int n; bstring *sp; bnumber *np; for ( v = CURTASK var_start.next; v != &CURTASK var_end; v = v->next ) { if ( v->preset != TRUE ) { switch( v->type ) { case NUMBER: np = v->memnum; for ( n = 0; n < (int) v->array_units; ++n ) { np[ n ] = (bnumber) 0.0; } break; case STRING: sp = v->memstr; for ( n = 0; n < (int) v->array_units; ++n ) { if ( sp[ n ].sbuffer != NULL ) { /* Revised to FREE pass-thru call by JBV */ FREE( sp[ n ].sbuffer, "bwb_clear" ); sp[ n ].sbuffer = NULL; } sp[ n ].rab = FALSE; sp[ n ].length = 0; } break; } } } return bwb_zline( l ); } /*********************************************************** FUNCTION: var_delcvars() DESCRIPTION: This function deletes all variables in memory except those previously marked as common. ***********************************************************/ #if ANSI_C int var_delcvars( void ) #else int var_delcvars() #endif { struct bwb_variable *v; struct bwb_variable *p; /* previous variable */ bstring *sp; /* JBV */ register int n; /* JBV */ p = &CURTASK var_start; for ( v = CURTASK var_start.next; v != &CURTASK var_end; v = v->next ) { if ( v->common != TRUE ) { /* if the variable is dimensioned, release allocated memory */ if ( v->dimensions > 0 ) { /* deallocate memory */ /* Revised to FREE pass-thru calls by JBV */ FREE( v->array_sizes, "var_delcvars" ); v->array_sizes = NULL; /* JBV */ FREE( v->array_pos, "var_delcvars" ); v->array_pos = NULL; /* JBV */ if ( v->type == NUMBER ) { /* Revised to FREE pass-thru call by JBV */ FREE( v->memnum, "var_delcvars" ); v->memnum = NULL; /* JBV */ } else { /* Following section added by JBV */ sp = v->memstr; for ( n = 0; n < (int) v->array_units; ++n ) { if ( sp[ n ].sbuffer != NULL ) { /* Revised to FREE pass-thru call by JBV */ FREE( sp[ n ].sbuffer, "var_delcvars" ); sp[ n ].sbuffer = NULL; } sp[ n ].rab = FALSE; sp[ n ].length = 0; } /* Revised to FREE pass-thru call by JBV */ FREE( v->memstr, "var_delcvars" ); v->memstr = NULL; /* JBV */ } } /* reassign linkage */ p->next = v->next; /* deallocate the variable itself */ /* Revised to FREE pass-thru call by JBV */ FREE( v, "var_delcvars" ); v = NULL; /* JBV */ } /* else reset previous variable */ else { p = v; } } return TRUE; } #if MS_CMDS /*********************************************************** FUNCTION: bwb_ddbl() DESCRIPTION: This function implements the BASIC DEFDBL command. SYNTAX: DEFDBL letter[-letter](, letter[-letter])... ***********************************************************/ #if ANSI_C struct bwb_line * bwb_ddbl( struct bwb_line *l ) #else struct bwb_line * bwb_ddbl( l ) struct bwb_line *l; #endif { /* call generalized DEF handler with DOUBLE set */ var_defx( l, NUMBER ); return bwb_zline( l ); } /*********************************************************** FUNCTION: bwb_dint() DESCRIPTION: This function implements the BASIC DEFINT command. SYNTAX: DEFINT letter[-letter](, letter[-letter])... ***********************************************************/ #if ANSI_C struct bwb_line * bwb_dint( struct bwb_line *l ) #else struct bwb_line * bwb_dint( l ) struct bwb_line *l; #endif { /* call generalized DEF handler with INTEGER set */ var_defx( l, NUMBER ); return bwb_zline( l ); } /*********************************************************** FUNCTION: bwb_dsng() DESCRIPTION: This function implements the BASIC DEFSNG command. SYNTAX: DEFSNG letter[-letter](, letter[-letter])... ***********************************************************/ #if ANSI_C struct bwb_line * bwb_dsng( struct bwb_line *l ) #else struct bwb_line * bwb_dsng( l ) struct bwb_line *l; #endif { /* call generalized DEF handler with SINGLE set */ var_defx( l, NUMBER ); return bwb_zline( l ); } /*********************************************************** FUNCTION: bwb_dstr() DESCRIPTION: This function implements the BASIC DEFSTR command. SYNTAX: DEFSTR letter[-letter](, letter[-letter])... ***********************************************************/ #if ANSI_C struct bwb_line * bwb_dstr( struct bwb_line *l ) #else struct bwb_line * bwb_dstr( l ) struct bwb_line *l; #endif { /* call generalized DEF handler with STRING set */ var_defx( l, STRING ); return bwb_zline( l ); } /*********************************************************** FUNCTION: bwb_mid() DESCRIPTION: This function implements the BASIC MID$ command. Same as MID$ function, except it will set the desired substring and not return its value. Added by JBV 10/95 SYNTAX: MID$( string-variable$, start-position-in-string [, number-of-spaces ] ) = expression ***********************************************************/ #if ANSI_C struct bwb_line * bwb_mid( struct bwb_line *l ) #else struct bwb_line * bwb_mid( l ) struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; char source_string[ MAXSTRINGSIZE + 1 ]; struct bwb_variable *v; static int pos; bstring *d; int *pp; int n_params; int p; register int n; int startpos, numchars, endpos; int source_counter, source_length, target_length; int target_terminate; struct exp_ese *e; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_mid(): MID$ command" ); bwb_debug( bwb_ebuf ); #endif /* Get past left parenthesis */ adv_ws( l->buffer, &( l->position ) ); ++( l->position ); adv_ws( l->buffer, &( l->position ) ); /* Get variable name and find variable */ bwb_getvarname( l->buffer, tbuf, &( l->position ) ); v = var_find( tbuf ); if ( v == NULL ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_mid(): failed to find variable" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif } if ( v->type != STRING ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_mid(): assignment must be to string variable" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif } /* read subscripts */ pos = 0; if ( ( v->dimensions == 1 ) && ( v->array_sizes[ 0 ] == 1 )) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_mid(): variable <%s> has 1 dimension", v->name ); bwb_debug( bwb_ebuf ); #endif n_params = 1; pp = &p; pp[ 0 ] = dim_base; } else { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_mid(): variable <%s> has > 1 dimensions", v->name ); bwb_debug( bwb_ebuf ); #endif dim_getparams( l->buffer, &( l->position ), &n_params, &pp ); } CURTASK exps[ CURTASK expsc ].pos_adv = pos; for ( n = 0; n < v->dimensions; ++n ) { v->array_pos[ n ] = pp[ n ]; } /* get bstring pointer */ d = var_findsval( v, pp ); /* Get past next comma and white space */ adv_ws( l->buffer, &( l->position ) ); ++( l->position ); adv_ws( l->buffer, &( l->position ) ); /* Get starting position (expression) */ adv_element( l->buffer, &( l->position ), tbuf ); pos = 0; e = bwb_exp( tbuf, FALSE, &pos ); startpos = (int) exp_getnval( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_mid(): startpos <%d> buffer <%lX>", startpos, (long) d->sbuffer ); bwb_debug( bwb_ebuf ); #endif /* Get past next comma and white space (if they exist) */ adv_ws( l->buffer, &( l->position ) ); if (l->buffer[l->position] == ',') { target_terminate = 0; ++( l->position ); adv_ws( l->buffer, &( l->position ) ); adv_element( l->buffer, &( l->position ), tbuf ); pos = 0; e = bwb_exp( tbuf, FALSE, &pos ); numchars = (int) exp_getnval( e ); if ( numchars == 0 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_mid(): destination string no. of chars out of range" ); bwb_error( bwb_ebuf ); #else bwb_error( "Argument out of range" ); #endif } } else { target_terminate = 1; numchars = 0; } if ( numchars < 0 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_mid(): negative string length" ); bwb_error( bwb_ebuf ); #else bwb_error( "Negative string length" ); #endif } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_mid(): numchars <%d> target_terminate <%d>", numchars, target_terminate ); bwb_debug( bwb_ebuf ); #endif /* Get past equal sign */ adv_ws( l->buffer, &( l->position ) ); if (l->buffer[l->position] == ')') { ++(l->position); adv_ws( l->buffer, &( l->position ) ); } ++(l->position); adv_ws( l->buffer, &( l->position ) ); /* Evaluate string expression */ e = bwb_exp( l->buffer, FALSE, &( l->position ) ); if ( e->type != STRING ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_mid(): assignment must be from string expression" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif } /* Prepare to MID the string */ str_btoc( source_string, exp_getsval( e ) ); str_btoc( tbuf, d ); target_length = strlen( tbuf ); if ( startpos > ( target_length + 1 ) ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_mid(): non-contiguous string created" ); bwb_error( bwb_ebuf ); #else bwb_error( "Non-contiguous string created" ); #endif } if ( startpos < 1 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_mid(): destination string start position out of range" ); bwb_error( bwb_ebuf ); #else bwb_error( "Argument out of range" ); #endif } source_length = strlen( source_string ); if ( numchars == 0 ) numchars = source_length; endpos = startpos + numchars - 1; /* MID the string */ if ( endpos < startpos ) tbuf[ startpos - 1 ] = '\0'; else { source_counter = 0; for ( n = startpos - 1; n < endpos; ++n ) { if ( source_counter < source_length ) tbuf[ n ] = source_string[ source_counter ]; else tbuf[ n ] = ' '; ++source_counter; } /* Terminate if indicated or characters were added */ if ( ( endpos > target_length ) || ( target_terminate == 1 ) ) tbuf[ endpos ] = '\0'; } str_ctob( d, tbuf ); #if MULTISEG_LINES adv_eos( l->buffer, &( l->position )); #endif return bwb_zline( l ); } /*********************************************************** Function: var_defx() DESCRIPTION: This function is a generalized DEFxxx handler. ***********************************************************/ #if ANSI_C static int var_defx( struct bwb_line *l, int type ) #else static int var_defx( l, type ) struct bwb_line *l; int type; #endif { int loop; register int c; static char vname[ 2 ]; struct bwb_variable *v; /* loop while there are variable names to process */ loop = TRUE; while ( loop == TRUE ) { /* check for end of line or line segment */ adv_ws( l->buffer, &( l->position ) ); switch( l->buffer[ l->position ] ) { case '\n': case '\r': case '\0': case ':': return FALSE; } /* find a sequence of letters for variables */ if ( var_letseq( l->buffer, &( l->position ), &first, &last ) == FALSE ) { return FALSE; } /* loop through the list getting variables */ for ( c = first; c <= last; ++c ) { vname[ 0 ] = (char) c; vname[ 1 ] = '\0'; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in var_defx(): calling var_find() for <%s>", vname ); bwb_debug( bwb_ebuf ); #endif v = var_find( vname ); /* but var_find() assigns on the basis of name endings (so all in this case should be SINGLEs), so we must force the type of the variable */ var_make( v, type ); } } return TRUE; } #endif /* MS_CMDS */ /*********************************************************** Function: var_letseq() DESCRIPTION: This function finds a sequence of letters for a DEFxxx command. ***********************************************************/ #if ANSI_C static int var_letseq( char *buffer, int *position, int *start, int *end ) #else static int var_letseq( buffer, position, start, end ) char *buffer; int *position; int *start; int *end; #endif { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in var_letseq(): buffer <%s>", &( buffer[ *position ] )); bwb_debug( bwb_ebuf ); #endif /* advance beyond whitespace */ adv_ws( buffer, position ); /* check for end of line */ switch( buffer[ *position ] ) { case '\0': case '\n': case '\r': case ':': return TRUE; } /* character at this position must be a letter */ if ( isalpha( buffer[ *position ] ) == 0 ) { bwb_error( err_defchar ); return FALSE; } *end = *start = buffer[ *position ]; /* advance beyond character and whitespace */ ++( *position ); adv_ws( buffer, position ); /* check for hyphen, indicating sequence of more than one letter */ if ( buffer[ *position ] == '-' ) { ++( *position ); /* advance beyond whitespace */ adv_ws( buffer, position ); /* character at this position must be a letter */ if ( isalpha( buffer[ *position ] ) == 0 ) { *end = *start; } else { *end = buffer[ *position ]; ++( *position ); } } /* advance beyond comma if present */ if ( buffer[ *position ] == ',' ) { ++( *position ); } return TRUE; } /*********************************************************** FUNCTION: bwb_const() DESCRIPTION: This function takes the string in lb (the large buffer), finds a string constant (beginning and ending with quotation marks), and returns it in sb (the small buffer), appropriately incrementing the integer pointed to by n. The string in lb should NOT include the initial quotation mark. ***********************************************************/ #if ANSI_C int bwb_const( char *lb, char *sb, int *n ) #else int bwb_const( lb, sb, n ) char *lb; char *sb; int *n; #endif { register int s; ++*n; /* advance past quotation mark */ s = 0; while ( TRUE ) { switch ( lb[ *n ] ) { case '\"': sb[ s ] = 0; ++*n; /* advance past ending quotation mark */ return TRUE; case '\n': case '\r': case 0: sb[ s ] = 0; return TRUE; default: sb[ s ] = lb[ *n ]; break; } ++*n; /* advance to next character in large buffer */ ++s; /* advance to next position in small buffer */ sb[ s ] = 0; /* terminate with 0 */ } } /*********************************************************** FUNCTION: bwb_getvarname() DESCRIPTION: This function takes the string in lb (the large buffer), finds a variable name, and returns it in sb (the small buffer), appropriately incrementing the integer pointed to by n. ***********************************************************/ #if ANSI_C int bwb_getvarname( char *lb, char *sb, int *n ) #else int bwb_getvarname( lb, sb, n ) char *lb; char *sb; int *n; #endif { register int s; s = 0; /* advance beyond whitespace */ adv_ws( lb, n ); while ( TRUE ) { switch ( lb[ *n ] ) { case ' ': /* whitespace */ case '\t': case '\n': /* end of string */ case '\r': case 0: case ':': /* end of expression */ case ',': case ';': case '(': /* beginning of parameter list for dimensioned array */ case '+': /* add variables */ case '=': /* Don't forget this one (JBV) */ sb[ s ] = 0; return TRUE; default: sb[ s ] = lb[ *n ]; break; } ++*n; /* advance to next character in large buffer */ ++s; /* advance to next position in small buffer */ sb[ s ] = 0; /* terminate with 0 */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_getvarname(): found <%s>", sb ); bwb_debug( bwb_ebuf ); #endif } } /*************************************************************** FUNCTION: var_find() DESCRIPTION: This C function attempts to find a variable name matching the argument in buffer. If it fails to find a matching name, it sets up a new variable with that name. ***************************************************************/ #if ANSI_C struct bwb_variable * var_find( char *buffer ) #else struct bwb_variable * var_find( buffer ) char *buffer; #endif { struct bwb_variable *v; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in var_find(): received <%s>", buffer ); bwb_debug( bwb_ebuf ); #endif /* check for a local variable at this EXEC level */ v = var_islocal( buffer ); if ( v != NULL ) { return v; } /* now run through the global variable list and try to find a match */ for ( v = CURTASK var_start.next; v != &CURTASK var_end; v = v->next ) { if ( strcmp( v->name, buffer ) == 0 ) { switch( v->type ) { case STRING: case NUMBER: break; default: #if PROG_ERRORS sprintf( bwb_ebuf, "in var_find(): inappropriate precision for variable <%s>", v->name ); bwb_error( bwb_ebuf ); #endif break; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in var_find(): found global variable <%s>", v->name ); bwb_debug( bwb_ebuf ); #endif return v; } } /* presume this is a new variable, so initialize it... */ /* check for NULL variable name */ if ( strlen( buffer ) == 0 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in var_find(): NULL variable name received\n" ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return NULL; } /* initialize new variable */ v = var_new( buffer ); /* set place at beginning of variable chain */ v->next = CURTASK var_start.next; CURTASK var_start.next = v; /* normally not a preset */ v->preset = FALSE; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in var_find(): initialized new variable <%s> type <%c>, dim <%d>", v->name, v->type, v->dimensions ); bwb_debug( bwb_ebuf ); getchar(); #endif return v; } /*************************************************************** FUNCTION: var_new() DESCRIPTION: This function assigns memory for a new variable. ***************************************************************/ #if ANSI_C struct bwb_variable * var_new( char *name ) #else struct bwb_variable * var_new( name ) char *name; #endif { struct bwb_variable *v; /* get memory for new variable */ /* Revised to CALLOC pass-thru call by JBV */ if ( ( v = (struct bwb_variable *) CALLOC( 1, sizeof( struct bwb_variable ), "var_new" )) == NULL ) { bwb_error( err_getmem ); return NULL; } /* copy the name into the appropriate structure */ strcpy( v->name, name ); /* set memory in the new variable */ var_make( v, (int) v->name[ strlen( v->name ) - 1 ] ); /* and return */ return v; } /*************************************************************** FUNCTION: bwb_isvar() DESCRIPTION: This function determines if the string in 'buffer' is the name of a previously- existing variable. ***************************************************************/ #if ANSI_C int bwb_isvar( char *buffer ) #else int bwb_isvar( buffer ) char *buffer; #endif { struct bwb_variable *v; /* run through the variable list and try to find a match */ for ( v = CURTASK var_start.next; v != &CURTASK var_end; v = v->next ) { if ( strcmp( v->name, buffer ) == 0 ) { return TRUE; } } /* search failed */ return FALSE; } /*************************************************************** FUNCTION: var_getnval() DESCRIPTION: This function returns the current value of the variable argument as a number. ***************************************************************/ #if ANSI_C bnumber var_getnval( struct bwb_variable *nvar ) #else bnumber var_getnval( nvar ) struct bwb_variable *nvar; #endif { switch( nvar->type ) { case NUMBER: return *( var_findnval( nvar, nvar->array_pos ) ); } #if PROG_ERRORS sprintf( bwb_ebuf, "in var_getnval(): type is <%d>=<%c>.", nvar->type, nvar->type ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif return (bnumber) 0.0; } /*************************************************************** FUNCTION: var_getsval() DESCRIPTION: This function returns the current value of the variable argument as a pointer to a BASIC string structure. ***************************************************************/ #if ANSI_C bstring * var_getsval( struct bwb_variable *nvar ) #else bstring * var_getsval( nvar ) struct bwb_variable *nvar; #endif { static bstring b; b.rab = FALSE; switch( nvar->type ) { case STRING: return var_findsval( nvar, nvar->array_pos ); case NUMBER: sprintf( bwb_ebuf, "%*f ", prn_precision( nvar ), *( var_findnval( nvar, nvar->array_pos ) ) ); str_ctob( &b, bwb_ebuf ); return &b; default: #if PROG_ERRORS sprintf( bwb_ebuf, "in var_getsval(): type is <%d>=<%c>.", nvar->type, nvar->type ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif return NULL; } } /*************************************************************** FUNCTION: bwb_dim() DESCRIPTION: This function implements the BASIC DIM statement, allocating memory for a dimensioned array of variables. SYNTAX: DIM variable(elements...)[variable(elements...)]... ***************************************************************/ #if ANSI_C struct bwb_line * bwb_dim( struct bwb_line *l ) #else struct bwb_line * bwb_dim( l ) struct bwb_line *l; #endif { register int n; static int n_params; /* number of parameters */ static int *pp; /* pointer to parameter values */ struct bwb_variable *newvar; bnumber *np; int loop; int old_name, old_dimensions; char tbuf[ MAXSTRINGSIZE + 1 ]; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_dim(): entered function." ); bwb_debug( bwb_ebuf ); #endif loop = TRUE; while ( loop == TRUE ) { old_name = FALSE; /* Get variable name */ adv_ws( l->buffer, &( l->position ) ); bwb_getvarname( l->buffer, tbuf, &( l->position ) ); /* check for previously used variable name */ if ( bwb_isvar( tbuf ) == TRUE ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_dim(): variable name is already used.", l->number ); bwb_debug( bwb_ebuf ); #endif old_name = TRUE; } /* get the new variable */ newvar = var_find( tbuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_dim(): new variable name is <%s>.", newvar->name ); bwb_debug( bwb_ebuf ); #endif /* note that DIM has been called */ dimmed = TRUE; /* read parameters */ old_dimensions = newvar->dimensions; dim_getparams( l->buffer, &( l->position ), &n_params, &pp ); newvar->dimensions = n_params; /* Check parameters for an old variable name */ if ( old_name == TRUE ) { /* check to be sure the number of dimensions is the same */ if ( newvar->dimensions != old_dimensions ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_dim(): variable <%s> cannot be re-dimensioned", newvar->name ); bwb_error( bwb_ebuf ); #else bwb_error( err_redim ); #endif } /* check to be sure sizes for the old variable are the same */ for ( n = 0; n < newvar->dimensions; ++n ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_dim(): old var <%s> parameter <%d> size <%d>.", newvar->name, n, pp[ n ] ); bwb_debug( bwb_ebuf ); #endif if ( ( pp[ n ] + ( 1 - dim_base )) != newvar->array_sizes[ n ] ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_dim(): variable <%s> parameter <%d> cannot be resized", newvar->name, n ); bwb_error( bwb_ebuf ); #else bwb_error( err_redim ); #endif } } } /* end of conditional for old variable */ /* a new variable */ else { /* assign memory for parameters */ /* Revised to CALLOC pass-thru call by JBV */ if ( ( newvar->array_sizes = (int *) CALLOC( n_params, sizeof( int ), "bwb_dim" )) == NULL ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in line %d: Failed to find memory for array_sizes for <%s>", l->number, newvar->name ); bwb_error( bwb_ebuf ); #else bwb_error( err_getmem ); #endif return bwb_zline( l ); } for ( n = 0; n < newvar->dimensions; ++n ) { newvar->array_sizes[ n ] = pp[ n ] + ( 1 - dim_base ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_dim(): array_sizes dim <%d> value <%d>", n, newvar->array_sizes[ n ] ); bwb_debug( bwb_ebuf ); #endif } /* assign memory for current position */ /* Revised to CALLOC pass-thru call by JBV */ if ( ( newvar->array_pos = (int *) CALLOC( n_params, sizeof( int ), "bwb_dim" )) == NULL ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in line %d: Failed to find memory for array_pos for <%s>", l->number, newvar->name ); bwb_error( bwb_ebuf ); #else bwb_error( err_getmem ); #endif return bwb_zline( l ); } for ( n = 0; n < newvar->dimensions; ++n ) { newvar->array_pos[ n ] = dim_base; } /* calculate the array size */ newvar->array_units = (size_t) MAXINTSIZE; /* avoid error in dim_unit() */ newvar->array_units = dim_unit( newvar, pp ) + 1; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_dim(): array memory requires <%ld> units", (long) newvar->array_units ); bwb_debug( bwb_ebuf ); #endif /* assign array memory */ switch( newvar->type ) { case STRING: #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_dim(): 1 STRING requires <%ld> bytes", (long) sizeof( bstring )); bwb_debug( bwb_ebuf ); sprintf( bwb_ebuf, "in bwb_dim(): STRING array memory requires <%ld> bytes", (long) ( newvar->array_units + 1 ) * sizeof( bstring )); bwb_debug( bwb_ebuf ); #endif /*------------------------------------------------------*/ /* memnum, not memstr, was used here -- incorrect (JBV) */ /* Revised to CALLOC pass-thru call by JBV */ /*------------------------------------------------------*/ if ( ( newvar->memstr = (bstring *) CALLOC( newvar->array_units, sizeof( bstring), "bwb_dim" )) == NULL ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in line %d: Failed to find memory for array <%s>", l->number, newvar->name ); bwb_error( bwb_ebuf ); #else bwb_error( err_getmem ); #endif return bwb_zline( l ); } break; case NUMBER: #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_dim(): 1 DOUBLE requires <%ld> bytes", (long) sizeof( double )); bwb_debug( bwb_ebuf ); sprintf( bwb_ebuf, "in bwb_dim(): DOUBLE array memory requires <%ld> bytes", (long) ( newvar->array_units + 1 ) * sizeof( double )); bwb_debug( bwb_ebuf ); #endif /* Revised to CALLOC pass-thru call by JBV */ if ( ( np = (bnumber *) CALLOC( newvar->array_units, sizeof( bnumber ), "bwb_dim" )) == NULL ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in line %d: Failed to find memory for array <%s>", l->number, newvar->name ); bwb_error( bwb_ebuf ); #else bwb_error( err_getmem ); #endif return bwb_zline( l ); } newvar->memnum = np; break; default: #if PROG_ERRORS sprintf( bwb_ebuf, "in line %d: New variable has unrecognized type.", l->number ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } } /* end of conditional for new variable */ /* now check for end of string */ if ( l->buffer[ l->position ] == ')' ) { ++( l->position ); } adv_ws( l->buffer, &( l->position )); switch( l->buffer[ l->position ] ) { case '\n': /* end of line */ case '\r': case ':': /* end of line segment */ case '\0': /* end of string */ loop = FALSE; break; case ',': ++( l->position ); adv_ws( l->buffer, &( l->position ) ); loop = TRUE; break; default: #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_dim(): unexpected end of string, buf <%s>", &( l->buffer[ l->position ] ) ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif loop = FALSE; break; } } /* end of loop through variables */ /* return */ return bwb_zline( l ); } /*************************************************************** FUNCTION: dim_unit() DESCRIPTION: This function calculates the unit position for an array. ***************************************************************/ #if ANSI_C static size_t dim_unit( struct bwb_variable *v, int *pp ) #else static size_t dim_unit( v, pp ) struct bwb_variable *v; int *pp; #endif { size_t r; size_t b; register int n; /* Calculate and return the address of the dimensioned array */ b = 1; r = 0; for ( n = 0; n < v->dimensions; ++n ) { r += b * ( pp[ n ] - dim_base ); b *= v->array_sizes[ n ]; } #if INTENSIVE_DEBUG for ( n = 0; n < v->dimensions; ++n ) { sprintf( bwb_ebuf, "in dim_unit(): variable <%s> pos <%d> val <%d>.", v->name, n, pp[ n ] ); bwb_debug( bwb_ebuf ); } sprintf( bwb_ebuf, "in dim_unit(): return unit: <%ld>", (long) r ); bwb_debug( bwb_ebuf ); #endif if ( r > v->array_units ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in dim_unit(): unit value <%ld> exceeds array units <%ld>", r, v->array_units ); bwb_error( bwb_ebuf ); #else bwb_error( err_valoorange ); #endif return 0; } return r; } /*************************************************************** FUNCTION: dim_getparams() DESCRIPTION: This function reads a string in beginning at position and finds a list of parameters surrounded by paren- theses, returning in the number of parameters found, and returning in an array of n_params integers giving the sizes for each dimension of the array. ***************************************************************/ #if ANSI_C int dim_getparams( char *buffer, int *pos, int *n_params, int **pp ) #else int dim_getparams( buffer, pos, n_params, pp ) char *buffer; int *pos; int *n_params; int **pp; #endif { int loop; static int params[ MAX_DIMS ]; int x_pos, s_pos; struct exp_ese *e; char tbuf[ MAXSTRINGSIZE + 1 ]; int paren_level, quote_level; /* JBV 1/97 */ #if INTENSIVE_DEBUG register int n; #endif /* set initial values */ *n_params = 0; #if OLDSTUFF paren_found = FALSE; #endif /* advance and check for undimensioned variable */ adv_ws( buffer, pos ); if ( buffer[ *pos ] != '(' ) { *n_params = 1; params[ 0 ] = dim_base; *pp = params; return TRUE; } else { ++(*pos); } /* Variable has DIMensions: Find each parameter */ s_pos = 0; tbuf[ 0 ] = '\0'; loop = TRUE; paren_level = 1; /* JBV 1/97 */ quote_level = 0; /* JBV 1/97 */ while( loop == TRUE ) { switch( buffer[ *pos ] ) { case ')': /* end of parameter list */ /*-----------------------------------------------------*/ /* paren_level and quote_level check added by JBV 1/97 */ /*-----------------------------------------------------*/ if ( quote_level == 0 ) --paren_level; if ( paren_level != 0 || quote_level != 0 ) /* Still not done? */ { tbuf[ s_pos ] = buffer[ *pos ]; ++(*pos); ++s_pos; tbuf[ s_pos ] = '\0'; break; } x_pos = 0; if ( tbuf[ 0 ] == '\0' ) { params[ *n_params ] = DEF_SUBSCRIPT; } else { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in dim_getparams(): call bwb_exp() for last element" ); bwb_debug( bwb_ebuf ); #endif e = bwb_exp( tbuf, FALSE, &x_pos ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in dim_getparams(): return from bwb_exp() for last element" ); bwb_debug( bwb_ebuf ); #endif params[ *n_params ] = (int) exp_getnval( e ); } ++(*n_params); loop = FALSE; ++( *pos ); break; case ',': /* end of a parameter */ /*-----------------------------------------------------*/ /* paren_level and quote_level check added by JBV 1/97 */ /*-----------------------------------------------------*/ if ( paren_level != 1 || quote_level != 0 ) /* Still not done? */ { tbuf[ s_pos ] = buffer[ *pos ]; ++(*pos); ++s_pos; tbuf[ s_pos ] = '\0'; break; } x_pos = 0; if ( tbuf[ 0 ] == '\0' ) { params[ *n_params ] = DEF_SUBSCRIPT; } else { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in dim_getparams(): call bwb_exp() for element (not last)" ); bwb_debug( bwb_ebuf ); #endif e = bwb_exp( tbuf, FALSE, &x_pos ); params[ *n_params ] = (int) exp_getnval( e ); } ++(*n_params); tbuf[ 0 ] = '\0'; ++(*pos); s_pos = 0; break; case ' ': /* whitespace -- skip */ case '\t': ++(*pos); break; default: if( buffer[ *pos ] == '(' && quote_level == 0 ) ++paren_level; /* JBV 1/97 */ if( buffer[ *pos ] == (char) 34 ) { if (quote_level == 0) quote_level = 1; else quote_level = 0; } tbuf[ s_pos ] = buffer[ *pos ]; ++(*pos); ++s_pos; tbuf[ s_pos ] = '\0'; break; } } #if INTENSIVE_DEBUG for ( n = 0; n < *n_params; ++n ) { sprintf( bwb_ebuf, "in dim_getparams(): Parameter <%d>: <%d>", n, params[ n ] ); bwb_debug( bwb_ebuf ); } #endif /* return params stack */ *pp = params; return TRUE; } /*************************************************************** FUNCTION: bwb_option() DESCRIPTION: This function implements the BASIC OPTION BASE statement, designating the base (1 or 0) for addressing DIM arrays. SYNTAX: OPTION BASE number ***************************************************************/ #if ANSI_C struct bwb_line * bwb_option( struct bwb_line *l ) #else struct bwb_line * bwb_option( l ) struct bwb_line *l; #endif { register int n; int newval; struct exp_ese *e; struct bwb_variable *current; char tbuf[ MAXSTRINGSIZE ]; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_option(): entered function." ); bwb_debug( bwb_ebuf ); #endif /* If DIM has already been called, do not allow OPTION BASE */ if ( dimmed != FALSE ) { #if PROG_ERRORS sprintf( bwb_ebuf, "at line %d: OPTION BASE must be called before DIM.", l->number ); bwb_error( bwb_ebuf ); #else bwb_error( err_obdim ); #endif return bwb_zline( l ); } /* capitalize first element in tbuf */ adv_element( l->buffer, &( l->position ), tbuf ); for ( n = 0; tbuf[ n ] != '\0'; ++n ) { if ( islower( tbuf[ n ] ) != FALSE ) { tbuf[ n ] = (char) toupper( tbuf[ n ] ); } } /* check for BASE statement */ if ( strncmp( tbuf, "BASE", (size_t) 4 ) != 0 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "at line %d: Unknown statement <%s> following OPTION.", l->number, tbuf ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return bwb_zline( l ); } /* Get new value from argument. */ adv_ws( l->buffer, &( l->position ) ); e = bwb_exp( l->buffer, FALSE, &( l->position ) ); newval = (int) exp_getnval( e ); /* Test the new value. */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_option(): New value received is <%d>.", newval ); bwb_debug( bwb_ebuf ); #endif if ( ( newval < 0 ) || ( newval > 1 ) ) { #if PROG_ERRORS sprintf( bwb_ebuf, "at line %d: value for OPTION BASE must be 1 or 0.", l->number ); bwb_error( bwb_ebuf ); #else bwb_error( err_valoorange ); #endif return bwb_zline( l ); } /* Set the new value. */ dim_base = newval; /* run through the variable list and change any positions that had set 0 before OPTION BASE was run */ for ( current = CURTASK var_start.next; current != &CURTASK var_end; current = current->next ) { current->array_pos[ 0 ] = dim_base; } /* Return. */ return bwb_zline( l ); } /*************************************************************** FUNCTION: var_findnval() DESCRIPTION: This function returns the address of the number for the variable . If is a dimensioned array, the address returned is for the double at the position indicated by the integer array . ***************************************************************/ #if ANSI_C bnumber * var_findnval( struct bwb_variable *v, int *pp ) #else bnumber * var_findnval( v, pp ) struct bwb_variable *v; int *pp; #endif { size_t offset; bnumber *p; #if INTENSIVE_DEBUG register int n; #endif /* Check for appropriate type */ if ( v->type != NUMBER ) { #if PROG_ERRORS sprintf ( bwb_ebuf, "in var_findnval(): Variable <%s> is not a number.", v->name ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif return NULL; } /* Check subscripts */ if ( dim_check( v, pp ) == FALSE ) { return NULL; } /* Calculate and return the address of the dimensioned array */ offset = dim_unit( v, pp ); #if INTENSIVE_DEBUG for ( n = 0; n < v->dimensions; ++n ) { sprintf( bwb_ebuf, "in var_findnval(): dimensioned variable pos <%d> <%d>.", n, pp[ n ] ); bwb_debug( bwb_ebuf ); } #endif p = v->memnum; return (p + offset); } /*************************************************************** FUNCTION: var_findsval() DESCRIPTION: This function returns the address of the string for the variable . If is a dimensioned array, the address returned is for the string at the position indicated by the integer array . ***************************************************************/ #if ANSI_C bstring * var_findsval( struct bwb_variable *v, int *pp ) #else bstring * var_findsval( v, pp ) struct bwb_variable *v; int *pp; #endif { size_t offset; bstring *p; #if INTENSIVE_DEBUG register int n; sprintf( bwb_ebuf, "in var_findsval(): entered, var <%s>", v->name ); bwb_debug( bwb_ebuf ); #endif /* Check for appropriate type */ if ( v->type != STRING ) { #if PROG_ERRORS sprintf ( bwb_ebuf, "in var_findsval(): Variable <%s> is not a string.", v->name ); bwb_error( bwb_ebuf ); #else bwb_error( err_mismatch ); #endif return NULL; } /* Check subscripts */ if ( dim_check( v, pp ) == FALSE ) { return NULL; } /* Calculate and return the address of the dimensioned array */ offset = dim_unit( v, pp ); #if INTENSIVE_DEBUG for ( n = 0; n < v->dimensions; ++n ) { sprintf( bwb_ebuf, "in var_findsval(): dimensioned variable pos <%d> val <%d>.", n, pp[ n ] ); bwb_debug( bwb_ebuf ); } #endif p = v->memstr; return (p + offset); } /*************************************************************** FUNCTION: dim_check() DESCRIPTION: This function checks subscripts of a specific variable to be sure that they are within the correct range. ***************************************************************/ #if ANSI_C static int dim_check( struct bwb_variable *v, int *pp ) #else static int dim_check( v, pp ) struct bwb_variable *v; int *pp; #endif { register int n; /* Check for dimensions */ if ( v->dimensions < 1 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in dim_check(): var <%s> dimensions <%d>", v->name, v->dimensions ); bwb_error( bwb_ebuf ); #else bwb_error( err_valoorange ); #endif return FALSE; } /* Check for validly allocated array */ if (( v->type == NUMBER ) && ( v->memnum == NULL )) { #if PROG_ERRORS sprintf( bwb_ebuf, "in dim_check(): numerical var <%s> memnum not allocated", v->name ); bwb_error( bwb_ebuf ); #else bwb_error( err_valoorange ); #endif return FALSE; } if (( v->type == STRING ) && ( v->memstr == NULL )) { #if PROG_ERRORS sprintf( bwb_ebuf, "in dim_check(): string var <%s> memstr not allocated", v->name ); bwb_error( bwb_ebuf ); #else bwb_error( err_valoorange ); #endif return FALSE; } /* Now check subscript values */ for ( n = 0; n < v->dimensions; ++n ) { if ( ( pp[ n ] < dim_base ) || ( ( pp[ n ] - dim_base ) > v->array_sizes[ n ] )) { #if PROG_ERRORS sprintf( bwb_ebuf, "in dim_check(): array subscript var <%s> pos <%d> val <%d> out of range <%d>-<%d>.", v->name, n, pp[ n ], dim_base, v->array_sizes[ n ] ); bwb_error( bwb_ebuf ); #else bwb_error( err_valoorange ); #endif return FALSE; } } /* No problems found */ return TRUE; } /*************************************************************** FUNCTION: var_make() DESCRIPTION: This function initializes a variable, allocating necessary memory for it. ***************************************************************/ #if ANSI_C int var_make( struct bwb_variable *v, int type ) #else int var_make( v, type ) struct bwb_variable *v; int type; #endif { size_t data_size; bstring *b; bstring *sp; /* JBV */ register int n; /* JBV */ #if TEST_BSTRING static int tnumber = 0; #endif switch( type ) { case STRING: v->type = STRING; data_size = sizeof( bstring ); break; default: v->type = NUMBER; data_size = sizeof( bnumber ); break; } /* get memory for array */ /* First kleanup the joint (JBV) */ if (v->memnum != NULL) { /* Revised to FREE pass-thru call by JBV */ FREE(v->memnum, "var_make"); v->memnum = NULL; } if (v->memstr != NULL) { /* Remember to deallocate those far-flung branches! (JBV) */ sp = v->memstr; for ( n = 0; n < (int) v->array_units; ++n ) { if ( sp[ n ].sbuffer != NULL ) { /* Revised to FREE pass-thru call by JBV */ FREE( sp[ n ].sbuffer, "var_make" ); sp[ n ].sbuffer = NULL; } sp[ n ].rab = FALSE; sp[ n ].length = 0; } /* Revised to FREE pass-thru call by JBV */ FREE(v->memstr, "var_make"); v->memstr = NULL; } /* Revised to FREE pass-thru calls by JBV */ if (v->array_sizes != NULL) { FREE(v->array_sizes, "var_make"); v->array_sizes = NULL; /* JBV */ } if (v->array_pos != NULL) { FREE(v->array_pos, "var_make"); v->array_pos = NULL; /* JBV */ } if ( v->type == NUMBER ) { /* Revised to CALLOC pass-thru call by JBV */ if ( ( v->memnum = CALLOC( 2, sizeof( bnumber ), "var_make" )) == NULL ) { bwb_error( err_getmem ); return FALSE; } } else { /* Revised to CALLOC pass-thru call by JBV */ if ( ( v->memstr = CALLOC( 2, sizeof( bstring ), "var_make" )) == NULL ) { bwb_error( err_getmem ); return FALSE; } } /* get memory for array_sizes and array_pos */ /* Revised to CALLOC pass-thru call by JBV */ if ( ( v->array_sizes = (int *) CALLOC( 2, sizeof( int ), "var_make" )) == NULL ) { bwb_error( err_getmem ); return FALSE; } /* Revised to CALLOC pass-thru call by JBV */ if ( ( v->array_pos = (int *) CALLOC( 2, sizeof( int ), "var_make" )) == NULL ) { bwb_error( err_getmem ); return FALSE; } v->array_pos[ 0 ] = dim_base; v->array_sizes[ 0 ] = 1; v->dimensions = 1; v->common = FALSE; v->array_units = 1; if ( type == STRING ) { b = var_findsval( v, v->array_pos ); b->rab = FALSE; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in var_make(): made variable <%s> type <%c> pos[ 0 ] <%d>", v->name, v->type, v->array_pos[ 0 ] ); bwb_debug( bwb_ebuf ); #endif #if TEST_BSTRING if ( type == STRING ) { b = var_findsval( v, v->array_pos ); sprintf( b->name, "bstring# %d", tnumber ); ++tnumber; sprintf( bwb_ebuf, "in var_make(): new string variable <%s>", b->name ); bwb_debug( bwb_ebuf ); } #endif return TRUE; } /*************************************************************** FUNCTION: var_islocal() DESCRIPTION: This function determines whether the string pointed to by 'buffer' has the name of a local variable at the present EXEC stack level. ***************************************************************/ #if ANSI_C extern struct bwb_variable * var_islocal( char *buffer ) #else struct bwb_variable * var_islocal( buffer ) char *buffer; #endif { struct bwb_variable *v; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in var_islocal(): check for local variable <%s> EXEC level <%d>", buffer, CURTASK exsc ); bwb_debug( bwb_ebuf ); #endif /* run through the local variable list and try to find a match */ for ( v = CURTASK excs[ CURTASK exsc ].local_variable; v != NULL; v = v->next ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in var_islocal(): checking var <%s> level <%d>...", v->name, CURTASK exsc ); bwb_debug( bwb_ebuf ); #endif if ( strcmp( v->name, buffer ) == 0 ) { #if PROG_ERRORS switch( v->type ) { case STRING: case NUMBER: break; default: sprintf( bwb_ebuf, "in var_islocal(): inappropriate precision for variable <%s>", v->name ); bwb_error( bwb_ebuf ); break; } #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in var_islocal(): found local variable <%s>", v->name ); bwb_debug( bwb_ebuf ); #endif return v; } } /* search failed, return NULL */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in var_islocal(): Failed to find local variable <%s> level <%d>", buffer, CURTASK exsc ); bwb_debug( bwb_ebuf ); #endif return NULL; } /*************************************************************** FUNCTION: bwb_vars() DESCRIPTION: This function implements the Bywater- specific debugging command VARS, which gives a list of all variables defined in memory. ***************************************************************/ #if PERMANENT_DEBUG #if ANSI_C struct bwb_line * bwb_vars( struct bwb_line *l ) #else struct bwb_line * bwb_vars( l ) struct bwb_line *l; #endif { struct bwb_variable *v; char tbuf[ MAXSTRINGSIZE + 1 ]; /* run through the variable list and print variables */ for ( v = CURTASK var_start.next; v != &CURTASK var_end; v = v->next ) { sprintf( bwb_ebuf, "variable <%s>\t", v->name ); prn_xprintf( stdout, bwb_ebuf ); switch( v->type ) { case STRING: str_btoc( tbuf, var_getsval( v ) ); sprintf( bwb_ebuf, "STRING\tval: <%s>\n", tbuf ); prn_xprintf( stdout, bwb_ebuf ); break; case NUMBER: #if NUMBER_DOUBLE sprintf( bwb_ebuf, "NUMBER\tval: <%lf>\n", var_getnval( v ) ); prn_xprintf( stdout, bwb_ebuf ); #else sprintf( bwb_ebuf, "NUMBER\tval: <%f>\n", var_getnval( v ) ); prn_xprintf( stdout, bwb_ebuf ); #endif break; default: sprintf( bwb_ebuf, "ERROR: type is <%c>", (char) v->type ); prn_xprintf( stdout, bwb_ebuf ); break; } } return bwb_zline( l ); } #endif bwbasic-2.20pl2.orig/bwbasic.c100644 0 0 106331 6055714562 14337 0ustar rootroot/*************************************************************** bwbasic.c Main Program File for Bywater BASIC Interpreter Copyright (c) 1993, Ted A. Campbell Bywater Software "I was no programmer, neither was I a programmer's son; but I was an herdman and a gatherer of sycomore fruit." - Amos 7:14b AV, slightly adapted 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). */ /*---------------------------------------------------------------*/ #include #include #include #include "bwbasic.h" #include "bwb_mes.h" #if HAVE_SIGNAL #include #endif #if HAVE_LONGJUMP #include #endif char *bwb_ebuf; /* error buffer */ static char *read_line; int bwb_trace = FALSE; FILE *errfdevice = stderr; /* output device for error messages */ #if HAVE_LONGJUMP jmp_buf mark; #endif static int program_run = 0; /* has the command-line program been run? */ int bwb_curtask = 0; /* current task */ struct bwb_variable *ed; /* BWB.EDITOR$ variable */ struct bwb_variable *fi; /* BWB.FILES$ variable */ struct bwb_variable *pr; /* BWB.PROMPT$ variable */ struct bwb_variable *im; /* BWB.IMPLEMENTATION$ variable */ struct bwb_variable *co; /* BWB.COLORS variable */ #if PARACT struct bwb_task *bwb_tasks[ TASKS ]; /* table of task pointers */ #else char progfile[ MAXARGSIZE ]; /* program file */ int rescan = TRUE; /* program needs to be rescanned */ int number = 0; /* current line number */ struct bwb_line *bwb_l; /* current line pointer */ struct bwb_line bwb_start; /* starting line marker */ struct bwb_line bwb_end; /* ending line marker */ struct bwb_line *data_line; /* current line to read data */ int data_pos = 0; /* position in data_line */ struct bwb_variable var_start; /* variable list start marker */ struct bwb_variable var_end; /* variable list end marker */ struct bwb_function fnc_start; /* function list start marker */ struct bwb_function fnc_end; /* function list end marker */ struct fslte fslt_start; /* function-sub-label lookup table start marker */ struct fslte fslt_end; /* function-sub-label lookup table end marker */ int exsc = -1; /* EXEC stack counter */ int expsc = 0; /* expression stack counter */ int xtxtsc = 0; /* eXecute TeXT stack counter */ struct exse *excs; /* EXEC stack */ struct exp_ese *exps; /* Expression stack */ struct xtxtsl *xtxts; /* Execute Text stack */ #endif /* Prototypes for functions visible only to this file */ #if ANSI_C extern int is_ln( char *buffer ); #else extern int is_ln(); #endif /*************************************************************** FUNCTION: bwb_init() DESCRIPTION: This function initializes bwBASIC. ***************************************************************/ void #if ANSI_C bwb_init( int argc, char **argv ) #else bwb_init( argc, argv ) int argc; char **argv; #endif { static FILE *input = NULL; register int n; #if PROFILE struct bwb_variable *v; #endif #if REDIRECT_STDERR FILE *newerr; #endif #if PROFILE FILE *profile; #endif #if PARACT #else static char start_buf[] = "\0"; static char end_buf[] = "\0"; #endif #if INTENSIVE_DEBUG prn_xprintf( stderr, "Memory Allocation Statistics:\n" ); prn_xprintf( stderr, "----------------------------\n" ); #if PARACT sprintf( bwb_ebuf, "task structure: %ld bytes\n", (long) sizeof( struct bwb_task ) ); prn_xprintf( stderr, bwb_ebuf ); getchar(); #endif #endif /* set all task pointers to NULL */ #if PARACT for ( n = 0; n < TASKS; ++n ) { bwb_tasks[ n ] = NULL; } #else /* Memory allocation */ /* eXecute TeXT stack */ /* Revised to CALLOC pass-thru call by JBV */ if ( ( xtxts = CALLOC( XTXTSTACKSIZE, sizeof( struct xtxtsl ), "bwb_init") ) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_init(): failed to find memory for xtxts" ); #else bwb_error( err_getmem ); #endif } /* expression stack */ /* Revised to CALLOC pass-thru call by JBV */ if ( ( exps = CALLOC( ESTACKSIZE, sizeof( struct exp_ese ), "bwb_init") ) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_init(): failed to find memory for exps" ); #else bwb_error( err_getmem ); #endif } /* EXEC stack */ /* Revised to CALLOC pass-thru call by JBV */ if ( ( excs = CALLOC( EXECLEVELS, sizeof( struct exse ), "bwb_init") ) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_init(): failed to find memory for excs" ); #else bwb_error( err_getmem ); #endif } /* initialize tables of variables, functions */ bwb_start.number = 0; bwb_start.next = &bwb_end; bwb_end.number = MAXLINENO + 1; bwb_end.next = &bwb_end; bwb_start.buffer = start_buf; bwb_end.buffer = end_buf; data_line = &bwb_start; data_pos = 0; exsc = -1; expsc = 0; xtxtsc = 0; bwb_start.position = 0; bwb_l = &bwb_start; var_init( 0 ); fnc_init( 0 ); fslt_init( 0 ); #endif /* character buffers */ /* Revised to CALLOC pass-thru call by JBV */ if ( ( bwb_ebuf = CALLOC( MAXSTRINGSIZE + 1, sizeof(char), "bwb_init") ) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_init(): failed to find memory for bwb_ebuf" ); #else bwb_error( err_getmem ); #endif } /* Revised to CALLOC pass-thru call by JBV */ if ( ( read_line = CALLOC( MAXREADLINESIZE + 1, sizeof(char), "bwb_init") ) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_init(): failed to find memory for read_line" ); #else bwb_error( err_getmem ); #endif } #if PARACT /* request task 0 as current (base) task */ bwb_curtask = bwb_newtask( 0 ); if ( bwb_curtask == -1 ) { return; /* error message has already been called*/ } #endif #if TEST_BSTRING for ( n = 0; n < ESTACKSIZE; ++n ) { sprintf( CURTASK exps[ n ].sval.name, "", n ); } #endif /* assign memory for the device table */ #if COMMON_CMDS /* Revised to CALLOC pass-thru call by JBV */ if ( ( dev_table = CALLOC( DEF_DEVICES, sizeof( struct dev_element ), "bwb_init") ) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_init(): failed to find memory for dev_table" ); #else bwb_error( err_getmem ); #endif bwx_terminate(); } /* initialize all devices to DEVMODE_AVAILABLE */ for ( n = 0; n < DEF_DEVICES; ++n ) { dev_table[ n ].mode = DEVMODE_AVAILABLE; dev_table[ n ].reclen = -1; dev_table[ n ].cfp = NULL; dev_table[ n ].buffer = NULL; dev_table[ n ].width = DEF_WIDTH; dev_table[ n ].col = 1; } #endif /* COMMON_CMDS */ /* initialize preset variables */ ed = var_find( DEFVNAME_EDITOR ); ed->preset = TRUE; ed->common = TRUE; str_ctob( var_findsval( ed, ed->array_pos ), DEF_EDITOR ); fi = var_find( DEFVNAME_FILES ); fi->preset = TRUE; fi->common = TRUE; str_ctob( var_findsval( fi, fi->array_pos ), DEF_FILES ); pr = var_find( DEFVNAME_PROMPT ); pr->preset = TRUE; pr->common = TRUE; str_ctob( var_findsval( pr, pr->array_pos ), PROMPT ); im = var_find( DEFVNAME_IMPL ); im->preset = TRUE; im->common = TRUE; str_ctob( var_findsval( im, im->array_pos ), IMP_IDSTRING ); co = var_find( DEFVNAME_COLORS ); co->preset = TRUE; co->common = TRUE; * var_findnval( co, co->array_pos ) = (bnumber) DEF_COLORS; /* Signon message */ bwx_signon(); /* Redirect stderr if specified */ #if REDIRECT_STDERR newerr = freopen( ERRFILE, "w", stderr ); if ( newerr == NULL ) { sprintf( bwb_ebuf, "Failed to redirect error messages to file <%s>\n", ERRFILE ); errfdevice = stdout; prn_xprintf( errfdevice, bwb_ebuf ); } else { sprintf( bwb_ebuf, "NOTE: Error messages are redirected to file <%s>\n", ERRFILE ); prn_xprintf( errfdevice, bwb_ebuf ); errfdevice = stderr; } #else errfdevice = stdout; #endif /* if there is a profile.bas, execute it */ #if PROFILE if ( ( profile = fopen( PROFILENAME, "r" )) != NULL ) { bwb_fload( profile ); /* load profile */ bwb_run( &CURTASK bwb_start ); /* run profile */ /* profile must be run immediately, not by scheduler */ while ( CURTASK exsc > -1 ) { bwb_execline(); } /* mark all profiled variables as preset */ for ( v = CURTASK var_start.next; v != &CURTASK var_end; v = v->next ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_init(): marked variable <%s> preset TRUE", v->name ); bwb_debug( bwb_ebuf ); #endif v->preset = TRUE; } bwb_new( &CURTASK bwb_start ); /* remove profile from memory */ } #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in main(): Ready to save jump MARKER" ); bwb_debug( bwb_ebuf ); #endif /* set a buffer for jump: program execution returns to this point in case of a jump (error, interrupt, or finish program) */ #if INTERACTIVE #if HAVE_SIGNAL signal( SIGINT, break_mes ); #endif #if HAVE_LONGJUMP setjmp( mark ); #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_init(): Return from jump MARKER, program run <%d>", program_run + 1 ); bwb_debug( bwb_ebuf ); getchar(); #endif /* if INTERACTIVE is FALSE, then we must have a program file */ #else if ( argc < 2 ) { bwb_error( err_noprogfile ); } #endif /* INTERACTIVE */ /* check to see if there is a program file: but do this only the first time around! */ ++program_run; if (( argc > 1 ) && ( program_run == 1 )) { strcpy( CURTASK progfile, argv[ 1 ] ); /* JBV */ if ( ( input = fopen( CURTASK progfile, "r" )) == NULL ) /* JBV */ { strcat( CURTASK progfile, ".bas" ); if ( ( input = fopen( CURTASK progfile, "r" )) == NULL ) { CURTASK progfile[ 0 ] = 0; sprintf( bwb_ebuf, err_openfile, argv[ 1 ] ); bwb_error( bwb_ebuf ); } } if ( input != NULL ) { /* strcpy( CURTASK progfile, argv[ 1 ] ); */ /* Removed by JBV */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in main(): progfile is <%s>.", CURTASK progfile ); bwb_debug( bwb_ebuf ); #endif bwb_fload( input ); bwb_run( &CURTASK bwb_start ); } } } /*************************************************************** FUNCTION: bwb_interact() DESCRIPTION: This function gets a line from the user and processes it. ***************************************************************/ #if INTERACTIVE int #if ANSI_C bwb_interact( void ) #else bwb_interact() #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; /* JBV */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_interact(): ready to read from keyboard" ); bwb_debug( bwb_ebuf ); #endif /* take input from keyboard */ bwb_gets( read_line ); bwb_stripcr( read_line ); /* JBV */ /* If there is no line number, execute the line as received */ if ( is_ln( read_line ) == FALSE ) { bwb_xtxtline( read_line ); } /*-----------------------------------------------------------------*/ /* Another possibility: if read_line is a numeric constant, delete */ /* the indicated line number (JBV) */ /*-----------------------------------------------------------------*/ else if ( is_numconst( read_line ) == TRUE ) { strcpy(tbuf, read_line); sprintf(read_line, "delete %s\0", tbuf); bwb_xtxtline( read_line ); } /* If there is a line number, add the line to the file in memory */ else { bwb_ladd( read_line, TRUE ); #if INTENSIVE_DEBUG bwb_debug( "Return from bwb_ladd()" ); #endif } return TRUE; } #endif /* INTERACTIVE == TRUE */ /*************************************************************** FUNCTION: bwb_fload() DESCRIPTION: This function loads a BASIC program file into memory given a FILE pointer. ***************************************************************/ int #if ANSI_C bwb_fload( FILE *file ) #else bwb_fload( file ) FILE *file; #endif { while ( feof( file ) == FALSE ) { read_line[ 0 ] = '\0'; fgets( read_line, MAXREADLINESIZE, file ); if ( file == stdin ) { * prn_getcol( stdout ) = 1; /* reset column */ } bwb_stripcr( read_line ); /* be sure that this is not EOF with a NULL line */ if (( feof( file ) == FALSE ) || ( strlen( read_line ) > 0 )) { bwb_ladd( read_line, FALSE ); } } /* close file stream */ fclose( file ); return TRUE; } /*************************************************************** FUNCTION: bwb_ladd() DESCRIPTION: This function adds a new line (in the buffer) to the program in memory. ***************************************************************/ int #if ANSI_C bwb_ladd( char *buffer, int replace ) #else bwb_ladd( buffer, replace ) char *buffer; int replace; #endif { struct bwb_line *l, *previous, *p; static char *s_buffer; static int init = FALSE; static int prev_num = 0; char *newbuffer; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_ladd(): add line <%s>", buffer ); bwb_debug( bwb_ebuf ); #endif /* get memory for temporary buffer if necessary */ if ( init == FALSE ) { init = TRUE; /* Revised to CALLOC pass-thru call by JBV */ if ( ( s_buffer = CALLOC( (size_t) MAXSTRINGSIZE + 1, sizeof( char ), "bwb_ladd" )) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_ladd(): failed to find memory for s_buffer" ); #else bwb_error( err_getmem ); #endif return FALSE; } } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_ladd(): s_buffer initialized " ); bwb_debug( bwb_ebuf ); #endif /* get memory for this line */ /* Revised to CALLOC pass-thru call by JBV */ if ( ( l = (struct bwb_line *) CALLOC( (size_t) 1, sizeof( struct bwb_line ), "bwb_ladd")) == NULL ) { #if PROG_ERRORS bwb_error( "in bwb_ladd(): failed to find memory for new line" ); #else bwb_error( err_getmem ); #endif return FALSE; } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_ladd(): got memory." ); bwb_debug( bwb_ebuf ); #endif /* note that line is not yet marked and the program must be rescanned */ l->marked = FALSE; CURTASK rescan = TRUE; /* program needs to be scanned again */ l->xnum = FALSE; /* get the first element and test for a line number */ adv_element( buffer, &( l->position ), s_buffer ); /* set line number in line structure */ if ( is_numconst( s_buffer ) == TRUE ) { l->number = atoi( s_buffer ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_ladd(): line is numbered, number is <%d>", l->number ); bwb_debug( bwb_ebuf ); #endif prev_num = l->number; l->xnum = TRUE; ++( l->position ); newbuffer = &( buffer[ l->position ] ); /* allocate memory and assign buffer to line buffer */ ln_asbuf( l, newbuffer ); } /* There is not a line number */ else { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_ladd(): line is not numbered, using prev <%d>", prev_num ); bwb_debug( bwb_ebuf ); #endif newbuffer = buffer; /* allocate memory and assign buffer to line buffer */ ln_asbuf( l, newbuffer ); l->xnum = FALSE; l->number = prev_num; } /* find the place of the current line */ for ( previous = &CURTASK bwb_start; previous != &CURTASK bwb_end; previous = previous->next ) { /* replace a previously existing line */ if ( ( l->xnum == (char) TRUE ) /* Better recast this one (JBV) */ && ( previous->number == l->number ) && ( replace == TRUE ) ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_ladd(): writing to previous number <%d>", l->number ); bwb_debug( bwb_ebuf ); #endif /* allocate memory and assign buffer to line buffer */ ln_asbuf( previous, newbuffer ); /* free the current line */ /* Revised to FREE pass-thru calls by JBV */ /* if (l->buffer != NULL) FREE( l->buffer, "bwb_ladd" ); */ /* FREE( l, "bwb_ladd" ); */ bwb_freeline( l ); /* JBV */ /* and return */ return TRUE; } /* add after previously existing line: this is to allow unnumbered lines that follow in sequence after a previously numbered line */ else if (( previous->number == l->number ) && ( replace == FALSE ) ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_ladd(): adding doubled number <%d>", l->number ); bwb_debug( bwb_ebuf); #endif /* if there are multiple instances of this particular line number, then it is incumbent upon us to find the very last one */ for ( p = previous; p->number == l->number; p = p->next ) { #if INTENSIVE_DEBUG bwb_debug( "in bwb_ladd(): advancing..." ); #endif previous = p; } l->next = previous->next; previous->next = l; return TRUE; } /* add a new line */ else if ( ( previous->number < l->number ) && ( previous->next->number > l->number )) { l->next = previous->next; previous->next = l; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_ladd(): added new line <%d> buffer <%s>", l->number, l->buffer ); bwb_debug( bwb_ebuf ); #endif return TRUE; } } /* attempt to link line number has failed; free memory */ /* Revised to FREE pass-thru calls by JBV */ /* if (l->buffer != NULL) FREE( l->buffer, "bwb_ladd" ); */ /* FREE( l, "bwb_ladd" ); */ bwb_freeline( l ); /* JBV */ sprintf( bwb_ebuf, ERR_LINENO ); bwb_error( bwb_ebuf ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_ladd(): attempt to add line has failed" ); bwb_debug( bwb_ebuf ); #endif return FALSE; } /*************************************************************** FUNCTION: bwb_xtxtline() DESCRIPTION: This function executes a text line, i.e., places it in memory and then relinquishes control. ***************************************************************/ struct bwb_line * #if ANSI_C bwb_xtxtline( char *buffer ) #else bwb_xtxtline( buffer ) char *buffer; #endif { struct bwb_line *c; char *p; int loop; #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xtxtline(): received <%s>", buffer ); bwb_debug( bwb_ebuf ); #endif /* increment xtxt stack counter */ if ( CURTASK xtxtsc >= XTXTSTACKSIZE ) { sprintf( bwb_ebuf, "Exceeded maximum xtxt stack <%d>", CURTASK xtxtsc ); return &CURTASK bwb_end; } ++CURTASK xtxtsc; /* advance past whitespace */ p = buffer; loop = TRUE; while( loop == TRUE ) { switch( *p ) { case '\0': /* end of string */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "Null command line received." ); bwb_debug( bwb_ebuf ); #endif --CURTASK xtxtsc; return &CURTASK bwb_end; case ' ': /* whitespace */ case '\t': ++p; break; default: loop = FALSE; break; } } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xtxtline(): ready to get memory" ); bwb_debug( bwb_ebuf ); #endif /* Removed by JBV (no longer needed, done by ln_asbuf) */ /* if ( CURTASK xtxts[ CURTASK xtxtsc ].l.buffer != NULL ) { */ /* #if INTENSIVE_DEBUG */ /* sprintf( bwb_ebuf, "in bwb_xtxtline(): freeing buffer memory" ); bwb_debug( bwb_ebuf ); */ /* #endif */ /* Revised to FREE pass-thru call by JBV */ /* FREE( CURTASK xtxts[ CURTASK xtxtsc ].l.buffer, "bwb_xtxtline" ); } */ /* copy the whole line to the line structure buffer */ ln_asbuf( &( CURTASK xtxts[ CURTASK xtxtsc ].l ), buffer ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_xtxtline(): copied to line buffer <%s>.", CURTASK xtxts[ CURTASK xtxtsc ].l.buffer ); bwb_debug( bwb_ebuf ); #endif /* set line number in line structure */ CURTASK xtxts[ CURTASK xtxtsc ].l.number = 0; CURTASK xtxts[ CURTASK xtxtsc ].l.marked = FALSE; /* execute the line as BASIC command line */ CURTASK xtxts[ CURTASK xtxtsc ].l.next = &CURTASK bwb_end; c = &( CURTASK xtxts[ CURTASK xtxtsc ].l ); c->position = 0; #if THEOLDWAY do { c = bwb_xline( c ); } while( c != &CURTASK bwb_end ); #endif bwb_incexec(); /* increment EXEC stack */ bwb_setexec( c, 0, EXEC_NORM ); /* and set current line in it */ /* decrement xtxt stack counter ??? */ --CURTASK xtxtsc; return c; } /*************************************************************** FUNCTION: bwb_incexec() DESCRIPTION: This function increments the EXEC stack counter. ***************************************************************/ #if ANSI_C extern void bwb_incexec( void ) { #else void bwb_incexec() { #endif ++CURTASK exsc; if ( CURTASK exsc >= EXECLEVELS ) { --CURTASK exsc; #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_incexec(): incremented EXEC stack past max <%d>", EXECLEVELS ); bwb_error( bwb_ebuf ); #else bwb_error( err_overflow ); #endif } CURTASK excs[ CURTASK exsc ].while_line = NULL; CURTASK excs[ CURTASK exsc ].wend_line = NULL; CURTASK excs[ CURTASK exsc ].n_cvs = 0; CURTASK excs[ CURTASK exsc ].local_variable = NULL; } /*************************************************************** FUNCTION: bwb_decexec() DESCRIPTION: This function decrements the EXEC stack counter. ***************************************************************/ #if ANSI_C extern void bwb_decexec( void ) { #else void bwb_decexec() { #endif /* decrement the exec stack counter */ --CURTASK exsc; if ( CURTASK exsc < -1 ) { CURTASK exsc = -1; #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_decexec(): decremented EXEC stack past min <-1>" ); bwb_error( bwb_ebuf ); #else bwb_error( err_overflow ); #endif } /* check for EXEC_ON and decrement recursively */ if ( CURTASK excs[ CURTASK exsc ].code == EXEC_ON ) { /* Revised to FREE pass-thru calls by JBV */ /* FREE( CURTASK excs[ CURTASK exsc ].while_line->buffer, "bwb_decexec" ); */ /* FREE( CURTASK excs[ CURTASK exsc ].while_line, "bwb_decexec" ); */ bwb_freeline( CURTASK excs[ CURTASK exsc ].while_line ); /* JBV */ bwb_decexec(); } } /*************************************************************** FUNCTION: bwb_setexec() DESCRIPTION: This function sets the line and position for the next call to bwb_execline(); ***************************************************************/ #if ANSI_C extern int bwb_setexec( struct bwb_line *l, int position, int code ) { #else int bwb_setexec( l, position, code ) struct bwb_line *l; int position; int code; { #endif CURTASK excs[ CURTASK exsc ].line = l; CURTASK excs[ CURTASK exsc ].position = position; CURTASK excs[ CURTASK exsc ].code = code; return TRUE; } /*************************************************************** FUNCTION: bwb_mainloop() DESCRIPTION: This C function performs one iteration of the interpreter. In a non-preemptive scheduler, this function should be called by the scheduler, not by bwBASIC code. ***************************************************************/ void #if ANSI_C bwb_mainloop( void ) #else bwb_mainloop() #endif { if ( CURTASK exsc > -1 ) { bwb_execline(); /* execute one line of program */ } #if INTERACTIVE else { bwb_interact(); /* get user interaction */ } #endif } /*************************************************************** FUNCTION: bwb_execline() DESCRIPTION: This function executes a single line of a program in memory. This function is called by bwb_mainloop(). ***************************************************************/ void #if ANSI_C bwb_execline( void ) #else bwb_execline() #endif { struct bwb_line *r, *l; l = CURTASK excs[ CURTASK exsc ].line; /* if the line is &CURTASK bwb_end, then break out of EXEC loops */ if ( l == &CURTASK bwb_end ) { CURTASK exsc = -1; return; } /* Check for wacko line numbers */ #if INTENSIVE_DEBUG if ( l->number < -1 ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_execline(): received line number <%d> < -1", l->number ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return; } if ( l->number > MAXLINENO ) { #if PROG_ERRORS sprintf( bwb_ebuf, "in bwb_execline(): received line number <%d> > MAX <%d>", l->number, MAXLINENO ); bwb_error( bwb_ebuf ); #else bwb_error( err_syntax ); #endif return; } #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_execline(): buffer <%s>", &( l->buffer[ l->position ] ) ); bwb_debug( bwb_ebuf ); #endif /* Print line number if trace is on */ if ( bwb_trace == TRUE ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "[ %d ]", l->number ); prn_xprintf( errfdevice, bwb_ebuf ); #else if ( l->number > 0 ) { sprintf( bwb_ebuf, "[ %d ]", l->number ); prn_xprintf( errfdevice, bwb_ebuf ); } #endif } /* Set current line for error/break handling */ CURTASK number = l->number; CURTASK bwb_l = l; /* advance beyond whitespace */ adv_ws( l->buffer, &( l->position ) ); /* advance past segment delimiter and warn */ #if MULTISEG_LINES if ( l->buffer[ l->position ] == ':' ) { ++( l->position ); adv_ws( l->buffer, &( l->position ) ); } l->marked = FALSE; #else #if PROG_ERRORS if ( l->buffer[ l->position ] == ':' ) { ++( l->position ); adv_ws( l->buffer, &( l->position ) ); sprintf( bwb_ebuf, "Enable MULTISEG_LINES for multi-segmented lines", VERSION ); bwb_error( bwb_ebuf ); } #endif #endif /* set positions in buffer */ #if MULTISEG_LINES if ( ( l->marked != TRUE ) || ( l->position > l->startpos )) { line_start( l->buffer, &( l->position ), &( l->lnpos ), &( l->lnum ), &( l->cmdpos ), &( l->cmdnum ), &( l->startpos ) ); l->marked = TRUE; } else { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_execline(): line <%d> is already marked", l->number ); bwb_debug( bwb_ebuf ); #endif } l->position = l->startpos; #else /* not MULTISEG_LINES */ line_start( l->buffer, &( l->position ), &( l->lnpos ), &( l->lnum ), &( l->cmdpos ), &( l->cmdnum ), &( l->startpos ) ); if ( l->position < l->startpos ) { l->position = l->startpos; } #endif /* if there is a BASIC command in the line, execute it here */ if ( l->cmdnum > -1 ) { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_execline(): executing <%s>", l->buffer ); bwb_debug( bwb_ebuf ); #endif /* execute the command vector */ r = bwb_cmdtable[ l->cmdnum ].vector ( l ); } /* No BASIC command; try to execute it as a shell command */ #if COMMAND_SHELL else { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "Breaking out to shell, line num <%d> buf <%s> cmd <%d> pos <%d>", l->number, &( l->buffer[ l->position ] ), l->cmdnum, l->position ); bwb_debug( bwb_ebuf ); getchar(); #endif bwx_shell( l ); bwb_setexec( l->next, 0, CURTASK excs[ CURTASK exsc ].code ); return; } #else /* COMMAND_SHELL == FALSE */ else { bwb_error( err_uc ); } #endif /* check for end of line: if so, advance to next line and return */ adv_ws( r->buffer, &( r->position ) ); switch( r->buffer[ r->position ] ) { case '\n': case '\r': case '\0': #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_execline(): detected end of line" ); bwb_debug( bwb_ebuf ); #endif r->next->position = 0; bwb_setexec( r->next, 0, CURTASK excs[ CURTASK exsc ].code ); return; /* and return */ } /* else reset with the value in r */ bwb_setexec( r, r->position, CURTASK excs[ CURTASK exsc ].code ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_execline(): exit setting line number <%d>", r->number ); bwb_debug( bwb_ebuf ); #endif } /*************************************************************** FUNCTION: ln_asbuf() DESCRIPTION: This function allocates memory and copies a null-terminated string to a line buffer. ***************************************************************/ int #if ANSI_C ln_asbuf( struct bwb_line *l, char *s ) #else ln_asbuf( l, s ) struct bwb_line *l; char *s; #endif { /* Reinstated by JBV */ /* #if DONTDOTHIS */ /* but why not? */ if ( l->buffer != NULL ) { /* Revised to FREE pass-thru call by JBV */ FREE( l->buffer, "ln_asbuf" ); l->buffer = NULL; /* JBV */ } /* #endif */ /* Revised to CALLOC pass-thru call by JBV */ if ( ( l->buffer = CALLOC( strlen( s ) + 2, sizeof( char ), "ln_asbuf") ) == NULL ) { #if PROG_ERRORS bwb_error( "in ln_asbuf(): failed to find memory for new line" ); #else bwb_error( err_getmem ); #endif return FALSE; } /* copy the whole line to the line structure buffer */ strcpy( l->buffer, s ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in ln_asbuf(): allocated buffer <%s>", l->buffer ); bwb_debug( bwb_ebuf ); #endif /* strip CR from the buffer */ bwb_stripcr( l->buffer ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in ln_asbuf(): stripped CRs" ); bwb_debug( bwb_ebuf ); #endif return TRUE; } /*************************************************************** FUNCTION: bwb_gets() DESCRIPTION: This function reads a single line from the specified buffer. ***************************************************************/ int #if ANSI_C bwb_gets( char *buffer ) #else bwb_gets( buffer ) char *buffer; #endif { struct bwb_variable *v; char tbuf[ MAXSTRINGSIZE + 1 ]; #if PARACT char ubuf[ MAXSTRINGSIZE + 1 ]; #endif CURTASK number = 0; v = var_find( DEFVNAME_PROMPT ); str_btoc( tbuf, var_getsval( v ) ); #if PARACT sprintf( ubuf, "TASK %d %s", bwb_curtask, tbuf ); strcpy( tbuf, ubuf ); #endif bwx_input( tbuf, buffer ); return TRUE; } /*************************************************************** FUNCTION: break_mes() DESCRIPTION: This function is called (a) by a SIGINT signal or (b) by error-handling routines. It prints an error message then calls break_handler() to handle the program interruption. ***************************************************************/ void #if ANSI_C break_mes( int x ) #else break_mes( x ) int x; #endif { static char *tmp_buffer; static int init = FALSE; /* get memory for temporary buffer if necessary */ if ( init == FALSE ) { init = TRUE; /* Revised to CALLOC pass-thru call by JBV */ if ( ( tmp_buffer = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "break_mes")) == NULL ) { #if PROG_ERRORS bwb_error( "in break_mes(): failed to find memory for tmp_buffer" ); #else bwb_error( err_getmem ); #endif } } CURTASK expsc = 0; sprintf( tmp_buffer, "\r%s %d\n", MES_BREAK, CURTASK number ); prn_xprintf( errfdevice, tmp_buffer ); break_handler(); } /*************************************************************** FUNCTION: break_handler() DESCRIPTION: This function is called by break_mes() and handles program interruption by break (or by the STOP command). ***************************************************************/ void #if ANSI_C break_handler( void ) #else break_handler() #endif { #if INTERACTIVE /* INTERACTIVE: reset counters and jump back to mark */ /* reset all stack counters */ CURTASK exsc = -1; CURTASK expsc = 0; CURTASK xtxtsc = 0; err_gosubl[ 0 ] = '\0'; /* reset the break handler */ #if HAVE_SIGNAL signal( SIGINT, break_mes ); #endif #if HAVE_LONGJUMP longjmp( mark, -1 ); #else /* HAVE_LONGJUMP = FALSE; no jump available; terminate */ bwx_terminate(); #endif #else /* nonINTERACTIVE: terminate immediately */ bwx_terminate(); #endif } /*************************************************************** FUNCTION: is_ln() DESCRIPTION: This function determines whether a program line (in buffer) begins with a line number. ***************************************************************/ int #if ANSI_C is_ln( char *buffer ) #else is_ln( buffer ) char *buffer; #endif { static int position; position = 0; adv_ws( buffer, &position ); switch( buffer[ position ] ) { case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': return TRUE; default: return FALSE; } } /*************************************************************** FUNCTION: CALLOC() DESCRIPTION: Pass-thru function to calloc() for debugging purposes. Added by JBV 10/95 ***************************************************************/ void * #if ANSI_C CALLOC( size_t nelem, size_t elsize, char *str ) #else CALLOC( nelem, elsize, str ) size_t nelem; size_t elsize; char *str; #endif { void *ptr; ptr = calloc(nelem, elsize); /* printf("%x %x\n", ptr, mallocblksize(ptr)); */ return ptr; } /*************************************************************** FUNCTION: FREE() DESCRIPTION: Pass-thru function to free() for debugging purposes. Added by JBV 10/95 ***************************************************************/ void #if ANSI_C FREE( void *ptr, char *str ) #else FREE( ptr, str ) void *ptr; char *str; #endif { /* printf("%x\n", ptr); */ free(ptr); } bwbasic-2.20pl2.orig/bwbasic.doc100644 0 0 163054 5456637004 14666 0ustar rootroot Bywater BASIC Interpreter/Shell, version 2.10 --------------------------------------------- Copyright (c) 1993, Ted A. Campbell for bwBASIC version 2.10, 11 October 1993 CONTENTS: 1. DESCRIPTION 2. TERMS OF USE 3. QUICK REFERENCE LIST OF COMMANDS AND FUNCTIONS 4. GENERAL NOTES ON USAGE 5. EXPANDED REFERENCE FOR COMMANDS AND FUNCTIONS 6. PREDEFINED VARIABLES 7. UNIMPLEMENTED COMMANDS AND FUNCTIONS and AGENDA FOR DEVELOPMENT 8. THE STORY OF BYWATER BASIC 9. COMMUNICATIONS The author wishes to express his thanks to Mr. David MacKenzie, who assisted in the development Unix installation and configuration for this version. 1. DESCRIPTION The Bywater BASIC Interpreter (bwBASIC) implements a large superset of the ANSI Standard for Minimal BASIC (X3.60-1978) and a significant subset of the ANSI Standard for Full BASIC (X3.113-1987) in C. It also offers shell programming facilities as an extension of BASIC. bwBASIC seeks to be as portable as possible. bwBASIC can be configured to emulate features, commands, and functions available on different types of BASIC interpreters; see the file INSTALL for further installation information. The interpreter is fairly slow. Whenever faced with a choice between conceptual clarity and speed, I have consistently chosen the former. The interpreter is the simplest design available, and utilizes no system of intermediate code, which would speed up considerably its operation. As it is, each line is interpreted afresh as the interpreter comes to it. bwBASIC implements one feature not available in previous BASIC interpreters: a shell command can be entered interactively at the bwBASIC prompt, and the interpreter will execute it under a command shell. For instance, the command "dir *.bas" can be entered in bwBASIC (under DOS, or "ls -l *.bas" under UNIX) and it will be executed as from the operating system command line. Shell commands can also be given on numbered lines in a bwBASIC program, so that bwBASIC can be used as a shell programming language. bwBASIC's implementation of the RMDIR, CHDIR, MKDIR, NAME, KILL, ENVIRON, and ENVIRON$() commands and functions offer further shell-processing capabilities. 2. TERMS OF USE: This version of Bywater BASIC 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. 3. QUICK REFERENCE LIST OF COMMANDS AND FUNCTIONS Be aware that many of these commands and functions will not be available unless you have set certain flags in the header files (see the expanded reference section below for dependencies). ABS( number ) ASC( string$ ) ATN( number ) CALL subroutine-name CASE ELSE | IF partial-expression | constant CHAIN [MERGE] file-name [, line-number] [, ALL] CHDIR pathname CHR$( number ) CINT( number ) CLEAR CLOSE [[#]file-number]... CLS COMMON variable [, variable...] COS( number ) CSNG( number ) CVD( string$ ) CVI( string$ ) CVS( string$ ) DATA constant[,constant]... DATE$ DEF FNname(arg...)] = expression DEFDBL letter[-letter](, letter[-letter])... DEFINT letter[-letter](, letter[-letter])... DEFSNG letter[-letter](, letter[-letter])... DEFSTR letter[-letter](, letter[-letter])... DELETE line[-line] DIM variable(elements...)[variable(elements...)]... DO NUM|UNNUM DO [WHILE expression] EDIT ELSE ELSEIF END IF | FUNCTION | SELECT | SUB ENVIRON variable-string = string ENVIRON$( variable-string ) EOF( device-number ) ERASE variable[, variable]... ERL ERR ERROR number EXP( number ) FIELD [#] device-number, number AS string-variable [, number AS string-variable...] FILES filespec$ FUNCTION FOR counter = start TO finish [STEP increment] GET [#] device-number [, record-number] GOSUB line | label GOTO line | label HEX$( number ) IF expression THEN [statement [ELSE statement]] INKEY$ INPUT [# device-number]|[;]["prompt string";]list of variables INSTR( [start-position,] string-searched$, string-pattern$ ) INT( number ) KILL file-name LEFT$( string$, number-of-spaces ) LEN( string$ ) LET variable = expression LINE INPUT [[#] device-number,]["prompt string";] string-variable$ LIST line[-line] LOAD file-name LOC( device-number ) LOCATE line, column LOF( device-number ) LOG( number ) LOOP [UNTIL expression] LSET string-variable$ = expression MERGE file-name MID$( string$, start-position-in-string[, number-of-spaces ] ) MKD$( number ) MKDIR pathname MKI$( number ) MKS$( number ) NAME old-file-name AS new-file-name NEW NEXT [counter] OCT$( number ) ON variable GOTO|GOSUB line[,line,line,...] ON ERROR GOSUB line OPEN "O"|"I"|"R", [#]device-number, file-name [,record length] file-name FOR INPUT|OUTPUT|APPEND AS [#]device-number [LEN = record-length] OPTION BASE number POS PRINT [# device-number,][USING format-string$;] expressions... PUT [#] device-number [, record-number] QUIT RANDOMIZE number READ variable[, variable]... REM string RESTORE line RETURN RIGHT$( string$, number-of-spaces ) RMDIR pathname RND( number ) RSET string-variable$ = expression RUN [line][file-name] SAVE file-name SELECT CASE expression SGN( number ) SIN( number ) SPACE$( number ) SPC( number ) SQR( number ) STOP STR$( number ) STRING$( number, ascii-value|string$ ) SUB subroutine-name SWAP variable, variable SYSTEM TAB( number ) TAN( number ) TIME$ TIMER TROFF TRON VAL( string$ ) WEND WHILE expression WIDTH [# device-number,] number WRITE [# device-number,] element [, element ].... 4. GENERAL NOTES ON USAGE: 4.a. Interactive Environment An interactive environment is provided if the flag INTERACTIVE is defined as TRUE in bwbasic.h, so that a line with a line number can be entered at the bwBASIC prompt and it will be added to the program in memory. Line numbers are not strictly required, but are useful if the interactive enviroment is used for programming. For longer program entry one might prefer to use an ASCII text editor, and in this case lines can be entered without numbers. One can use DO NUM and DO UNNUM to number or unnumber lines. See also the documentation below for the pseudo-command EDIT. 4.b. Naming Conventions Command names and function names are not case sensitive, so that "Run" and "RUN" and "run" are equivalent and "abs()" and "ABS()" and "Abs()" are equivalent. HOWEVER, variable names ARE case sensitive in bwbASIC, so that "d$" and "D$" are different variables. This differs from some BASIC implementations where variable names are not case sensitive. Variable names can use any alphabetic characters, the period and underscore characters and decimal digits (but not in the first position). They can be terminated with '#' or '!' to allow Microsoft-type names, even though the precision is irrelevant to bwBASIC. 4.c. Numerical Constants Numerical constants may begin with a digit 0-9 (decimal), with the "&H" or "&h" (hexadecimal) or the "&o" or "&O" (octal). Decimal numbers may terminated with 'E', 'e', 'D', or 'd' followed by an exponent number to denote exponential notation. Decimal constants may also be terminated by the '#' or '!' to comply with Microsoft-style precision terminators, although the precision specified will be irrelevant to bwBASIC. 4.d. Command-Line Execution A filename can be specified on the command line and will be LOADed and RUN immediately, so that the command line bwbasic prog.bas will load and execute "prog.bas". 4.e. Program Storage All programs are stored as ASCII text files. 4.f. TRUE and FALSE TRUE is defined as -1 and FALSE is defined as 0 in the default distribution of bwBASIC. These definitions can be changed by those compiling bwBASIC (see file BWBASIC.H). 4.g. Assignments Assignment must be made to variables. This differs from some implementations of BASIC where assignment can be made to a function. Implication: "INSTR( 3, x$, y$ ) = z$" will not work under bwBASIC. 4.h. Operators and Precedence bwBASIC recognizes the following operators, with their level of precedence given (1 = highest): ^ 1 exponentiation * 2 multiplication / 2 division \ 3 integer division + 5 addition - 5 subtraction = 6 equality or assignment MOD 4 modulus (remainder) arithmetic <> 7 inequality < 8 less than > 9 greater than <= 10 less than or equal to =< 10 less than or equal to >= 11 greater than or equal to => 11 greater than or equal to NOT 12 negation AND 13 conjunction OR 14 disjunction XOR 15 exclusive or IMP 16 implication EQV 17 equivalence 4.h. Numerical Precision (NOT) bwBASIC utilizes numbers with only one level of precision. If the flag NUMBER_DOUBLE is defined as TRUE in bwbasic.h, the precision implemented will be that of the C "double" data type; otherwise (default) the precision will be that of the C "float" type. At a number of points there are commands (or pseudo- commands) that seem to recognize Microsoft-style precision distinctions, but for the most part these are just work-around aliases to allow Microsoft-style programs to be run. 5. EXPANDED REFERENCE FOR COMMANDS AND FUNCTIONS The "Dependencies" listed in the folowing reference materials refers to flags that must be set to TRUE in bwbasic.h for the associated command or function to be implemented. These flags are as follows: (core) Commands and Functions in any implementation of bwBASIC; these are the ANSI Minimal BASIC core INTERACTIVE Commands supporting the interactive programming environment COMMON_CMDS Commands beyond ANSI Minimal BASIC which are common to Full ANSI BASIC and Microsoft BASICs COMMON_FUNCS Functions beyond the ANSI Mimimal BASIC core, but common to both ANSI Full BASIC and Microsoft-style BASIC varieties UNIX_CMDS Commands which require Unix-style directory and environment routines not specified in C STRUCT_CMDS Commands related to structured programming; all of these are part of the Full ANSI BASIC standard ANSI_FUNCS Functions unique to ANSI Full BASIC MS_CMDS Commands unique to Microsoft BASICs MS_FUNCS Functions unique to Microsoft BASICs ------------------------------------------ Function: ABS( number ) Description: ABS returns the absolute value of the argument 'number'. Dependencies: (core) ------------------------------------------ Function: ASC( string$ ) Description: ASC returns the ASCII code for the first letter in the argument string$. Dependencies: MS_FUNCS ------------------------------------------ Function: ATN( number ) Description: ATN returns the arctangent value of the argument 'number' in radians. Dependencies: (core) ------------------------------------------ Command: CALL subroutine-name Description: CALL calls a named subroutine (see SUB and END SUB). Dependencies: STRUCT_CMDS ------------------------------------------ Command: CASE ELSE | IF partial-expression | constant Description: CASE introduces an element of a SELECT CASE statement (see SELECT CASE). CASE IF introduces a conditional SELECT CASE element, and CASE ELSE introduces a default SELECT CASE element. Dependencies: STRUCT_CMDS ------------------------------------------ Command: CHAIN [MERGE] file-name [, line-number] [, ALL] Description: CHAIN passes control to another BASIC program. Variables declared COMMON (q.v.) will be passed to the new program. Dependencies: COMMON_CMDS ------------------------------------------ Command: CHDIR pathname$ Description: CHDIR changes the current directory to that indicated by the argument pathname$. Dependencies: UNIX_CMDS ------------------------------------------ Function: CHR$( number ) Description: CHR$ returns a one-character string with the character corresponding to the ASCII code indicated by argument 'number'. Dependencies: COMMON_FUNCS ------------------------------------------ Function: CINT( number ) Description: CINT returns the truncated integer for the argument 'number'. Dependencies: MS_FUNCS ------------------------------------------ Command: CLEAR Description: CLEAR sets all numerical variables to 0, and all string variables to null. Dependencies: COMMON_CMDS ------------------------------------------ Command: CLOSE [[#]file-number]... Description: CLOSE closes the file indicated by file-number (see OPEN). Dependencies: COMMON_CMDS ------------------------------------------ Command: CLS Description: CLS clears the display screen (IBM and compatibles only as of version 2.10). Dependencies: IMP_IQC and IMP_CMDLOC ------------------------------------------ Command: CMDS Description: CMDS is a debugging command that prints a list of all implemented bwBASIC commands. Dependencies: DEBUG ------------------------------------------ Command: COMMON variable [, variable...] Description: COMMON designates variables to be passed to a CHAINed program (see CHAIN). Dependencies: COMMON_CMDS ------------------------------------------ Function: COS( number ) Description: COS returns the cosine of the argument 'number' in radians. Dependencies: (core) ------------------------------------------ Function: CSNG( number ) Description: CSNG is a pseudo-function that has no effect under bwBASIC. It replicates a Microsoft-type command that would convert the 'number' to single-precision. Dependencies: MS_FUNCS ------------------------------------------ Function: CVD( string$ ) Description: CVD converts the argument string$ into a bwBASIC number (precision is irrelevant in bwBASIC since bwBASIC numbers have only one precision). Implenentation-Specific Notes: CVD(), CVI(), CVS(), MKI$(), MKD$(), MKS$(): These functions are implemented, but are dependent on a) the sizes for integer, float, and double values on particular systems, and b) how particular versions of C store these numerical values. The implication is that data files created using these functions on a DOS-based microcomputer may not be translated correctly by bwBASIC running on a Unix-based computer. Similarly, data files created by bwBASIC compiled by one version of C may not be readable by bwBASIC compiled by another version of C (even under the same operating system). So be careful with these. Dependencies: MS_FUNCS ------------------------------------------ Function: CVI( string$ ) Description: CVI converts the argument string$ into a bwBASIC number (precision is irrelevant in bwBASIC since bwBASIC numbers have only one precision; see also the note on CVD). Dependencies: MS_FUNCS ------------------------------------------ Function: CVS( string$ ) Description: CVI converts the argument string$ into a bwBASIC number (precision is irrelevant in bwBASIC since bwBASIC numbers have only one precision; see also the note on CVD). Dependencies: MS_FUNCS ------------------------------------------ Command: DATA constant[,constant]... Description: DATA stores numerical and string constants to be accessed by READ (q.v.). Dependencies: (core) ------------------------------------------ Function: DATE$ Description: DATE$ returns the current date based on the computer's internal clock as a string in the form "YYYY-MM-DD". As implemented under bwBASIC, DATE$ cannot be used for assignment (i.e., to set the system date). Note: bwBASIC presently (v2.10) does not allow assignment to a function. Dependencies: COMMON_FUNCS ------------------------------------------ Command: DEF FNname(arg...)] = expression Description: DEF defines a user-written function. This function corresponds to Microsoft-type implementation, although in bwBASIC DEF is a working equivalent of FUNCTION. Dependencies: (core) ------------------------------------------ Command: DEFDBL letter[-letter](, letter[-letter])... Description: DEFDBL declares variables with single-letter names as numerical variables (precision is irrelevant in bwBASIC). Dependencies: MS_CMDS ------------------------------------------ Command: DEFINT letter[-letter](, letter[-letter])... Description: DEFINT declares variables with single-letter names as numerical variables (precision is irrelevant in bwBASIC). Dependencies: MS_CMDS ------------------------------------------ Command: DEFSNG letter[-letter](, letter[-letter])... Description: DEFSNG declares variables with single-letter names as numerical variables (precision is irrelevant in bwBASIC). Dependencies: MS_CMDS ------------------------------------------ Command: DEFSTR letter[-letter](, letter[-letter])... Description: DEFSTR declares variables with single-letter names as string variables. Dependencies: MS_CMDS ------------------------------------------ Command: DELETE line[-line] Description: DELETE deletes program lines indicated by the argument(s). If you want to use DELETE for non- numbered programs, first use DO NUM, then DELETE, then DO UNNUM. Dependencies: INTERACTIVE ------------------------------------------ Command: DIM variable(elements...)[variable(elements...)]... Description: DIM specifies variables that have more than one element in a single dimension, i.e., arrayed variables. Note: As implemented under bwBASIC, DIM accepts only parentheses as delimiters for variable fields. (Some BASICs allow the use of square brackets.) Dependencies: (core) ------------------------------------------ Command: DO NUM|UNNUM Description: DO NUM numbers all lines in a program. The first line is given the number 10, and subsequent lines are numbered consecutively in multiples of 10. DO UNNUM removes all line numbers from a program. NOTE that these functions do nothing to line numbers, e.g., following a GOSUB or GOTO statement; these commands cannot be used as a replacement for RENUM (available in some systems, but not bwBASIC). With these commands, however, one can develop unnumbered programs by entering new lines with numbers, then running DO UNNUM to remove the line numbers. Together with LOAD and SAVE (q.v.) one can use bwBASIC as a primitive text editor. Dependencies: INTERACTIVE ------------------------------------------ Command: DO [WHILE expression] Description: DO implements a number of forms of program loops. DO...LOOP simply loops; the only way out is by EXIT; DO WHILE...LOOP loops while "expression" is true (this is equivalent to the older WHILE-WEND loop, also implemented in bwBASIC); DO...LOOP UNTIL loops until the expression following UNTIL is true. Dependencies: STRUCT_CMDS ------------------------------------------ Command: EDIT Description: EDIT is a pseudo-command which calls the text editor specified in the variable BWB.EDITOR$ to edit the program in memory. After the call to the text editor, the (edited) prgram is reloaded into memory. The user normally must specific a valid path and filename in BWB.EDITOR$ before this command will be useful. Dependencies: COMMON_CMDS ------------------------------------------ Command: ELSE Description: ELSE introduces a default condition in a multi-line IF statement. Dependencies: STRUCT_CMDS ------------------------------------------ Command: ELSEIF Description: ELSEIF introduces a secondary condition in a multi- line IF statement. Dependencies: STRUCT_CMDS ------------------------------------------ Command: END IF | FUNCTION | SELECT | SUB Description: END IF ends a multi-line IF statement. END FUNCTION ends a multi-line function definition. END SELECT ends a SELECT CASE statement. END SUB ends a multi- line subroutine definition. Dependencies: STRUCT_CMDS ------------------------------------------ Command: ENVIRON variable-string$ = string$ Description: ENVIRON sets the environment variable identified by variable-string$ to string$. It might be noted that this differs from the implementation of ENVIRON in some versions of BASIC, but bwBASIC's ENVIRON allows BASIC variables to be used on either side of the equals sign. Note that the function ENVIRON$() is different from the command, and be aware of the fact that in some operating systems an environment variable set within a program will not be passed to its parent shell. Dependencies: UNIX_CMDS ------------------------------------------ Function: ENVIRON$( variable-string$ ) Description: ENVIRON$ returns the environment variable associated with the name variable-string$. Dependencies: MS_FUNCS ------------------------------------------ Function: EOF( device-number ) Description: EOF returns TRUE (-1) if the device associated with device-number is at the end-of-file, otherwise it returns FALSE (0). Dependencies: MS_FUNCS ------------------------------------------ Command: ERASE variable[, variable]... Description: ERASE eliminates arrayed variables from a program. Dependencies: COMMON_CMDS ------------------------------------------ Function: ERL Description: ERL returns the line number of the most recent error. Dependencies: MS_FUNCS ------------------------------------------ Function: ERR Description: ERR returns the error number of the most recent error. Note that if PROG_ERRORS has been defined when bwBASIC is compiled, the ERR variable will not be set correctly upon errors. It only works when standard error messages are used. Dependencies: MS_FUNCS ------------------------------------------ Command: ERROR number Description: ERROR simulates an error, i.e., displays the message appropriate for that error. This command is helpful in writing ON ERROR GOSUB routines that can identify a few errors for special treatment and then ERROR ERR (i.e., default handling) for all others. Dependencies: COMMON_CMDS ------------------------------------------ Command: EXIT [FOR] Description: EXIT by itself exits from a DO...LOOP loop; EXIT FOR exits from a FOR...NEXT loop. Dependencies: STRUCT_CMDS ------------------------------------------ Function: EXP( number ) Description: EXP returns the exponential value of 'number'. Dependencies: (core) ------------------------------------------ Command: FIELD [#] device-number, number AS string-variable$ [, number AS string-variable$...] Description: FIELD allocates space in a random file buffer for device indicated by device-number, allocating 'number' bytes and assigning the bytes at this position to the variable string-variable$. Dependencies: COMMON_CMDS ------------------------------------------ Command: FILES filespec$ Description: FILES is a pseudocommand that invokes the directory program specified in the variable BWB.FILES$ with the argument filespec$. Normally, the user must set this variable before FILES can be used. E.g., for PC-type computers, BWB.FILES$ = "DIR" will work, for Unix machines, BWB.FILES$ = "ls -l" etc. Dependencies: COMMON_CMDS ------------------------------------------ Command: FNCS Description: CMDS is a debugging command that prints a list of all pre-defined bwBASIC functions. Dependencies: DEBUG ------------------------------------------ Command: FUNCTION Description: FUNCTION introduces a function definition, normally ending with END FUNCTION. In bwBASIC, FUNCTION and DEF are qorking equivalents, so either can be used with single-line function definitions or with multi- line definitions terminated by END FUNCTION. Dependencies: STRUCT_CMDS ------------------------------------------ Command: FOR counter = start TO finish [STEP increment] Description: FOR initiates a FOR-NEXT loop with the variable 'counter' initially set to 'start' and incrementing in 'increment' steps (default is 1) until 'counter' equals 'finish'. Dependencies: (core) ------------------------------------------ Command: GET [#] device-number [, record-number] Description: GET reads the next reacord from a random-access file or device into the buffer associated with that file. If record-number is specified, the GET command reads the specified record. Dependencies: COMMON_CMDS ------------------------------------------ Command: GOSUB line | label Description: GOSUB initiates a subroutine call to the line (or label) specified. The subroutine must end with RETURN. Dependencies: (core), but STRUCT_CMDS for labels ------------------------------------------ Command: GOTO line | label Description: GOTO branches program execution to the specified line (or label). Dependencies: (core), but STRUCT_CMDS for labels ------------------------------------------ Function: HEX$( number ) Description: HEX$ returns a string giving the hexadecimal (base 16) value for the 'number'. Dependencies: MS_FUNCS ------------------------------------------ Command: IF expression THEN [statement [ELSE statement]] Description: IF evaluates 'expression' and performs the THEN statement if it is true or (optionally) the ELSE statement if it is FALSE. If STRUCT_CMDS is set to TRUE, bwBASIC allows multi-line IF statements with ELSE and ELSEIF cases, ending with END IF. Dependencies: (core), STRUCT_CMDS for multi-line IF statements ------------------------------------------ Function: INKEY$ Description: INKEY$ reads the status of the keyboard, and a single keypress, if available. If a keypress is not available, then INKEY$ immediately returns a null string (""). Currently (v2.10) implemented in bwx_iqc.c only. Dependencies: IMP_IQC and IMP_CMDLOC ------------------------------------------ Command: INPUT [# device-number]|[;]["prompt string";]list of variables Description: INPUT allows input from the terminal or a device specified by device-number. If terminal, the "prompt string" is output, and input is assigned to the appropriate variables specified. bwBASIC does not support the optional feature of INPUT that suppresses the carriage-return and line-feed at the end of the input. This is because C alone does not provide for any means of input other than CR-LF-terminated strings. Dependencies: (core) ------------------------------------------ Function: INSTR( [start-position,] string-searched$, string-pattern$ ) Description: INSTR returns the position at which string-pattern$ occurs in string-searched$, beginning at start-position. As implemented in bwBASIC, INSTR cannot be used for assignments. Note: bwBASIC presently (v2.10) does not allow assignment to a function. Dependencies: MS_FUNCS ------------------------------------------ Function: INT( number ) Description: INT returns the largest integer less than or equal to the argument 'number'. NOTE that this is not a "truncated" integer function, for which see CINT. Dependencies: (core) ------------------------------------------ Command: KILL file-name$ Description: KILL deletes the file specified by file-name$. Dependencies: UNIX_CMDS ------------------------------------------ Function: LEFT$( string$, number-of-spaces ) Description: LEFT$ returns a substring a string$ with number-of-spaces from the left (beginning) of the string). As implemented under bwBASIC, it cannot be used for assignment. Dependencies: MS_FUNCS ------------------------------------------ Function: LEN( string$ ) Description: LEN returns the length in bytes of string$. Dependencies: COMMON_FUNCS ------------------------------------------ Command: LET variable = expression Description: LET assigns the value of 'expression' to the variable. As currently implemented, bwBASIC supports implied LET statements (e.g., "X = 4.5678" at the beginning of a line or line segment, but does not support assignment to multiple variables (e.g., "x, y, z = 3.141596"). Dependencies: (core) ------------------------------------------ Command: LINE INPUT [[#] device-number,]["prompt string";] string-variable$ Description: LINE INPUT reads entire line from the keyboard or a file or device into string-variable$. If input is from the keyboard (stdin), then "prompt string" will be printed first. Unlike INPUT, LINE INPUT reads a whole line, not stopping for comma-delimited data items. Dependencies: COMMON_CMDS ------------------------------------------ Command: LIST line[-line] Description: LIST lists program lines as specified in its argument. Dependencies: INTERACTIVE ------------------------------------------ Command: LOAD file-name Description: LOAD loads an ASCII BASIC program into memory. Dependencies: INTERACTIVE ------------------------------------------ Function: LOC( device-number ) Description: LOC returns the next record that GET or PUT statements will use. Dependencies: MS_FUNCS ------------------------------------------ Command: LOCATE line, column Description: LOCATE addresses trhe curor to a specified line and column. Currently (v2.10) implemented in bwx_iqc.c only. Dependencies: IMP_IQC and IMP_CMDLOC ------------------------------------------ Function: LOF( device-number ) Description: LOF returns the length of a file (specified by device-number) in bytes. Dependencies: MS_FUNCS ------------------------------------------ Function: LOG( number ) Description: LOG returns the natural logarithm of the argument 'number'. Dependencies: (core) ------------------------------------------ Command: LOOP [UNTIL expression] Description: LOOP terminates a program loop: see DO. Dependencies: STRUCT_CMDS ------------------------------------------ Command: LSET string-variable$ = expression Description: LSET transfers data from 'expression' to the left-hand side of a string variable or random access buffer field. Dependencies: COMMON_CMDS ------------------------------------------ Command: MERGE file-name Description: MERGE adds program lines from 'file-name' to the program in memory. Unlike LOAD, it does not clear the program currently in memory. Dependencies: COMMON_CMDS ------------------------------------------ Function: MID$( string$, start-position-in-string[, number-of-spaces ] ) Description: MID$ returns a substring of string$ beginning at start-position-in-string and continuing for number-of-spaces bytes. Dependencies: MS_FUNCS ------------------------------------------ Command: MKDIR pathname$ Description: MKDIR creates a new directory path as specified by pathname$. Dependencies: UNIX_CMDS ------------------------------------------ Function: MKD$( number ) Description: MKD$, MKI$, and MKS$ are all equivalent in bwBASIC. They convert the numerical value 'number' into a string which can be stored in a more compressed form in a file (especially for random file access). Since bwBASIC does not recognize differences in precision, these commands are effectively equivalent. Dependencies: MS_FUNCS ------------------------------------------ Function: MKI$( number ) Description: Equivalent to MKD$ (q.v.) Dependencies: MS_FUNCS ------------------------------------------ Function: MKS$( number ) Description: Equivalent to MKD$ (q.v.). Dependencies: MS_FUNCS ------------------------------------------ Command: NAME old-file-name AS new-file-name Description: NAME renames an existing file (old-file-name) as new-file-name. Dependencies: UNIX_CMDS ------------------------------------------ Command: NEW Description: NEW deletes the program in memory and clears all variables. Dependencies: INTERACTIVE ------------------------------------------ Command: NEXT [counter-variable] Description: NEXT comes at the end of a FOR-NEXT loop; see FOR. Dependencies: (core) ------------------------------------------ Function: OCT$( number ) Description: OCT$ returns a string giving the octal (base 8) representation of 'number'. Dependencies: MS_FUNCS ------------------------------------------ Command: ON variable GOTO|GOSUB line[,line,line,...] Description: ON either branches (GOTO) or calls a subroutine (GOSUB) based on the rounded value of variable; if it is 1, the first line is called, if 2, the second line is called, etc. Dependencies: (core) ------------------------------------------ Command: ON ERROR GOSUB line|label Description: ON ERROR sets up an error handling subroutine. See also ERROR. Dependencies: COMMON_CMDS, STRUCT_CMDS for labels ------------------------------------------ Command: OPEN "O"|"I"|"R", [#]device-number, file-name [,record length] file-name FOR INPUT|OUTPUT|APPEND AS [#]device-number [LEN = record-length] Description: OPEN allocates random access memory for access to a disk file or other device. Note that two quite different forms of the OPEN statement are supported. In the first form, "O" (note that these letters must be encased in quotation marks) denotes sequential output, "I" denotes sequential input, and "R" denotes random-access input and output. Once OPEN, any number of operations can be performed on a device (see WRITE #, INPUT #, PRINT #, etc.). Dependencies: COMMON_CMDS ------------------------------------------ Command: OPTION BASE number Description: OPTION BASE sets the lowest value for array subscripts, either 0 or 1. Dependencies: (core) ------------------------------------------ Function: POS Description: POS returns the current cursor position in the line. Dependencies: COMMON_FUNCS ------------------------------------------ Command: PRINT [# device-number,][USING format-string$;] expressions... Description: PRINT outputs text to the screen or to a file or device specified by device-number. In the current implementation of bwBASIC, expressions to be printed must be separated by the comma (tabbed output), the semicolon (immediate sequential output) or the plus sign (immediate sequential output by string concatenation). Expressions separated by blanks or tabs are not supported. If USING is specified, a number of formatting marks may appear in the format string: ! prints the first character of a string \\ prints 2+x characters of a string, where x = the number of spaces between the backslashes & variable-length string field # represents a single digit in output format for a number . decimal point in a number + sign of a number (will output + or -) - trailing minus after a number ** fill leading spaces with asterisks $$ output dollar sign in front of a number ^^ output number in exponential format _ output next character literally As currently implemented, the exponential format will be that used by the C compiler. Dependencies: (core), COMMON_FUNCS for USING ------------------------------------------ Command: PUT [#] device-number [, record-number] Description: PUT outputs the next available record or the record specified by record-number to the file or device denoted by device-number. Dependencies: COMMON_CMDS ------------------------------------------ Command: QUIT Description: QUIT is a synonym for SYSTEM; with INTERACTIVE environment, it exits the program to the operating system (or the calling program). Dependencies: INTERACTIVE ------------------------------------------ Command: RANDOMIZE number Description: RANDOMIZE seeds the random number generator (see RND). Under bwBASIC, the TIMER function (q.v.) can be used to supply a 'number' seed for the random number generator. Dependencies: (core) ------------------------------------------ Command: READ variable[, variable]... Description: READ reads values from DATA statements and assigns these values to the named variables. Variable types in a READ statement must match the data types in DATA statements as they are occurred. See also DATA and RESTORE. Dependencies: (core) ------------------------------------------ Command: REM string Description: REM allows remarks to be included in a program. As currently implemented, the entire line following REM is ignored by the interpreter (thus, even if MULTISEG_LINES is set, a REM line will not be able to find a segment delimiter (":") followed by another line segment with command. bwBASIC does not currently implement the Microsoft-style use of the single quotation mark to denote remarks. Dependencies: (core) ------------------------------------------ Command: RESTORE line Description: RESTORE resets the line and position counters for DATA and READ statements to the top of the program file or to the beginning of the specified line. (Currently this must be a line number.) Dependencies: (core) ------------------------------------------ Command: RETURN Description: RETURN concludes a subroutine called by GOSUB. Dependencies: (core) ------------------------------------------ Function: RIGHT$( string$, number-of-spaces ) Description: RIGHT$ returns a substring a string$ with number-of-spaces from the right (end) of the string). As implemented under bwBASIC, it cannot be used for assignment. Dependencies: MS_FUNCS ------------------------------------------ Command: RMDIR pathname Description: RMDIR deletes the directory path indicated by pathname. Dependencies: UNIX_CMDS ------------------------------------------ Function: RND( number ) Description: RND returns a pseudo-random number. The 'number' value is ignored by bwBASIC if supplied. The RANDOMIZE command (q.v.) reseeds the random-number generator. Dependencies: (core) ------------------------------------------ Command: RSET string-variable$ = expression Description: RSET transfers data from 'expression' to the right-hand side of a string variable or random access buffer field. Dependencies: COMMON_CMDS ------------------------------------------ Command: RUN [line][file-name$] Description: RUN executes the program in memory. If a file-name$ is supplied, then the specified file is loaded into memory and executed. If a line number is supplied, then execution begins at that line. Dependencies: INTERACTIVE ------------------------------------------ Command: SAVE file-name$ Description: SAVE saves the program in memory to file-name$. bwBASIC only saves files in ASCII format. Dependencies: INTERACTIVE ------------------------------------------ Command: SELECT CASE expression Description: SELECT CASE introduces a multi-line conditional selection statement. The expression given as the argument to SELECT CASE will be evaluated by CASE statements following. The SELECT CASE statement conclludes with an END SELECT statement. As currently implemented, CASE statements may be followed by string values, but in this case only simple comparisons (equals, not equals) can be performed. Dependencies: STRUCT_CMDS ------------------------------------------ Function: SGN( number ) Description: SGN returns the sign of the argument 'number', +1 for positive numbers, 0 for 0, and -1 for negative numbers. Dependencies: (core) ------------------------------------------ Function: SIN( number ) Description: SIN returns the sine of the argument 'number' in radians. Dependencies: (core) ------------------------------------------ Function: SPACE$( number ) Description: SPACE$ returns a string of blank spaces 'number' bytes long. Dependencies: MS_FUNCS ------------------------------------------ Function: SPC( number ) Description: SPC returns a string of blank spaces 'number' bytes long. Dependencies: MS_FUNCS ------------------------------------------ Function: SQR( number ) Description: SQR returns the square root of the argument 'number'. Dependencies: (core) ------------------------------------------ Command: STOP Description: STOP interrupts program execution. As implemented under bwBASIC, STOP issues a SIGINT signal. Dependencies: (core) ------------------------------------------ Function: STR$( number ) Description: STR$ returns a string giving the decimal (base 10) representation of the argument 'number'. Dependencies: COMMON_FUNCS ------------------------------------------ Function: STRING$( number, ascii-value|string$ ) Description: STRING$ returns a string 'number' bytes long consisting of either the first character of string$ or the character answering to the ASCII value ascii-value. Dependencies: MS_FUNCS ------------------------------------------ Command: SUB subroutine-name Description: SUB introduces a named, multi-line subroutine. The subroutine is called by a CALL statement, and concludes with an END SUB statement. Dependencies: STRUCT_CMDS ------------------------------------------ Command: SWAP variable, variable Description: SWAP swaps the values of two variables. The two variables must be of the same type (either numerical or string). Dependencies: COMMON_CMDS ------------------------------------------ Command: SYSTEM Description: SYSTEM exits from bwBASIC to the calling program or (more usually) the operating system. Dependencies: INTERACTIVE ------------------------------------------ Function: TAB( number ) Description: TAB outputs spaces until the column indicated by 'number' has been reached. Dependencies: (core) ------------------------------------------ Function: TAN( number ) Description: TAN returns the tangent of the argument 'number' in radians. Dependencies: (core) ------------------------------------------ Function: TIME$ Description: TIME$ returns the current time based on the computer's internal clock as a string in the form "HH-MM-SS". As implemented under bwBASIC, TIME$ cannot be used for assignment (i.e., to set the system time). Note: bwBASIC presently (v2.10) does not allow assignment to a function. Dependencies: COMMON_FUNCS ------------------------------------------ Function: TIMER Description: TIMER returns the time in the system clock in seconds elapsed since midnight. Dependencies: MS_FUNCS ------------------------------------------ Command: TROFF Description: TROFF turns of the trace facility; see TRON. Dependencies: COMMON_CMDS ------------------------------------------ Command: TRON Description: TRON turns on the trace facility. This facility will print each line number in square brackets as the program is executed. This is useful in debugging programs with line numbers. To debug an unnumbered program with TRON, call DO NUM first, but remember to call DO UNNUM before you save the program later. Dependencies: COMMON_CMDS ------------------------------------------ Function: VAL( string$ ) Description: VAL returns the numerical value of the string$. Dependencies: COMMON_FUNCS ------------------------------------------ Command: VARS Description: VARS is a debugging command which prints a list of all variables defined which have global scope. Dependencies: DEBUG ------------------------------------------ Command: WEND Description: WEND concludes a WHILE-WEND loop; see WHILE. Dependencies: COMMON_CMDS ------------------------------------------ Command: WHILE expression Description: WHILE initiates a WHILE-WEND loop. The loop ends with WEND, and execution reiterates through the loop as long as the 'expression' is TRUE (-1). Dependencies: COMMON_CMDS ------------------------------------------ Command: WIDTH [# device-number,] number Description: WIDTH sets screen or device output to 'number' columns. device-number specifies the device or file for oputput. Dependencies: COMMON_CMDS ------------------------------------------ Command: WRITE [# device-number,] element [, element ].... Description: WRITE outputs variables to the screen or to a file or device specified by device-number. Commas are inserted between expressions output, and strings are enclosed in quotation marks. Dependencies: COMMON_CMDS ------------------------------------------ 6. PREDEFINED VARIABLES BWB.EDITOR$ BWB.FILES$ BWB.PROMPT$ BWB.IMPLEMENTATION$ The commands EDIT and FILES are pseudo-commands that launch shell programs named in the variables BWB.EDITOR$ and BWB.FILES$, respectively. The default values for these variables can be changed in bwbasic.h (DEF_EDITOR and DEF_FILES), or they can be changed on the fly by the user. An idea might be to initialize these variables in "profile.bas" for specific implementations; for instance, BWB.FILES$ might be defined as "ls -l" on Unix systems or "dir" on DOS systems. The preset variable BWB.PROMPT$ can be used to set the prompt string for bwBASIC. Again, it is suggested that a user- selected promptcan be set up in a "profile.bas" to be initialized each time bwBASIC starts. Note that special characters can be added to the prompt string, e.g., BWB.PROMPT$ = "Ok"+CHR$(10) will give an "Ok" prompt followed by a linefeed. The preset variable BWB.IMPLEMENTATION$ will return "TTY" for the bwx_tty implementation and will return "IQC" for the IBM PC or Compatibles with QuickC (bwx_iqc) implementation. This may be useful in determing which commands and functions (specifically CLS, LOCATE, and INKEY$) may be available. 7. UNIMPLEMENTED COMMANDS AND FUNCTIONS, and AGENDA FOR DEVELOPMENT There are some items not implemented that have been so long a part of standard BASICs that their absence will seem surprising. In each case, though, their implementation would require opera- ting-system-specific functions or terminal-specific functions that cannot be universally provided. Some specific examples: CLOAD Relies on CP/M or MSDOS conventions for binary executable files. CONT See RESUME below (programmer ignorance?). DEF USR Relies on CP/M or MSDOS conventions for binary executable files. FRE() The ability to report the amount of free memory remaining is system-specific due to varying patterns of memory allocation and access; consequently this ability is not present in ANSI or earlier versions of C and this function is not available in bwBASIC. INPUT$() C by itself is not able to read unechoed keyboard input, and can read keyboard input only after a Carriage-Return has been entered. INP Calls to hardware ports, like machine-language routines, are highly system-specific and cannot be implemented in C alone. LLIST See LPRINT below. LPOS See LPRINT below. LPRINT and LLIST, etc., require access to a printer device, and this varies from one system to another. Users might try OPENing the printer device on their own operating system (e.g., "/dev/lp" on Unix systems, or "PRN" under DOS) and see if printing can be done from bwBASIC in this way. NULL In this case, I am convinced that NULL is no longer necessary, since very few printers now require NULLs at the end of lines. OUT See INP above (calls to hardware ports). PEEK() PEEK and POKE enabled earlier BASICs to address particular memory locations. Although bwBASIC could possibly implement this command (POKE) and this function (PEEK()), the limitation would be highly limited by the different systems for memory access in different systems. POKE see PEEK() above. RENUM Since unnumbered lines can be entered and executed under bwBASIC, it would not be possible to implement a RENUM routine. Instead, bwBASIC uses DO NUM and DO UNNUM. RESUME Is this possible under C? If so, I simply have failed to figure it out yet. Mea culpa (but not maxima). USR See CALL and DEF USR above (machine language subroutines). VARPTR See PEEK and POKE above. WAIT See INP and OUT above. There are other commands, functions, and implementation details that I am working on, and which are on the agenda list for future versions of bwBASIC. These agenda include: PARACT i.e., the ability to execute PARallel ACTions. This is described in ANSI BASIC, although I have not seen it implemented before. It will offer a rough, non- preemptive form of multitasking within the scope of a BASIC program. Programmers will note points at which there are already hooks for PARACT in bwBASIC. XMEM PC-type computers need to be able to use extended memory. If we could use extended memory for program lines, variables, and function defitions, we could write much longer programs. This would entail, however, a fairly serious rewriting of the program to utilize memory handles for these storage features instead of direct memory pointers. Windows The addition of memory handles in addition to the non-preemptive execution of program lines (in a crude form, already present) will make it possible to develop implementations for Windows and perhaps for other graphical user interfaces. But what form should this take? I have in mind presently a BASIC that would run in the background, appearing only as an icon in the GUI space, with pop-up editors and output windows. Thus, the interpreted language would serve a purpose something like 'cron' (a task scheduler) under Unix systems. You may have some reflections that would help me in this. Graphics Here we face fairly critical differences in different styles and implementations of graphics, e.g., between GWBASIC, ANSI BASIC, VisualBASIC, etc. But it's possible that Graphics commands and functions could be added. These would all be implementation-specific. The ANSI Standard for full BASIC does not specify which particular commands or functions must be implemented, and in fact the standard is very robust. Perhaps no implementation of BASIC would ever include all of the items, but some ANSI commands and functions which remain unimplemented are: ACCESS ANGLE AREA ARITHMETIC ARRAY ASK BSTR BVAL CEIL CELLS CLIP COLLATE CONNECT COSH DATUM DEBUG DECIMAL DECLARE DEGREES DEVICE DISCONNECT DISPLAY DOT DRAW ERASE EVENT EXCEPTION GRAPH HANDLER IMAGE KEY LCASE LINES LOG10 LOG2 MAT MIX MULTIPOINT OUTIN OUTPUT PARACT PICTURE PIXEL PLOT POINTS RADIANS RECEIVE RENUMBER REWRITE ROTATE ROUND SEIZE SEND SHIFT SINH TANH TIMEOUT TRACE TRANSFORM TRUNCATE UBOUND UCASE VIEWPORT WAIT VIEWPORT ZONEWIDTH 8. THE STORY OF BYWATER BASIC This program was originally begun in 1982 by my grandmother, Mrs. Verda Spell of Beaumont, TX. She was writing the program using an ANSI C compiler on an Osborne I CP/M computer and although my grandfather (Lockwood Spell) had bought an IBM PC with 256k of RAM my grandmother would not use it, paraphrasing George Herbert to the effect that "He who cannot in 64k program, cannot in 512k." She had used Microsoft BASIC and although she had nothing against it she said repeatedly that she didn't understand why Digital Research didn't "sue the socks off of Microsoft" for version 1.0 of MSDOS and so I reckon that she hoped to undercut Microsoft's entire market and eventually build a new software empire on the North End of Beaumont. Her programming efforts were cut tragically short when she was thrown from a Beaumont to Port Arthur commuter train in the summer of 1986. I found the source code to bwBASIC on a single-density Osborne diskette in her knitting bag and eventually managed to have it all copied over to a PC diskette. I have revised it slightly prior to this release. You should know, though, that I myself am an historian, not a programmer. 9. COMMUNICATIONS: email: tcamp@delphi.com bwbasic-2.20pl2.orig/bwbasic.h100644 0 0 156571 6473161701 14352 0ustar rootroot/*************************************************************** bwbasic.h Header File 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). */ /*---------------------------------------------------------------*/ #ifndef TRUE #define TRUE -1 #define FALSE 0 #endif /*************************************************************** bwbasic.h Part I: Definitions ***************************************************************/ /* Version number */ #define VERSION "2.20 patch level 2" /* Current version number */ /*************************************************************** bwbasic.h: Part I-A: Define Major Hardware Implementation Gone is the simplicity of earlier versions. You must specify one and only one of the following hardware implementations as TRUE. IMP_TTY is the default implementation. It is the most minimal, but the most universal hardware implementation. If you pick IMP_TTY then check the settings in bwx_tty.h for your system. ***************************************************************/ #define IMP_TTY TRUE /* simple TTY-style interface using stdio */ #define IMP_IQC FALSE /* IBM PC, Microsoft QuickC Compiler */ #define IMP_NCU FALSE /* Linux, ncurses */ #define ALLOW_RENUM TRUE /* Added by JBV */ #if IMP_TTY #include "bwx_tty.h" #endif #if IMP_IQC #include "bwx_iqc.h" #endif #if IMP_NCU #include "bwx_ncu.h" #endif /*************************************************************** bwbasic.h: Part I-B: Define Compiler Implementation You also need to give some information about your C compiler. If your compiler is ANSI- compatible, don't worry about these. But if your compiler is "stock," you might want to indicate which of the following sets of features it has or dosn't have. ***************************************************************/ #ifdef MSDOS #define HAVE_RAISE TRUE #define HAVE_STRING TRUE #define HAVE_STDLIB TRUE #endif #ifdef __STDC__ #define HAVE_SIGNAL TRUE #else #define HAVE_SIGNAL TRUE /* Compiler supports signal() */ #endif #ifdef __STDC__ #define HAVE_LONGJUMP TRUE #else #define HAVE_LONGJUMP TRUE /* Compiler supports setjmp() and longjmp() */ #endif /* configure sets this */ #ifndef HAVE_RAISE #define HAVE_RAISE FALSE /* Compiler supports raise() */ #endif /* configure sets this */ #ifndef HAVE_STRING #define HAVE_STRING FALSE /* Compiler has header */ #endif /* configure sets this */ #ifndef HAVE_STDLIB #define HAVE_STDLIB FALSE /* Compiler has header */ #endif /* configure sets this (section added by JBV) */ #ifndef HAVE_UNISTD #define HAVE_UNISTD FALSE /* Compiler has header */ #endif #ifdef __STDC__ #define HAVE_SYSTYPES TRUE #else #define HAVE_SYSTYPES TRUE /* Compiler has header */ #endif #ifdef __STDC__ #define HAVE_SYSSTAT TRUE #else #define HAVE_SYSSTAT TRUE /* Compiler has header */ #endif /*************************************************************** bwbasic.h: Part I-C: Define Program Configuration You must specify one and only one of the following progrm configurations as TRUE. If you specify CFG_CUSTOM, then you will need to fill out the custom section below. ***************************************************************/ #define CFG_ANSIMINIMAL FALSE /* Conforms to ANSI Minimal BASIC standard X3.60-1978 */ #define CFG_COMMON FALSE /* Small implementation with commands and functions common to GWBASIC (tm) and ANSI full BASIC */ #define CFG_MSTYPE FALSE /* Configuration similar to Microsoft line-oriented BASICs */ #define CFG_ANSIFULL FALSE /* Conforms to ANSI Full BASIC standard X3.113-1987 */ #define CFG_CUSTOM TRUE /* Custom Configuration specified below */ /*************************************************************** bwbasic.h: Part I-D: Define Custom Program Configuration If you specified CFG_CUSTOM above, then you will need to fill out this section. ***************************************************************/ #if CFG_CUSTOM #define COMMAND_SHELL TRUE /* allow command shell processing */ #define PROFILE TRUE /* interpret profile at beginning */ #define NUMBER_DOUBLE TRUE /* define BASIC number as double: default is float*/ #define MULTISEG_LINES TRUE /* allow multi-segment lines delimited by ':' */ #define PARACT FALSE /* Implement PARallen ACTion (Multi-tasking) interpreter */ #define INTERACTIVE TRUE /* interactive programming environment and related commands */ #define COMMON_CMDS TRUE /* commands common to ANSI full BASIC and GWBASIC */ #if UNIX_CMDS #define UNIX_CMDS TRUE /* implement Unix-style directory commands */ #endif #define STRUCT_CMDS TRUE /* commands for structured programming required by full ANSI BASIC */ #define MS_CMDS TRUE /* commands specific to Microsoft GWBASIC (tm) */ #define MS_FUNCS TRUE /* Microsoft-specific functions and commands */ #define COMMON_FUNCS TRUE /* functions common to GWBASIC and ANSI full BASIC */ #define ANSI_FUNCS TRUE /* functions required by ANSI full BASIC */ #endif /* end of CFG_CUSTOM */ /*************************************************************** bwbasic.h: Part I-E: Define Natural Language for Messages One and only one of the following must be defined as TRUE. Note that the language definitions themselves are in file bwb_mes.h. If none is specified, then ENGLISH will be taken as the default. ***************************************************************/ #define STD_ENGLISH TRUE /* standard English */ #define POL_ENGLISH FALSE /* polite English messages */ #define IMP_ENGLISH FALSE /* impolite English messages */ #define LATIN FALSE /* Latin language messages */ #define STD_RUSSIAN FALSE /* Russian language messages */ #define STD_GERMAN FALSE /* German language messages */ #define ESPERANTO FALSE /* Esperanto messages */ /*************************************************************** bwbasic.h: Part I-F: Define Debugging Options You can specify debugging options here. Defining DEBUG true provides some useful commands: CMDS, VARS, FNCS ***************************************************************/ #define DEBUG FALSE /* current debugging */ #define PROG_ERRORS TRUE /* identify serious programming errors */ /* and print extensive error messages */ /* This will override messages defined in */ /* bwb_mes.h, and almost all messages will be in English */ #define CHECK_RECURSION FALSE /* check for recursion violation in expression parser */ #define INTENSIVE_DEBUG FALSE /* old debugging; might be useful later */ #define REDIRECT_STDERR FALSE /* Redirect stderr to file ERRFILE */ #define TEST_BSTRING FALSE /* test bstring integrity */ #ifdef __STDC__ #define ANSI_C TRUE /* FALSE to test and debug non-ANSI-C version with ANSI C compiler (watch out) */ #endif /*************************************************************** bwbasic.h: This ends the section of definitions that users of bwBASIC will normally need to specify. The following are internally defined. Note that you may need to set up the default FILES command and the default editor below. See Part I-G ***************************************************************/ #if CFG_ANSIMINIMAL #define COMMAND_SHELL FALSE /* allow command shell processing */ #define PROFILE FALSE /* interpret profile at beginning */ #define NUMBER_DOUBLE FALSE /* define BASIC number as double: default is float*/ #define MULTISEG_LINES FALSE /* allow multi-segment lines delimited by ':' */ #define PARACT FALSE /* Implement PARallen ACTion (Multi-tasking) interpreter */ #define INTERACTIVE TRUE /* interactive programming environment and related commands */ #define COMMON_CMDS FALSE /* commands common to ANSI full BASIC and GWBASIC */ #if UNIX_CMDS #define UNIX_CMDS FALSE /* implement Unix-style directory commands */ #endif #define STRUCT_CMDS FALSE /* commands for structured programming required by full ANSI BASIC */ #define MS_CMDS FALSE /* commands specific to Microsoft GWBASIC (tm) */ #define MS_FUNCS FALSE /* Microsoft-specific functions and commands */ #define COMMON_FUNCS FALSE /* functions common to GWBASIC and ANSI full BASIC */ #define ANSI_FUNCS FALSE /* functions required by ANSI full BASIC */ #endif /* end of CFG_ANSIMINIMAL */ #if CFG_COMMON #define COMMAND_SHELL FALSE /* allow command shell processing */ #define PROFILE FALSE /* interpret profile at beginning */ #define NUMBER_DOUBLE FALSE /* define BASIC number as double: default is float*/ #define MULTISEG_LINES FALSE /* allow multi-segment lines delimited by ':' */ #define PARACT FALSE /* Implement PARallen ACTion (Multi-tasking) interpreter */ #define INTERACTIVE TRUE /* interactive programming environment and related commands */ #define COMMON_CMDS TRUE /* commands common to ANSI full BASIC and GWBASIC */ #if UNIX_CMDS #define UNIX_CMDS FALSE /* implement Unix-style directory commands */ #endif #define STRUCT_CMDS FALSE /* commands for structured programming required by full ANSI BASIC */ #define MS_CMDS FALSE /* commands specific to Microsoft GWBASIC (tm) */ #define MS_FUNCS FALSE /* Microsoft-specific functions and commands */ #define COMMON_FUNCS TRUE /* functions common to GWBASIC and ANSI full BASIC */ #define ANSI_FUNCS FALSE /* functions required by ANSI full BASIC */ #endif /* end of CFG_COMMON */ #if CFG_ANSIFULL #define COMMAND_SHELL TRUE /* allow command shell processing */ #define PROFILE TRUE /* interpret profile at beginning */ #define NUMBER_DOUBLE FALSE /* define BASIC number as double: default is float*/ #define MULTISEG_LINES FALSE /* allow multi-segment lines delimited by ':' */ #define PARACT TRUE /* Implement PARallen ACTion (Multi-tasking) interpreter */ #define INTERACTIVE TRUE /* interactive programming environment and related commands */ #define COMMON_CMDS TRUE /* commands common to ANSI full BASIC and GWBASIC */ #if UNIX_CMDS #define UNIX_CMDS FALSE /* implement Unix-style directory commands */ #endif #define STRUCT_CMDS TRUE /* commands for structured programming required by full ANSI BASIC */ #define MS_CMDS FALSE /* commands specific to Microsoft GWBASIC (tm) */ #define MS_FUNCS FALSE /* Microsoft-specific functions and commands */ #define COMMON_FUNCS TRUE /* functions common to GWBASIC and ANSI full BASIC */ #define ANSI_FUNCS TRUE /* functions required by ANSI full BASIC */ #endif /* end of CFG_ANSIFULL */ #if CFG_MSTYPE #define COMMAND_SHELL FALSE /* allow command shell processing */ #define PROFILE FALSE /* interpret profile at beginning */ #define NUMBER_DOUBLE FALSE /* define BASIC number as double: default is float*/ #define MULTISEG_LINES TRUE /* allow multi-segment lines delimited by ':' */ #define PARACT FALSE /* Implement PARallen ACTion (Multi-tasking) interpreter */ #define INTERACTIVE TRUE /* interactive programming environment and related commands */ #define COMMON_CMDS TRUE /* commands common to ANSI full BASIC and GWBASIC */ #define STRUCT_CMDS FALSE /* commands for structured programming required by full ANSI BASIC */ #define MS_CMDS TRUE /* commands specific to Microsoft GWBASIC (tm) */ #define MS_FUNCS TRUE /* Microsoft-specific functions and commands */ #define COMMON_FUNCS TRUE /* functions common to GWBASIC and ANSI full BASIC */ #define ANSI_FUNCS FALSE /* functions required by ANSI full BASIC */ #endif /* end of CFG_MSTYPE */ /* inclusions and definitions necessary if C compiler is not ANSI compliant */ #if HAVE_STRING #include #else #include #endif #if HAVE_STDLIB #include #endif /* Section added by JBV */ #if HAVE_UNISTD #include #endif #if HAVE_SYSTYPES #include #endif #if HAVE_STDLIB /* if neither ANSI */ #else #if HAVE_SYSTYPES /* nor SYSTYPES */ #else #define size_t unsigned int /* then define these */ #define time_t long #endif #endif /* define number of commands */ #define CMDS_CORE 22 /* number of core commands defined */ #if UNIX_CMDS #define CMDS_DIR 5 #else #define CMDS_DIR 0 #endif #if COMMON_CMDS #define CMDS_COMMON 25 /* Was 24 (JBV) */ #else #define CMDS_COMMON 0 #endif #if STRUCT_CMDS #define CMDS_STC 10 #else #define CMDS_STC 0 #endif #if INTERACTIVE #define CMDS_INT 8 #else #define CMDS_INT 0 #endif #if MS_CMDS #define CMDS_MS 5+IMP_CMDCLS+IMP_CMDLOC+IMP_CMDCOLOR #else #define CMDS_MS 0 #endif #if DEBUG #define CMDS_DEBUG 3 /* number of debugging cmds */ #else #define CMDS_DEBUG 0 /* no debugging cmds */ #endif #define COMMANDS (CMDS_CORE+CMDS_DEBUG+CMDS_DIR+CMDS_COMMON+CMDS_INT+CMDS_MS+CMDS_STC) /* define number of functions */ #define FUNCS_BASE 12 /* number of basic functions */ #ifdef INTENSIVE_DEBUG #define FUNCS_DEBUG 1 /* number of debugging functions */ #else #define FUNCS_DEBUG 0 /* number of debugging functions */ #endif #if MS_FUNCS #define FUNCS_MS (25+IMP_FNCINKEY) #else #define FUNCS_MS 0 #endif #if COMMON_FUNCS #define FUNCS_COMMON 7 #else #define FUNCS_COMMON 0 #endif #if ANSI_FUNCS #define FUNCS_ANSI 0 #else #define FUNCS_ANSI 0 #endif #define FUNCTIONS (FUNCS_BASE+FUNCS_DEBUG+FUNCS_MS+FUNCS_COMMON+FUNCS_ANSI) /* Check for inconsistencies */ #if MULTISEG_LINES & STRUCT_CMDS /* ERROR: MULTISEG_LINES and STRUCT_CMDS cannot be defined together! */ #endif /*************************************************************** bwbasic.h: Part I-G: Define User Defaults Defining your default editor and files commands is a good idea. You must supply the file name for the editor to use. These defaults can be changed from inside the program or in your profile program by setting the appropriate variables shown below. ***************************************************************/ #define DEF_EDITOR "vi" /* default editor */ #define DEF_FILES "ls -Fx" /* default "files" command */ #define DEF_COLORS 256 /* default # of colors */ #define DEFVNAME_EDITOR "BWB.EDITOR$" /* default variable name for EDITOR */ #define DEFVNAME_PROMPT "BWB.PROMPT$" /* default variable name for PROMPT */ #define DEFVNAME_FILES "BWB.FILES$" /* default variable name for FILES */ #define DEFVNAME_COLORS "BWB.COLORS" /* default variable name for COLORS */ #define DEFVNAME_IMPL "BWB.IMPLEMENTATION$" /* default variable name for IMPLEMENTATION */ #define ERRFILE "err.out" /* Filename for redirected error messages */ #define PROFILENAME "profile.bas" /* Filename for profile execution */ #define TASKS 4 /* number of tasks available */ #define MAXARGSIZE 128 /* maximum size of argument */ #define MAXREADLINESIZE 256 /* size of read_line buffer */ #define MAXCMDNAMESIZE 64 /* maximum size for command name */ #define MAXLINENO 32766 /* maximum line number */ #define MAXVARNAMESIZE 40 /* maximum size for variable name */ #define MAXFILENAMESIZE 40 /* maximum size for file name */ #if 0 /* JBV 9/4/97 */ #define MAXSTRINGSIZE 255 /* maximum string length */ #endif #define MAXSTRINGSIZE 5000 /* maximum string length */ #define EXECLEVELS 64 /* EXEC stack levels */ #define MAX_GOLINES 12 /* Maximum # of lines for ON...GOTO statements */ #define MAX_FARGS 6 /* maximum # arguments to function */ #define MAX_DIMS 64 /* maximum # of dimensions */ #define ESTACKSIZE 64 /* elements in expression stack */ #define XTXTSTACKSIZE 16 /* elements in eXecute TeXT stack */ #define N_OPERATORS 25 /* number of operators defined */ #define N_ERRORS 25 /* number of errors defined */ #define MAX_PRECEDENCE 20 /* highest (last) level of precedence */ #if 0 /* JBV 9/96 */ #define MININTSIZE -32767 /* minimum integer size */ #define MAXINTSIZE 32767 /* maximum integer size */ #endif #define MININTSIZE -2147483647 /* minimum integer size */ #define MAXINTSIZE 2147483647 /* maximum integer size */ #define DEF_SUBSCRIPT 11 /* default subscript */ #define DEF_DEVICES 16 /* default number of devices available */ #define DEF_WIDTH 128 /* default width for devices */ #define PRN_TAB 0x02 /* send TAB followed by col number to output device */ #define COMPRESS_FUNCS TRUE /* Derivative definitions */ #if MULTISEG_LINES #define MARK_LINES FALSE #else #define MARK_LINES TRUE #endif #if PARACT #define CURTASK bwb_tasks[ bwb_curtask ]-> #define LOCALTASK bwb_tasks[ task ]-> #else #define CURTASK #define LOCALTASK #endif #if DEBUG #define PERMANENT_DEBUG TRUE #else #define PERMANENT_DEBUG FALSE #endif #if HAVE_STDLIB #else extern char *calloc(); #ifndef NULL #define NULL 0L #endif #endif /* typedef for BASIC number */ #if NUMBER_DOUBLE typedef double bnumber; #else typedef float bnumber; #endif /* define variable types based on last character */ #define STRING '$' /* define mathematical operations */ #define MULTIPLY '*' #define DIVIDE '/' #define ADD '+' #define SUBTRACT '-' #define ARGUMENT 'A' /* Operations defined */ #define OP_ERROR -255 /* operation error (break out) */ #define OP_NULL 0 /* null: operation not defined yet */ #define NUMBER 1 /* number held as internal variable in uvar */ #define CONST_STRING 2 /* string constant */ #define CONST_NUMERICAL 3 /* numerical constant */ #define FUNCTION 4 /* function header */ #define VARIABLE 5 /* external variable pointed to by xvar */ #define PARENTHESIS 6 /* begin parenthetical expression */ #define OP_ADD 7 /* addition sign '+' */ #define OP_SUBTRACT 8 /* subtraction sign '-' */ #define OP_MULTIPLY 9 /* multiplication sign '*' */ #define OP_DIVIDE 10 /* division sign '/' */ #define OP_MODULUS 11 /* modulus "MOD" */ #define OP_EXPONENT 12 /* exponentiation '^' */ #define OP_INTDIVISION 13 /* integer division sign '\' */ #define OP_NEGATION 14 /* negation '-' ??? */ #define OP_STRJOIN 15 /* string join ';' */ #define OP_STRTAB 16 /* string tab ',' */ #define OP_EQUALS 17 /* either logical equal operator */ #define OP_ASSIGN 18 /* assignment operator */ #define OP_NOTEQUAL 20 /* inequality */ #define OP_LESSTHAN 21 /* less than */ #define OP_GREATERTHAN 22 /* greater than */ #define OP_LTEQ 23 /* less than or equal to */ #define OP_GTEQ 24 /* greater than or equal to */ #define OP_NOT 25 /* negation */ #define OP_AND 26 /* conjunction */ #define OP_OR 27 /* disjunction */ #define OP_XOR 28 /* exclusive or */ #define OP_IMPLIES 29 /* implication */ #define OP_EQUIV 30 /* equivalence */ #define OP_TERMINATE 31 /* terminate expression parsing */ #define OP_USERFNC 32 /* user-defined function */ /* Device input/output modes */ #define DEVMODE_AVAILABLE -1 #define DEVMODE_CLOSED 0 #define DEVMODE_OUTPUT 1 #define DEVMODE_INPUT 2 #define DEVMODE_APPEND 3 #define DEVMODE_RANDOM 4 /* codes for EXEC stack and for function-sub-label lookup table */ #define EXEC_NORM 0 #define EXEC_GOSUB 1 #define EXEC_WHILE 2 #define EXEC_FOR 3 #define EXEC_FUNCTION 4 #define EXEC_CALLSUB 5 #define EXEC_IFTRUE 6 #define EXEC_IFFALSE 7 #define EXEC_MAIN 8 #define EXEC_SELTRUE 9 #define EXEC_SELFALSE 10 #define EXEC_LABEL 11 #define EXEC_DO 12 #define EXEC_ON 13 /*************************************************************** bwbasic.h Part II: Structures ***************************************************************/ /* Typdef structure for strings under Bywater BASIC */ typedef struct bstr { /* unsigned int was unsigned char (JBV 9/4/97) */ unsigned int length; /* length of string */ char *sbuffer; /* pointer to string buffer */ int rab; /* is it a random-access buffer? */ #if TEST_BSTRING char name[ MAXVARNAMESIZE + 1 ]; /* name for test purposes */ #endif } bstring; /* Structure used for all variables under Bywater BASIC */ struct bwb_variable { char name[ MAXVARNAMESIZE + 1 ]; /* name */ int type; /* type, i.e., STRING or NUMBER */ #if OLDWAY void *array; /* pointer to array memory */ #endif bnumber *memnum; /* memory for number */ bstring *memstr; /* memory for string */ size_t array_units; /* total number of units of memory */ int *array_sizes; /* pointer to array of integers, with sizes of each dimension */ int *array_pos; /* current position in array */ int dimensions; /* number of dimensions, 0 = not an array */ struct bwb_variable *next; /* next variable in chain */ int common; /* should this variable be common to chained programs? */ int preset; /* preset variable: CLEAR should not alter */ }; /* Structure to represent program lines under Bywater BASIC */ struct bwb_line { struct bwb_line *next; /* pointer to next line in chain */ int number; /* line number */ char xnum; /* is there actually a line number? */ char *buffer; /* buffer to hold the line */ int position; /* current position in line */ int lnpos; /* line number position in buffer */ int lnum; /* line number read from buffer */ int cmdpos; /* command position in buffer */ int cmdnum; /* number of command in command table read from buffer */ int startpos; /* start of rest of line read from buffer */ int marked; /* has line been checked yet? */ }; /* Structure used for all predefined functions under Bywater BASIC */ struct bwb_function { char name[ MAXVARNAMESIZE + 1 ]; /* name */ int type; /* type, i.e., STRING or NUMBER */ int arguments; /* number of args passed */ #if ANSI_C struct bwb_variable * (*vector) ( int argc, struct bwb_variable *argv, int unique_id ); /* vector to function to call */ #else struct bwb_variable * (*vector) (); /* vector to function to call */ #endif struct bwb_function *next; /* next function in chain */ int id; /* id to identify multiple functions */ }; /* Structure to represent all command statements under Bywater BASIC */ struct bwb_command { char name[ MAXCMDNAMESIZE + 1 ]; #if ANSI_C struct bwb_line * (*vector) (struct bwb_line *); #else struct bwb_line * (*vector) (); #endif }; /* Structure to define device stack for Bywater BASIC */ struct dev_element { int mode; /* DEVMODE_ item */ int width; /* width for output control */ int col; /* current column */ int reclen; /* record length for random access */ int next_record; /* next record to read/write */ int loc; /* location in file */ int lof; /* length of file in bytes (JBV) */ char filename[ MAXFILENAMESIZE + 1 ];/* filename */ FILE *cfp; /* C file pointer for this device */ char *buffer; /* pointer to character buffer for random access */ }; /* Structure to define expression stack elements under Bywater BASIC */ struct exp_ese { int operation; /* operation at this level */ char type; /* type of operation at this level: STRING or NUMBER */ bstring sval; /* string */ bnumber nval; /* number */ char string[ MAXSTRINGSIZE + 1 ]; /* string for writing */ struct bwb_variable *xvar; /* pointer to external variable */ struct bwb_function *function; /* pointer to function structure */ int array_pos[ MAX_DIMS ]; /* array for variable positions */ int pos_adv; /* position advanced in string */ int rec_pos; /* position marker for recursive calls */ }; /* structure for FUNCTION-SUB loopup table element */ struct fslte { char *name; struct bwb_line *line; int code; int startpos; /* starting position in line */ struct fslte *next; struct bwb_variable *local_variable; }; /* Structure to define EXEC stack elements */ struct exse { struct bwb_line *line; /* line for execution */ int code; /* code to note special operations */ int position; /* position in line for restore */ struct bwb_variable *local_variable; /* local variable chain and current FOR counter */ struct bwb_variable *calling_variable[ MAX_FARGS ]; int n_cvs; /* number of calling variables */ int for_step; /* STEP value for FOR */ int for_target; /* target value for FOR */ struct bwb_line *while_line; /* return line for current WHILE */ struct bwb_line *wend_line; /* breakout line for current WHILE (or FOR-NEXT) */ struct exp_ese expression; /* expression for evaluation by SELECT CASE */ #if MULTISEG_LINES struct bwb_line *for_line; /* top line for FOR-NEXT loop, multisegmented */ int for_position; /* position in top line for FOR-NEXT loop, multisegmented */ #endif }; struct xtxtsl { int position; struct bwb_line l; }; /* Structure to define bwBASIC task: UNDER CONSTRUCTION */ #if PARACT struct bwb_task { char progfile[ MAXARGSIZE ]; /* program file */ int rescan; /* program needs to be rescanned */ int number; /* current line number */ struct bwb_line *bwb_l; /* current line pointer */ struct bwb_line bwb_start; /* starting line marker */ struct bwb_line bwb_end; /* ending line marker */ struct bwb_line *data_line; /* current line to read data */ int data_pos; /* position in data_line */ struct bwb_variable var_start; /* variable list start marker */ struct bwb_variable var_end; /* variable list end marker */ struct bwb_function fnc_start; /* function list start marker */ struct bwb_function fnc_end; /* function list end marker */ struct fslte fslt_start; /* function-sub-label lookup table start marker */ struct fslte fslt_end; /* function-sub-label lookup table end marker */ int exsc; /* EXEC stack counter */ int expsc; /* expression stack counter */ int xtxtsc; /* eXecute TeXT stack counter */ struct exse excs[ EXECLEVELS ]; /* EXEC stack */ struct exp_ese exps[ ESTACKSIZE ]; /* Expression stack */ struct xtxtsl xtxts[ XTXTSTACKSIZE ];/* Execute Text stack */ }; extern struct bwb_task *bwb_tasks[ TASKS ]; /* table of task pointers */ #else /* not multi-tasking */ extern char progfile[ MAXARGSIZE ]; /* program file */ extern int rescan; /* program needs to be rescanned */ extern int number; /* current line number */ extern struct bwb_line *bwb_l; /* current line pointer */ extern struct bwb_line bwb_start; /* starting line marker */ extern struct bwb_line bwb_end; /* ending line marker */ extern struct bwb_line *data_line; /* current line to read data */ extern int data_pos; /* position in data_line */ extern struct bwb_variable var_start; /* variable list start marker */ extern struct bwb_variable var_end; /* variable list end marker */ extern struct bwb_function fnc_start; /* function list start marker */ extern struct bwb_function fnc_end; /* function list end marker */ extern struct fslte fslt_start; /* function-sub-label lookup table start marker */ extern struct fslte fslt_end; /* function-sub-label lookup table end marker */ extern int exsc; /* EXEC stack counter */ extern int expsc; /* expression stack counter */ extern int xtxtsc; /* eXecute TeXT stack counter */ extern struct exse *excs; /* EXEC stack */ extern struct exp_ese *exps; /* Expression stack */ extern struct xtxtsl *xtxts; /* Execute Text stack */ #endif extern int bwb_curtask; /* current task */ extern struct bwb_variable *ed; /* EDITOR$ variable */ extern struct bwb_variable *fi; /* FILES$ variable */ extern struct bwb_variable *pr; /* PROMPT$ variable */ extern struct bwb_variable *im; /* IMPLEMENTATION$ variable */ extern struct bwb_variable *co; /* COLORS variable */ /*************************************************************** bwbasic.h Part III: Global Data ***************************************************************/ extern char *bwb_ebuf; extern int bwb_trace; extern int dim_base; /* set by OPTION BASE */ extern struct bwb_command bwb_cmdtable[ COMMANDS ]; extern FILE *errfdevice; /* output device for error messages */ extern int err_line; /* line in which error occurred */ extern int err_number; /* number of last error */ extern char err_gosubl[ MAXVARNAMESIZE + 1 ]; /* line for error GOSUB */ extern char *err_table[ N_ERRORS ]; /* table of error messages */ extern int prn_col; extern struct bwb_function bwb_prefuncs[ FUNCTIONS ]; /* table of predefined functions */ #if COMMON_CMDS extern struct dev_element *dev_table; /* table of devices */ #endif /* Operator Structure and Table */ struct bwb_op { char symbol[ 8 ]; /* BASIC symbol for the operator */ int operation; /* internal code for the operator */ int precedence; /* level of precedence, 0 = highest */ }; extern struct bwb_op exp_ops[ N_OPERATORS ]; /* the table itself, filled in in bwb_tbl.c */ /*************************************************************** bwbasic.h Part IV: Function Prototypes ***************************************************************/ #if ANSI_C extern void *CALLOC(size_t nelem, size_t elsize, char *str); /* JBV */ extern void FREE(void *ptr, char *str); /* JBV */ extern void bwb_init( int argc, char **argv ); extern int bwb_fload( FILE *file ); extern int bwb_ladd( char *buffer, int replace ); extern int bwb_findcmd( int argc, int a, struct bwb_line *l ); extern struct bwb_line *bwb_xtxtline( char *buffer ); extern void bwb_mainloop( void ); extern void bwb_execline( void ); extern int bwb_gets( char *buffer ); extern int bwb_error( char *message ); extern void break_handler( void ); extern void break_mes( int x ); extern struct bwb_line *bwb_null( struct bwb_line *l ); extern struct bwb_line *bwb_rem( struct bwb_line *l ); extern struct bwb_line *bwb_lerror( struct bwb_line *l ); extern struct bwb_line *bwb_run( struct bwb_line *l ); extern struct bwb_line *bwb_let( struct bwb_line *l ); extern struct bwb_line *bwb_load( struct bwb_line *l ); extern struct bwb_line *bwb_merge( struct bwb_line *l ); extern struct bwb_line *bwb_chain( struct bwb_line *l ); extern struct bwb_line *bwb_common( struct bwb_line *l ); extern struct bwb_line *bwb_xload( struct bwb_line *l ); extern struct bwb_line *bwb_new( struct bwb_line *l ); extern struct bwb_line *bwb_save( struct bwb_line *l ); extern struct bwb_line *bwb_list( struct bwb_line *l ); extern struct bwb_line *bwb_xlist( struct bwb_line *l, FILE *file ); extern struct bwb_line *bwb_go( struct bwb_line *l ); extern struct bwb_line *bwb_goto( struct bwb_line *l ); extern struct bwb_line *bwb_gosub( struct bwb_line *l ); extern struct bwb_line *bwb_return( struct bwb_line *l ); extern struct bwb_line *bwb_xend( struct bwb_line *l ); extern struct bwb_line *bwb_system( struct bwb_line *l ); extern struct bwb_line *bwb_tron( struct bwb_line *l ); extern struct bwb_line *bwb_troff( struct bwb_line *l ); extern struct bwb_line *bwb_randomize( struct bwb_line *l ); extern struct bwb_line *bwb_stop( struct bwb_line *l ); extern struct bwb_line *bwb_data( struct bwb_line *l ); extern struct bwb_line *bwb_read( struct bwb_line *l ); extern struct bwb_line *bwb_restore( struct bwb_line *l ); extern struct bwb_line *bwb_delete( struct bwb_line *l ); extern struct bwb_line *bwb_if( struct bwb_line *l ); extern struct bwb_line *bwb_else( struct bwb_line *l ); extern struct bwb_line *bwb_elseif( struct bwb_line *l ); extern struct bwb_line *bwb_select( struct bwb_line *l ); extern struct bwb_line *bwb_case( struct bwb_line *l ); extern struct bwb_line *bwb_endselect( struct bwb_line *l ); extern struct bwb_line *bwb_endif( struct bwb_line *l ); extern struct bwb_line *bwb_while( struct bwb_line *l ); extern struct bwb_line *bwb_wend( struct bwb_line *l ); extern struct bwb_line *bwb_for( struct bwb_line *l ); extern struct bwb_line *bwb_next( struct bwb_line *l ); extern struct bwb_line *bwb_dim( struct bwb_line *l ); extern struct bwb_line *bwb_option( struct bwb_line *l ); extern struct bwb_line *bwb_open( struct bwb_line *l ); extern struct bwb_line *bwb_close( struct bwb_line *l ); extern struct bwb_line *bwb_get( struct bwb_line *l ); extern struct bwb_line *bwb_put( struct bwb_line *l ); extern struct bwb_line *bwb_rmdir( struct bwb_line *l ); extern struct bwb_line *bwb_chdir( struct bwb_line *l ); extern struct bwb_line *bwb_mkdir( struct bwb_line *l ); extern struct bwb_line *bwb_kill( struct bwb_line *l ); extern struct bwb_line *bwb_name( struct bwb_line *l ); extern struct bwb_line *bwb_rset( struct bwb_line *l ); extern struct bwb_line *bwb_lset( struct bwb_line *l ); extern struct bwb_line *bwb_field( struct bwb_line *l ); extern struct bwb_line *bwb_on( struct bwb_line *l ); extern struct bwb_line *bwb_line( struct bwb_line *l ); extern struct bwb_line *bwb_ddbl( struct bwb_line *l ); extern struct bwb_line *bwb_dint( struct bwb_line *l ); extern struct bwb_line *bwb_dsng( struct bwb_line *l ); extern struct bwb_line *bwb_dstr( struct bwb_line *l ); extern struct bwb_line *bwb_mid( struct bwb_line *l ); extern struct bwb_line *bwb_clear( struct bwb_line *l ); extern struct bwb_line *bwb_erase( struct bwb_line *l ); extern struct bwb_line *bwb_swap( struct bwb_line *l ); extern struct bwb_line *bwb_environ( struct bwb_line *l ); extern struct bwb_line *bwb_width( struct bwb_line *l ); extern struct bwb_line *bwb_write( struct bwb_line *l ); extern struct bwb_line *bwb_edit( struct bwb_line *l ); extern struct bwb_line *bwb_files( struct bwb_line *l ); extern struct bwb_line *bwb_do( struct bwb_line *l ); extern struct bwb_line *bwb_doloop( struct bwb_line *l ); extern struct bwb_line *bwb_cls( struct bwb_line *l ); extern struct bwb_line *bwb_locate( struct bwb_line *l ); extern struct bwb_line *bwb_color( struct bwb_line *l ); extern struct bwb_line *bwb_do( struct bwb_line *l ); extern struct bwb_line *bwb_loop( struct bwb_line *l ); extern struct bwb_line *bwb_exit( struct bwb_line *l ); extern struct bwb_line *bwb_exitfor( struct bwb_line *l ); extern struct bwb_line *bwb_exitdo( struct bwb_line *l ); extern struct bwb_line *bwb_zline( struct bwb_line *l ); extern void bwb_incexec( void ); extern void bwb_decexec( void ); extern int bwb_setexec( struct bwb_line *l, int position, int code ); extern int bwb_getcnd( char *lb, char *lhs, char *rhs, char *op, int *n ); extern int bwb_getlhs( char *lb, char *lhs, int *n ); extern int bwb_getop( char *lb, char *op, int *n ); extern int bwb_getrhs( char *lb, char *rhs, int *n ); extern int bwb_evalcnd( char *lhs, char *rhs, char *op ); extern int bwb_isstr( char *b ); extern int eval_int( int l, int r, char *op ); extern int eval_sng( float l, float r, char *op ); extern int eval_dbl( double l, double r, char *op ); extern struct exp_ese *bwb_exp( char *expression, int assignment, int *position ); extern int exp_getvfname( char *source, char *destination ); extern int exp_operation( int entry_level ); extern int inc_esc( void ); extern int dec_esc( void ); extern int fnc_init( int task ); extern struct bwb_function *fnc_find( char *buffer ); extern struct bwb_line *bwb_def( struct bwb_line *l ); extern int bwb_getargs( char *buffer ); extern int bwb_stripcr( char *s ); extern int bwb_numseq( char *buffer, int *start, int *end ); extern int bwb_freeline( struct bwb_line *l ); extern struct bwb_line *bwb_print( struct bwb_line *l ); extern int bwb_xprint( struct bwb_line *l, FILE *f ); extern int bwb_eltype( char *l_buffer, int p ); extern int var_init( int task ); extern int fslt_init( int task ); extern int var_delcvars( void ); extern struct bwb_variable *var_new( char *name ); extern struct bwb_variable *var_islocal( char *buffer ); extern int bwb_strel( char *lb, char *sb, int *n ); extern struct bwb_variable *bwb_numel( char *lb, int *n ); extern int bwb_const( char *lb, char *sb, int *n ); extern int bwb_getvarname( char *lb, char *sb, int *n ); extern struct bwb_variable *var_find( char *buffer ); extern int bwb_isvar( char *buffer ); extern struct bwb_line *bwb_input( struct bwb_line *l ); extern int inp_adv( char *b, int *c ); extern int var_make( struct bwb_variable *v, int type ); extern bstring *var_getsval( struct bwb_variable *nvar ); extern bstring *var_findsval( struct bwb_variable *v, int *pp ); extern bstring *exp_getsval( struct exp_ese *e ); extern int dim_getparams( char *buffer, int *pos, int *n_params, int **pp ); extern int adv_element( char *buffer, int *pos, char *element ); extern int adv_ws( char *buffer, int *pos ); #if MULTISEG_LINES extern int adv_eos( char *buffer, int *pos ); #endif extern int line_start( char *buffer, int *pos, int *lnpos, int *lnum, int *cmdpos, int *cmdnum, int *startpos ); extern int is_cmd( char *buffer, int *cmdnum ); extern int is_let( char *buffer, int *cmdnum ); extern int is_eol( char *buffer, int *position ); extern int is_numconst( char *buffer ); extern int is_label( char *buffer ); extern struct bwb_line * find_label( char *buffer ); extern struct bwb_line *find_loop( struct bwb_line *l ); extern int int_qmdstr( char *buffer_a, char *buffer_b ); extern struct bwb_line * cnd_xpline( struct bwb_line *l, char *buffer ); extern int scan_element( char *buffer, int *pos, char *element ); extern int prn_precision( struct bwb_variable *v ); extern int * prn_getcol( FILE *f ); extern int prn_getwidth( FILE *f ); extern int prn_xprintf( FILE *f, char *buffer ); extern int prn_xxprintf( FILE *f, char *buffer ); /* JBV */ extern int bwb_strtoupper( char *buffer ); extern int getcmdnum( char *cmdstr ); extern int str_btoc( char *buffer, bstring *s ); extern int str_btob( bstring *d, bstring *s ); extern int str_ctob( bstring *s, char *buffer ); extern int str_cmp( bstring *s, bstring *t ); extern char * str_cat( bstring *s, bstring *t ); extern int exp_findop( char *expression ); extern int exp_isop( char *expression ); extern int exp_isfn( char *expression ); extern int exp_isufn( char *expression ); extern int exp_isnc( char *expression ); extern int exp_isvn( char *expression ); extern int exp_iscmd( char *expression ); extern int exp_paren( char *expression ); extern int exp_strconst( char *expression ); extern int exp_numconst( char *expression ); extern int exp_function( char *expression ); extern int exp_ufnc( char *expression ); extern int exp_variable( char *expression ); extern int exp_validarg( char *expression ); extern int ln_asbuf( struct bwb_line *l, char *s ); extern int xputc( FILE *f, char c ); extern int bwx_signon( void ); extern int bwx_message( char *m ); extern int bwx_putc( char c ); extern int bwx_errmes( char *m ); extern int bwx_input( char *prompt, char *buffer ); extern void bwx_terminate( void ); #if COMMAND_SHELL extern int bwx_shell( struct bwb_line *l ); #endif int bwb_scan( void ); struct bwb_line *bwb_call( struct bwb_line *l ); struct bwb_line *bwb_sub( struct bwb_line *l ); struct bwb_line *bwb_endsub( struct bwb_line *l ); struct bwb_line *bwb_endfnc( struct bwb_line *l ); struct bwb_line *bwb_function( struct bwb_line *l ); extern bnumber var_getnval( struct bwb_variable *nvar ); extern bnumber *var_findnval( struct bwb_variable *v, int *pp ); extern bnumber exp_getnval( struct exp_ese *e ); extern bnumber *exp_findnval( struct exp_ese *e ); #if PARACT extern int bwb_newtask( int task_requested ); #endif #if INTERACTIVE extern int bwb_interact( void ); #endif #if DEBUG extern int bwb_debug( char *message ); extern struct bwb_line *bwb_cmds( struct bwb_line *l ); extern struct bwb_line *bwb_vars( struct bwb_line *l ); extern struct bwb_line *bwb_fncs( struct bwb_line *l ); #endif #ifdef ALLOW_RENUM extern struct bwb_line *bwb_renum( struct bwb_line *l ); #endif #if UNIX_CMDS #if !HAVE_UNISTD /* Not needed if one has (JBV) */ extern int rmdir( char *path ); extern int chdir( char *path ); #endif #if !HAVE_SYSSTAT /* Not needed if one has (JBV) */ #if MKDIR_ONE_ARG extern int mkdir( char *path ); #else extern int mkdir( char *path, unsigned short permissions ); #endif /* JBV */ #endif #endif /* declarations of function commands */ extern struct bwb_variable *fnc_null( int argc, struct bwb_variable *argv, int unique_id ); #if COMPRESS_FUNCS extern struct bwb_variable *fnc_core( int argc, struct bwb_variable *argv, int unique_id ); #else extern struct bwb_variable *fnc_abs( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_atn( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_cos( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_log( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_sin( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_sqr( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_sgn( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_int( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_rnd( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_exp( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_tan( int argc, struct bwb_variable *argv, int unique_id ); #endif extern struct bwb_variable *fnc_tab( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_date( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_time( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_chr( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_mid( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_left( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_right( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_timer( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_val( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_len( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_hex( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_oct( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_cint( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_asc( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_mkd( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_mki( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_mks( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_cvi( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_cvd( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_cvs( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable *fnc_string( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable * fnc_spc( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable * fnc_space( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable * fnc_environ( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable * fnc_pos( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable * fnc_err( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable * fnc_erl( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable * fnc_loc( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable * fnc_lof( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable * fnc_eof( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable * fnc_csng( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable * fnc_instr( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable * fnc_str( int argc, struct bwb_variable *argv, int unique_id ); extern struct bwb_variable * fnc_inkey( int argc, struct bwb_variable *argv, int unique_id ); extern bnumber trnc_int( bnumber x ); extern int fnc_checkargs( int argc, struct bwb_variable *argv, int min, int max ); extern int ufsc; /* user function stack counter */ #if DEBUG extern struct bwb_variable *fnc_test( int argc, struct bwb_variable *argv, int unique_id ); #endif #else /* ANSI_C */ extern void *CALLOC(); /* JBV */ extern void FREE(); /* JBV */ extern void bwb_init(); extern int bwb_fload(); extern int bwb_ladd(); extern int bwb_findcmd(); extern struct bwb_line *bwb_xtxtline(); extern void bwb_mainloop(); extern void bwb_execline(); extern int bwb_gets(); extern int bwb_error(); extern void break_handler(); extern void break_mes(); extern struct bwb_line *bwb_null(); extern struct bwb_line *bwb_rem(); extern struct bwb_line *bwb_lerror(); extern struct bwb_line *bwb_run(); extern struct bwb_line *bwb_let(); extern struct bwb_line *bwb_load(); extern struct bwb_line *bwb_merge(); extern struct bwb_line *bwb_chain(); extern struct bwb_line *bwb_common(); extern struct bwb_line *bwb_xload(); extern struct bwb_line *bwb_new(); extern struct bwb_line *bwb_save(); extern struct bwb_line *bwb_list(); extern struct bwb_line *bwb_xlist(); extern struct bwb_line *bwb_go(); extern struct bwb_line *bwb_goto(); extern struct bwb_line *bwb_gosub(); extern struct bwb_line *bwb_return(); extern struct bwb_line *bwb_xend(); extern struct bwb_line *bwb_system(); extern struct bwb_line *bwb_tron(); extern struct bwb_line *bwb_troff(); extern struct bwb_line *bwb_randomize(); extern struct bwb_line *bwb_stop(); extern struct bwb_line *bwb_data(); extern struct bwb_line *bwb_read(); extern struct bwb_line *bwb_restore(); extern struct bwb_line *bwb_delete(); extern struct bwb_line *bwb_if(); extern struct bwb_line *bwb_else(); extern struct bwb_line *bwb_elseif(); extern struct bwb_line *bwb_select(); extern struct bwb_line *bwb_case(); extern struct bwb_line *bwb_endselect(); extern struct bwb_line *bwb_endif(); extern struct bwb_line *bwb_while(); extern struct bwb_line *bwb_wend(); extern struct bwb_line *bwb_for(); extern struct bwb_line *bwb_next(); extern struct bwb_line *bwb_dim(); extern struct bwb_line *bwb_option(); extern struct bwb_line *bwb_open(); extern struct bwb_line *bwb_close(); extern struct bwb_line *bwb_get(); extern struct bwb_line *bwb_put(); extern struct bwb_line *bwb_rmdir(); extern struct bwb_line *bwb_chdir(); extern struct bwb_line *bwb_mkdir(); extern struct bwb_line *bwb_kill(); extern struct bwb_line *bwb_name(); extern struct bwb_line *bwb_rset(); extern struct bwb_line *bwb_lset(); extern struct bwb_line *bwb_field(); extern struct bwb_line *bwb_on(); extern struct bwb_line *bwb_line(); extern struct bwb_line *bwb_ddbl(); extern struct bwb_line *bwb_dint(); extern struct bwb_line *bwb_dsng(); extern struct bwb_line *bwb_dstr(); extern struct bwb_line *bwb_mid(); extern struct bwb_line *bwb_clear(); extern struct bwb_line *bwb_erase(); extern struct bwb_line *bwb_swap(); extern struct bwb_line *bwb_environ(); extern struct bwb_line *bwb_width(); extern struct bwb_line *bwb_write(); extern struct bwb_line *bwb_edit(); extern struct bwb_line *bwb_files(); extern struct bwb_line *bwb_do(); extern struct bwb_line *bwb_doloop(); extern struct bwb_line *bwb_cls(); extern struct bwb_line *bwb_locate(); extern struct bwb_line *bwb_color(); extern struct bwb_line *bwb_do(); extern struct bwb_line *bwb_loop(); extern struct bwb_line *bwb_exit(); extern struct bwb_line *bwb_exitfor(); extern struct bwb_line *bwb_exitdo(); extern struct bwb_line *bwb_zline(); extern void bwb_incexec(); extern void bwb_decexec(); extern int bwb_setexec(); extern int bwb_getcnd(); extern int bwb_getlhs(); extern int bwb_getop(); extern int bwb_getrhs(); extern int bwb_evalcnd(); extern int bwb_isstr(); extern int eval_int(); extern int eval_sng(); extern int eval_dbl(); extern struct exp_ese *bwb_exp(); extern int exp_getvfname(); extern int exp_operation(); extern int inc_esc(); extern int dec_esc(); extern int fnc_init(); extern struct bwb_function *fnc_find(); extern struct bwb_line *bwb_def(); extern int bwb_getargs(); extern int bwb_stripcr(); extern int bwb_numseq(); extern int bwb_freeline(); extern struct bwb_line *bwb_print(); extern int bwb_xprint(); extern int bwb_eltype(); extern int var_init(); extern int fslt_init(); extern int var_delcvars(); extern struct bwb_variable *var_new(); extern struct bwb_variable *var_islocal(); extern int bwb_strel(); extern struct bwb_variable *bwb_numel(); extern int bwb_const(); extern int bwb_getvarname(); extern struct bwb_variable *var_find(); extern int bwb_isvar(); extern struct bwb_line *bwb_input(); extern int inp_adv(); extern int var_make(); extern bstring *var_getsval(); extern bstring *var_findsval(); extern bstring *exp_getsval(); extern int dim_getparams(); extern int adv_element(); extern int adv_ws(); #if MULTISEG_LINES extern int adv_eos(); #endif extern int line_start(); extern int is_cmd(); extern int is_let(); extern int is_eol(); extern int is_numconst(); extern int is_label(); extern struct bwb_line * find_label(); extern struct bwb_line *find_loop(); extern int int_qmdstr(); extern struct bwb_line * cnd_xpline(); extern int scan_element(); extern int prn_precision(); extern int * prn_getcol(); extern int prn_getwidth(); extern int prn_xprintf(); extern int prn_xxprintf(); /* JBV */ extern int bwb_strtoupper(); extern int getcmdnum(); extern int str_btoc(); extern int str_btob(); extern int str_ctob(); extern int str_cmp(); extern char * str_cat(); extern int exp_findop(); extern int exp_isop(); extern int exp_isfn(); extern int exp_isufn(); extern int exp_isnc(); extern int exp_isvn(); extern int exp_iscmd(); extern int exp_paren(); extern int exp_strconst(); extern int exp_numconst(); extern int exp_function(); extern int exp_ufnc(); extern int exp_variable(); extern int exp_validarg(); extern int ln_asbuf(); extern int xputc(); extern int bwx_signon(); extern int bwx_message(); extern int bwx_putc(); extern int bwx_errmes(); extern int bwx_input(); extern void bwx_terminate(); #if COMMAND_SHELL extern int bwx_shell(); #endif int bwb_scan(); struct bwb_line *bwb_call(); struct bwb_line *bwb_sub(); struct bwb_line *bwb_endsub(); struct bwb_line *bwb_endfnc(); struct bwb_line *bwb_function(); extern bnumber var_getnval(); extern bnumber *var_findnval(); extern bnumber exp_getnval(); extern bnumber *exp_findnval(); #if PARACT extern int bwb_newtask(); #endif #if INTERACTIVE extern int bwb_interact(); #endif #if DEBUG extern int bwb_debug(); extern struct bwb_line *bwb_cmds(); extern struct bwb_line *bwb_vars(); extern struct bwb_line *bwb_fncs(); #endif #ifdef ALLOW_RENUM extern struct bwb_line *bwb_renum(); #endif #if UNIX_CMDS extern int rmdir(); extern int chdir(); #if MKDIR_ONE_ARG extern int mkdir(); #else extern int mkdir(); #endif #endif /* declarations of function commands */ extern struct bwb_variable *fnc_null(); #if COMPRESS_FUNCS extern struct bwb_variable *fnc_core(); #else extern struct bwb_variable *fnc_abs(); extern struct bwb_variable *fnc_atn(); extern struct bwb_variable *fnc_cos(); extern struct bwb_variable *fnc_log(); extern struct bwb_variable *fnc_sin(); extern struct bwb_variable *fnc_sqr(); extern struct bwb_variable *fnc_sgn(); extern struct bwb_variable *fnc_int(); extern struct bwb_variable *fnc_rnd(); extern struct bwb_variable *fnc_exp(); extern struct bwb_variable *fnc_tan(); #endif extern struct bwb_variable *fnc_tab(); extern struct bwb_variable *fnc_date(); extern struct bwb_variable *fnc_time(); extern struct bwb_variable *fnc_chr(); extern struct bwb_variable *fnc_mid(); extern struct bwb_variable *fnc_left(); extern struct bwb_variable *fnc_right(); extern struct bwb_variable *fnc_timer(); extern struct bwb_variable *fnc_val(); extern struct bwb_variable *fnc_len(); extern struct bwb_variable *fnc_hex(); extern struct bwb_variable *fnc_oct(); extern struct bwb_variable *fnc_cint(); extern struct bwb_variable *fnc_asc(); extern struct bwb_variable *fnc_mkd(); extern struct bwb_variable *fnc_mki(); extern struct bwb_variable *fnc_mks(); extern struct bwb_variable *fnc_cvi(); extern struct bwb_variable *fnc_cvd(); extern struct bwb_variable *fnc_cvs(); extern struct bwb_variable *fnc_string(); extern struct bwb_variable * fnc_spc(); extern struct bwb_variable * fnc_space(); extern struct bwb_variable * fnc_environ(); extern struct bwb_variable * fnc_pos(); extern struct bwb_variable * fnc_err(); extern struct bwb_variable * fnc_erl(); extern struct bwb_variable * fnc_loc(); extern struct bwb_variable * fnc_lof(); extern struct bwb_variable * fnc_eof(); extern struct bwb_variable * fnc_csng(); extern struct bwb_variable * fnc_instr(); extern struct bwb_variable * fnc_str(); extern struct bwb_variable * fnc_inkey(); extern bnumber trnc_int(); extern int fnc_checkargs(); extern int ufsc; /* user function stack counter */ #if DEBUG extern struct bwb_variable *fnc_test(); #endif #endif /* ANSI_C */ #if COMPRESS_FUNCS #define F_ABS 1 #define F_ATN 2 #define F_COS 3 #define F_EXP 4 #define F_INT 5 #define F_LOG 6 #define F_RND 7 #define F_SGN 8 #define F_SIN 9 #define F_SQR 10 #define F_TAN 11 #endif bwbasic-2.20pl2.orig/bwbasic.mak100644 0 0 2570 5455156551 14626 0ustar rootrootPROJ =BWBASIC DEBUG =0 CC =qcl CFLAGS_G = /AL /W3 /Za /DMSDOS CFLAGS_D = /Zd /Gi$(PROJ).mdt /Od CFLAGS_R = /O /Ot /Gs /DNDEBUG CFLAGS =$(CFLAGS_G) $(CFLAGS_R) LFLAGS_G = /CP:0xffff /NOI /NOE /SE:0x80 /ST:0x1fa0 LFLAGS_D = /INCR LFLAGS_R = LFLAGS =$(LFLAGS_G) $(LFLAGS_R) RUNFLAGS = OBJS_EXT = LIBS_EXT = all: $(PROJ).exe bwbasic.obj: bwbasic.c bwb_cmd.obj: bwb_cmd.c bwb_cnd.obj: bwb_cnd.c bwb_dio.obj: bwb_dio.c bwb_elx.obj: bwb_elx.c bwb_exp.obj: bwb_exp.c bwb_fnc.obj: bwb_fnc.c bwb_inp.obj: bwb_inp.c bwb_int.obj: bwb_int.c bwb_mth.obj: bwb_mth.c bwb_ops.obj: bwb_ops.c bwb_par.obj: bwb_par.c bwb_prn.obj: bwb_prn.c bwb_stc.obj: bwb_stc.c bwb_str.obj: bwb_str.c bwb_tbl.obj: bwb_tbl.c bwb_var.obj: bwb_var.c bwx_tty.obj: bwx_tty.c $(PROJ).exe: bwbasic.obj bwb_cmd.obj bwb_cnd.obj bwb_dio.obj bwb_elx.obj bwb_exp.obj \ bwb_fnc.obj bwb_inp.obj bwb_int.obj bwb_mth.obj bwb_ops.obj bwb_par.obj bwb_prn.obj \ bwb_stc.obj bwb_str.obj bwb_tbl.obj bwb_var.obj bwx_tty.obj $(OBJS_EXT) echo >NUL @<<$(PROJ).crf bwbasic.obj + bwb_cmd.obj + bwb_cnd.obj + bwb_dio.obj + bwb_elx.obj + bwb_exp.obj + bwb_fnc.obj + bwb_inp.obj + bwb_int.obj + bwb_mth.obj + bwb_ops.obj + bwb_par.obj + bwb_prn.obj + bwb_stc.obj + bwb_str.obj + bwb_tbl.obj + bwb_var.obj + bwx_tty.obj + $(OBJS_EXT) $(PROJ).exe $(LIBS_EXT); << link $(LFLAGS) @$(PROJ).crf run: $(PROJ).exe $(PROJ) $(RUNFLAGS) bwbasic-2.20pl2.orig/bwbtest/ 40755 0 0 0 6054476013 14065 5ustar rootrootbwbasic-2.20pl2.orig/bwbtest/abs.bas100644 2140 24 232 5437750052 16170 0ustar rootdialout10 rem ABS.BAS -- Test ABS() function 20 X = -1.23456789 30 ABSX = ABS( X ) 40 print "The absolute value of "; X; " is"; ABSX 50 print "Is that correct?" bwbasic-2.20pl2.orig/bwbtest/assign.bas100644 2140 24 66 5437750052 16674 0ustar rootdialout10 Print "TEST.BAS -- TEST" 20 X=7 30 print "X is ";X bwbasic-2.20pl2.orig/bwbtest/callfunc.bas100644 2140 24 2010 5437750052 17226 0ustar rootdialout rem ---------------------------------------------------- rem CallFunc.BAS rem ---------------------------------------------------- Print "CallFunc.BAS -- Test BASIC User-defined Function Statements" Print "The next printed line should be from the Function." Print testvar = 17 x = TestFnc( 5, "Hello", testvar ) Print Print "This is back at the main program. " Print "The value of variable is now "; testvar Print "The returned value from the function is "; x Print "Did it work?" End rem ---------------------------------------------------- rem Subroutine TestFnc rem ---------------------------------------------------- Function TestFnc( xarg, yarg$, tvar ) Print "This is written from the Function." Print "The value of variable is"; xarg Print "The value of variable is "; yarg$ Print "The value of variable is "; tvar tvar = 99 Print "The value of variable is reset to "; tvar TestFnc = xarg + tvar Print "The Function should return "; TestFnc End Function bwbasic-2.20pl2.orig/bwbtest/callsub.bas100644 2140 24 1571 5437750052 17077 0ustar rootdialout rem ---------------------------------------------------- rem CallSub.BAS rem ---------------------------------------------------- Print "CallSub.BAS -- Test BASIC Call and Sub Statements" Print "The next printed line should be from the Subroutine." Print testvar = 17 Call TestSub 5, "Hello", testvar Print Print "This is back at the main program. " Print "The value of variable is now "; testvar Print "Did it work?" End rem ---------------------------------------------------- rem Subroutine TestSub rem ---------------------------------------------------- Sub TestSub( xarg, yarg$, tvar ) Print "This is written from the Subroutine." Print "The value of variable is"; xarg Print "The value of variable is "; yarg$ Print "The value of variable is "; tvar tvar = 99 Print "The value of variable is reset to "; tvar End Sub bwbasic-2.20pl2.orig/bwbtest/chain1.bas100644 2140 24 261 5437750052 16570 0ustar rootdialoutREM CHAIN1.BAS print "This is program CHAIN1.BAS" X = 5.6789 common X print "The value of X is";X print "We shall no pass execution to program CHAIN2.BAS..." chain "chain2.bas" bwbasic-2.20pl2.orig/bwbtest/chain2.bas100644 2140 24 171 5437750052 16571 0ustar rootdialoutREM CHAIN2.BAS print "This is program CHAIN2.BAS" print "The value of X is now";X print "This concludes our CHAIN test." bwbasic-2.20pl2.orig/bwbtest/dataread.bas100644 2140 24 771 5437750052 17200 0ustar rootdialout10 rem DATAREAD.BAS -- Test DATA, READ, and RESTORE Statements 20 print "DATAREAD.BAS -- Test DATA, READ, and RESTORE Statements" 30 DATA "Ted", 56.789 40 REM just to see if it advances correctly 50 DATA "Dale", 45.678 60 READ N$, NUMBER, ANOTHER$ 70 READ ANUMBER 80 PRINT "Data read: ";N$;" ";NUMBER;" ";ANOTHER$;" ";ANUMBER 90 RESTORE 30 100 READ ANOTHER$ 110 READ ANUMBER, N$,NUMBER 120 PRINT "After RESTORE:" 130 PRINT "Data read: ";ANOTHER$;" ";ANUMBER;" ";N$;" ";NUMBER 140 END bwbasic-2.20pl2.orig/bwbtest/deffn.bas100644 2140 24 360 5437750052 16507 0ustar rootdialout10 REM ------------------------------------------ 20 PRINT "DEFFN.BAS -- Test DEF FN Statement" 30 DEF fnadd( x, y ) = x + y 40 PRINT fnadd( 2, 3 ) 50 DEF fnjoin$( a$, b$ ) = a$ + b$ 60 PRINT fnjoin$( chr$( &h43 ), "orrect" ) 70 END bwbasic-2.20pl2.orig/bwbtest/dim.bas100644 2140 24 171 5437750052 16176 0ustar rootdialout10 DIM n(5) 20 FOR i = 0 to 5 30 LET n(i) = i + 2 40 PRINT "The value at position ";i;" is ";n(i) 50 NEXT i 60 END bwbasic-2.20pl2.orig/bwbtest/doloop.bas100644 2140 24 137 5437750052 16723 0ustar rootdialout10 i = 0 20 do 30 i = i + 1 40 print "i is";i 50 if i > 12 then exit do 60 loop 70 print "End" bwbasic-2.20pl2.orig/bwbtest/dowhile.bas100644 2140 24 355 5437750052 17064 0ustar rootdialout10 REM DOWHILE.BAS -- Test DO WHILE-LOOP 20 PRINT "START" 30 LET X = 0 40 DO WHILE X < 25 50 PRINT "x is ";X 60 LET X = X + 1 70 LET Y = 0 80 DO WHILE Y < 2 90 PRINT "y is "; Y 100 LET Y = Y + 1 110 LOOP 120 LOOP 130 PRINT "END" bwbasic-2.20pl2.orig/bwbtest/elseif.bas100644 2140 24 1120 5437750052 16707 0ustar rootdialout rem ----------------------------------------------------- rem elseif.bas -- Test MultiLine IF-ELSEIF-THEN statement rem ----------------------------------------------------- Print "ELSEIF.BAS -- Test MultiLine IF-THEN-ELSE Constructions" Print Print "The program should detect if the number you enter is 4 or 5 or 6." Input "Please enter a number, 1-9"; x If x = 4 then Print "The number is 4." Elseif x = 5 then Print "The number is 5." Elseif x = 6 then Print "The number is 6." Else Print "The number is neither 4 nor 5 nor 6." End If Print "This concludes our test." bwbasic-2.20pl2.orig/bwbtest/end.bas100644 2140 24 334 5437750052 16174 0ustar rootdialout10 REM END.BAS -- Test END Statement 20 PRINT "END.BAS -- Test END Statement" 30 PRINT "If the program ends after this line, END worked OK." 40 END 50 PRINT "But if this line printed, then it did not work." 60 END bwbasic-2.20pl2.orig/bwbtest/err.bas100644 2140 24 41 5437750052 16171 0ustar rootdialout10 dim n(5) 20 print n(7) 30 end bwbasic-2.20pl2.orig/bwbtest/fncallfn.bas100644 2140 24 530 5437750052 17207 0ustar rootdialout10 rem FNCALLFN.BAS -- Test User-defined function called 20 rem from user-defined function 30 def fnabs(x) = abs(x) 40 def fncmp(y) = 1.45678+fnabs(y) 50 print "Test user-defined function calling user-defined function" 60 print "The result should be: ";2.45678 70 q = -1.000 80 print "The result is: : "; fncmp( q ) 90 end bwbasic-2.20pl2.orig/bwbtest/fornext.bas100644 2140 24 527 5437750052 17117 0ustar rootdialout10 REM FORNEXT.BAS -- Test FOR-NEXT Statements 20 REM 30 PRINT "FORNEXT.BAS: Test FOR-NEXT Statements" 40 PRINT "A FOR-NEXT Loop with STEP statement:" 50 FOR i=1 to 30 step 2 60 PRINT "FOR: i is ";i 70 NEXT i 80 REM 90 PRINT "A FOR-NEXT Loop without STEP statement:" 100 FOR i = 2 to 7 110 PRINT "FOR: i is ";i 120 NEXT i 130 END bwbasic-2.20pl2.orig/bwbtest/function.bas100644 2140 24 3265 5437750052 17301 0ustar rootdialout1000 PRINT "ABS(-2.2): "; ABS(-2.2) 1010 PRINT "DATE$: <"; DATE$; ">" 1020 PRINT "TIME$: <"; TIME$; ">" 1030 PRINT "ATN(-2.2): "; ATN(-2.2) 1040 PRINT "COS(-2.2): "; COS(-2.2) 1050 PRINT "LOG(2.2): "; LOG(2.2) 1060 PRINT "SIN(-2.2): "; SIN(-2.2) 1070 PRINT "SQR(2.2): "; SQR(2.2) 1080 PRINT "TAN(-2.2): "; TAN(-2.2) 1090 PRINT "SGN(-2.2): "; SGN(-2.2) 1100 PRINT "INT(-2.2): "; INT(-2.2) 1102 INPUT "Paused";X$ 1110 PRINT "RND(-2.2): "; RND(-2.2) 1120 PRINT "CHR$(&h60): "; CHR$(&H60) 1130 PRINT "TAB(52): <"; TAB(52); ">" 1140 PRINT "SPC(5): <"; SPC(5); ">" 1150 PRINT "SPACE$(5): <"; SPACE$(5); ">" 1160 PRINT "STRING$(5,X): <"; STRING$(5,"X"); ">" 1170 PRINT "MID$(0123456789, 5, 4): <"; MID$("0123456789", 5, 4); ">" 1180 PRINT "LEFT$(0123456789, 5): <"; LEFT$("0123456789", 5); ">" 1190 PRINT "RIGHT$(0123456789, 5): <"; RIGHT$("0123456789", 5); ">" 1200 PRINT "TIMER: "; TIMER 1202 INPUT "Paused";X$ 1210 PRINT "VAL(X): "; VAL("X") 1230 PRINT "ERR: "; ERR 1240 PRINT "ERL: "; ERL 1250 PRINT "LEN(0123456789): "; LEN("0123456789") 1260 PRINT "CSNG(-2.2): "; CSNG(-2.2) 1270 PRINT "EXP(-2.2): "; EXP(-2.2) 1280 PRINT "INSTR(0123456789, 234): "; INSTR("0123456789", "234") 1290 PRINT "STR$(-2.2): <"; STR$(-2.2); ">" 1300 PRINT "HEX$(27): <"; HEX$(27); ">" 1302 INPUT "Paused";X$ 1310 PRINT "OCT$(27): <"; OCT$(27); ">" 1320 PRINT "CINT(-2.2): "; CINT(-2.2) 1330 PRINT "ASC(0123456789): "; ASC("0123456789") 1340 PRINT "ENVIRON$(PATH): <"; ENVIRON$("PATH"); ">" 1350 PRINT "MKD$(17): <"; MKD$(17); ">" 1360 PRINT "MKI$(17): <"; MKI$(17); ">" 1370 PRINT "MKS$(17): <"; MKS$(17); ">" 1380 PRINT "CVD(MKD$(17)): "; CVD(MKD$(17)) 1390 PRINT "CVS(MKS$(17)): "; CVS(MKS$(17)) 1400 PRINT "CVI(MKI$(17)): "; CVI(MKI$(17)) bwbasic-2.20pl2.orig/bwbtest/gosub.bas100644 2140 24 2076 5437750052 16572 0ustar rootdialout10 REM -------------------------------------------------------- 20 REM GOSUB.BAS Test Bywater BASIC Interpreter GOSUB Statement 30 REM -------------------------------------------------------- 40 GOSUB 160 50 PRINT "Test GOSUB Statements" 60 PRINT "---------------------" 70 PRINT 80 PRINT "1 - Run Subroutine" 90 PRINT "9 - Exit to system" 92 PRINT "x - Exit to BASIC" 100 PRINT 110 INPUT c$ 120 IF c$ = "1" then gosub 430 130 IF c$ = "9" then goto 600 132 IF c$ = "x" then end 134 IF c$ = "X" then end 140 GOTO 10 150 END 160 REM subroutine to clear screen 170 PRINT 180 PRINT 190 PRINT 200 PRINT 210 PRINT 220 PRINT 230 PRINT 240 PRINT 250 PRINT 260 PRINT 270 PRINT 280 PRINT 290 PRINT 300 PRINT 310 PRINT 320 PRINT 330 PRINT 340 PRINT 350 PRINT 360 PRINT 370 PRINT 380 PRINT 390 PRINT 400 PRINT 410 PRINT 420 RETURN 430 REM subroutine to test branching 435 GOSUB 160 440 PRINT "This is the subroutine." 445 PRINT "Press any key: "; 450 INPUT x$ 460 RETURN 600 GOSUB 160 610 PRINT "Exit from Bywater BASIC Test Program" 620 SYSTEM bwbasic-2.20pl2.orig/bwbtest/gotolabl.bas100644 2140 24 375 5437750052 17236 0ustar rootdialoutPrint "Hello" goto test_label Print "This should NOT print" test_label: gosub test_sub Print "Goodbye" End test_sub: Print "This is the subroutine." gosub test_subsub Return test_subsub: Print "This is the sub-subroutine." Return bwbasic-2.20pl2.orig/bwbtest/ifline.bas100644 2140 24 220 5437750052 16666 0ustar rootdialout10 rem test if then followed by line number 20 if 5 = 5 then 80 30 print "The statement failed" 40 stop 80 print "The program succeeded" 90 end bwbasic-2.20pl2.orig/bwbtest/index.txt100644 2140 24 2165 5437750052 16633 0ustar rootdialoutTest Programs for bwBASIC: ------------------------- ___ ___ ABS BAS ___ ___ ASSIGN BAS ___ ___ CALLFUNC BAS * STRUCT_CMDS ___ ___ CALLSUB BAS * STRUCT_CMDS ___ ___ CHAIN1 BAS ___ ___ CHAIN2 BAS * called from CHAIN1.BAS ___ ___ DATAREAD BAS ___ ___ DEFFN BAS ___ ___ DIM BAS ___ ___ DOLOOP BAS * STRUCT_CMDS ___ ___ DOWHILE BAS * STRUCT_CMDS ___ ___ ELSEIF BAS * STRUCT_CMDS ___ ___ END BAS ___ ___ ERR BAS ___ ___ FORNEXT BAS ___ ___ FUNCTION BAS ___ ___ GOSUB BAS ___ ___ GOTOLABL BAS * STRUCT_CMDS ___ ___ IFLINE BAS ___ ___ INPUT BAS ___ ___ LOF BAS * LOF(): IMPLEMENTATION-SPECIFIC ___ ___ LOOPUNTL BAS * STRUCT_CMDS ___ ___ MAIN BAS * STRUCT_CMDS ___ ___ MLIFTHEN BAS * STRUCT_CMDS ___ ___ ON BAS ___ ___ ONERR BAS ___ ___ ONERRLBL BAS * STRUCT_CMDS ___ ___ ONGOSUB BAS ___ ___ OPENTEST BAS ___ ___ OPTION BAS ___ ___ PUTGET BAS * KILL: IMPLEMENTATION-SPECIFIC ___ ___ RANDOM BAS ___ ___ SELCASE BAS * STRUCT_CMDS ___ ___ SNGLFUNC BAS ___ ___ STOP BAS ___ ___ TERM BAS ___ ___ WHILWEND BAS ___ ___ WIDTH BAS ___ ___ WRITEINP BAS bwbasic-2.20pl2.orig/bwbtest/input.bas100644 2140 24 317 5437750052 16566 0ustar rootdialout10 REM INPUT.BAS -- Test INPUT Statement 20 PRINT "INPUT.BAS -- Test INPUT Statement" 30 REM 40 INPUT "Input string, number: "; s$, n 50 PRINT "The string is: ";s$ 60 PRINT "The number is: ";n 70 END bwbasic-2.20pl2.orig/bwbtest/lof.bas100644 2140 24 211 5437750052 16200 0ustar rootdialout10 print "Test LOF() Function" 20 input "Filename";F$ 30 open "i", 1, F$ 40 print "Length of file ";F$;" is ";LOF(1);" bytes" 50 close 1 bwbasic-2.20pl2.orig/bwbtest/loopuntl.bas100644 2140 24 140 5437750052 17275 0ustar rootdialout10 rem LOOPUNTL.BAS 20 i = 0 30 do 40 i = i + 1 50 print "Value of i is";i 60 loop until i > 12 bwbasic-2.20pl2.orig/bwbtest/main.bas100644 2140 24 454 5437750052 16355 0ustar rootdialout Sub Prior Print "This is a subroutine prior to MAIN." Print "This should not print." End Sub Sub Main Print "This is the MAIN subroutine." Print "This should print." End Sub Sub Subsequent Print "This is a subroutine subsequent to MAIN." Print "This should not print." End Sub bwbasic-2.20pl2.orig/bwbtest/mlifthen.bas100644 2140 24 652 5437750052 17237 0ustar rootdialout rem ------------------------------------------------- rem mlifthen.bas -- Test MultiLine IF-THEN statement rem ------------------------------------------------- Print "MLIFTHEN.BAS -- Test MultiLine IF-THEN-ELSE Constructions" If 3 = 4 then Print "The Condition is true." Print "And it still is true." Else Print "The condition is false." Print "And it still is false." End If Print "This concludes our test." bwbasic-2.20pl2.orig/bwbtest/on.bas100644 2140 24 466 5437750052 16050 0ustar rootdialout10 print "ON.BAS -- Test ON...GOTO Statement" 20 input "Enter a number 1-5:";n 30 on n goto 40, 60, 80, 100, 120 40 print "You entered 1" 50 goto 140 60 print "You entered 2" 70 goto 140 80 print "You entered 3" 90 goto 140 100 print "You entered 4" 110 goto 140 120 print "You entered 5" 130 goto 140 140 end bwbasic-2.20pl2.orig/bwbtest/onerr.bas100644 2140 24 650 5437750052 16554 0ustar rootdialout10 rem onerr.bas -- test bwBASIC ON ERROR GOSUB statement 20 print "Test bwBASIC ON ERROR GOSUB statement" 30 on error gosub 100 40 print "The next line will include an error" 50 if d$ = 78.98 then print "This should not print" 60 print "This is the line after the error" 70 end 100 rem Error handler 110 print "This is the error handler" 120 print "The error number is ";err 130 print "The error line is ";erl 150 return bwbasic-2.20pl2.orig/bwbtest/onerrlbl.bas100644 2140 24 610 5437750052 17242 0ustar rootdialoutrem onerrlbl.bas -- test bwBASIC ON ERROR GOSUB statement with label print "Test bwBASIC ON ERROR GOSUB statement" on error gosub handler print "The next line will include an error" if d$ = 78.98 then print "This should not print" print "This is the line after the error" end handler: print "This is the error handler" print "The error number is ";err print "The error line is ";erl return bwbasic-2.20pl2.orig/bwbtest/ongosub.bas100644 2140 24 506 5437750052 17103 0ustar rootdialout10 print "ONGOSUB.BAS -- Test ON..GOSUB Statement" 20 input "Enter a number 1-5";n 30 on n gosub 60, 80, 100, 120, 140 40 print "The End" 50 end 60 print "You entered 1" 70 return 80 print "You entered 2" 90 return 100 print "You entered 3" 110 return 120 print "You entered 4" 130 return 140 print "You entered 5" 150 return bwbasic-2.20pl2.orig/bwbtest/opentest.bas100644 2140 24 510 5437750052 17263 0ustar rootdialout10 PRINT "OPENTEST.BAS -- Test OPEN, PRINT#, LINE INPUT#, and CLOSE" 20 OPEN "test.out" FOR OUTPUT AS # 1 30 PRINT #1,"This is line 1." 40 PRINT #1, "This is line 2." 50 CLOSE #1 60 OPEN "test.out" FOR INPUT AS #1 70 LINE INPUT #1,A$ 80 LINE INPUT #1,B$ 90 PRINT "Read from file:" 100 PRINT ">";A$ 110 PRINT ">";B$ 120 CLOSE #1 bwbasic-2.20pl2.orig/bwbtest/option.bas100644 2140 24 274 5437750052 16741 0ustar rootdialout1 PRINT "OPTION.BAS -- Test OPTION BASE Statement" 5 OPTION BASE 1 10 DIM n(5) 20 FOR i = 1 to 5 30 LET n(i) = i + 2 40 PRINT "The value at position ";i;" is ";n(i) 50 NEXT i 60 END bwbasic-2.20pl2.orig/bwbtest/pascaltr.bas100644 2140 24 637 5456547146 17256 0ustar rootdialout100 dim pascal(14,14) 110 pascal(1,1) = 1 120 for i = 2 to 14 130 pascal(i,1) = 1 140 for j = 2 to i 150 pascal(i,j) = pascal(i-1,j)+pascal(i-1,j-1) 160 next j 170 next i 180 for i = 1 to 14 190 print i-1; ": "; 200 for j = 1 to i 210 print pascal(i,j); 220 next j 230 print 240 next i 250 end bwbasic-2.20pl2.orig/bwbtest/putget.bas100644 2140 24 646 5437750052 16744 0ustar rootdialoutrem PUTGET.BAS -- Test PUT and GET statements open "r", 1, "test.dat", 48 field 1, 20 as r1$, 20 as r2$, 8 as r3$ for l = 1 to 2 line input "name: "; n$ line input "address: "; m$ line input "phone: "; p$ lset r1$ = n$ lset r2$ = m$ lset r3$ = p$ put #1, l next l close #1 open "r", 1, "test.dat", 48 field 1, 20 as r1$, 20 as r2$, 8 as r3$ for l = 1 to 2 get #1, l print r1$, r2$, r3$ next l close #1 kill "test.dat" end bwbasic-2.20pl2.orig/bwbtest/random.bas100644 2140 24 575 5437750052 16715 0ustar rootdialout100 rem RANDOM.BAS -- Test RANDOMIZE and RND 110 print "This is a first sequence of three RND numbers:" 120 randomize timer 130 print rnd 140 print rnd 150 print rnd 160 print "This is a second sequence of three RND numbers:" 170 randomize timer + 18 180 print rnd 190 print rnd 200 print rnd 210 print "The second sequence should have been differrent" 220 print "from the first." bwbasic-2.20pl2.orig/bwbtest/selcase.bas100644 2140 24 1054 5437750052 17065 0ustar rootdialoutrem SelCase.bas -- test SELECT CASE Sub Main Print "SelCase.bas -- test SELECT CASE statement" Input "Enter a number"; d Select Case d Case 3 to 5 Print "The number is between 3 and 5." Case 6 Print "The number you entered is 6." Case 7 to 9 Print "The number is between 7 and 9." Case If > 10 Print "The number is greater than 10" Case If < 0 Print "The number is less than 0" Case Else Print "The number is 1, 2 or 10." End Select End Sub bwbasic-2.20pl2.orig/bwbtest/snglfunc.bas100644 2140 24 503 5437750052 17243 0ustar rootdialout rem ---------------------------------------------------- rem SnglFunc.BAS rem ---------------------------------------------------- Print "SnglFunc.BAS -- Test Single-Line User-defined Function Statement" Print Def Sum( x, y ) = x + y Print Print "The sum of 6 and 4 is "; Sum( 6, 4 ) Print "Did it work properly?" End bwbasic-2.20pl2.orig/bwbtest/stop.bas100644 2140 24 352 5437750052 16413 0ustar rootdialout10 REM STOP.BAS -- Test STOP Statement 20 PRINT "STOP.BAS -- Test STOP Statement" 30 PRINT "If the program is interrupted after this line, STOP worked OK" 40 STOP 50 PRINT "But if this line printed, then it did not work." 60 END bwbasic-2.20pl2.orig/bwbtest/term.bas100644 2140 24 470 5437750052 16376 0ustar rootdialout10 REM BWBASIC Program to Demonstrate Terminal-Specific Use 20 REM The following definitions are for an ANSI Terminal. 30 REM You may have to define different variables for your 40 REM particular terminal 50 REM 60 LET CL$ = chr$(&h1b)+"[2J" 70 PRINT CL$; 80 PRINT " Bywater BASIC" 90 INPUT c$ 100 END bwbasic-2.20pl2.orig/bwbtest/whilwend.bas100644 2140 24 357 5437750052 17254 0ustar rootdialout10 REM WHILWEND.BAS -- Test WHILE-WEND Loops 20 PRINT "START" 30 LET X = 0 40 WHILE X < 25 50 PRINT "x is ";X 60 LET X = X + 1 70 LET Y = 0 80 WHILE Y < 2 90 PRINT "y is "; Y 100 LET Y = Y + 1 110 WEND 120 WEND 130 PRINT "END" bwbasic-2.20pl2.orig/bwbtest/width.bas100644 2140 24 316 5437750052 16545 0ustar rootdialout10 open "o", #1, "data.tmp" 20 width #1, 35 30 print #1, "123456789012345678901234567890123456789012345678901234567890" 40 close #1 50 print "Check file to see if the printing wrapped at col 35" bwbasic-2.20pl2.orig/bwbtest/writeinp.bas100644 2140 24 1110 5437750052 17300 0ustar rootdialout10 rem WRITEINP.BAS -- Test WRITE # and INPUT # Statements 20 print "WRITEINP.BAS -- Test WRITE # and INPUT # Statements" 30 s1$ = "String 1" 40 s2$ = "String 2" 50 s3$ = "String 3" 60 x1 = 1.1234567 70 x2 = 2.2345678 80 x3 = 3.3456789 90 open "o", #1, "data.tmp" 100 write #1, s1$, x1, s2$, x2, s3$, x3 110 close #1 120 print "This is what was written:" 130 write s1$, x1, s2$, x2, s3$, x3 140 open "i", #2, "data.tmp" 150 input #2, b1$, n1, b2$, n2, b3$, n3 160 close #2 170 print "This is what was read:" 180 write b1$, n1, b2$, n2, b3$, n3 190 print "End of WRITEINP.BAS" 200 end bwbasic-2.20pl2.orig/bwx_iqc.c100644 0 0 40641 6473161701 14335 0ustar rootroot/*************************************************************** bwx_iqc.c Environment-dependent implementation of Bywater BASIC Interpreter for IBM PC and Compatibles using the Microsoft QuickC (tm) Compiler 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). */ /*---------------------------------------------------------------*/ #include #include #include #include #include #include #include "bwbasic.h" #include "bwb_mes.h" extern int prn_col; extern jmp_buf mark; short oldfgd; long oldbgd; int reset_mode = FALSE; static int iqc_setpos( void ); /*************************************************************** FUNCTION: main() DESCRIPTION: As in any C program, main() is the basic function from which the rest of the program is called. Some environments, however, provide their own main() functions (Microsoft Windows (tm) is an example). In these cases, the following code will have to be included in the initialization function that is called by the environment. ***************************************************************/ void main( int argc, char **argv ) { #if MS_CMDS struct videoconfig vc; short videomode; /* Save original foreground, background, and text position. */ _getvideoconfig( &vc ); oldfgd = _gettextcolor(); oldbgd = _getbkcolor(); if ( vc.mode != _TEXTC80 ) { if ( _setvideomode( _TEXTC80 ) == 0 ) { _getvideoconfig( &vc ); prn_xprintf( stderr, "Failed to set color video mode\n" ); } else { reset_mode = FALSE; } } else { reset_mode = FALSE; } #endif /* MS_CMDS */ bwb_init( argc, argv ); #if INTERACTIVE setjmp( mark ); #endif /* now set the number of colors available */ * var_findnval( co, co->array_pos ) = (bnumber) vc.numcolors; /* main program loop */ while( !feof( stdin ) ) /* condition !feof( stdin ) added in v1.11 */ { bwb_mainloop(); } } /*************************************************************** FUNCTION: bwx_signon() DESCRIPTION: ***************************************************************/ int bwx_signon( void ) { sprintf( bwb_ebuf, "\r%s %s\n", MES_SIGNON, VERSION ); prn_xprintf( stdout, bwb_ebuf ); sprintf( bwb_ebuf, "\r%s\n", MES_COPYRIGHT ); prn_xprintf( stdout, bwb_ebuf ); sprintf( bwb_ebuf, "\r%s\n", MES_COPYRIGHT_2 ); /* JBV 1/97 */ prn_xprintf( stdout, bwb_ebuf ); #if PERMANENT_DEBUG sprintf( bwb_ebuf, "\r%s\n", "Debugging Mode" ); prn_xprintf( stdout, bwb_ebuf ); #else sprintf( bwb_ebuf, "\r%s\n", MES_LANGUAGE ); prn_xprintf( stdout, bwb_ebuf ); #endif return TRUE; } /*************************************************************** FUNCTION: bwx_message() DESCRIPTION: ***************************************************************/ int bwx_message( char *m ) { #if DEBUG _outtext( "" ); #endif _outtext( m ); return TRUE; } /*************************************************************** FUNCTION: bwx_putc() DESCRIPTION: ***************************************************************/ extern int bwx_putc( char c ) { static char tbuf[ 2 ]; tbuf[ 0 ] = c; tbuf[ 1 ] = '\0'; _outtext( tbuf ); return TRUE; } /*************************************************************** FUNCTION: bwx_error() DESCRIPTION: ***************************************************************/ int bwx_errmes( char *m ) { static char tbuf[ MAXSTRINGSIZE + 1 ]; /* this memory should be permanent in case of memory overrun errors */ if (( prn_col != 1 ) && ( errfdevice == stderr )) { prn_xprintf( errfdevice, "\n" ); } if ( CURTASK number == 0 ) { sprintf( tbuf, "\n%s: %s\n", ERRD_HEADER, m ); } else { sprintf( tbuf, "\n%s %d: %s\n", ERROR_HEADER, CURTASK number, m ); } #if INTENSIVE_DEBUG prn_xprintf( stderr, "" ); #endif prn_xprintf( errfdevice, tbuf ); return TRUE; } /*************************************************************** FUNCTION: bwx_input() DESCRIPTION: As implemented here, the input facility is a hybrid of _outtext output (which allows the color to be set) and standard output (which does not). The reason is that I've found it helpful to use the DOS facility for text entry, with its backspace-delete and recognition of the SIGINT, depite the fact that its output goes to stdout. ***************************************************************/ int bwx_input( char *prompt, char *buffer ) { #if INTENSIVE_DEBUG prn_xprintf( stdout, "" ); #endif prn_xprintf( stdout, prompt ); fgets( buffer, MAXREADLINESIZE, stdin ); prn_xprintf( stdout, "\n" ); /* let _outtext catch up */ * prn_getcol( stdout ) = 1; /* reset column */ return TRUE; } /*************************************************************** FUNCTION: bwx_terminate() DESCRIPTION: ***************************************************************/ void bwx_terminate( void ) { #if MS_CMDS if ( reset_mode == TRUE ) { _setvideomode( _DEFAULTMODE ); /* Restore original foreground and background. */ _settextcolor( oldfgd ); _setbkcolor( oldbgd ); } #endif exit( 0 ); } /*************************************************************** FUNCTION: bwx_shell() DESCRIPTION: ***************************************************************/ #if COMMAND_SHELL extern int bwx_shell( struct bwb_line *l ) { static char *s_buffer; static int init = FALSE; static int position; /* get memory for temporary buffer if necessary */ if ( init == FALSE ) { init = TRUE; /* Revised to CALLOC pass-thru call by JBV */ if ( ( s_buffer = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL ) { bwb_error( err_getmem ); return FALSE; } } /* get the first element and check for a line number */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwx_shell(): line buffer is <%s>.", l->buffer ); bwb_debug( bwb_ebuf ); #endif position = 0; adv_element( l->buffer, &position, s_buffer ); if ( is_numconst( s_buffer ) != TRUE ) /* not a line number */ { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwx_shell(): no line number, command <%s>.", l->buffer ); bwb_debug( bwb_ebuf ); #endif if ( system( l->buffer ) == 0 ) { iqc_setpos(); return TRUE; } else { iqc_setpos(); return FALSE; } } else /* advance past line number */ { adv_ws( l->buffer, &position ); /* advance past whitespace */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwx_shell(): line number, command <%s>.", l->buffer ); bwb_debug( bwb_ebuf ); #endif if ( system( &( l->buffer[ position ] ) ) == 0 ) { iqc_setpos(); return TRUE; } else { iqc_setpos(); return FALSE; } } } #endif /*************************************************************** FUNCTION: iqc_setpos() DESCRIPTION: ***************************************************************/ static int iqc_setpos( void ) { union REGS ibm_registers; /* call the BDOS function 0x10 to read the current cursor position */ ibm_registers.h.ah = 3; ibm_registers.h.bh = (unsigned char) _getvisualpage(); int86( 0x10, &ibm_registers, &ibm_registers ); /* set text to this position */ _settextposition( ibm_registers.h.dh, ibm_registers.h.dl ); /* and move down one position */ prn_xprintf( stdout, "\n" ); return TRUE; } #if COMMON_CMDS /*************************************************************** FUNCTION: bwb_edit() DESCRIPTION: ***************************************************************/ struct bwb_line * bwb_edit( struct bwb_line *l ) { char tbuf[ MAXSTRINGSIZE + 1 ]; char edname[ MAXSTRINGSIZE + 1 ]; struct bwb_variable *ed; FILE *loadfile; ed = var_find( DEFVNAME_EDITOR ); str_btoc( edname, var_getsval( ed )); sprintf( tbuf, "%s %s", edname, CURTASK progfile ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_edit(): command line <%s>", tbuf ); bwb_debug( bwb_ebuf ); #else system( tbuf ); #endif /* open edited file for read */ if ( ( loadfile = fopen( CURTASK progfile, "r" )) == NULL ) { sprintf( bwb_ebuf, err_openfile, CURTASK progfile ); bwb_error( bwb_ebuf ); iqc_setpos(); return bwb_zline( l ); } /* clear current contents */ bwb_new( l ); /* Relocated by JBV (bug found by DD) */ /* and (re)load the file into memory */ bwb_fload( loadfile ); iqc_setpos(); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_renum() DESCRIPTION: This function implements the BASIC RENUM command by shelling out to a default renumbering program called "renum". Added by JBV 10/95 SYNTAX: RENUM ***************************************************************/ #if ANSI_C struct bwb_line * bwb_renum( struct bwb_line *l ) #else struct bwb_line * bwb_renum( l ) struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; FILE *loadfile; sprintf( tbuf, "renum %s\0", CURTASK progfile ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_renum(): command line <%s>", tbuf ); bwb_debug( bwb_ebuf ); #else system( tbuf ); #endif /* open edited file for read */ if ( ( loadfile = fopen( CURTASK progfile, "r" )) == NULL ) { sprintf( bwb_ebuf, err_openfile, CURTASK progfile ); bwb_error( bwb_ebuf ); iqc_setpos(); return bwb_zline( l ); } /* clear current contents */ bwb_new( l ); /* Relocated by JBV (bug found by DD) */ /* and (re)load the file into memory */ bwb_fload( loadfile ); iqc_setpos(); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_files() DESCRIPTION: ***************************************************************/ struct bwb_line * bwb_files( struct bwb_line *l ) { char tbuf[ MAXVARNAMESIZE + 1 ]; char finame[ MAXVARNAMESIZE + 1 ]; char argument[ MAXVARNAMESIZE + 1 ]; struct bwb_variable *fi; struct exp_ese *e; fi = var_find( DEFVNAME_FILES ); str_btoc( finame, var_getsval( fi )); /* get argument */ adv_ws( l->buffer, &( l->position )); switch( l->buffer[ l->position ] ) { case '\0': case '\r': case '\n': argument[ 0 ] = '\0'; break; default: e = bwb_exp( l->buffer, FALSE, &( l->position ) ); if ( e->type != STRING ) { bwb_error( err_mismatch ); return bwb_zline( l ); } str_btoc( argument, exp_getsval( e ) ); break; } sprintf( tbuf, "%s %s", finame, argument ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_files(): command line <%s>", tbuf ); bwb_debug( bwb_ebuf ); #else system( tbuf ); #endif iqc_setpos(); return bwb_zline( l ); } #endif /* COMMON_CMDS */ #if INTERACTIVE /*************************************************************** FUNCTION: fnc_inkey() DESCRIPTION: This C function implements the BASIC INKEY$ function. It is implementation-specific. ***************************************************************/ extern struct bwb_variable * fnc_inkey( int argc, struct bwb_variable *argv ) { static struct bwb_variable nvar; char tbuf[ MAXSTRINGSIZE + 1 ]; static int init = FALSE; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, STRING, "fnc_inkey" ); } /* check arguments */ #if PROG_ERRORS if ( argc > 0 ) { sprintf( bwb_ebuf, "Two many arguments to function INKEY$()" ); bwb_error( bwb_ebuf ); return &nvar; } #else if ( fnc_checkargs( argc, argv, 0, 0 ) == FALSE ) { return NULL; } #endif /* body of the INKEY$ function */ if ( _bios_keybrd( _KEYBRD_READY ) == 0 ) { tbuf[ 0 ] = '\0'; } else { tbuf[ 0 ] = (char) _bios_keybrd( _KEYBRD_READ ); tbuf[ 1 ] = '\0'; } /* assign value to nvar variable */ str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf ); /* return value contained in nvar */ return &nvar; } #endif /* INTERACTIVE */ #if MS_CMDS /*************************************************************** FUNCTION: bwb_cls() DESCRIPTION: This C function implements the BASIC CLS command. It is implementation-specific. ***************************************************************/ extern struct bwb_line * bwb_cls( struct bwb_line *l ) { _clearscreen( _GCLEARSCREEN ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_locate() DESCRIPTION: This C function implements the BASIC LOCATE command. It is implementation-specific. ***************************************************************/ extern struct bwb_line * bwb_locate( struct bwb_line *l ) { struct exp_ese *e; int row, column; /* get first argument */ e = bwb_exp( l->buffer, FALSE, &( l->position )); row = (int) exp_getnval( e ); /* advance past comma */ adv_ws( l->buffer, &( l->position )); if ( l->buffer[ l->position ] != ',' ) { bwb_error( err_syntax ); return bwb_zline( l ); } ++( l->position ); /* get second argument */ e = bwb_exp( l->buffer, FALSE, &( l->position )); column = (int) exp_getnval( e ); /* position the cursor */ _settextposition( row, column ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_color() DESCRIPTION: This C function implements the BASIC COLOR command. It is implementation-specific. ***************************************************************/ extern struct bwb_line * bwb_color( struct bwb_line *l ) { struct exp_ese *e; int color; /* get first argument */ e = bwb_exp( l->buffer, FALSE, &( l->position )); color = (int) exp_getnval( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "Setting text color to %d", color ); bwb_debug( bwb_ebuf ); #endif _settextcolor( (short) color ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "Set text color to %d", color ); bwb_debug( bwb_ebuf ); #endif /* advance past comma */ adv_ws( l->buffer, &( l->position )); if ( l->buffer[ l->position ] == ',' ) { ++( l->position ); /* get second argument */ e = bwb_exp( l->buffer, FALSE, &( l->position )); color = (int) exp_getnval( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "Setting background color to %d", color ); bwb_debug( bwb_ebuf ); #endif /* set the background color */ _setbkcolor( (long) color ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "Setting background color to %d\n", color ); bwb_debug( bwb_ebuf ); #endif } return bwb_zline( l ); } #endif /* MS_CMDS */ bwbasic-2.20pl2.orig/bwx_iqc.h100644 0 0 3065 5437750044 14324 0ustar rootroot/*************************************************************** bwx_iqc.h Header File for IBM PC and Compatible Implementation of bwBASIC Using Microsoft QuickC (tm) Compiler 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. ***************************************************************/ #define IMP_IDSTRING "IQC" /* unique ID string for this implementation */ /* Definitions indicating which commands and functions are implemented */ #define IMP_FNCINKEY 1 /* 0 if INKEY$ is not implemented, 1 if it is */ #define IMP_CMDCLS 1 /* 0 if CLS is not implemented, 1 if it is */ #define IMP_CMDLOC 1 /* 0 if LOCATE is not implemented, 1 if it is */ #define IMP_CMDCOLOR 1 /* 0 if COLOR is not implemented, 1 if it is */ #define UNIX_CMDS TRUE #define MKDIR_ONE_ARG TRUE /* TRUE if your mkdir has but one argument; FALSE if it has two */ #define PERMISSIONS 493 /* permissions to set in Unix-type system */ bwbasic-2.20pl2.orig/bwx_tty.c100644 0 0 30662 6473161702 14404 0ustar rootroot/*************************************************************** bwx_tty.c Environment-dependent implementation for Bywater BASIC Interpreter using simple TTY-style input/output This file should be used as a template for developing more sophisticated environment-dependent implementations 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). */ /*---------------------------------------------------------------*/ #include #include "bwbasic.h" #include "bwb_mes.h" #if HAVE_LONGJUMP /* Revised by JBV (bug found by DD) */ #include #endif extern int prn_col; #if HAVE_LONGJUMP /* Revised by JBV (bug found by DD) */ extern jmp_buf mark; #endif /*************************************************************** FUNCTION: main() DESCRIPTION: As in any C program, main() is the basic function from which the rest of the program is called. Some environments, however, provide their own main() functions (Microsoft Windows (tm) is an example). In these cases, the following code will have to be included in the initialization function that is called by the environment. ***************************************************************/ #if ANSI_C void main( int argc, char **argv ) #else main( argc, argv ) int argc; char **argv; #endif { bwb_init( argc, argv ); #if HAVE_LONGJUMP /* Revised by JBV (bug found by DD) */ #if INTERACTIVE setjmp( mark ); #endif #endif /* main program loop */ while( !feof( stdin ) ) /* condition !feof( stdin ) added in v1.11 */ { bwb_mainloop(); } bwx_terminate(); /* allow ^D (Unix) exit with grace */ } /*************************************************************** FUNCTION: bwx_signon() DESCRIPTION: This function prints out the sign-on message for bwBASIC. ***************************************************************/ #if ANSI_C int bwx_signon( void ) #else int bwx_signon() #endif { sprintf( bwb_ebuf, "\r%s %s\n", MES_SIGNON, VERSION ); prn_xprintf( stdout, bwb_ebuf ); sprintf( bwb_ebuf, "\r%s\n", MES_COPYRIGHT ); prn_xprintf( stdout, bwb_ebuf ); sprintf( bwb_ebuf, "\r%s\n", MES_COPYRIGHT_2 ); /* JBV 1/97 */ prn_xprintf( stdout, bwb_ebuf ); #if PERMANENT_DEBUG sprintf( bwb_ebuf, "\r%s\n", "Debugging Mode" ); prn_xprintf( stdout, bwb_ebuf ); #else sprintf( bwb_ebuf, "\r%s\n", MES_LANGUAGE ); prn_xprintf( stdout, bwb_ebuf ); #endif return TRUE; } /*************************************************************** FUNCTION: bwx_message() DESCRIPTION: This function outputs a message to the default output device. ***************************************************************/ #if ANSI_C int bwx_message( char *m ) #else int bwx_message( m ) char *m; #endif { #if INTENSIVE_DEBUG fprintf( stderr, "" ); #endif prn_xprintf( stdout, m ); return TRUE; } /*************************************************************** FUNCTION: bwx_putc() DESCRIPTION: This function outputs a single character to the default output device. ***************************************************************/ #if ANSI_C int bwx_putc( char c ) #else int bwx_putc( c ) char c; #endif { return fputc( c, stdout ); } /*************************************************************** FUNCTION: bwx_error() DESCRIPTION: This function outputs a message to the default error-message device. ***************************************************************/ #if ANSI_C int bwx_errmes( char *m ) #else int bwx_errmes( m ) char *m; #endif { static char tbuf[ MAXSTRINGSIZE + 1 ]; /* this memory should be permanent in case of memory overrun errors */ if (( prn_col != 1 ) && ( errfdevice == stderr )) { prn_xprintf( errfdevice, "\n" ); } if ( CURTASK number == 0 ) { sprintf( tbuf, "\n%s: %s\n", ERRD_HEADER, m ); } else { sprintf( tbuf, "\n%s %d: %s\n", ERROR_HEADER, CURTASK number, m ); } #if INTENSIVE_DEBUG fprintf( stderr, "" ); #endif prn_xprintf( errfdevice, tbuf ); return TRUE; } /*************************************************************** FUNCTION: bwx_input() DESCRIPTION: This function outputs the string pointed to by 'prompt', then inputs a character string. ***************************************************************/ #if ANSI_C int bwx_input( char *prompt, char *buffer ) #else int bwx_input( prompt, buffer ) char *prompt; char *buffer; #endif { #if INTENSIVE_DEBUG fprintf( stderr, "" ); #endif prn_xprintf( stdout, prompt ); fgets( buffer, MAXREADLINESIZE, stdin ); * prn_getcol( stdout ) = 1; /* reset column */ return TRUE; } /*************************************************************** FUNCTION: bwx_terminate() DESCRIPTION: This function terminates program execution. ***************************************************************/ #if ANSI_C void bwx_terminate( void ) #else void bwx_terminate() #endif { exit( 0 ); } /*************************************************************** FUNCTION: bwx_shell() DESCRIPTION: This function runs a shell program. ***************************************************************/ #if COMMAND_SHELL #if ANSI_C extern int bwx_shell( struct bwb_line *l ) #else extern int bwx_shell( l ) struct bwb_line *l; #endif { static char *s_buffer; static int init = FALSE; static int position; /* get memory for temporary buffer if necessary */ if ( init == FALSE ) { init = TRUE; /* Revised to CALLOC pass-thru call by JBV */ if ( ( s_buffer = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "bwx_shell" )) == NULL ) { bwb_error( err_getmem ); return FALSE; } } /* get the first element and check for a line number */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwx_shell(): line buffer is <%s>.", l->buffer ); bwb_debug( bwb_ebuf ); #endif position = 0; adv_element( l->buffer, &position, s_buffer ); if ( is_numconst( s_buffer ) != TRUE ) /* not a line number */ { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwx_shell(): no line number, command <%s>.", l->buffer ); bwb_debug( bwb_ebuf ); #endif if ( system( l->buffer ) == 0 ) { return TRUE; } else { return FALSE; } } else /* advance past line number */ { adv_ws( l->buffer, &position ); /* advance past whitespace */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwx_shell(): line number, command <%s>.", l->buffer ); bwb_debug( bwb_ebuf ); #endif if ( system( &( l->buffer[ position ] ) ) == 0 ) { return TRUE; } else { return FALSE; } } } #endif /*************************************************************** FUNCTION: matherr() DESCRIPTION: This function is called to handle math errors in Bywater BASIC. It displays the error message, then calls the break_handler() routine. ***************************************************************/ #if ANSI_C int matherr( struct exception *except ) #else int matherr( except ) struct exception *except; #endif { perror( MATHERR_HEADER ); break_handler(); return FALSE; } #if COMMON_CMDS /*************************************************************** FUNCTION: bwb_edit() DESCRIPTION: This function implements the BASIC EDIT program by shelling out to a default editor specified by the variable BWB.EDITOR$. SYNTAX: EDIT ***************************************************************/ #if ANSI_C struct bwb_line * bwb_edit( struct bwb_line *l ) #else struct bwb_line * bwb_edit( l ) struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; char edname[ MAXSTRINGSIZE + 1 ]; struct bwb_variable *ed; FILE *loadfile; ed = var_find( DEFVNAME_EDITOR ); str_btoc( edname, var_getsval( ed )); sprintf( tbuf, "%s %s", edname, CURTASK progfile ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_edit(): command line <%s>", tbuf ); bwb_debug( bwb_ebuf ); #else system( tbuf ); #endif /* open edited file for read */ if ( ( loadfile = fopen( CURTASK progfile, "r" )) == NULL ) { sprintf( bwb_ebuf, err_openfile, CURTASK progfile ); bwb_error( bwb_ebuf ); return bwb_zline( l ); } /* clear current contents */ bwb_new( l ); /* Relocated by JBV (bug found by DD) */ /* and (re)load the file into memory */ bwb_fload( loadfile ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_renum() DESCRIPTION: This function implements the BASIC RENUM command by shelling out to a default renumbering program called "renum". Added by JBV 10/95 SYNTAX: RENUM ***************************************************************/ #if ANSI_C struct bwb_line * bwb_renum( struct bwb_line *l ) #else struct bwb_line * bwb_renum( l ) struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; FILE *loadfile; sprintf( tbuf, "renum %s\0", CURTASK progfile ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_renum(): command line <%s>", tbuf ); bwb_debug( bwb_ebuf ); #else system( tbuf ); #endif /* open edited file for read */ if ( ( loadfile = fopen( CURTASK progfile, "r" )) == NULL ) { sprintf( bwb_ebuf, err_openfile, CURTASK progfile ); bwb_error( bwb_ebuf ); return bwb_zline( l ); } /* clear current contents */ bwb_new( l ); /* Relocated by JBV (bug found by DD) */ /* and (re)load the file into memory */ bwb_fload( loadfile ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_files() DESCRIPTION: This function implements the BASIC FILES command, in this case by shelling out to a directory listing program or command specified in the variable BWB.FILES$. SYNTAX: FILES filespec$ ***************************************************************/ #if ANSI_C struct bwb_line * bwb_files( struct bwb_line *l ) #else struct bwb_line * bwb_files( l ) struct bwb_line *l; #endif { char tbuf[ MAXVARNAMESIZE + 1 ]; char finame[ MAXVARNAMESIZE + 1 ]; char argument[ MAXVARNAMESIZE + 1 ]; struct bwb_variable *fi; struct exp_ese *e; fi = var_find( DEFVNAME_FILES ); str_btoc( finame, var_getsval( fi )); /* get argument */ adv_ws( l->buffer, &( l->position )); switch( l->buffer[ l->position ] ) { case '\0': case '\r': case '\n': argument[ 0 ] = '\0'; break; default: e = bwb_exp( l->buffer, FALSE, &( l->position ) ); if ( e->type != STRING ) { bwb_error( err_mismatch ); return bwb_zline( l ); } str_btoc( argument, exp_getsval( e ) ); break; } sprintf( tbuf, "%s %s", finame, argument ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_files(): command line <%s>", tbuf ); bwb_debug( bwb_ebuf ); #else system( tbuf ); #endif return bwb_zline( l ); } #endif /* COMMON_CMDS */ bwbasic-2.20pl2.orig/bwx_tty.h100644 0 0 3653 6055714562 14375 0ustar rootroot/*************************************************************** bwx_tty.h Header file for TTY-style hardware implementation of bwBASIC This file may be used as a template for developing more sophisticated hardware implementations 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). */ /*---------------------------------------------------------------*/ #define IMP_IDSTRING "TTY" /* unique ID string for this implementation */ /* Definitions indicating which commands and functions are implemented */ #define IMP_FNCINKEY 0 /* 0 if INKEY$ is not implemented, 1 if it is */ #define IMP_CMDCLS 0 /* 0 if CLS is not implemented, 1 if it is */ #define IMP_CMDLOC 0 /* 0 if LOCATE is not implemented, 1 if it is */ #define IMP_CMDCOLOR 0 /* 0 if COLOR is not implemented, 1 if it is */ #define UNIX_CMDS TRUE /* It better be for UNIX systems (JBV) */ #define MKDIR_ONE_ARG FALSE /* TRUE if your mkdir has but one argument; FALSE if it has two */ #define PERMISSIONS 644 /* permissions to set in Unix-type system */ bwbasic-2.20pl2.orig/configure100755 0 0 21742 6055714562 14452 0ustar rootroot#!/bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated automatically using autoconf. # Copyright (C) 1991, 1992, 1993 Free Software Foundation, Inc. # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # Usage: configure [--srcdir=DIR] [--host=HOST] [--gas] [--nfp] [--no-create] # [--prefix=PREFIX] [--exec-prefix=PREFIX] [--with-PACKAGE] [TARGET] # Ignores all args except --srcdir, --prefix, --exec-prefix, --no-create, and # --with-PACKAGE unless this script has special code to handle it. ##---------------------------------------------------------------## ## NOTE: Modifications marked "JBV" were made by Jon B. Volkoff, ## ## 11/1995 (eidetics@cerf.net). ## ##---------------------------------------------------------------## for arg do # Handle --exec-prefix with a space before the argument. if test x$next_exec_prefix = xyes; then exec_prefix=$arg; next_exec_prefix= # Handle --host with a space before the argument. elif test x$next_host = xyes; then next_host= # Handle --prefix with a space before the argument. elif test x$next_prefix = xyes; then prefix=$arg; next_prefix= # Handle --srcdir with a space before the argument. elif test x$next_srcdir = xyes; then srcdir=$arg; next_srcdir= else case $arg in # For backward compatibility, also recognize exact --exec_prefix. -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* | --exec=* | --exe=* | --ex=* | --e=*) exec_prefix=`echo $arg | sed 's/[-a-z_]*=//'` ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- | --exec | --exe | --ex | --e) next_exec_prefix=yes ;; -gas | --gas | --ga | --g) ;; -host=* | --host=* | --hos=* | --ho=* | --h=*) ;; -host | --host | --hos | --ho | --h) next_host=yes ;; -nfp | --nfp | --nf) ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre | --no-cr | --no-c | --no- | --no) no_create=1 ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=`echo $arg | sed 's/[-a-z_]*=//'` ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) next_prefix=yes ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=* | --s=*) srcdir=`echo $arg | sed 's/[-a-z_]*=//'` ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr | --s) next_srcdir=yes ;; -with-* | --with-*) package=`echo $arg|sed 's/-*with-//'` # Delete all the valid chars; see if any are left. if test -n "`echo $package|sed 's/[-a-zA-Z0-9_]*//g'`"; then echo "configure: $package: invalid package name" >&2; exit 1 fi eval "with_`echo $package|sed s/-/_/g`=1" ;; *) ;; esac fi done trap 'rm -f conftest* core; exit 1' 1 3 15 rm -f conftest* compile='${CC-cc} $DEFS conftest.c -o conftest $LIBS >/dev/null 2>&1' # A filename unique to this package, relative to the directory that # configure is in, which we can look for to find out if srcdir is correct. unique_file=bwb_cmd.c # Find the source files, if location was not specified. if test -z "$srcdir"; then srcdirdefaulted=yes # Try the directory containing this script, then `..'. prog=$0 confdir=`echo $prog|sed 's%/[^/][^/]*$%%'` test "X$confdir" = "X$prog" && confdir=. srcdir=$confdir if test ! -r $srcdir/$unique_file; then srcdir=.. fi fi if test ! -r $srcdir/$unique_file; then if test x$srcdirdefaulted = xyes; then echo "configure: Can not find sources in \`${confdir}' or \`..'." 1>&2 else echo "configure: Can not find sources in \`${srcdir}'." 1>&2 fi exit 1 fi # Preserve a srcdir of `.' to avoid automounter screwups with pwd. # But we can't avoid them for `..', to make subdirectories work. case $srcdir in .|/*|~*) ;; *) srcdir=`cd $srcdir; pwd` ;; # Make relative path absolute. esac if test -z "$CC"; then echo checking for gcc saveifs="$IFS"; IFS="${IFS}:" for dir in $PATH; do test -z "$dir" && dir=. if test -f $dir/gcc; then CC="gcc" break fi done IFS="$saveifs" fi test -z "$CC" && CC="cc" # Find out if we are using GNU C, under whatever name. cat > conftest.c < conftest.out 2>&1 if egrep yes conftest.out >/dev/null 2>&1; then GCC=1 # For later tests. fi rm -f conftest* echo checking how to run the C preprocessor if test -z "$CPP"; then CPP='${CC-cc} -E' cat > conftest.c < EOF err=`eval "$CPP $DEFS conftest.c 2>&1 >/dev/null"` if test -z "$err"; then : else CPP=/lib/cpp fi rm -f conftest* fi # Make sure to not get the incompatible SysV /etc/install and # /usr/sbin/install, which might be in PATH before a BSD-like install, # or the SunOS /usr/etc/install directory, or the AIX /bin/install, # or the AFS install, which mishandles nonexistent args. (Sigh.) if test -z "$INSTALL"; then echo checking for install saveifs="$IFS"; IFS="${IFS}:" for dir in $PATH; do test -z "$dir" && dir=. case $dir in /etc|/usr/sbin|/usr/etc|/usr/afsws/bin) ;; *) if test -f $dir/install; then if grep dspmsg $dir/install >/dev/null 2>&1; then : # AIX else INSTALL="$dir/install -c" INSTALL_PROGRAM='$(INSTALL)' INSTALL_DATA='$(INSTALL) -m 644' break fi fi ;; esac done IFS="$saveifs" fi INSTALL=${INSTALL-cp} INSTALL_PROGRAM=${INSTALL_PROGRAM-'$(INSTALL)'} INSTALL_DATA=${INSTALL_DATA-'$(INSTALL)'} echo checking for size_t in sys/types.h echo '#include ' > conftest.c eval "$CPP $DEFS conftest.c > conftest.out 2>&1" if egrep "size_t" conftest.out >/dev/null 2>&1; then : else DEFS="$DEFS -Dsize_t=unsigned" fi rm -f conftest* echo checking for string.h cat > conftest.c < EOF err=`eval "$CPP $DEFS conftest.c 2>&1 >/dev/null"` if test -z "$err"; then DEFS="$DEFS -DHAVE_STRING=1" fi rm -f conftest* echo checking for stdlib.h cat > conftest.c < EOF err=`eval "$CPP $DEFS conftest.c 2>&1 >/dev/null"` if test -z "$err"; then DEFS="$DEFS -DHAVE_STDLIB=1" fi rm -f conftest* # unistd.h checking added by JBV echo checking for unistd.h cat > conftest.c < EOF err=`eval "$CPP $DEFS conftest.c 2>&1 >/dev/null"` if test -z "$err"; then DEFS="$DEFS -DHAVE_UNISTD=1" fi rm -f conftest* echo checking for raise cat > conftest.c < #include main() { exit(0); } t() { raise(1); } EOF if eval $compile; then DEFS="$DEFS -DHAVE_RAISE=1" fi rm -f conftest* if test -n "$prefix"; then test -z "$exec_prefix" && exec_prefix='${prefix}' prsub="s%^prefix\\([ ]*\\)=\\([ ]*\\).*$%prefix\\1=\\2$prefix%" fi if test -n "$exec_prefix"; then prsub="$prsub s%^exec_prefix\\([ ]*\\)=\\([ ]*\\).*$%\ exec_prefix\\1=\\2$exec_prefix%" fi trap 'rm -f config.status; exit 1' 1 3 15 echo creating config.status rm -f config.status cat > config.status </dev/null`: # # $0 $* for arg do case "\$arg" in -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) exec /bin/sh $0 $* ;; *) echo "Usage: config.status --recheck" 2>&1; exit 1 ;; esac done trap 'rm -f Makefile; exit 1' 1 3 15 CC='$CC' CPP='$CPP' INSTALL='$INSTALL' INSTALL_PROGRAM='$INSTALL_PROGRAM' INSTALL_DATA='$INSTALL_DATA' LIBS='$LIBS' srcdir='$srcdir' DEFS='$DEFS' prefix='$prefix' exec_prefix='$exec_prefix' prsub='$prsub' EOF cat >> config.status <<\EOF top_srcdir=$srcdir for file in .. Makefile; do if [ "x$file" != "x.." ]; then srcdir=$top_srcdir # Remove last slash and all that follows it. Not all systems have dirname. dir=`echo $file|sed 's%/[^/][^/]*$%%'` if test "$dir" != "$file"; then test "$top_srcdir" != . && srcdir=$top_srcdir/$dir test ! -d $dir && mkdir $dir fi echo creating $file rm -f $file echo "# Generated automatically from `echo $file|sed 's|.*/||'`.in by configure." > $file sed -e " $prsub s%@CC@%$CC%g s%@CPP@%$CPP%g s%@INSTALL@%$INSTALL%g s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g s%@INSTALL_DATA@%$INSTALL_DATA%g s%@LIBS@%$LIBS%g s%@srcdir@%$srcdir%g s%@DEFS@%$DEFS% " $top_srcdir/${file}.in >> $file fi; done EOF chmod +x config.status test -n "$no_create" || ./config.status bwbasic-2.20pl2.orig/configure.in100644 0 0 633 6055714562 15010 0ustar rootrootdnl Process this file with autoconf to produce a configure script. AC_INIT(bwb_cmd.c) AC_PROG_CC AC_PROG_CPP AC_PROG_INSTALL AC_SIZE_T AC_HEADER_CHECK(string.h, AC_DEFINE(HAVE_STRING)) AC_HEADER_CHECK(stdlib.h, AC_DEFINE(HAVE_STDLIB)) AC_HEADER_CHECK(unistd.h, AC_DEFINE(HAVE_UNISTD)) AC_COMPILE_CHECK(raise, [#include #include ], [raise(1);], AC_DEFINE(HAVE_RAISE)) AC_OUTPUT(Makefile) bwbasic-2.20pl2.orig/makefile.qcl100644 0 0 2651 5455156634 15002 0ustar rootroot# Microsoft QuickC Makefile for Bywater BASIC Interpreter # # This makefile is for line-oriented QuickC only, not for # the QuickC integrated environment. To make the program: # type "nmake -f makefile.qcl". # # To implement the bwx_iqc implementation (using specific # features for the IBM PC and compatibles), chainge each # instance of "bwx_tty" to "bwx_iqc". # PROJ= bwbasic CC= qcl # # These are the normal flags I used to compile bwBASIC: # CFLAGS= -O -AL -W3 -Za -DMSDOS # # The following flags can be used for debugging: # #CFLAGS= -Od -AL -W3 -Za -Zr -Zi -DMSDOS LFLAGS= /NOE /ST:8192 OFILES= bwbasic.obj bwb_int.obj bwb_tbl.obj bwb_cmd.obj bwb_prn.obj\ bwb_exp.obj bwb_var.obj bwb_inp.obj bwb_fnc.obj bwb_cnd.obj\ bwb_ops.obj bwb_dio.obj bwb_str.obj bwb_elx.obj bwb_mth.obj\ bwb_stc.obj bwb_par.obj bwx_tty.obj HFILES= bwbasic.h bwb_mes.h all: $(PROJ).exe $(OFILES): $(HFILES) makefile.qcl $(PROJ).exe: $(OFILES) echo >NUL @<<$(PROJ).crf bwbasic.obj + bwb_cmd.obj + bwb_cnd.obj + bwb_fnc.obj + bwb_inp.obj + bwb_int.obj + bwb_prn.obj + bwb_tbl.obj + bwb_var.obj + bwb_exp.obj + bwb_ops.obj + bwb_dio.obj + bwb_str.obj + bwb_elx.obj + bwb_mth.obj + bwb_stc.obj + bwb_par.obj + bwx_tty.obj + $(OBJS_EXT) $(PROJ).exe $(LIBS_EXT); << link $(LFLAGS) @$(PROJ).crf erase $(PROJ).crf bwbasic-2.20pl2.orig/renum.c100644 0 0 35143 6055714562 14035 0ustar rootroot/*-------------------------------------------------------------------*/ /* renum.c -- Renumbers a BASIC program in an ASCII file. */ /* Originally written in HP 2000 BASIC by David Lance Robinson, 1977 */ /* Adapted to MS BASIC and translated to C 4/1995 by Jon B. Volkoff */ /* (eidetics@cerf.net) */ /*-------------------------------------------------------------------*/ #include int instr(); char *midstr1(); char *midstr2(); void binary_search(void); int f2, l2, n, x; int sidx[1500][2]; char rstr[255]; main(argc, argv) int argc; char *argv[]; { int f, d, s, p, s1, t, l, g; int c, f1, c1, i, f8, r, l1, l3; int v1, f6, l6, b, f9, x9, b1, p8, p9, a, d9; char pstr[255], sstr[255], f9str[255], s9str[255], tempstr[255]; FILE *fdin, *fdout; int skip, bp, temp, getout, disp_msg; f = 1; if (argc > 1) strcpy(pstr, argv[1]); else { printf("Program in file? "); gets(pstr); } if (strlen(pstr) == 0) strcpy(pstr, "0.doc"); fdin = fopen(pstr, "r"); if (fdin == NULL) { printf("Unable to open input file\n"); exit(1); } strcpy(f9str, pstr); strcpy(pstr, "editfl"); fdout = fopen(pstr, "w"); if (fdout == NULL) { printf("Unable to open editfl output file\n"); exit(1); } /* Main program begins here */ s = 0; l2 = 0; d = 0; f2 = 10000; printf ("PLEASE WAIT A FEW SECONDS!\n"); while (fgets(pstr, 255, fdin) != NULL) { pstr[strlen(pstr) - 1] = '\0'; p = instr(pstr, " "); if (p != 0 && p <= 5) { n = atoi(midstr2(pstr, 1, p)); if (n != 0) { s++; sidx[s][0] = n; s1 = s; while (s1 >= 2) { s1--; if (sidx[s1][0] < sidx[s1 + 1][0]) break; if (sidx[s1][0] == sidx[s1 + 1][0]) { printf("ERROR !!! MORE THAN ONE STATEMENT FOR A "); printf("STATEMENT NUMBER\n"); exit(1); } t = sidx[s1][0]; sidx[s1][0] = sidx[s1 + 1][0]; sidx[s1 + 1][0] = t; } } } } fclose(fdin); if (s == 0) { printf("NO PROGRAM IS IN THE FILE!\n"); exit(1); } for (l = 1; l <= s; l++) sidx[l][1] = sidx[l][0]; g = 1; disp_msg = 1; /*------------------------------------------------------------------------*/ /* Find out how and what to renumber (using HP BASIC renumber parameters) */ /* MS BASIC renumber is: RENUM (newnum) (,(oldnum) (,increment)) */ /*------------------------------------------------------------------------*/ while(1) { if (disp_msg == 1) { printf("RENUMBER (-starting number (,interval (,first statement "); printf("(,last))))\n"); disp_msg = 0; } skip = 0; bp = 0; printf("RENUMBER-"); gets(pstr); p = strlen(pstr); if (g == 0) { if (strlen(pstr) == 0) break; if (p == 0) skip = 1; else { t = atoi(midstr2(pstr, 1, 1)); if (t == 0) break; } } if (strlen(pstr) == 0) skip = 1; if (skip == 0) { c = instr(pstr, ","); temp = 0; if (c != 0) temp = -1; f1 = atoi(midstr2(pstr, 1, p + temp*(p - c + 1))); if (f1 == 0) bp = 1; if (c == 0) skip = 2; } if (skip == 0 && bp == 0) { c1 = instr(midstr1(pstr, c + 1), ",") + c; temp = 0; if (c1 != c) temp = -1; i = atoi(midstr2(pstr, c + 1, p + temp*(p - c1 + 1) - c)); if (i == 0) bp = 1; if (c1 == c) skip = 3; } if (skip == 0 && bp == 0) { c = instr(midstr1(pstr, c1 + 1), ",") + c1; temp = 0; if (c != c1) temp = -1; f8 = atoi(midstr2(pstr, c1 + 1, p + temp*(p - c + 1) - c1)); if (f8 == 0) bp = 1; if (c == c1) skip = 4; } if (skip == 0 && bp == 0) { l = atoi(midstr1(pstr, c + 1)); if (l == 0) bp = 1; } if (bp == 0) switch (skip) { case 1: f1 = 10; i = 10; f8 = 1; l = 99999; break; case 2: i = 10; f8 = 1; l = 99999; break; case 3: f8 = 1; l = 99999; break; case 4: l = 99999; break; } if (f1 < 1 || i == 0 || f8 < 1 || l < 1) bp = 1; if (f1 > 99999 || i > 99999 || f8 > 99999 || l > 99999 || f8 > l) bp = 1; c = 0; for (r = 1; r <= s; r++) if (sidx[r][0] >= f8 && sidx[r][0] <= l) c = c + 1; if (c == 0) { printf("There is nothing to renumber !!\n"); disp_msg = 1; } /*------------------------------------*/ /* Make list of new statement numbers */ /*------------------------------------*/ l1 = f1 + (c - 1)*i; if (l1 < 1 || l1 > 99999) bp = 1; x = 0; c = 0; if (bp == 0 && disp_msg == 0) for (r = 1; r <= s; r++) { if (sidx[r][0] < f8 || sidx[r][0] > l) if (sidx[r][1] >= f1 && sidx[r][1] <= l1) { printf("SEQUENCE NUMBER OVERLAP\n"); exit(1); } else {} else { if (sidx[r][0] != f1 + c*i) { if (x == 0) { if (r < f2) f2 = r; x = 1; } if (r > l2) l2 = r; } sidx[r][1] = f1 + c*i; c++; l3 = r; } } if (bp == 0 && disp_msg == 0) g = 0; if (bp == 1) printf("BAD PARAMETER\n"); } /*-------------------*/ /* Start renumbering */ /*-------------------*/ if (l2 == 0) { printf("NOTHING RENUMBERED!\n"); exit(1); } printf("RENUMBERING\n"); /* for (r = 1; r <= s; r ++) printf("%d -> %d\n", sidx[r][0], sidx[r][1]); */ printf("VERIFY? "); gets(pstr); v1 = 0; if (strcmp(midstr2(pstr, 1, 1), "N") == 0) v1 = 1; fdin = fopen(f9str, "r"); if (fdin == NULL) { printf("Unable to open input file\n"); exit(1); } f6 = sidx[f2][0]; l6 = sidx[l2][0]; while (fgets(pstr, 255, fdin) != NULL) { pstr[strlen(pstr) - 1] = '\0'; b = instr(pstr, " "); if (b != 0) { n = atoi(midstr2(pstr, 1, b)); if (n != 0) { if (n >= f6 && n <= l6) { binary_search(); if (x == 0) { strcat(rstr, midstr1(pstr, b)); strcpy(pstr, rstr); b = instr(pstr, " "); } } b++; /*-------------------------------------------------------------*/ /* There are differences, of course, between processing for HP */ /* BASIC and MS BASIC. */ /* */ /* CONVERT, PRINT USING, and MAT PRINT USING changes are not */ /* applicable in MS BASIC. */ /* */ /* Had to also add capability for multiple statements here. */ /*-------------------------------------------------------------*/ while(1) { if (strcmp(midstr2(pstr, b, 3), "REM") == 0 || strcmp(midstr2(pstr, b, 1), "'") == 0) break; f9 = 0; skip = 0; for (x9 = b; x9 <= strlen(pstr); x9++) { if ((char)(*midstr2(pstr, x9, 1)) == 34) { if (f9 == 0) f9 = 1; else f9 = 0; } else if (strcmp(midstr2(pstr, x9, 1), ":") == 0 && f9 == 0) { b1 = x9 - 1; skip = 1; break; } } if (skip == 0) b1 = strlen(pstr); t = instr("GOSGOTIF ON RESRET", midstr2(pstr, b, 3)); temp = (t + 5)/3; if (temp != 1) { if (temp == 2 || temp == 3 || temp == 4 || temp == 6 || temp == 7) { /*-------------------------------------------------*/ /* Change GOSUB, GOTO, IF, RESTORE, RESUME, RETURN */ /* routine. */ /* Go word by word through the statement. */ /*-------------------------------------------------*/ getout = 0; p8 = b; strcpy(s9str, " "); } else if (temp == 5) { /*---------------------------------------------------*/ /* Change ON event/expression GOSUB/GOTO routine. */ /* Find starting point appropriate to this statement */ /* type. */ /*---------------------------------------------------*/ getout = 1; for (x9 = b1; x9 >= b; x9--) { if (strcmp(midstr2(pstr, x9, 1), " ") == 0) { p8 = x9 + 1; getout = 0; break; } } if (getout == 0) strcpy(s9str, ","); } /* Start looping here */ if (getout == 0) while(1) { f9 = 0; skip = 0; for (x9 = p8; x9 <= b1; x9++) { if ((char)(*midstr2(pstr, x9, 1)) == 34) { if (f9 == 0) f9 = 1; else f9 = 0; } else if (strcmp(midstr2(pstr, x9, 1), s9str) == 0 && f9 == 0) { p9 = x9 - 1; skip = 1; break; } } if (skip == 0) p9 = b1; skip = 0; for (x9 = p8; x9 <= p9; x9++) { a = (char)(*midstr2(pstr, x9, 1)); if (a < 48 || a > 57) { skip = 1; break; } } if (skip == 0) { /*---------------------*/ /* Found a line number */ /*---------------------*/ n = atoi(midstr2(pstr, p8, p9 - p8 + 1)); if (n != 0) { if (n >= f6 && n <= l6) { binary_search(); if (x == 0) { if (p9 == strlen(pstr)) { strcpy(tempstr, midstr2(pstr, 1, p8 - 1)); strcat(tempstr, rstr); strcpy(pstr, tempstr); } else { strcpy(tempstr, midstr2(pstr, 1, p8 - 1)); strcat(tempstr, rstr); strcat(tempstr, midstr1(pstr, p9 + 1)); strcpy(pstr, tempstr); } /*-----------------------------------*/ /* Adjust indices to account for new */ /* substring length, if any. */ /*-----------------------------------*/ d9 = strlen(rstr) - (p9 - p8 + 1); p9 = p9 + d9; b1 = b1 + d9; } } } } p8 = p9 + 2; if (p8 > b1) break; } } /*--------------------------------------------------*/ /* No more words to process in the statement, go to */ /* next statement. */ /*--------------------------------------------------*/ if (b1 == strlen(pstr)) break; b = b1 + 2; } } } fprintf(fdout, "%s\n", pstr); if (v1 == 0) printf("%s\n", pstr); } fclose(fdin); fclose(fdout); sprintf(tempstr, "mv editfl %s\0", f9str); system(tempstr); } int instr(astr, bstr) char *astr, *bstr; { int p; p = strstr(astr, bstr); if (p == NULL) p = (int)(astr) - 1; p = p - (int)(astr) + 1; return p; } char *midstr1(astr, start) char *astr; int start; { static char tempstr[255]; char *startptr; strcpy(tempstr, astr); startptr = (char *)((long)(tempstr) + start - 1); return startptr; } char *midstr2(astr, start, len) char *astr; int start, len; { static char tempstr[255]; char *startptr, *endptr; strcpy(tempstr, astr); startptr = (char *)((long)(tempstr) + start - 1); endptr = (char *)((long)(tempstr) + start + len - 1); strcpy(endptr, "\0"); return startptr; } void binary_search(void) { int f5, l5, m; f5 = f2; l5 = l2 + 1; while(1) { m = (f5 + l5)/2; if (sidx[m][0] == n) { sprintf(rstr, "%d\0", sidx[m][1]); x = 0; return; } if (m == f5 || m == l5) { x = 1; return; } if (sidx[m][0] < n) f5 = m; else l5 = m; } } bwbasic-2.20pl2.orig/Makefile.ncu100644 0 0 7040 6473161676 14750 0ustar rootroot# Generated automatically from Makefile.in by configure. # Unix Makefile for Bywater BASIC Interpreter ##---------------------------------------------------------------## ## NOTE: Modifications marked "JBV" were made by Jon B. Volkoff, ## ## 10/1995 (eidetics@cerf.net). ## ##---------------------------------------------------------------## srcdir = . VPATH = . CC = cc INSTALL = cp INSTALL_PROGRAM = $(INSTALL) INSTALL_DATA = $(INSTALL) DEFS = -DHAVE_STRING=1 -DHAVE_STDLIB=1 -DHAVE_RAISE=1 -DHAVE_UNISTD=1 # Revised by JBV #CFLAGS = -O CFLAGS = -g -ansi # Revised by JBV #LDFLAGS = -s prefix = /usr/local exec_prefix = $(prefix) bindir = $(exec_prefix)/bin SHELL = /bin/sh #CFILES= bwbasic.c bwb_int.c bwb_tbl.c bwb_cmd.c bwb_prn.c\ # bwb_exp.c bwb_var.c bwb_inp.c bwb_fnc.c bwb_cnd.c\ # bwb_ops.c bwb_dio.c bwb_str.c bwb_elx.c bwb_mth.c\ # bwb_stc.c bwb_par.c bwx_tty.c CFILES= bwbasic.c bwb_int.c bwb_tbl.c bwb_cmd.c bwb_prn.c\ bwb_exp.c bwb_var.c bwb_inp.c bwb_fnc.c bwb_cnd.c\ bwb_ops.c bwb_dio.c bwb_str.c bwb_elx.c bwb_mth.c\ bwb_stc.c bwb_par.c bwx_ncu.c #OFILES= bwbasic.o bwb_int.o bwb_tbl.o bwb_cmd.o bwb_prn.o\ # bwb_exp.o bwb_var.o bwb_inp.o bwb_fnc.o bwb_cnd.o\ # bwb_ops.o bwb_dio.o bwb_str.o bwb_elx.o bwb_mth.o\ # bwb_stc.o bwb_par.o bwx_tty.o OFILES= bwbasic.o bwb_int.o bwb_tbl.o bwb_cmd.o bwb_prn.o\ bwb_exp.o bwb_var.o bwb_inp.o bwb_fnc.o bwb_cnd.o\ bwb_ops.o bwb_dio.o bwb_str.o bwb_elx.o bwb_mth.o\ bwb_stc.o bwb_par.o bwx_ncu.o #HFILES= bwbasic.h bwb_mes.h bwx_tty.h HFILES= bwbasic.h bwb_mes.h bwx_ncu.h MISCFILES= COPYING INSTALL Makefile.in README bwbasic.doc\ bwbasic.mak configure.in configure makefile.qcl\ bwb_tcc.c bwx_iqc.c bwx_iqc.h bwx_ncu.c bwx_ncu.h TESTFILES= \ abs.bas assign.bas callfunc.bas callsub.bas chain1.bas\ chain2.bas dataread.bas deffn.bas dim.bas doloop.bas\ dowhile.bas elseif.bas end.bas err.bas fncallfn.bas\ fornext.bas function.bas gosub.bas gotolabl.bas ifline.bas\ index.txt input.bas lof.bas loopuntl.bas main.bas\ mlifthen.bas on.bas onerr.bas onerrlbl.bas ongosub.bas\ opentest.bas option.bas putget.bas random.bas selcase.bas\ snglfunc.bas stop.bas term.bas whilwend.bas width.bas\ writeinp.bas pascaltr.bas DISTFILES= $(CFILES) $(HFILES) $(MISCFILES) # Revised by JBV #all: bwbasic all: bwbasic renum bwbasic: $(OFILES) $(CC) $(OFILES) -lm -lcurses -o $@ $(LDFLAGS) # Added by JBV renum: $(CC) renum.c -o renum $(OFILES): $(HFILES) .c.o: $(CC) -c $(CPPFLAGS) -I$(srcdir) $(DEFS) $(CFLAGS) $< install: all $(INSTALL_PROGRAM) bwbasic $(bindir)/bwbasic uninstall: rm -f $(bindir)/bwbasic Makefile: Makefile.in config.status $(SHELL) config.status config.status: configure $(SHELL) config.status --recheck configure: configure.in cd $(srcdir); autoconf TAGS: $(CFILES) etags $(CFILES) clean: rm -f *.o bwbasic core mostlyclean: clean distclean: clean rm -f Makefile config.status realclean: distclean rm -f TAGS # Version number changed from 2.10 to 2.20 by JBV dist: $(DISTFILES) echo bwbasic-2.20 > .fname rm -rf `cat .fname` mkdir `cat .fname` ln $(DISTFILES) `cat .fname` mkdir `cat .fname`/bwbtest cd bwbtest; ln $(TESTFILES) ../`cat ../.fname`/bwbtest tar czhf `cat .fname`.tar.gz `cat .fname` rm -rf `cat .fname` .fname # Prevent GNU make v3 from overflowing arg limit on SysV. .NOEXPORT: bwbasic-2.20pl2.orig/README.patch01100644 0 0 2200 6473161676 14634 0ustar rootroot README.patch01 file for Bywater BASIC Interpreter/Shell, version 2.20 --------------------------------------------- Copyright (c) 1993, Ted A. Campbell for bwBASIC version 2.10, 11 October 1993 Version 2.20 modifications by Jon B. Volkoff, 25 November 1995 Patch level 1 release by Jon B. Volkoff, 15 March 1996 LIST OF PATCHES TO 2.20: bwb_cnd.c Moved init routine for bwb_while so that it would be initialized regardless of expression value, not just if TRUE. This was causing some segmentation faults in WHILE-WEND loops. bwb_elx.c Plugged gaping memory leak. Temp variable space for expression evaluation was being allocated but not freed when done (oops!). bwb_fnc.c Added check for NULL return from getenv to prevent segmentation faults. bwbasic.h Revised VERSION define to reflect above changes. To implement these patches simply replace the old versions of the above source files with the new ones and remake bwbasic. bwbasic-2.20pl2.orig/README.patch02100644 0 0 4244 6473161676 14647 0ustar rootroot README.patch02 file for Bywater BASIC Interpreter/Shell, version 2.20 --------------------------------------------- Copyright (c) 1993, Ted A. Campbell for bwBASIC version 2.10, 11 October 1993 Version 2.20 modifications by Jon B. Volkoff, 25 November 1995 Patch level 1 release by Jon B. Volkoff, 15 March 1996 Patch level 2 release by Jon B. Volkoff, 11 October 1997 LIST OF PATCHES TO 2.20: bwb_cmd.c Fixed calling stack level logic in RETURN statement to prevent erroneous "RETURN without GOSUB" messages. bwb_cnd.c bwb_stc.c Changed continuation condition for WHILE, ELSEIF, and LOOP UNTIL to be != FALSE, not == TRUE. More in line with common commercial BASIC implementations. bwb_mth.c Fixed initialization in VAL function so that old results are not later returned as values. bwb_var.c Added parenthesis level checking to dim_getparams. Using multi-level expressions as array subscripts was causing the program to bomb. bwx_iqc.c bwx_tty.c bwb_mes.h Added second copyright notice. bwb_dio.c bwb_str.c Added support for strings longer than 255 characters. bwb_prn.c Disabled tab expansion and print width checks when not printing to a file. bwb_inp.c Fixed LINE INPUT file reads to accommodate strings of length MAXSTRINGSIZE. bwx_ncu.h bwx_ncu.c New files. Code for UNIX ncurses interface, compliments of L.C. Benschop, Eindhoven, The Netherlands. Makefile.ncu New files. Sample makefile for ncurses implementation. bwbasic.h Revised defines for MININTSIZE and MAXINTSIZE from 16-bit to 32-bit limits. Revised define for MAXSTRINGSIZE from 255 to 5000 characters. Changed string length from unsigned char to unsigned int to support strings longer than 255 characters. Added support for new ncurses package. Revised VERSION define to reflect above changes. To implement these patches simply replace the old versions of the above source files with the new ones and remake bwbasic. bwbasic-2.20pl2.orig/bwx_ncu.c100644 0 0 44715 6473161701 14354 0ustar rootroot/*************************************************************** bwx_ncu.c Environment-dependent implementation of Bywater BASIC Interpreter for Linux (and others?) using Ncurses library, This BWBASIC file hacked together by L.C. Benschop, Eindhoven, The Netherlands. 1997/01/14 and 1997/01/15 derived from the iqc version. (benschop@eb.ele.tue.nl) All the shell commands (like FILES) interact badly with curses. I should replace them with popen/addch 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). */ /*---------------------------------------------------------------*/ #include #include #include /* Should be the ncurses version */ #include #include #undef TRUE #undef FALSE /* So curses TRUE and FALSE conflict with the ones defined by bwbasic. Doesn't this suck big time? */ #include "bwbasic.h" #include "bwb_mes.h" extern int prn_col; extern jmp_buf mark; short oldfgd; long oldbgd; int reset_mode = FALSE; static int ncu_setpos( void ); /*************************************************************** FUNCTION: main() DESCRIPTION: As in any C program, main() is the basic function from which the rest of the program is called. Some environments, however, provide their own main() functions (Microsoft Windows (tm) is an example). In these cases, the following code will have to be included in the initialization function that is called by the environment. ***************************************************************/ static int col_arr[]={COLOR_BLACK,COLOR_RED,COLOR_GREEN,COLOR_YELLOW, COLOR_BLUE,COLOR_MAGENTA,COLOR_CYAN,COLOR_WHITE}; int /* Nobody shall declare main() as void!!!!! (L.C. Benschop)*/ main( int argc, char **argv ) { int i,j; initscr(); start_color(); if(has_colors()) { /* so there are 63 color pairs, from 1 to 63. Just 1 too few for all the foreground/background combinations. */ for(i=0;i<8;i++) for(j=0;j<8;j++) if(i||j) init_pair(i*8+j,col_arr[i],col_arr[j]); } cbreak(); nonl(); noecho(); scrollok(stdscr,1); bwb_init( argc, argv ); #if INTERACTIVE setjmp( mark ); #endif while( !feof( stdin ) ) /* condition !feof( stdin ) added in v1.11 */ { bwb_mainloop(); } } /*************************************************************** FUNCTION: bwx_signon() DESCRIPTION: ***************************************************************/ int bwx_signon( void ) { sprintf( bwb_ebuf, "\r%s %s\n", MES_SIGNON, VERSION ); prn_xprintf( stdout, bwb_ebuf ); sprintf( bwb_ebuf, "\r%s\n", MES_COPYRIGHT ); prn_xprintf( stdout, bwb_ebuf ); sprintf( bwb_ebuf, "\r%s\n", MES_COPYRIGHT_2 ); /* JBV 1/97 */ prn_xprintf( stdout, bwb_ebuf ); #if PERMANENT_DEBUG sprintf( bwb_ebuf, "\r%s\n", "Debugging Mode" ); prn_xprintf( stdout, bwb_ebuf ); #else sprintf( bwb_ebuf, "\r%s\n", MES_LANGUAGE ); prn_xprintf( stdout, bwb_ebuf ); #endif return TRUE; } /*************************************************************** FUNCTION: bwx_message() DESCRIPTION: ***************************************************************/ int bwx_message( char *m ) { #if DEBUG addstr( "" ); #endif addstr( m ); refresh(); return TRUE; } /*************************************************************** FUNCTION: bwx_putc() DESCRIPTION: ***************************************************************/ extern int bwx_putc( char c ) { addch(c); refresh(); } /*************************************************************** FUNCTION: bwx_error() DESCRIPTION: ***************************************************************/ int bwx_errmes( char *m ) { static char tbuf[ MAXSTRINGSIZE + 1 ]; /* this memory should be permanent in case of memory overrun errors */ if (( prn_col != 1 ) && ( errfdevice == stderr )) { prn_xprintf( errfdevice, "\n" ); } if ( CURTASK number == 0 ) { sprintf( tbuf, "\n%s: %s\n", ERRD_HEADER, m ); } else { sprintf( tbuf, "\n%s %d: %s\n", ERROR_HEADER, CURTASK number, m ); } #if INTENSIVE_DEBUG prn_xprintf( stderr, "" ); #endif prn_xprintf( errfdevice, tbuf ); return TRUE; } /*************************************************************** FUNCTION: bwx_input() DESCRIPTION: (w)get(n)str seems to interact badly with last line on screen condition and scrolling. ***************************************************************/ int bwx_input( char *prompt, char *buffer ) { int y,x,my,mx; #if INTENSIVE_DEBUG prn_xprintf( stdout, "" ); #endif prn_xprintf( stdout, prompt ); getyx(stdscr,y,x); echo(); wgetnstr(stdscr, buffer, MAXREADLINESIZE); noecho(); getmaxyx(stdscr,my,mx); /* printf("%d %d",my,mx);*/ if(y+1==my)scroll(stdscr); /* So this is an extreeeeemely ugly kludge to work around some bug/feature/wart in ncurses FIXME I should replace it with getch/addch in a loop */ /* prn_xprintf( stdout, "\n" );*/ /* let _outtext catch up */ * prn_getcol( stdout ) = 1; /* reset column */ return TRUE; } /*************************************************************** FUNCTION: bwx_terminate() DESCRIPTION: ***************************************************************/ void bwx_terminate( void ) { nodelay(stdscr,FALSE); echo(); nl(); nocbreak(); endwin(); exit( 0 ); } /*************************************************************** FUNCTION: bwx_shell() DESCRIPTION: ***************************************************************/ #if COMMAND_SHELL extern int bwx_shell( struct bwb_line *l ) { static char *s_buffer; static int init = FALSE; static int position; /* get memory for temporary buffer if necessary */ if ( init == FALSE ) { init = TRUE; /* Revised to CALLOC pass-thru call by JBV */ if ( ( s_buffer = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ),"bwx_shell" )) == NULL ) { bwb_error( err_getmem ); return FALSE; } } /* get the first element and check for a line number */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwx_shell(): line buffer is <%s>.", l->buffer ); bwb_debug( bwb_ebuf ); #endif position = 0; adv_element( l->buffer, &position, s_buffer ); if ( is_numconst( s_buffer ) != TRUE ) /* not a line number */ { #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwx_shell(): no line number, command <%s>.", l->buffer ); bwb_debug( bwb_ebuf ); #endif nl(); endwin(); /* Added by JBV 10/11/97 */ if ( system( l->buffer ) == 0 ) { refresh(); /* Added by JBV 10/11/97 */ nonl(); ncu_setpos(); return TRUE; } else { refresh(); /* Added by JBV 10/11/97 */ nonl(); ncu_setpos(); return FALSE; } } else /* advance past line number */ { adv_ws( l->buffer, &position ); /* advance past whitespace */ #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwx_shell(): line number, command <%s>.", l->buffer ); bwb_debug( bwb_ebuf ); #endif nl(); endwin(); /* Added by JBV 10/11/97 */ if ( system( &( l->buffer[ position ] ) ) == 0 ) { refresh(); /* Added by JBV 10/11/97 */ nonl(); ncu_setpos(); return TRUE; } else { refresh(); /* Added by JBV 10/11/97 */ nonl(); ncu_setpos(); return FALSE; } } } #endif /*************************************************************** FUNCTION: ncu_setpos() DESCRIPTION: ***************************************************************/ static int ncu_setpos( void ) { int x,y; getyx(stdscr,y,x); move(y,x); /* and move down one position */ prn_xprintf( stdout, "\n" ); return TRUE; } #if COMMON_CMDS /*************************************************************** FUNCTION: bwb_edit() DESCRIPTION: ***************************************************************/ struct bwb_line * bwb_edit( struct bwb_line *l ) { char tbuf[ MAXSTRINGSIZE + 1 ]; char edname[ MAXSTRINGSIZE + 1 ]; struct bwb_variable *ed; FILE *loadfile; ed = var_find( DEFVNAME_EDITOR ); str_btoc( edname, var_getsval( ed )); sprintf( tbuf, "%s %s", edname, CURTASK progfile ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_edit(): command line <%s>", tbuf ); bwb_debug( bwb_ebuf ); #else nl(); endwin(); /* Added by JBV 10/11/97 */ system( tbuf ); /*-----------------------*/ /* Added by JBV 10/11/97 */ /*-----------------------*/ fprintf( stderr, "Press RETURN when ready..." ); fgets( tbuf, MAXREADLINESIZE, stdin ); refresh(); nonl(); #endif /* open edited file for read */ if ( ( loadfile = fopen( CURTASK progfile, "r" )) == NULL ) { sprintf( bwb_ebuf, err_openfile, CURTASK progfile ); bwb_error( bwb_ebuf ); ncu_setpos(); return bwb_zline( l ); } /* clear current contents */ bwb_new( l ); /* Relocated by JBV (bug found by DD) */ /* and (re)load the file into memory */ bwb_fload( loadfile ); ncu_setpos(); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_renum() DESCRIPTION: This function implements the BASIC RENUM command by shelling out to a default renumbering program called "renum". Added by JBV 10/95 SYNTAX: RENUM ***************************************************************/ #if ANSI_C struct bwb_line * bwb_renum( struct bwb_line *l ) #else struct bwb_line * bwb_renum( l ) struct bwb_line *l; #endif { char tbuf[ MAXSTRINGSIZE + 1 ]; FILE *loadfile; sprintf( tbuf, "renum %s\0", CURTASK progfile ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_renum(): command line <%s>", tbuf ); bwb_debug( bwb_ebuf ); #else nl(); endwin(); /* Added by JBV 10/11/97 */ system( tbuf ); /*-----------------------*/ /* Added by JBV 10/11/97 */ /*-----------------------*/ fprintf( stderr, "Press RETURN when ready..." ); fgets( tbuf, MAXREADLINESIZE, stdin ); refresh(); nonl(); #endif /* open edited file for read */ if ( ( loadfile = fopen( CURTASK progfile, "r" )) == NULL ) { sprintf( bwb_ebuf, err_openfile, CURTASK progfile ); bwb_error( bwb_ebuf ); ncu_setpos(); return bwb_zline( l ); } /* clear current contents */ bwb_new( l ); /* Relocated by JBV (bug found by DD) */ /* and (re)load the file into memory */ bwb_fload( loadfile ); ncu_setpos(); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_files() DESCRIPTION: ***************************************************************/ struct bwb_line * bwb_files( struct bwb_line *l ) { char tbuf[ MAXVARNAMESIZE + 1 ]; char finame[ MAXVARNAMESIZE + 1 ]; char argument[ MAXVARNAMESIZE + 1 ]; struct bwb_variable *fi; struct exp_ese *e; fi = var_find( DEFVNAME_FILES ); str_btoc( finame, var_getsval( fi )); /* get argument */ adv_ws( l->buffer, &( l->position )); switch( l->buffer[ l->position ] ) { case '\0': case '\r': case '\n': argument[ 0 ] = '\0'; break; default: e = bwb_exp( l->buffer, FALSE, &( l->position ) ); if ( e->type != STRING ) { bwb_error( err_mismatch ); return bwb_zline( l ); } str_btoc( argument, exp_getsval( e ) ); break; } sprintf( tbuf, "%s %s", finame, argument ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "in bwb_files(): command line <%s>", tbuf ); bwb_debug( bwb_ebuf ); #else nl(); endwin(); /* Added by JBV 10/11/97 */ system( tbuf ); /*-----------------------*/ /* Added by JBV 10/11/97 */ /*-----------------------*/ fprintf( stderr, "Press RETURN when ready..." ); fgets( tbuf, MAXREADLINESIZE, stdin ); refresh(); nonl(); #endif ncu_setpos(); return bwb_zline( l ); } #endif /* COMMON_CMDS */ #if INTERACTIVE /*************************************************************** FUNCTION: fnc_inkey() DESCRIPTION: This C function implements the BASIC INKEY$ function. It is implementation-specific. ***************************************************************/ extern struct bwb_variable * fnc_inkey( int argc, struct bwb_variable *argv,int unique) { static struct bwb_variable nvar; char tbuf[ MAXSTRINGSIZE + 1 ]; static int init = FALSE; int c; /* initialize the variable if necessary */ if ( init == FALSE ) { init = TRUE; var_make( &nvar, STRING); } /* check arguments */ #if PROG_ERRORS if ( argc > 0 ) { sprintf( bwb_ebuf, "Two many arguments to function INKEY$()" ); bwb_error( bwb_ebuf ); return &nvar; } #else if ( fnc_checkargs( argc, argv, 0, 0 ) == FALSE ) { return NULL; } #endif /* body of the INKEY$ function */ nodelay(stdscr,1); if ( (c=getch())==EOF ) { tbuf[ 0 ] = '\0'; } else { tbuf[ 0 ] = (char) c; tbuf[ 1 ] = '\0'; } nodelay(stdscr,0); /* assign value to nvar variable */ str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf ); /* return value contained in nvar */ return &nvar; } #endif /* INTERACTIVE */ #if MS_CMDS /*************************************************************** FUNCTION: bwb_cls() DESCRIPTION: This C function implements the BASIC CLS command. It is implementation-specific. ***************************************************************/ extern struct bwb_line * bwb_cls( struct bwb_line *l ) { clear(); refresh(); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_locate() DESCRIPTION: This C function implements the BASIC LOCATE command. It is implementation-specific. ***************************************************************/ extern struct bwb_line * bwb_locate( struct bwb_line *l ) { struct exp_ese *e; int row, column; /* get first argument */ e = bwb_exp( l->buffer, FALSE, &( l->position )); row = (int) exp_getnval( e ); /* advance past comma */ adv_ws( l->buffer, &( l->position )); if ( l->buffer[ l->position ] != ',' ) { bwb_error( err_syntax ); return bwb_zline( l ); } ++( l->position ); /* get second argument */ e = bwb_exp( l->buffer, FALSE, &( l->position )); column = (int) exp_getnval( e ); /* position the cursor */ move( row-1, column-1 ); return bwb_zline( l ); } /*************************************************************** FUNCTION: bwb_color() DESCRIPTION: This C function implements the BASIC COLOR command. It is implementation-specific. ***************************************************************/ extern struct bwb_line * bwb_color( struct bwb_line *l ) { struct exp_ese *e; int fgcolor,bgcolor; /* get first argument */ e = bwb_exp( l->buffer, FALSE, &( l->position )); fgcolor = (int) exp_getnval( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "Setting text color to %d", fgcolor ); bwb_debug( bwb_ebuf ); #endif #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "Set text color to %d", fgcolor ); bwb_debug( bwb_ebuf ); #endif /* advance past comma */ adv_ws( l->buffer, &( l->position )); if ( l->buffer[ l->position ] == ',' ) { ++( l->position ); /* get second argument */ e = bwb_exp( l->buffer, FALSE, &( l->position )); bgcolor = (int) exp_getnval( e ); #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "Setting background color to %d", bgcolor ); bwb_debug( bwb_ebuf ); #endif /* set the foreground and background color */ if (has_colors()) { attrset(A_NORMAL); bkgdset(COLOR_PAIR((bgcolor&7))|' '); if((fgcolor&7)==0 && (bgcolor&7)==0){ /* we didn't reserve a color pair for fg and bg both black. Bright black(color 8)==dark gray as foreground color A_DIM A_INVIS doesn't seem to work. wait for next version of ncurses, don't bother for now.*/ if(fgcolor<8) attrset(A_INVIS); else attrset(A_DIM); } else attrset(COLOR_PAIR((8*(fgcolor&7)+(bgcolor&7))) | ((fgcolor>7)*A_BOLD)); /* fg colors 8--15 == extra brightness */ } else { /* no colors, have a go at it with reverse/bold/dim */ attrset(A_NORMAL); bkgdset(A_REVERSE*((fgcolor&7)<(bgcolor&7))|' '); attrset(A_BOLD*(fgcolor>8)| A_REVERSE*((fgcolor&7)<(bgcolor&7))|A_INVIS*(fgcolor==bgcolor)); } #if INTENSIVE_DEBUG sprintf( bwb_ebuf, "Setting background color to %d\n", bgcolor ); bwb_debug( bwb_ebuf ); #endif } return bwb_zline( l ); } #endif /* MS_CMDS */ bwbasic-2.20pl2.orig/bwx_ncu.h100644 0 0 3401 6473161701 14324 0ustar rootroot/*************************************************************** bwx_ncu.h Header File for Linux (and others?) using Ncurses library, This BWBASIC file hacked together by L.C. Benschop, Eindhoven, The Netherlands. (benschop@eb.ele.tue.nl) 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. ***************************************************************/ #define IMP_IDSTRING "NCU" /* unique ID string for this implementation */ /* Definitions indicating which commands and functions are implemented */ #define IMP_FNCINKEY 1 /* 0 if INKEY$ is not implemented, 1 if it is */ #define IMP_CMDCLS 1 /* 0 if CLS is not implemented, 1 if it is */ #define IMP_CMDLOC 1 /* 0 if LOCATE is not implemented, 1 if it is */ #define IMP_CMDCOLOR 1 /* 0 if COLOR is not implemented, 1 if it is */ #define UNIX_CMDS TRUE #define MKDIR_ONE_ARG FALSE /* TRUE if your mkdir has but one argument; FALSE if it has two */ #define PERMISSIONS 644 /* permissions to set in Unix-type system */