commit 266be03f4346515a187c81182cd61d3a355388ed Author: Jon Foster Date: Sun Sep 26 20:55:20 2021 -0700 v2.10 diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000..acdade5 --- /dev/null +++ b/.gitattributes @@ -0,0 +1,12 @@ +# Default auto detect text, and normalize EOL +* text=auto eol=crlf + +# Specific text files needing EOL fixing +*.in text eol=crlf +*.c text eol=crlf +*.h text eol=crlf +*.bas text eol=crlf +INSTALL text eol=crlf +COPYING text eol=crlf +README text eol=crlf +/bwbasic.doc text eol=crlf diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..bba3fa4 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +*.o +/bwbasic +/renum diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..e1887ed --- /dev/null +++ b/COPYING @@ -0,0 +1,342 @@ + + 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. + + \ No newline at end of file diff --git a/INSTALL b/INSTALL new file mode 100644 index 0000000..0fa3410 --- /dev/null +++ b/INSTALL @@ -0,0 +1,158 @@ +Some 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. diff --git a/Makefile.in b/Makefile.in new file mode 100644 index 0000000..e429a6f --- /dev/null +++ b/Makefile.in @@ -0,0 +1,101 @@ +# Unix Makefile for Bywater BASIC Interpreter + +srcdir = @srcdir@ +VPATH = @srcdir@ + +CC = @CC@ + +INSTALL = @INSTALL@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_DATA = @INSTALL_DATA@ + +DEFS = @DEFS@ + +CFLAGS = -O +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 + +DISTFILES= $(CFILES) $(HFILES) $(MISCFILES) + +all: bwbasic + +bwbasic: $(OFILES) + $(CC) $(OFILES) -lm -o $@ $(LDFLAGS) + +$(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 + +dist: $(DISTFILES) + echo bwbasic-2.10 > .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: + \ No newline at end of file diff --git a/README b/README new file mode 100644 index 0000000..3105e19 --- /dev/null +++ b/README @@ -0,0 +1,189 @@ + + + Bywater Software Announces + + + Bywater BASIC Interpreter/Shell, version 2.10 + --------------------------------------------- + + Copyright (c) 1993, Ted A. Campbell + for bwBASIC version 2.10, 11 October 1993 + + + +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 (1.11): + + * now compilable on "stock" (older K&R specification) C compilers; + + * implements ANSI-BASIC-style structured programming, with + called subroutines, multi-line functions, multi-line IF-THEN + ELSE statements, SELECT CASE statements, etc.; + + * new enhancements to the interactive environment, such as DO NUM + and DO UNNUM to number or unnumber all program lines; + + * addition of some hardware-specific commands such as CLS, LOCATE, + and INKEY$ (at present for IBM PC and compatibles, using the + Microsoft QuickC compiler), opening the way for more hardware- + specific commands and functions in the future; + + * general improvements to reliability and portability, including + more extensive testing than previous versions; + + +OBTAINING THE SOURCE CODE: + + The source code for bwBASIC 2.10 will be posted to network news + groups and is available immediately by anonymous ftp. To obtain + the source code, ftp to site ftp.eng.umd.edu, cd to pub/basic and + get the file bwbasic-2.10.tar.gz. + + +COMMUNICATIONS: + + email: tcamp@delphi.com + + +A LIST OF BASIC COMMANDS AND FUNCTIONS IMPLEMENTED in bwBASIC 2.10: + + 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 + 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 ].... diff --git a/bwb_cmd.c b/bwb_cmd.c new file mode 100644 index 0000000..a18445d --- /dev/null +++ b/bwb_cmd.c @@ -0,0 +1,2217 @@ +/*************************************************************** + + 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. + +***************************************************************/ + +#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" */ + + if ( CURTASK excs[ CURTASK exsc ].code != EXEC_GOSUB ) + { + 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 */ + + if ( ( oline = calloc( 1, sizeof( struct bwb_line ) ) ) == NULL ) + { +#if PROG_ERRORS + bwb_error( "in bwb_on(): failed to find memory for oline" ); +#else + bwb_error( err_getmem ); +#endif + } + if ( ( oline->buffer = calloc( 1, MAXSTRINGSIZE + 1 ) ) == 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 */ + bwb_run( &CURTASK bwb_start ); /* and call bwb_run() recursively */ + } + + /* else if it is a line number, execute the program in memory + at that line number */ + + else + { + + if ( current == NULL ) + { + + if ( e != NULL ) + { + 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; + } + } + } + + 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 ); + + } + +#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; + + /* Get an argument for filename */ + + adv_ws( l->buffer, &( l->position ) ); + switch( l->buffer[ l->position ] ) + { + case '\0': + case '\n': + case '\r': + case ':': + + return bwb_zline( l ); + default: + break; + } + + bwb_const( l->buffer, CURTASK progfile, &( l->position ) ); + 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 + LOAD 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 ]; + +#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; + } + + bwb_const( l->buffer, filename, &( l->position ) ); + 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 == TRUE ) + { + sprintf( tbuf, "%7d: %s\n", l->number, l->buffer ); + } + else + { + sprintf( tbuf, " : %s\n", l->buffer ); + } + + prn_xprintf( file, tbuf ); + } + else + { + + if ( l->xnum == TRUE ) + { + 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 ) + { + if (( current->xnum == 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 ) + { + if (( current->xnum == 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 ) + { + free( previous ); + } + 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 + } + + + \ No newline at end of file diff --git a/bwb_cnd.c b/bwb_cnd.c new file mode 100644 index 0000000..4a16682 --- /dev/null +++ b/bwb_cnd.c @@ -0,0 +1,2409 @@ +/*************************************************************** + + 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. + +***************************************************************/ + +#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 + { + bwb_setexec( endif_line, 0, CURTASK excs[ CURTASK exsc ].code ); + 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 ); + 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 */ + + 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 ); + } + + 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 ) == TRUE ) + { + + /* 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; + + /* call bwb_exp() to interpret the expression */ + + e = bwb_exp( l->buffer, FALSE, &( l->position ) ); + + if ( (int) exp_getnval( e ) == TRUE ) + { + + /* 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 + + 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 + + /* 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 ]; +#if INTENSIVE_DEBUG + struct bwb_variable *v; +#endif + +#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 */ + +#if MULTISEG_LINES /* not currently needed otherwise */ + + exp_getvfname( &( l->buffer[ l->position ] ), tbuf ); + l->position += strlen( tbuf ); + +#if INTENSIVE_DEBUG + v = var_find( tbuf ); + sprintf( bwb_ebuf, "in bwb_next(): variable name detected <%s>.", v->name ); + bwb_debug( bwb_ebuf ); +#endif +#endif + + /* decrement or increment the value */ + + 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 ); +#else + bwb_setexec( CURTASK excs[ CURTASK exsc - 1 ].line, + CURTASK excs[ CURTASK exsc - 1 ].position, EXEC_FOR ); +#endif + + return CURTASK excs[ CURTASK exsc - 1 ].line; + + } + +#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 ); + + 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; + + } + + + \ No newline at end of file diff --git a/bwb_dio.c b/bwb_dio.c new file mode 100644 index 0000000..6f4759f --- /dev/null +++ b/bwb_dio.c @@ -0,0 +1,1807 @@ +/*************************************************************** + + 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. + +***************************************************************/ + +#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 record length" ); +#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 */ + + 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 ); + + /* allocate a character buffer for random access */ + + if (( mode == DEVMODE_RANDOM ) && ( previous_buffer != TRUE )) + { + if ( ( dev_table[ req_devnumber ].buffer = calloc( rlen + 1, 1 )) == 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 ]; + + /* loop to get device numbers to close */ + + do + { + + 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 ); + } + + req_devnumber = (int) exp_getnval( e ); + +#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; + + /* eat up any remaining whitespace */ + + adv_ws( l->buffer, &( l->position ) ); + + } + + while ( l->buffer[ l->position ] == ',' ); + + /* 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; + if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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; + if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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; + if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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; + if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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; + if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL ) + { +#if PROG_ERRORS + bwb_error( "in bwb_name(): failed to find memory for atbuf" ); +#else + bwb_error( err_getmem ); +#endif + } + if ( ( btbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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 ) + { + free( b->sbuffer ); + } +#endif + + b->sbuffer = dev_table[ dev_number ].buffer + current_pos; + b->length = (unsigned char) length; + 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->buffer ); + 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->buffer ); + 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 ]; + + /* 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 */ + + if ( fseek( dev_table[ dev_number ].cfp, + (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ), + 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 */ + + 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 ]; + + /* 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 ); + +#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 */ + + if ( fseek( dev_table[ dev_number ].cfp, + (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ), + 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 */ + + 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 */ + + + \ No newline at end of file diff --git a/bwb_elx.c b/bwb_elx.c new file mode 100644 index 0000000..a35fd92 --- /dev/null +++ b/bwb_elx.c @@ -0,0 +1,1199 @@ +/**************************************************************** + + 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. + +****************************************************************/ + +#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( expression[ e_pos ] != '\"' ) + { + 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 */ + + ++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': + 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 ]; + bstring *b; +#if INTENSIVE_DEBUG + char tbuf[ MAXSTRINGSIZE + 1 ]; + + sprintf( bwb_ebuf, "in exp_function(): entered function, expression <%s>", + expression ); + bwb_debug( bwb_ebuf ); +#endif + + /* 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 ); + +#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(): level <%d> variable <%s> has <%d> dimensions", + CURTASK expsc, + v->name, + v->dimensions ); + 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 + if ( v->dimensions > 1 ) + { + sprintf( bwb_ebuf, "in exp_variable(): exec stack level <%d>", + CURTASK exsc ); + bwb_debug( bwb_ebuf ); + for ( n = 0; n < v->dimensions; ++n ) + { + sprintf( bwb_ebuf, " variable <%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; + CURTASK exps[ CURTASK expsc ].xvar = v; + + 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; + + } + + + diff --git a/bwb_exp.c b/bwb_exp.c new file mode 100644 index 0000000..1381d77 --- /dev/null +++ b/bwb_exp.c @@ -0,0 +1,1469 @@ +/**************************************************************** + + 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. + +****************************************************************/ + +#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 beginningg 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: + +#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 bwb_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 logical or mathematical operation is + required at this point. + +***************************************************************/ + +#if ANSI_C +int +exp_isnc( char *expression ) +#else +int +exp_isnc( expression ) + char *expression; +#endif + { + + 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; + } + + /* 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 aphabetical 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; + } + diff --git a/bwb_fnc.c b/bwb_fnc.c new file mode 100644 index 0000000..50270ea --- /dev/null +++ b/bwb_fnc.c @@ -0,0 +1,1910 @@ +/**************************************************************** + + 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. + +****************************************************************/ + +#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; + if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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 ); + if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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 ); + if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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 ); + if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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 ); + * var_findnval( &nvar, nvar.array_pos ) + = (float) fmod( (bnumber) now, (bnumber) (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 ); + if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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 ); + if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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>", + argv[ 1 ].string, 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 ); + if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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 */ + + strcpy( tmp, getenv( tbuf )); + 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 workd 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; + +#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; + } + else if ( feof( dev_table[ dev_number ].cfp ) == 0 ) + { + * 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; +#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 */ + +#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 + + * var_findnval( &nvar, nvar.array_pos ) = (bnumber) FALSE; + +#endif + + 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 ); + if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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 + diff --git a/bwb_inp.c b/bwb_inp.c new file mode 100644 index 0000000..bd70c0c --- /dev/null +++ b/bwb_inp.c @@ -0,0 +1,1440 @@ +/*************************************************************** + + 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. + +***************************************************************/ + +#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 ); +#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(); +#endif + +static char_saved = FALSE; +static cs; + +/*************************************************************** + + 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 */ + + suppress_qm = inp_adv( l->buffer, &( l->position ) ); + + /* 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 + * var_findnval( v, v->array_pos ) = (bnumber) atof( 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 + inoput 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 + { + *( var_findnval( v, v->array_pos )) = (bnumber) atof( 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; + return rval; + default: + 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 ]; + + /* 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 ); + +#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 + { + fgets( tbuf, MAXSTRINGSIZE, 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 */ + + \ No newline at end of file diff --git a/bwb_int.c b/bwb_int.c new file mode 100644 index 0000000..e81396d --- /dev/null +++ b/bwb_int.c @@ -0,0 +1,955 @@ +/***************************************************************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. + +***************************************************************/ + +#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': + 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; + + 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; + if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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; + if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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 */ + + free( l ); + + 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; + } + + } + + \ No newline at end of file diff --git a/bwb_mes.h b/bwb_mes.h new file mode 100644 index 0000000..fcaba1f --- /dev/null +++ b/bwb_mes.h @@ -0,0 +1,474 @@ +/*************************************************************** + + 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. + +***************************************************************/ + + +#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_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_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_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_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_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_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_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_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_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[]; + + + + \ No newline at end of file diff --git a/bwb_mth.c b/bwb_mth.c new file mode 100644 index 0000000..7df2c88 --- /dev/null +++ b/bwb_mth.c @@ -0,0 +1,2017 @@ +/**************************************************************** + + 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. + +****************************************************************/ + +#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: + * var_findnval( &nvar, nvar.array_pos ) = + (bnumber) fabs( 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: + * var_findnval( &nvar, nvar.array_pos ) + = (bnumber) exp( 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: + * var_findnval( &nvar, nvar.array_pos ) = (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 + + * var_findnval( &nvar, nvar.array_pos ) = + (bnumber) fabs( 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 ); + } + + * var_findnval( &nvar, nvar.array_pos ) = (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 */ + + * var_findnval( &nvar, nvar.array_pos ) + = (bnumber) exp( 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 ); + if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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 ] ) )); +#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 ); + if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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 ); + if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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 ); + if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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 */ + + sprintf( tbuf, "%o", (int) 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 ]; + } + 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 ]; + } + 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 numerial 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 + { + bnumber sign; + + if ( x < (bnumber) 0.0 ) + { + sign = (bnumber) -1.0; + } + else + { + sign = (bnumber) 1.0; + } + + return (bnumber) ( floor( fabs( 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 ) + { + if ( (bnumber) fabs( (bnumber) floor( x ) - x ) < (bnumber) 0.500 ) + { + return (bnumber) floor( x ); + } + else + { + return (bnumber) ceil( x ); + } + } + else + { + if ( ( x - (bnumber) floor( x )) < (bnumber) 0.500 ) + { + return (bnumber) floor( x ); + } + else + { + return (bnumber) ceil( x ); + } + } + } + + + \ No newline at end of file diff --git a/bwb_ops.c b/bwb_ops.c new file mode 100644 index 0000000..bb2bb3e --- /dev/null +++ b/bwb_ops.c @@ -0,0 +1,1932 @@ +/**************************************************************** + + 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. + +****************************************************************/ + +#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_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_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; + + 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; + + error_condition = 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_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 + + str_cat( exp_getsval( &( CURTASK exps[ level - 1 ] ) ), + exp_getsval( &( CURTASK exps[ level + 1 ] ) ) ); + +#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, +#ifdef OLDWAY + CURTASK exps[ level - 1 ].xvar->array_pos ) = +#else + CURTASK exps[ level - 1 ].array_pos ) = +#endif + 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 NOT 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 NOT 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 compares two integers and + performs a logical NOT on them. + +***************************************************************/ + +#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>", + (int) r, 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 NOT 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_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 ) ) + { + + memcpy( &CURTASK exps[ level ], &CURTASK exps[ level + how_far ], + (size_t) ( sizeof( struct exp_ese )) ); + ++level; + + } + + /* decrement the expression stack counter */ + + for ( c = 0; c < how_far; ++c ) + { + + if ( dec_esc() == TRUE ) + { + --op_level; + } + else + { + return FALSE; + } + + } + + return TRUE; + + } + + diff --git a/bwb_par.c b/bwb_par.c new file mode 100644 index 0000000..db05e98 --- /dev/null +++ b/bwb_par.c @@ -0,0 +1,110 @@ +/*************************************************************** + + 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. + +***************************************************************/ + +#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 */ + + if ( ( bwb_tasks[ task_requested ] = calloc( 1, sizeof( struct bwb_task ) ) ) + == 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 + + + \ No newline at end of file diff --git a/bwb_prn.c b/bwb_prn.c new file mode 100644 index 0000000..baf0377 --- /dev/null +++ b/bwb_prn.c @@ -0,0 +1,1703 @@ +/*************************************************************** + + 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. + +***************************************************************/ + +#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; + if ( ( s_buffer = calloc( MAXSTRINGSIZE + 1, sizeof(char) ) ) == 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; +#if INTENSIVE_DEBUG || TEST_BSTRING + bstring *b; +#endif + + /* initialize buffers if necessary */ + + if ( init == FALSE ) + { + init = TRUE; + if ( ( format_string = calloc( MAXSTRINGSIZE + 1, sizeof(char) ) ) == NULL ) + { +#if PROG_ERRORS + bwb_error( "in bwb_xprint(): failed to get memory for format_string" ); +#else + bwb_error( err_getmem ); +#endif + } + if ( ( output_string = calloc( MAXSTRINGSIZE + 1, sizeof(char) ) ) == NULL ) + { +#if PROG_ERRORS + bwb_error( "in bwb_xprint(): failed to get memory for output_string" ); +#else + bwb_error( err_getmem ); +#endif + } + if ( ( element = calloc( MAXSTRINGSIZE + 1, sizeof(char) ) ) == NULL ) + { +#if PROG_ERRORS + bwb_error( "in bwb_xprint(): failed to get memory for element buffer" ); +#else + bwb_error( err_getmem ); +#endif + } + if ( ( prnbuf = calloc( MAXSTRINGSIZE + 1, sizeof(char) ) ) == 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 + } + 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_xprintf( f, output_string ); + 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 ) + { + sprintf( output_string, "%e", + exp_getnval( e ) ); + } + else + { + sprintf( output_string, "%*.*f", + format->width, format->precision, exp_getnval( e ) ); + } + +#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_xprintf( f, output_string ); + 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 */ + 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 */ + + /* 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 ); + + /* 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 */ + loop = FALSE; + break; + case '\0': /* end of format string */ + case '\n': + case '\r': + *position = -1; + return &retstruct; + case '_': /* print next character as literal */ + ++( *position ); + xputc( f, buffer[ *position ] ); + ++( *position ); + break; + + case '!': + retstruct.type = STRING; + retstruct.width = 1; + 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 '$': + ++( *position ); + retstruct.money = TRUE; + if ( buffer[ *position ] == '$' ) + { + ++( *position ); + } + break; + case '*': + ++( *position ); + retstruct.fill = '*'; + if ( buffer[ *position ] == '*' ) + { + ++( *position ); + } + break; + case '+': + ++( *position ); + retstruct.sign = TRUE; + break; + case '#': + retstruct.type = NUMBER; /* for now */ + ++( *position ); + for ( retstruct.width = 1; buffer[ *position ] == '#'; ++( *position ) ) + { + ++retstruct.width; + } + if ( buffer[ *position ] == ',' ) + { + retstruct.commas = TRUE; + } + 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; + + } + } /* 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: 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; + + /* 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 + { + + /* 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( nval, d ) ); + bwb_debug( bwb_ebuf ); +#endif + + if ( fmod( nval, d ) < 0.0000001 ) + { + 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; + +#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 ); + +#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 + diff --git a/bwb_stc.c b/bwb_stc.c new file mode 100644 index 0000000..eaf7482 --- /dev/null +++ b/bwb_stc.c @@ -0,0 +1,2278 @@ +/*************************************************************** + + 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. + +***************************************************************/ + +#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; + free( c ); + c = n; + } + + next = current->next; + free( current ); + } + + /* 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; + + 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 */ + + if ( ( name = calloc( 1, strlen( tbuf ) + 1 ) ) == 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 ) ) ) == 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 ) == TRUE ) + { + 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 + sprintf( bwb_ebuf, "in bwb_exitfor(): 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 lookuop 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: expufnc() + + 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 lookuop 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; + } + + } + + + \ No newline at end of file diff --git a/bwb_str.c b/bwb_str.c new file mode 100644 index 0000000..7259d7c --- /dev/null +++ b/bwb_str.c @@ -0,0 +1,355 @@ +/*************************************************************** + + 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. + +***************************************************************/ + +#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 */ + + if ( ( t = (char *) calloc( s->length + 1, 1 )) == NULL ) + { +#if PROG_ERRORS + bwb_error( "in str_btob(): failed to get memory for new buffer" ); +#else + bwb_error( err_getmem ); +#endif + return FALSE; + } + + /* write the c string to the b string */ + + t[ 0 ] = '\0'; + for ( i = 0; i < (int) s->length; ++i ) + { + t[ i ] = s->sbuffer[ i ]; +#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 + + 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 ); + } + else + { + d->rab = (char) FALSE; + } + + /* 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 */ + + if ( ( t = (char *) calloc( strlen( buffer ) + 1, 1 )) == NULL ) + { +#if PROG_ERRORS + bwb_error( "in str_ctob(): failed to get memory for new buffer" ); +#else + bwb_error( err_getmem ); +#endif + return FALSE; + } + + /* write the c string to the b string */ + + t[ 0 ] = '\0'; + for ( i = 0; i < (int) strlen( buffer ); ++i ) + { + t[ i ] = buffer[ i ]; +#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 + + if (( s->rab != TRUE ) && ( s->sbuffer != NULL )) + { + free( s->sbuffer ); + } + else + { + s->rab = (char) FALSE; + } + + /* reassign buffer */ + + s->sbuffer = t; + + /* reassign length */ + + s->length = (unsigned char) 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 ); + } + + + + \ No newline at end of file diff --git a/bwb_tbl.c b/bwb_tbl.c new file mode 100644 index 0000000..8484330 --- /dev/null +++ b/bwb_tbl.c @@ -0,0 +1,335 @@ +/*************************************************************** + + 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. + +***************************************************************/ + +#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 }, +#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 }, +#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, 12 }, /* 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, 4 }, + { "<>", OP_NOTEQUAL, 7 }, + { "<=", OP_LTEQ, 10 }, + { "=<", OP_LTEQ, 10 }, /* allow either form */ + { ">=", OP_GTEQ, 11 }, + { "=>", OP_GTEQ, 11 }, /* allow either form */ + { "<", OP_LESSTHAN, 8 }, + { ">", OP_GREATERTHAN, 9 }, + { "^", OP_EXPONENT, 0 }, + { "*", OP_MULTIPLY, 2 }, + { "/", OP_DIVIDE, 2 }, + { "\\", OP_INTDIVISION, 3 }, + { "+", OP_ADD, 5 }, + { "-", OP_SUBTRACT, 5 }, + { "=", OP_EQUALS, 6 }, + { "=", OP_ASSIGN, 6 }, /* don't worry: OP_EQUALS will be converted to OP_ASSIGN if necessary */ + { ";", OP_STRJOIN, 18 }, + { ",", OP_STRTAB, 19 } + }; + +/* 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 + }; + + + \ No newline at end of file diff --git a/bwb_tcc.c b/bwb_tcc.c new file mode 100644 index 0000000..593d2b2 --- /dev/null +++ b/bwb_tcc.c @@ -0,0 +1,5 @@ +/* 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; + \ No newline at end of file diff --git a/bwb_var.c b/bwb_var.c new file mode 100644 index 0000000..fe56dc1 --- /dev/null +++ b/bwb_var.c @@ -0,0 +1,2236 @@ +/*************************************************************** + + 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. + +***************************************************************/ + +#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 ]; + + /* 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 */ + + free( v->array_sizes ); + free( v->array_pos ); + if ( v->type == NUMBER ) + { + free( v->memnum ); + } + else + { + free( v->memstr ); + } + free( v ); + + /* 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 ) + { + free( sp[ n ].sbuffer ); + 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 */ + + 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 */ + + free( v->array_sizes ); + free( v->array_pos ); + if ( v->type == NUMBER ) + { + free( v->memnum ); + } + else + { + free( v->memstr ); + } + } + + /* reassign linkage */ + + p->next = v->next; + + /* deallocate the variable itself */ + + free( v ); + + } + + /* 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: 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 */ + 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 */ + + if ( ( v = (struct bwb_variable *) calloc( 1, sizeof( struct bwb_variable ) )) + == 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 */ + + if ( ( newvar->array_sizes = (int *) calloc( n_params, sizeof( int ) )) == 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 */ + + if ( ( newvar->array_pos = (int *) calloc( n_params, sizeof( int ) )) == 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 + if ( ( newvar->memnum = calloc( newvar->array_units, sizeof( bstring) )) == 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 + if ( ( np = (bnumber *) + calloc( newvar->array_units, sizeof( bnumber ) )) == 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 ]; + + /* 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; + while( loop == TRUE ) + { + switch( buffer[ *pos ] ) + { + case ')': /* end of parameter list */ + 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 */ + 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: + 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 <%s> pos <%d> <%d>.", + v->name, + 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 + 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; +#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 */ + + if ( v->type == NUMBER ) + { + if ( ( v->memnum = calloc( 2, sizeof( bnumber ) )) == NULL ) + { + bwb_error( err_getmem ); + return FALSE; + } + } + else + { + if ( ( v->memstr = calloc( 2, sizeof( bstring ) )) == NULL ) + { + bwb_error( err_getmem ); + return FALSE; + } + } + + /* get memory for array_sizes and array_pos */ + + if ( ( v->array_sizes = (int *) calloc( 2, sizeof( int ) )) == NULL ) + { + bwb_error( err_getmem ); + return FALSE; + } + + if ( ( v->array_pos = (int *) calloc( 2, sizeof( int ) )) == 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 + diff --git a/bwbasic.c b/bwbasic.c new file mode 100644 index 0000000..2e2cde5 --- /dev/null +++ b/bwbasic.c @@ -0,0 +1,1450 @@ +/*************************************************************** + + 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. + +***************************************************************/ + +#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 */ + + if ( ( xtxts = calloc( XTXTSTACKSIZE, sizeof( struct xtxtsl ) ) ) == NULL ) + { +#if PROG_ERRORS + bwb_error( "in bwb_init(): failed to find memory for xtxts" ); +#else + bwb_error( err_getmem ); +#endif + } + + /* expression stack */ + + if ( ( exps = calloc( ESTACKSIZE, sizeof( struct exp_ese ) ) ) == NULL ) + { +#if PROG_ERRORS + bwb_error( "in bwb_init(): failed to find memory for exps" ); +#else + bwb_error( err_getmem ); +#endif + } + + /* EXEC stack */ + + if ( ( excs = calloc( EXECLEVELS, sizeof( struct exse ) ) ) == 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 = 1; + bwb_l = &bwb_start; + + var_init( 0 ); + fnc_init( 0 ); + fslt_init( 0 ); + +#endif + + /* character buffers */ + + if ( ( bwb_ebuf = calloc( MAXSTRINGSIZE + 1, sizeof(char) ) ) == NULL ) + { +#if PROG_ERRORS + bwb_error( "in bwb_init(): failed to find memory for bwb_ebuf" ); +#else + bwb_error( err_getmem ); +#endif + } + if ( ( read_line = calloc( MAXREADLINESIZE + 1, sizeof(char) ) ) == 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 + if ( ( dev_table = calloc( DEF_DEVICES, sizeof( struct dev_element ) ) ) == 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 )) + { + if ( ( input = fopen( argv[ 1 ], "r" )) == NULL ) + { + strcpy( CURTASK progfile, argv[ 1 ] ); + 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 ] ); +#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 + { + +#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 ); + + /* If there is no line number, execute the line as received */ + + if ( is_ln( read_line ) == FALSE ) + { + 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; + if ( ( s_buffer = calloc( (size_t) MAXSTRINGSIZE + 1, sizeof( char ) )) == 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 */ + + if ( ( l = (struct bwb_line *) calloc( (size_t) 1, sizeof( struct bwb_line ) )) == 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 == TRUE ) + && ( 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 */ + + free( l ); + + /* 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 */ + + free( l->buffer ); + free( l ); + + 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 + + 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 + free( CURTASK xtxts[ CURTASK xtxtsc ].l.buffer ); + } + + /* 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 ) + { + + free( CURTASK excs[ CURTASK exsc ].while_line->buffer ); + free( CURTASK excs[ CURTASK exsc ].while_line ); + + 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 + { + +#if DONTDOTHIS /* but why not? */ + if ( l->buffer != NULL ) + { + free( l->buffer ); + } +#endif + + if ( ( l->buffer = calloc( strlen( s ) + 2, sizeof( char ) ) ) + == 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; + if ( ( tmp_buffer = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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; + } + } + + diff --git a/bwbasic.doc b/bwbasic.doc new file mode 100644 index 0000000..163b5d9 --- /dev/null +++ b/bwbasic.doc @@ -0,0 +1,1880 @@ + + + + + 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 diff --git a/bwbasic.h b/bwbasic.h new file mode 100644 index 0000000..7dc15e1 --- /dev/null +++ b/bwbasic.h @@ -0,0 +1,1392 @@ +/*************************************************************** + + 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. + +***************************************************************/ + + +#ifndef TRUE +#define TRUE -1 +#define FALSE 0 +#endif + +/*************************************************************** + + bwbasic.h Part I: Definitions + +***************************************************************/ + +/* Version number */ + +#define VERSION "2.10" /* 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. + +***************************************************************/ + +#define IMP_TTY TRUE /* simple TTY-style interface using stdio */ +#define IMP_IQC FALSE /* IBM PC, Microsoft QuickC Compiler */ + +#if IMP_TTY +#include "bwx_tty.h" +#endif + +#if IMP_IQC +#include "bwx_iqc.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 + +#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 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 */ +#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. + +***************************************************************/ + +#define DEBUG FALSE /* current debugging */ +#define PROG_ERRORS FALSE /* 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 + +***************************************************************/ + +#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 + +#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 24 +#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 + +#define DEF_EDITOR "" /* default editor */ +#define DEF_FILES "" /* default "files" command */ +#define DEF_COLORS 0 /* 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 */ +#define MAXSTRINGSIZE 255 /* 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 24 /* number of operators defined */ +#define N_ERRORS 25 /* number of errors defined */ +#define MAX_PRECEDENCE 19 /* highest (last) level of precedence */ +#define MININTSIZE -32767 /* minimum integer size */ +#define MAXINTSIZE 32767 /* 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 char 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 */ + 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 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_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 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 +extern int rmdir( char *path ); +extern int chdir( char *path ); +#if MKDIR_ONE_ARG +extern int mkdir( char *path ); +#else +extern int mkdir( char *path, unsigned short permissions ); +#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 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_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 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 diff --git a/bwbasic.mak b/bwbasic.mak new file mode 100644 index 0000000..1627117 --- /dev/null +++ b/bwbasic.mak @@ -0,0 +1,85 @@ +PROJ =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) + diff --git a/bwbtest/abs.bas b/bwbtest/abs.bas new file mode 100644 index 0000000..8ff3889 --- /dev/null +++ b/bwbtest/abs.bas @@ -0,0 +1,5 @@ +10 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?" diff --git a/bwbtest/assign.bas b/bwbtest/assign.bas new file mode 100644 index 0000000..625eb93 --- /dev/null +++ b/bwbtest/assign.bas @@ -0,0 +1,3 @@ +10 Print "TEST.BAS -- TEST" +20 X=7 +30 print "X is ";X diff --git a/bwbtest/callfunc.bas b/bwbtest/callfunc.bas new file mode 100644 index 0000000..e19d489 --- /dev/null +++ b/bwbtest/callfunc.bas @@ -0,0 +1,34 @@ + +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 diff --git a/bwbtest/callsub.bas b/bwbtest/callsub.bas new file mode 100644 index 0000000..4682909 --- /dev/null +++ b/bwbtest/callsub.bas @@ -0,0 +1,32 @@ + +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 + diff --git a/bwbtest/chain1.bas b/bwbtest/chain1.bas new file mode 100644 index 0000000..aa5a85e --- /dev/null +++ b/bwbtest/chain1.bas @@ -0,0 +1,7 @@ +REM 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" diff --git a/bwbtest/chain2.bas b/bwbtest/chain2.bas new file mode 100644 index 0000000..bbe2c36 --- /dev/null +++ b/bwbtest/chain2.bas @@ -0,0 +1,4 @@ +REM CHAIN2.BAS +print "This is program CHAIN2.BAS" +print "The value of X is now";X +print "This concludes our CHAIN test." diff --git a/bwbtest/dataread.bas b/bwbtest/dataread.bas new file mode 100644 index 0000000..b2d4ff6 --- /dev/null +++ b/bwbtest/dataread.bas @@ -0,0 +1,14 @@ +10 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 diff --git a/bwbtest/deffn.bas b/bwbtest/deffn.bas new file mode 100644 index 0000000..d3a52a4 --- /dev/null +++ b/bwbtest/deffn.bas @@ -0,0 +1,7 @@ +10 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 diff --git a/bwbtest/dim.bas b/bwbtest/dim.bas new file mode 100644 index 0000000..fefb6dd --- /dev/null +++ b/bwbtest/dim.bas @@ -0,0 +1,6 @@ +10 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 diff --git a/bwbtest/doloop.bas b/bwbtest/doloop.bas new file mode 100644 index 0000000..78bf47a --- /dev/null +++ b/bwbtest/doloop.bas @@ -0,0 +1,7 @@ +10 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" diff --git a/bwbtest/dowhile.bas b/bwbtest/dowhile.bas new file mode 100644 index 0000000..ff3ce05 --- /dev/null +++ b/bwbtest/dowhile.bas @@ -0,0 +1,13 @@ +10 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" diff --git a/bwbtest/elseif.bas b/bwbtest/elseif.bas new file mode 100644 index 0000000..f91e2a0 --- /dev/null +++ b/bwbtest/elseif.bas @@ -0,0 +1,26 @@ + +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." diff --git a/bwbtest/end.bas b/bwbtest/end.bas new file mode 100644 index 0000000..6ca2807 --- /dev/null +++ b/bwbtest/end.bas @@ -0,0 +1,6 @@ +10 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 diff --git a/bwbtest/err.bas b/bwbtest/err.bas new file mode 100644 index 0000000..92fa7a2 --- /dev/null +++ b/bwbtest/err.bas @@ -0,0 +1,3 @@ +10 dim n(5) +20 print n(7) +30 end diff --git a/bwbtest/fncallfn.bas b/bwbtest/fncallfn.bas new file mode 100644 index 0000000..809a29b --- /dev/null +++ b/bwbtest/fncallfn.bas @@ -0,0 +1,9 @@ +10 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 diff --git a/bwbtest/fornext.bas b/bwbtest/fornext.bas new file mode 100644 index 0000000..67fab86 --- /dev/null +++ b/bwbtest/fornext.bas @@ -0,0 +1,13 @@ +10 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 diff --git a/bwbtest/function.bas b/bwbtest/function.bas new file mode 100644 index 0000000..04d152e --- /dev/null +++ b/bwbtest/function.bas @@ -0,0 +1,43 @@ +1000 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)) diff --git a/bwbtest/gosub.bas b/bwbtest/gosub.bas new file mode 100644 index 0000000..1c51e9a --- /dev/null +++ b/bwbtest/gosub.bas @@ -0,0 +1,54 @@ +10 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 diff --git a/bwbtest/gotolabl.bas b/bwbtest/gotolabl.bas new file mode 100644 index 0000000..2827ab1 --- /dev/null +++ b/bwbtest/gotolabl.bas @@ -0,0 +1,22 @@ +Print "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 diff --git a/bwbtest/ifline.bas b/bwbtest/ifline.bas new file mode 100644 index 0000000..11a4201 --- /dev/null +++ b/bwbtest/ifline.bas @@ -0,0 +1,6 @@ +10 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 diff --git a/bwbtest/index.txt b/bwbtest/index.txt new file mode 100644 index 0000000..39c8b94 --- /dev/null +++ b/bwbtest/index.txt @@ -0,0 +1,43 @@ +Test 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 + diff --git a/bwbtest/input.bas b/bwbtest/input.bas new file mode 100644 index 0000000..79311ce --- /dev/null +++ b/bwbtest/input.bas @@ -0,0 +1,7 @@ +10 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 diff --git a/bwbtest/lof.bas b/bwbtest/lof.bas new file mode 100644 index 0000000..fb02ae6 --- /dev/null +++ b/bwbtest/lof.bas @@ -0,0 +1,5 @@ +10 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 diff --git a/bwbtest/loopuntl.bas b/bwbtest/loopuntl.bas new file mode 100644 index 0000000..535c9d2 --- /dev/null +++ b/bwbtest/loopuntl.bas @@ -0,0 +1,6 @@ +10 rem LOOPUNTL.BAS +20 i = 0 +30 do +40 i = i + 1 +50 print "Value of i is";i +60 loop until i > 12 diff --git a/bwbtest/main.bas b/bwbtest/main.bas new file mode 100644 index 0000000..c527072 --- /dev/null +++ b/bwbtest/main.bas @@ -0,0 +1,17 @@ + +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 + + diff --git a/bwbtest/mlifthen.bas b/bwbtest/mlifthen.bas new file mode 100644 index 0000000..6ac0706 --- /dev/null +++ b/bwbtest/mlifthen.bas @@ -0,0 +1,16 @@ + +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." diff --git a/bwbtest/on.bas b/bwbtest/on.bas new file mode 100644 index 0000000..fa72374 --- /dev/null +++ b/bwbtest/on.bas @@ -0,0 +1,14 @@ +10 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 diff --git a/bwbtest/onerr.bas b/bwbtest/onerr.bas new file mode 100644 index 0000000..8c60352 --- /dev/null +++ b/bwbtest/onerr.bas @@ -0,0 +1,12 @@ +10 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 diff --git a/bwbtest/onerrlbl.bas b/bwbtest/onerrlbl.bas new file mode 100644 index 0000000..e3a0026 --- /dev/null +++ b/bwbtest/onerrlbl.bas @@ -0,0 +1,12 @@ +rem 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 diff --git a/bwbtest/ongosub.bas b/bwbtest/ongosub.bas new file mode 100644 index 0000000..8cf1573 --- /dev/null +++ b/bwbtest/ongosub.bas @@ -0,0 +1,15 @@ +10 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 diff --git a/bwbtest/opentest.bas b/bwbtest/opentest.bas new file mode 100644 index 0000000..2f1b3c8 --- /dev/null +++ b/bwbtest/opentest.bas @@ -0,0 +1,12 @@ +10 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 diff --git a/bwbtest/option.bas b/bwbtest/option.bas new file mode 100644 index 0000000..4bae33f --- /dev/null +++ b/bwbtest/option.bas @@ -0,0 +1,8 @@ +1 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 diff --git a/bwbtest/pascaltr.bas b/bwbtest/pascaltr.bas new file mode 100644 index 0000000..ed61655 --- /dev/null +++ b/bwbtest/pascaltr.bas @@ -0,0 +1,17 @@ +100 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 + diff --git a/bwbtest/putget.bas b/bwbtest/putget.bas new file mode 100644 index 0000000..9185ba1 --- /dev/null +++ b/bwbtest/putget.bas @@ -0,0 +1,22 @@ +rem 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 diff --git a/bwbtest/random.bas b/bwbtest/random.bas new file mode 100644 index 0000000..09107e8 --- /dev/null +++ b/bwbtest/random.bas @@ -0,0 +1,13 @@ +100 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." diff --git a/bwbtest/selcase.bas b/bwbtest/selcase.bas new file mode 100644 index 0000000..8fca268 --- /dev/null +++ b/bwbtest/selcase.bas @@ -0,0 +1,31 @@ +rem 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 + + diff --git a/bwbtest/snglfunc.bas b/bwbtest/snglfunc.bas new file mode 100644 index 0000000..b707b5b --- /dev/null +++ b/bwbtest/snglfunc.bas @@ -0,0 +1,15 @@ + +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 diff --git a/bwbtest/stop.bas b/bwbtest/stop.bas new file mode 100644 index 0000000..3454e75 --- /dev/null +++ b/bwbtest/stop.bas @@ -0,0 +1,6 @@ +10 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 diff --git a/bwbtest/term.bas b/bwbtest/term.bas new file mode 100644 index 0000000..af6b3e9 --- /dev/null +++ b/bwbtest/term.bas @@ -0,0 +1,10 @@ +10 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 diff --git a/bwbtest/whilwend.bas b/bwbtest/whilwend.bas new file mode 100644 index 0000000..d469622 --- /dev/null +++ b/bwbtest/whilwend.bas @@ -0,0 +1,13 @@ +10 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" diff --git a/bwbtest/width.bas b/bwbtest/width.bas new file mode 100644 index 0000000..291f257 --- /dev/null +++ b/bwbtest/width.bas @@ -0,0 +1,5 @@ +10 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" diff --git a/bwbtest/writeinp.bas b/bwbtest/writeinp.bas new file mode 100644 index 0000000..c172500 --- /dev/null +++ b/bwbtest/writeinp.bas @@ -0,0 +1,20 @@ +10 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 diff --git a/bwx_iqc.c b/bwx_iqc.c new file mode 100644 index 0000000..48545a7 --- /dev/null +++ b/bwx_iqc.c @@ -0,0 +1,704 @@ +/*************************************************************** + + 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. + +***************************************************************/ + +#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 ); +#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; + 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 + + /* clear current contents */ + + bwb_new( l ); + + /* 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 ); + } + + /* 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 ); + } + + /* 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 */ + diff --git a/bwx_iqc.h b/bwx_iqc.h new file mode 100644 index 0000000..95ae38b --- /dev/null +++ b/bwx_iqc.h @@ -0,0 +1,40 @@ +/*************************************************************** + + 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 */ + \ No newline at end of file diff --git a/bwx_tty.c b/bwx_tty.c new file mode 100644 index 0000000..22a5279 --- /dev/null +++ b/bwx_tty.c @@ -0,0 +1,517 @@ +/*************************************************************** + + 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. + +***************************************************************/ + +#include + +#include "bwbasic.h" +#include "bwb_mes.h" + +#if HAVE_LONGJMP +#include +#endif + +extern int prn_col; +#if HAVE_LONGJMP +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_LONGJMP +#if INTERACTIVE + setjmp( mark ); +#endif +#endif + + /* main program loop */ + + while( !feof( stdin ) ) /* condition !feof( stdin ) added in v1.11 */ + { + bwb_mainloop(); + } + + bwx_terminate(); /* in case of ^D exit in Unix systems */ + + } + +/*************************************************************** + + 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 ); +#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 + { +#if INTENSIVE_DEBUG + fprintf( stderr, "Normal Termination\n" ); +#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; + 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 ) + { + 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 + + /* clear current contents */ + + bwb_new( l ); + + /* 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 ); + } + + /* 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 */ + diff --git a/bwx_tty.h b/bwx_tty.h new file mode 100644 index 0000000..76fe9a9 --- /dev/null +++ b/bwx_tty.h @@ -0,0 +1,43 @@ +/*************************************************************** + + 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. + +***************************************************************/ + +#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 FALSE +#define MKDIR_ONE_ARG FALSE /* TRUE if your mkdir has but one argument; + FALSE if it has two */ +#define PERMISSIONS 493 /* permissions to set in Unix-type system */ + \ No newline at end of file diff --git a/configur b/configur new file mode 100644 index 0000000..62e07ec --- /dev/null +++ b/configur @@ -0,0 +1,303 @@ +#!/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. + + +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* + +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 + + \ No newline at end of file diff --git a/configur.in b/configur.in new file mode 100644 index 0000000..b5e53dd --- /dev/null +++ b/configur.in @@ -0,0 +1,12 @@ +dnl 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_COMPILE_CHECK(raise, [#include +#include ], [raise(1);], AC_DEFINE(HAVE_RAISE)) +AC_OUTPUT(Makefile) + \ No newline at end of file diff --git a/makefile.qcl b/makefile.qcl new file mode 100644 index 0000000..601da3a --- /dev/null +++ b/makefile.qcl @@ -0,0 +1,63 @@ +# 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 +