diff options
Diffstat (limited to 'Build/source/utils/m-tx/mtx-0.60d/libp2c')
-rw-r--r-- | Build/source/utils/m-tx/mtx-0.60d/libp2c/COPYING | 339 | ||||
-rw-r--r-- | Build/source/utils/m-tx/mtx-0.60d/libp2c/ChangeLog | 390 | ||||
-rw-r--r-- | Build/source/utils/m-tx/mtx-0.60d/libp2c/Makefile.am | 2 | ||||
-rw-r--r-- | Build/source/utils/m-tx/mtx-0.60d/libp2c/README | 31 | ||||
-rw-r--r-- | Build/source/utils/m-tx/mtx-0.60d/libp2c/p2c.h | 533 | ||||
-rw-r--r-- | Build/source/utils/m-tx/mtx-0.60d/libp2c/p2clib.c | 1117 |
6 files changed, 2412 insertions, 0 deletions
diff --git a/Build/source/utils/m-tx/mtx-0.60d/libp2c/COPYING b/Build/source/utils/m-tx/mtx-0.60d/libp2c/COPYING new file mode 100644 index 00000000000..e77696ae8dd --- /dev/null +++ b/Build/source/utils/m-tx/mtx-0.60d/libp2c/COPYING @@ -0,0 +1,339 @@ + 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 + + 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. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) 19yy <name of author> + + 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. + + <signature of Ty Coon>, 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. diff --git a/Build/source/utils/m-tx/mtx-0.60d/libp2c/ChangeLog b/Build/source/utils/m-tx/mtx-0.60d/libp2c/ChangeLog new file mode 100644 index 00000000000..17e4bc2dbc5 --- /dev/null +++ b/Build/source/utils/m-tx/mtx-0.60d/libp2c/ChangeLog @@ -0,0 +1,390 @@ +Wed Mar 10 15:03:20 1999 Alexander L. Belikoff <abel@blinky> + + * src/p2c.h: DOUBLE defined as double + +Tue Mar 31 14:57:26 1998 Alexander L. Belikoff <abel@blinky> + + * src/trans.h: + Magic limits (MININT, MAXINT), causing random p2c bugs on the Alpha replaced + with LONG-MIN/MAX from limits.h (integers in Pascal include longs in C, + according to p2c) + +Tue Sep 23 09:14:22 1997 Harvey J. Stein <hjstein@bfr.co.il> + + * src/p2c.proto, src/funcs.c, src/p2c.hdrs: + Adjustments to get pad to work correctly. + +Thu Jul 3 20:41:55 1997 Harvey J. Stein <hjstein@bfr.co.il> + + * src/p2c.proto, src/sys.p2crc, src/trans.h, src/expr.c, src/funcs.c, src/p2c.hdrs: + Bug: Consider: + + procedure foo(x: array[i..j : integer] of varying[k] of char); + ... + var z : array[3..12] of varying[20] of char; + ... + foo(z); + + This should become something like: + + foo(int i, int j, int k, char x[j-i+1][k]) + ... + char z[10][20]; + ... + foo(3, 12, 20, z); + + Instead, it was generating: + + foo(3, 12, 255, z); + + which totally screws up accessing z. + + Analysis: To do this correctly, p2c has to keep dereferencing z as it + processes the hidden arguments i, j, & k so that it's working on an + expression of the appropriate type each time it tries to find either + the size of the string or the start & end points of arrays. Instead, + it just wasn't. + + Fix done: I couldn't figure out exactly how to do the above. But, p2c + calls strmax_func to get the length of the character string. I just + built some additional dereferencing into it so that it gets the + correct length in the above sort of situation. So, changed + strmax_func in expr.c. + + + Bug: Index(x,y) is a common pascal extension for finding a substring + in a string. p2c handles it but it wasn't working right on Dec code. + + Analysis: Some dialects of pascal consider x to be the string and y + to be the substring. Others switch x & y. p2c supports (substring, + string), and Dec pascal supports the opposite. + + Fix: There was some support for switching index argument order, but it + was tightly coupled to HP compiler directive support. I added a + comment switch ("IndexOrder") for additional control of this feature. + Changed func_strpos in funcs.c, and added the switch in trans.h. + +Fri Jun 13 07:22:26 1997 Harvey J. Stein <hjstein@blinky.bfr.co.il> + + * src/p2c.hdrs, src/p2c.proto, src/pexpr.c, src/decl.c, src/funcs.c: + Fixed bug in [truncate] handling - I didn't clear the new Meaning + fields (fakenumargs & truncated) at meaning creation time, so they + were sometimes showing up on non-truncated variables. Changed + initmeaning (decl.c). + + Moved hidden number_of_args from beginning to end of arg list. At the + beginning it was interfering with the return hidden variable, + causing return to not be generated. Changes were in p_funcdecl + (decl.c), func_present (funcs.c), and p_funcarglist (pexpr.c). Added + has_truncate function to pexpr.c to check whether an arg list has the + truncated attribute. + + Argument variables were sometimes getting shadowed just because + they're initialized. Problem was in var_reference, which clones + Meanings that have constdefns. But arg variables don't need to be + cloned since the constants are handled by p_funcarglist. So skipped + cloning if Meaning's kind is MK_PARAM or MK_VARPARAM. Previous fix of + always cloning, but only copying meanings if not MK_PARAM seems to + have been incorrect. + +Sun Jun 1 13:15:06 1997 Harvey J. Stein <hjstein@blinky.bfr.co.il> + + * src/sys.p2crc, src/trans.h, src/pexpr.c, src/parse.c, src/lex.c, src/p2c.hdrs, src/p2c.proto, src/funcs.c, src/decl.c: + Enhancements: + + Added support for [truncate]. This involved: + 1. Added a truncated flag & a fakenumargs flag to the Meaning + structure. + 2. In p_funcdecl (decl.c), recognizing the [truncate] attribute in + argument lists. If it's seen, the argument's truncated flag is + set, and it and all arguments following are given default values + (assuming that they don't already have default values). The + default values gets p2c to automatically generate the correct + number of arguments for calling the subroutine when some are + left out. + 3. In p_funcdecl (decl.c), if any of the args are tagged with + [truncate], then add a hidden argument to the front of the + argument list - number_of_args. Flag it with fakenumargs. + 4. In p_funcarglist (pexpr.c), when the fcn has a fakenumargs + parameter as the first parameter, (and truncateisdefalt is zero) + compute the index of the last argument supplied, and pass it as + the first argument in the call. + 5. In funcs.c, added func_present to handle the PRESENT(x) calls. + It parses the call, figures out the index of the argument in the + fcns calling sequence (say n), and generates an expression + (number_of_args >= n) to be the output for the PRESENT(x) call. + 6. Added new config parameter - TruncateIsDefault to turn off + PRESENT support (in case one doesn't want the extra arg to be + generated). + + Added support for CONTINUE & BREAK. Just had to basically declare + them as keywords in lex.c, and recognize them in parse.c, and declare + their tokens in trans.h (since p2c already supported them internally). + + Added descriptions for SkipReIncludes, NoOutput, and TruncateIsDefault + to sys.p2crc. + + Bug fixes: + + Bug: args with default values which are also used in local functions + lose their default values. + + Attempted fix: in var_reference (pexpr.c), don't zero out the + constdefn when the arg is cloned if the arg is a parameter. + + Problems: This works, but it sometimes causes bogus declarations of + the old variable to be output. + +Wed May 14 14:27:32 1997 Harvey J. Stein <hjstein@blinky.bfr.co.il> + + * src/stuff.c, src/p2c.hdrs, src/p2c.proto, src/out.c, src/expr.c, p2c.patch: + (Updated p2c.patch for last set of changes) + + Bug: p2c was seg faulting when given expressions such as: + there := + '1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890' + + '1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890' + + '1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890' + + '1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890' + + '1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890'; + + and: + + there := + '1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890' + + '1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890' + + '1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890' + + '1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890' + where; + + when there is VARYING [XXX] OF CHAR; + + Analysis: There seem to be all sorts of fixed length character arrays + around the code. It seems that especially long expressions and/or + character strings can cause them to overflow. + + Fix: I upped some of the limits, which at least avoided core dumps on + the code I'm currently processing, but really one needs to go through + and properly keep track of the amount copied into strings so as to + avoid buffer overruns. But, this is a real pain in the ass because of + the shitty semantics of the standard C library. + + Basically, the stack allocated ones that I noticed in expr.c and out.c + I upped to length 2000, and in stuff.c, I upped the size of the + strings in formatbuf[] to 4000. + +Tue May 13 19:27:00 1997 Harvey J. Stein <hjstein@blinky.bfr.co.il> + + * src/lex.c, src/p2c.hdrs, src/p2c.proto, src/trans.c, src/Makefile, src/decl.c, src/expr.c, src/funcs.c: + Minor fixes/changes: + -Was calling close in handle_include (lex.c) when it should have + been fclose. + -Modified src/Makefile to allow for using insure on the source code + (to catch memory bugs). + + + Major fixes: + + Bug: p2c occasionally was freeing memory that was already freed. + + Analysis: This seems to occur sometimes on constant string + definitions because mp->val.s might point to the same string as + mp->constdefn->val.s, and forget_ctx tries to free them both. + + Fix: In decl.c, in forget_ctx: After calling free_value(&mp->val) when + mp->kind == MK_CONST, instead of always calling + freexpr(mp->constdefn), only call it when mp->kind != MK_CONST, + or when mp->constdefn->val.s != mp->val.s. + + I also tried to fix this by copying mp->val.s in p_constdecl when + creating mp->constdefn->val.s, but never got this to work + correctly, so I commented it out. + + + Bug: p2c core dumped on: + + readv(data, short_string); + + when data is a packed array[1..7] of char, and + short_string is a packed array[1..3] of char. + + Analysis: What was happening was that in handleread_text (funcs.c), + when the readv argument is an array, it was checking + ord_range(ex->val.type->indextype, ...), and ex was NULL. + + Fix: It seems like this was a typo, so I change it to check + var->... instead of ex->... + + + Bug: p2c core dumped on: + + WRITELN('%SQLMOD ', msg); + + when msg was of type varying[x] of char. + + Analysis: Some part of the code was converting the above string to + "%%SQLMOD %s". It seems that cleansprintf (from expr.c) didn't + realize that % is escaped by %%, so it thought that there should + be 2 arguments (maybe 3?) for the above printf string instead of + one, and thus was going off of the end of the args list (i.e. - + ex->args[j] out of range). + + Fix: Inside the for loop, if the next character is also a %, then + skip arg processing, and skip the next character (just copy it + into fmtbuf). + + + Bug: p2c core dumps on: + + readv(c, i); + + when c is a char and i is an integer. + + Analysis: In funcs.c, in handleread_text, var is never getting + initialized - it's getting passed in as NULL, and it only gets + set if isstrread is true. Since c is a char, fex->val.type->kind + is TK_CHAR, not TK_STRING, so isstrread is false, so var fails to + get initialized. + + Fix: After the case that var is set when isstrread is true, if it's + still NULL, we set it to p_expr(NULL). This prevents the core + dump, but produces incorrect code! It outputs: + + fscanf(c, "%ld", &i); + + when it should more likely be something along the lines of + sscanf(&c, ...) (but safer). + +Mon May 5 15:23:04 1997 Harvey J. Stein <hjstein@blinky.bfr.co.il> + + * src/out.c, src/p2c.hdrs, src/p2c.proto, src/trans.h, src/decl.c, src/lex.c, p2c.patch: + New features (out.c, trans.h): + New parameter NoOutput - setting it to 1 stops p2c from generating + output. Useful when trying to simulate Dec style modules via + include files - just convert INHERIT to %include, and put + {*NoOutput=1} at the top of each include file, and p2c does the + right thing. This was done by not pushing characters into the + output stream when nooutput is 1. The real code changes occur in + out.c, in putc_outf, and puts_outf. Accumulating the output, but + turning off writes (i.e. - wiring it into flush_outfilebuf) failed + because of timing differences btw when comment directives are + processed and when output occurs. + + Bug fixes: + + Bug: Some variable declarations weren't getting output. Most + noticable were the automatically generated Return variables. + + Analysis: When using the {INTF-ONLY} directive in include files + then the fwd declaration of fcns was being interpreted as the fcn + definition, and so the variables generated when the declaration was + seen were marked as "wasdeclared". Then, when the code for the + function was being generated, these variables weren't getting + output because "wasdeclared" was 1. This was most visible from the + automatically generated Return variable, but occasionally happened + to other variables. + + Fix: in decl.c:activatemeaning - added resetting of "wasdeclared" + if we can identify that the variable is the autogenerated return + variable. Detected them by snarfing code from isretvar. But this + was a lousy fix because as mentioned above, there are other + variables which are occasionally affected. And, it's no longer + needed because of the new NoOutput feature, so I commented out the + change, but left the code there as a reminder of the problem. + + + Bug: Comments weren't getting output in the correct places. This + is a serious problem when using {EMBED comments to insert C code + into the output stream. Sometimes code from the {EMBED comment + given in an include file showed up in the includer. Sometimes the + code didn't get emitted at all because of mistiming against + {nooutput} directives. + + Analysis: p2c builds up a comment string structure as it parses + the code, and hangs it off of the code's internal representation. + Presumably this is so that when doing code transformations, the + comments are output in the correct places. However, this seems to + sometimes fail when using %include files. It seems that the + comments weren't getting processed & output until the current block + was finished. Included files don't start a new block because one + could conceivably include random snippets of code anywhere you want + (inside of RECORD declarations, for example). Thus, sometimes + comments from inside the include file don't get processed & output + until well after the include file itself is finished being + processed. + + Fix: Added the call flushcomments(NULL, -1, -1) to both push_input + and pop_input (in lex.c). This seems to have fixed it with no + noticable side effects. + +Tue Apr 29 18:36:51 1997 Harvey J. Stein <hjstein@blinky.bfr.co.il> + + * src/p2c.hdrs, src/p2c.proto, src/lex.c: + Added recognition of AND_THEN and OR_ELSE. + + * src/trans.h, src/lex.c, src/p2c.hdrs, src/p2c.proto: + Added tracking of files that have been included so that they can + optionally be ignored the second time they're seen. This is needed + because a module (say X) can inherit from two other modules (say Y and + Z), both of whom inherit from a fourth module (say Z). Converting the + inherits to includes thus gets Z included twice. If it's not ignored, + it causes p2c to start renaming procedures so as to avoid name + clashes. + + Added an rc file parameter (skipreincludes) for controling the above + action. + + * src/decl.c, src/p2c.hdrs, src/p2c.proto, src/parse.c: + Various adjustments & bug fixes suggested by Dave Gillespie: + + decl.c: Call format_s so that we work with a copy of the string + when removing dollar signs - a little more robust. + + Missing ! on strcicmp caused bogus externs to be emitted on + some variable declarations. + + parse.c: Sprinkle afew p_attributes around p_block so that p2c + properly parses attributes in front of declaration blocks. + In particular, this fixes the problem where p2c was choking + on [hidden] followed by TYPE, which appears in analytic.pas. + +Wed Apr 23 12:17:08 1997 Harvey J. Stein <hjstein@blinky.bfr.co.il> + + * src/p2c.proto, src/decl.c, src/p2c.hdrs: + Modified addfield so that it removes dollar signs from record field + identifiers. This is more consistent with the handling of other + identifiers, and also needed by much of the Pascal code. + +Mon Apr 21 10:41:53 1997 Harvey J. Stein <hjstein@blinky.bfr.co.il> + + * p2c.patch: Submitted new patch to Dave G. + + * src/p2c.proto, src/lex.c, src/p2c.cat, src/p2c.hdrs, src/Makefile: + Changed VALUE from a keyword to a possible keyword when working with + Dec Pascal code. Original code set it to be a keyword for Dec, and a + possible keyword otherwise. However, if it's a keyword, then p2c + doesn't accept it the name of a slot in a record. Since Dec accepts + this usage, I figured that VALUE should always be a possible keyword + instead of a keyword. + +Thu Apr 17 11:33:22 1997 Harvey J. Stein <hjstein@blinky.bfr.co.il> + + * p2c.patch: patches generated & mailed to Dave Gillespie + +Wed Apr 16 16:26:07 1997 Harvey J. Stein <hjstein@blinky.bfr.co.il> + + * src/p2c.hdrs, src/p2c.proto, .cvsignore, examples/.cvsignore, src/.cvsignore, src/decl.c, src/p2c.cat: + Parser didn't expect a ( after the OTHERWISE keyword. Modified + decl.c to expect it. + + * src/INSTALL, src/citmods.c, src/comment.c, src/decl.c, src/dir.c, src/expr.c, src/funcs.c, src/hpmods.c, src/lex.c, src/loc.p2clib.c, src/loc.p2crc, src/makeproto.c, src/out.c, src/p2c.cat, src/p2c.h, src/p2c.hdrs, src/p2c.proto, src/p2cc.cat, src/p2cc.man, src/p2cc.perl, src/p2clib.c, src/parse.c, src/pexpr.c, src/string.pas, src/system.imp, src/system.m2, src/trans.h, src/turbo.imp: + Import of p2c 1.21alpha2 + + * src/INSTALL, src/citmods.c, src/comment.c, src/decl.c, src/dir.c, src/expr.c, src/funcs.c, src/hpmods.c, src/lex.c, src/loc.p2clib.c, src/loc.p2crc, src/makeproto.c, src/out.c, src/p2c.cat, src/p2c.h, src/p2c.hdrs, src/p2c.proto, src/p2cc.cat, src/p2cc.man, src/p2cc.perl, src/p2clib.c, src/parse.c, src/pexpr.c, src/string.pas, src/system.imp, src/system.m2, src/trans.h, src/turbo.imp: + Initial revision + + * HP/import/asm.imp, HP/import/fs.imp, HP/import/general_0.imp, HP/import/general_1.imp, HP/import/general_2.imp, HP/import/general_3.imp, HP/import/general_4.imp, HP/import/hpib_0.imp, HP/import/hpib_1.imp, HP/import/hpib_2.imp, HP/import/hpib_3.imp, HP/import/iodecl.imp, HP/import/misc.imp, HP/import/rnd.imp, HP/import/sysdevs.imp, HP/import/sysglobals.imp, HP/include/asm.h, HP/include/fs.h, HP/include/general_0.h, HP/include/general_1.h, HP/include/general_2.h, HP/include/general_3.h, HP/include/general_4.h, HP/include/hpib_0.h, HP/include/hpib_1.h, HP/include/hpib_2.h, HP/include/hpib_3.h, HP/include/iodecl.h, HP/include/misc.h, HP/include/rnd.h, HP/include/sysdevs.h, HP/include/sysglobals.h, Makefile, README, examples/Makefile, examples/README, examples/basic.doc, examples/basic.p, examples/c/basic.c, examples/c/cref.c, examples/c/e.c, examples/c/fact.c, examples/c/self.c, examples/cref.p, examples/e.p, examples/fact.p, examples/p2crc, examples/self.p, ftp.README, src/COPYING, src/HISTORY, src/Makefile, src/NOTES, src/README, src/p2c.man, src/stuff.c, src/sys.p2crc, src/trans.c: + Import of p2c 1.21alpha2 + + * HP/import/asm.imp, HP/import/fs.imp, HP/import/general_0.imp, HP/import/general_1.imp, HP/import/general_2.imp, HP/import/general_3.imp, HP/import/general_4.imp, HP/import/hpib_0.imp, HP/import/hpib_1.imp, HP/import/hpib_2.imp, HP/import/hpib_3.imp, HP/import/iodecl.imp, HP/import/misc.imp, HP/import/rnd.imp, HP/import/sysdevs.imp, HP/import/sysglobals.imp, HP/include/asm.h, HP/include/fs.h, HP/include/general_0.h, HP/include/general_1.h, HP/include/general_2.h, HP/include/general_3.h, HP/include/general_4.h, HP/include/hpib_0.h, HP/include/hpib_1.h, HP/include/hpib_2.h, HP/include/hpib_3.h, HP/include/iodecl.h, HP/include/misc.h, HP/include/rnd.h, HP/include/sysdevs.h, HP/include/sysglobals.h, Makefile, README, examples/Makefile, examples/README, examples/basic.doc, examples/basic.p, examples/c/basic.c, examples/c/cref.c, examples/c/e.c, examples/c/fact.c, examples/c/self.c, examples/cref.p, examples/e.p, examples/fact.p, examples/p2crc, examples/self.p, ftp.README, src/COPYING, src/HISTORY, src/Makefile, src/NOTES, src/README, src/p2c.man, src/stuff.c, src/sys.p2crc, src/trans.c: + Initial revision + diff --git a/Build/source/utils/m-tx/mtx-0.60d/libp2c/Makefile.am b/Build/source/utils/m-tx/mtx-0.60d/libp2c/Makefile.am new file mode 100644 index 00000000000..fd208029eef --- /dev/null +++ b/Build/source/utils/m-tx/mtx-0.60d/libp2c/Makefile.am @@ -0,0 +1,2 @@ +noinst_LIBRARIES = libp2c.a +libp2c_a_SOURCES = p2c.h p2clib.c diff --git a/Build/source/utils/m-tx/mtx-0.60d/libp2c/README b/Build/source/utils/m-tx/mtx-0.60d/libp2c/README new file mode 100644 index 00000000000..47a102c88d2 --- /dev/null +++ b/Build/source/utils/m-tx/mtx-0.60d/libp2c/README @@ -0,0 +1,31 @@ + +This directory contains "p2c", a Pascal to C translator. + +"p2c" Copyright 1989, 1990, 1991, 1992, 1993 Free Software Foundation, Inc. + +Written and maintained by: Dave Gillespie + c/o Synaptics, Inc. + 2698 Orchard Parkway + San Jose CA 95134 + daveg@synaptics.com, uunet!synaptx!daveg + + +This program is distributed under the terms of the GNU License Agreement. +See the file src/COPYING for details. + +The GNU License Agreement restrictions do _not_ apply to code generated +by p2c, nor to the p2c run-time files "p2clib.c" and "p2c.h". + +NO WARRANTY: + The program in this directory was developed for internal use at + Caltech and thus absolutely no guarantee is made that the program + will compile or run on other systems or that it will produce correct + code. P2c is _not_ a compiler, it is a translator; it strives to + produce correct code but reserves the right to sacrifice correctness + in extreme cases for readability in the general case. P2c is designed + to be extended (see funcs.c, hpmods.c and citmods.c for examples), but + some of the main code is pretty messy since the translator has grown + considerably beyond its original planned scale. Bug reports are + welcome at daveg@synaptics.com, but I may not have time to respond + to them immediately. Suggestions are welcome, too! + diff --git a/Build/source/utils/m-tx/mtx-0.60d/libp2c/p2c.h b/Build/source/utils/m-tx/mtx-0.60d/libp2c/p2c.h new file mode 100644 index 00000000000..c8216a6002c --- /dev/null +++ b/Build/source/utils/m-tx/mtx-0.60d/libp2c/p2c.h @@ -0,0 +1,533 @@ +#ifndef P2C_H +#define P2C_H + + +/* Header file for code generated by "p2c", the Pascal-to-C translator */ + +/* "p2c" Copyright (C) 1989, 1990, 1991, 1992, 1993 Free Software Foundation. + * By Dave Gillespie, daveg@synaptics.com. Version 1.21alpha-07.Dec.93. + * This file may be copied, modified, etc. in any way. It is not restricted + * by the licence agreement accompanying p2c itself. + */ + + +#include <stdio.h> + +#define DOUBLE double + + + +/* If the following heuristic fails, compile -DBSD=0 for non-BSD systems, + or -DBSD=1 for BSD systems. */ + +#ifdef M_XENIX +# define BSD 0 +#endif + +#ifdef vms +# define BSD 0 +# ifndef __STDC__ +# define __STDC__ 1 +# endif +#endif + +#ifdef __TURBOC__ +# define MSDOS 1 +#endif + +#ifdef MSDOS +# define BSD 0 +#endif + +#ifdef FILE /* a #define in BSD, a typedef in SYSV (hp-ux, at least) */ +# ifndef BSD /* (a convenient, but horrible kludge!) */ +# define BSD 1 +# endif +#endif + +#ifdef BSD +# if !BSD +# undef BSD +# endif +#endif + + +#if (defined(__STDC__) && !defined(M_XENIX)) || defined(__TURBOC__) +# include <stdlib.h> +# include <stddef.h> +# define HAS_STDLIB +# if defined(vms) || defined(__TURBOC__) +# define NON_ANSI_CAT +# endif +#else +# ifndef BSD +# ifndef __TURBOC__ +# include <memory.h> +# endif +# endif +# ifdef hpux +# ifdef _INCLUDE__STDC__ +# include <stddef.h> +# include <stdlib.h> +# define HAS_STDLIB +# endif +# endif +# include <sys/types.h> +# if !defined(MSDOS) || defined(__TURBOC__) +# define NON_ANSI_CAT +# endif +#endif + +#if defined(NON_ANSI_CAT) && !defined(ANSI_CAT) +# ifdef NON_ANSI_CAT_ALTERNATE +# define __CAT__(a,b)a/**/b +# else +# define __ID__(a)a +# define __CAT__(a,b)__ID__(a)b +# endif +#else +# define __CAT__(a,b)a##b +#endif + + +#ifdef BSD +# include <strings.h> +# define memcpy(a,b,n) (bcopy(b,a,n),a) +# define memcmp(a,b,n) bcmp(a,b,n) +# define strchr(s,c) index(s,c) +# define strrchr(s,c) rindex(s,c) +#else +# include <string.h> +#endif + +#include <ctype.h> +#include <math.h> +#include <setjmp.h> +#include <assert.h> + + +#ifndef NO_LACK +#ifdef vms + +#define LACK_LABS +#define LACK_MEMMOVE +#define LACK_MEMCPY + +#else + +#define LACK_LABS /* Undefine these if your library has these */ +#define LACK_MEMMOVE + +#endif +#endif + + +typedef struct __p2c_jmp_buf { + struct __p2c_jmp_buf *next; + jmp_buf jbuf; +} __p2c_jmp_buf; + + +/* Warning: The following will not work if setjmp is used simultaneously. + This also violates the ANSI restriction about using vars after longjmp, + but a typical implementation of longjmp will get it right anyway. */ + +#ifndef FAKE_TRY +# define TRY(x) do { __p2c_jmp_buf __try_jb; \ + __try_jb.next = __top_jb; \ + if (!setjmp((__top_jb = &__try_jb)->jbuf)) { +# define RECOVER(x) __top_jb = __try_jb.next; } else { +# define RECOVER2(x,L) __top_jb = __try_jb.next; } else { \ + if (0) { L: __top_jb = __try_jb.next; } +# define ENDTRY(x) } } while (0) +#else +# define TRY(x) if (1) { +# define RECOVER(x) } else do { +# define RECOVER2(x,L) } else do { L: ; +# define ENDTRY(x) } while (0) +#endif + + + +#ifdef M_XENIX /* avoid compiler bug */ +# define SHORT_MAX (32767) +# define SHORT_MIN (-32768) +#endif + + +/* The following definitions work only on twos-complement machines */ +#ifndef SHORT_MAX +# define SHORT_MAX ((short)(((unsigned short) -1) >> 1)) +# define SHORT_MIN (~SHORT_MAX) +#endif + +#ifndef INT_MAX +# define INT_MAX ((int)(((unsigned int) -1) >> 1)) +# define INT_MIN (~INT_MAX) +#endif + +#ifndef LONG_MAX +# define LONG_MAX ((long)(((unsigned long) -1) >> 1)) +# define LONG_MIN (~LONG_MAX) +#endif + +#ifndef SEEK_SET +# define SEEK_SET 0 +# define SEEK_CUR 1 +# define SEEK_END 2 +#endif + +#ifndef EXIT_SUCCESS +# ifdef vms +# define EXIT_SUCCESS 1 +# define EXIT_FAILURE (02000000000L) +# else +# define EXIT_SUCCESS 0 +# define EXIT_FAILURE 1 +# endif +#endif + + +#define SETBITS 32 + + +#if defined(__STDC__) || defined(__TURBOC__) +# if !defined(vms) && !defined(M_LINT) +# define Signed signed +# else +# define Signed +# endif +# define Void void /* Void f() = procedure */ +# ifndef Const +# define Const const +# endif +# ifndef Volatile +# define Volatile volatile +# endif +# ifdef M_LINT +# define PP(x) () +# define PV() () +typedef char *Anyptr; +# else +# define PP(x) x /* function prototype */ +# define PV() (void) /* null function prototype */ +typedef void *Anyptr; +# endif +#else +# define Signed +# define Void void +# ifndef Const +# define Const +# endif +# ifndef Volatile +# define Volatile +# endif +# define PP(x) () +# define PV() () +typedef char *Anyptr; +#endif + +#ifdef __GNUC__ +# define Inline inline +#else +# define Inline +#endif + +#define Register register /* Register variables */ +#define Char char /* Characters (not bytes) */ + +#ifndef Static +# define Static static /* Private global funcs and vars */ +#endif + +#ifndef Local +# define Local static /* Nested functions */ +#endif + +typedef Signed char schar; +typedef unsigned char uchar; +typedef unsigned char boolean; + +#ifndef NO_DECLARE_ALFA +typedef Char alfa[10]; +#endif + +#ifndef true +# define true 1 +# define false 0 +#endif + +#ifndef TRUE +# define TRUE 1 +# define FALSE 0 +#endif + + +typedef struct { + Anyptr proc, link; +} _PROCEDURE; + +#ifndef _FNSIZE +# define _FNSIZE 120 +#endif + + +extern Void PASCAL_MAIN PP( (int, Char **) ); +extern Char **P_argv; +extern int P_argc; +extern short P_escapecode; +extern int P_ioresult; +extern __p2c_jmp_buf *__top_jb; + + +#ifdef P2C_H_PROTO /* if you have Ansi C but non-prototyped header files */ +extern Char *strcat PP( (Char *, Const Char *) ); +extern Char *strchr PP( (Const Char *, int) ); +extern int strcmp PP( (Const Char *, Const Char *) ); +extern Char *strcpy PP( (Char *, Const Char *) ); +extern size_t strlen PP( (Const Char *) ); +extern Char *strncat PP( (Char *, Const Char *, size_t) ); +extern int strncmp PP( (Const Char *, Const Char *, size_t) ); +extern Char *strncpy PP( (Char *, Const Char *, size_t) ); +extern Char *strrchr PP( (Const Char *, int) ); + +extern Anyptr memchr PP( (Const Anyptr, int, size_t) ); +extern Anyptr memmove PP( (Anyptr, Const Anyptr, size_t) ); +extern Anyptr memset PP( (Anyptr, int, size_t) ); +#ifndef memcpy +extern Anyptr memcpy PP( (Anyptr, Const Anyptr, size_t) ); +extern int memcmp PP( (Const Anyptr, Const Anyptr, size_t) ); +#endif + +extern int atoi PP( (Const Char *) ); +extern double atof PP( (Const Char *) ); +extern long atol PP( (Const Char *) ); +extern double strtod PP( (Const Char *, Char **) ); +extern long strtol PP( (Const Char *, Char **, int) ); +#endif /*P2C_H_PROTO*/ + +#ifndef HAS_STDLIB +#ifndef NO_DECLARE_MALLOC +extern Anyptr malloc PP( (size_t) ); +extern Void free PP( (Anyptr) ); +#endif +#endif + +extern int _OutMem PV(); +extern int _CaseCheck PV(); +extern int _NilCheck PV(); +extern int _Escape PP( (int) ); +extern int _EscIO PP( (int) ); +extern int _EscIO2 PP( (int, Char *) ); + +extern long ipow PP( (long, long) ); +extern long P_imax PP( (long, long) ); +extern long P_imin PP( (long, long) ); +extern double P_rmax PP( (double, double) ); +extern double P_rmin PP( (double, double) ); +extern Char *strsub PP( (Char *, Char *, int, int) ); +extern Char *strltrim PP( (Char *) ); +extern Char *strrtrim PP( (Char *) ); +extern Char *strrpt PP( (Char *, Char *, int) ); +extern Char *strpad PP( (Char *, Char *, int, int) ); +extern int strpos2 PP( (Char *, Char *, int) ); +extern long memavail PV(); +extern int P_peek PP( (FILE *) ); +extern int P_eof PP( (FILE *) ); +extern int P_eoln PP( (FILE *) ); +extern Void P_readpaoc PP( (FILE *, Char *, int) ); +extern Void P_readlnpaoc PP( (FILE *, Char *, int) ); +extern long P_maxpos PP( (FILE *) ); +extern Char *P_trimname PP( (Char *, int) ); +extern long *P_setunion PP( (long *, long *, long *) ); +extern long *P_setint PP( (long *, long *, long *) ); +extern long *P_setdiff PP( (long *, long *, long *) ); +extern long *P_setxor PP( (long *, long *, long *) ); +extern int P_inset PP( (unsigned, long *) ); +extern int P_setequal PP( (long *, long *) ); +extern int P_subset PP( (long *, long *) ); +extern long *P_addset PP( (long *, unsigned) ); +extern long *P_addsetr PP( (long *, unsigned, unsigned) ); +extern long *P_remset PP( (long *, unsigned) ); +extern long *P_setcpy PP( (long *, long *) ); +extern long *P_expset PP( (long *, long) ); +extern long P_packset PP( (long *) ); +extern int P_getcmdline PP( (int, int, Char *) ); +extern Void TimeStamp PP( (int *, int *, int *, + int *, int *, int *) ); +extern Void P_sun_argv PP( (char *, int, int) ); +extern FILE *_skipspaces PP( (FILE *) ); +extern FILE *_skipnlspaces PP( (FILE *) ); + + +/* I/O error handling */ +#define _CHKIO(cond,ior,val,def) ((cond) ? P_ioresult=0,(val) \ + : P_ioresult=(ior),(def)) +#define _SETIO(cond,ior) (P_ioresult = (cond) ? 0 : (ior)) + +/* Following defines are suitable for the HP Pascal operating system */ +#define FileNotFound 10 +#define FileNotOpen 13 +#define FileWriteError 38 +#define BadInputFormat 14 +#define EndOfFile 30 + +#define FILENOTFOUND 10 +#define FILENOTOPEN 13 +#define FILEWRITEERROR 38 +#define BADINPUTFORMAT 14 +#define ENDOFFILE 30 + +/* Creating temporary files */ +#if (defined(BSD) || defined(NO_TMPFILE)) && !defined(HAVE_TMPFILE) +# define tmpfile() (fopen(tmpnam(NULL), "w+")) +#endif + +/* File buffers */ +#define FILEBUF(f,sc,type) sc int __CAT__(f,_BFLAGS); \ + sc type __CAT__(f,_BUFFER) +#define FILEBUFNC(f,type) int __CAT__(f,_BFLAGS); \ + type __CAT__(f,_BUFFER) + +#define RESETBUF(f,type) (__CAT__(f,_BFLAGS) = 1) +#define SETUPBUF(f,type) (__CAT__(f,_BFLAGS) = 0) + +#define GETFBUF(f,type) (*((__CAT__(f,_BFLAGS) == 1 && \ + ((__CAT__(f,_BFLAGS) = 2), \ + fread(&__CAT__(f,_BUFFER), \ + sizeof(type),1,(f)))),\ + &__CAT__(f,_BUFFER))) +#define AGETFBUF(f,type) ((__CAT__(f,_BFLAGS) == 1 && \ + ((__CAT__(f,_BFLAGS) = 2), \ + fread(__CAT__(f,_BUFFER), \ + sizeof(type),1,(f)))),\ + __CAT__(f,_BUFFER)) + +#define PUTFBUF(f,type,v) (GETFBUF(f,type) = (v)) +#define CPUTFBUF(f,v) (PUTFBUF(f,char,v)) +#define APUTFBUF(f,type,v) (memcpy(AGETFBUF(f,type), (v), \ + sizeof(__CAT__(f,_BUFFER)))) + +#define GET(f,type) (__CAT__(f,_BFLAGS) == 1 ? \ + fread(&__CAT__(f,_BUFFER),sizeof(type),1,(f)) : \ + (__CAT__(f,_BFLAGS) = 1)) + +#define PUT(f,type) (fwrite(&__CAT__(f,_BUFFER),sizeof(type),1,(f)), \ + (__CAT__(f,_BFLAGS) = 0)) +#define CPUT(f) (PUT(f,char)) + +#define BUFEOF(f) (__CAT__(f,_BFLAGS) != 2 && P_eof(f)) +#define BUFFPOS(f) (ftell(f) - (__CAT__(f,_BFLAGS) == 2)) + +typedef struct { + FILE *f; + int f_BFLAGS; /* FILEBUFNC(f,Char); */ + Char f_BUFFER; + Char name[_FNSIZE]; +} _TEXT; + +/* Memory allocation */ +#ifdef __GCC__ +# define Malloc(n) (malloc(n) ?: (Anyptr)_OutMem()) +#else +extern Anyptr __MallocTemp__; +# define Malloc(n) ((__MallocTemp__ = malloc(n)) ? __MallocTemp__ : (Anyptr)_OutMem()) +#endif +#define FreeR(p) (free((Anyptr)(p))) /* used if arg is an rvalue */ +#define Free(p) (free((Anyptr)(p)), (p)=NULL) + +/* sign extension */ +#define SEXT(x,n) ((x) | -(((x) & (1L<<((n)-1))) << 1)) + +/* packed arrays */ /* BEWARE: these are untested! */ +#define P_getbits_UB(a,i,n,L) ((int)((a)[(i)>>(L)-(n)] >> \ + (((~(i))&((1<<(L)-(n))-1)) << (n)) & \ + (1<<(1<<(n)))-1)) + +#define P_getbits_SB(a,i,n,L) ((int)((a)[(i)>>(L)-(n)] << \ + (16 - ((((~(i))&((1<<(L)-(n))-1))+1) <<\ + (n)) >> (16-(1<<(n)))))) + +#define P_putbits_UB(a,i,x,n,L) ((a)[(i)>>(L)-(n)] |= \ + (x) << (((~(i))&((1<<(L)-(n))-1)) << (n))) + +#define P_putbits_SB(a,i,x,n,L) ((a)[(i)>>(L)-(n)] |= \ + ((x) & (1<<(1<<(n)))-1) << \ + (((~(i))&((1<<(L)-(n))-1)) << (n))) + +#define P_clrbits_B(a,i,n,L) ((a)[(i)>>(L)-(n)] &= \ + ~( ((1<<(1<<(n)))-1) << \ + (((~(i))&((1<<(L)-(n))-1)) << (n))) ) + +/* small packed arrays */ +#define P_getbits_US(v,i,n) ((int)((v) >> ((i)<<(n)) & (1<<(1<<(n)))-1)) +#define P_getbits_SS(v,i,n) ((int)((long)(v) << (SETBITS - (((i)+1) << (n))) >> (SETBITS-(1<<(n))))) +#define P_putbits_US(v,i,x,n) ((v) |= (x) << ((i) << (n))) +#define P_putbits_SS(v,i,x,n) ((v) |= ((x) & (1<<(1<<(n)))-1) << ((i)<<(n))) +#define P_clrbits_S(v,i,n) ((v) &= ~( ((1<<(1<<(n)))-1) << ((i)<<(n)) )) + +#define P_max(a,b) ((a) > (b) ? (a) : (b)) +#define P_min(a,b) ((a) < (b) ? (a) : (b)) + + +/* Fix ANSI-isms */ + +#ifdef LACK_LABS +# ifndef labs +# define labs my_labs + extern long my_labs PP( (long) ); +# endif +#endif + +#ifdef LACK_MEMMOVE +# ifndef memmove +# define memmove my_memmove + extern Anyptr my_memmove PP( (Anyptr, Const Anyptr, size_t) ); +# endif +#endif + +#ifdef LACK_MEMCPY +# ifndef memcpy +# define memcpy my_memcpy + extern Anyptr my_memcpy PP( (Anyptr, Const Anyptr, size_t) ); +# endif +# ifndef memcmp +# define memcmp my_memcmp + extern int my_memcmp PP( (Const Anyptr, Const Anyptr, size_t) ); +# endif +# ifndef memset +# define memset my_memset + extern Anyptr my_memset PP( (Anyptr, int, size_t) ); +# endif +#endif + +/* Fix toupper/tolower on Suns and other stupid BSD systems */ +#ifdef toupper +# undef toupper +# undef tolower +# define toupper(c) my_toupper(c) +# define tolower(c) my_tolower(c) +#endif + +#ifndef _toupper +# if 'A' == 65 && 'a' == 97 +# define _toupper(c) ((c)-'a'+'A') +# define _tolower(c) ((c)-'A'+'a') +# else +# ifdef toupper +# undef toupper /* hope these are shadowing real functions, */ +# undef tolower /* because my_toupper calls _toupper! */ +# endif +# define _toupper(c) toupper(c) +# define _tolower(c) tolower(c) +# endif +#endif + + +#endif /* P2C_H */ + + + +/* End. */ + + diff --git a/Build/source/utils/m-tx/mtx-0.60d/libp2c/p2clib.c b/Build/source/utils/m-tx/mtx-0.60d/libp2c/p2clib.c new file mode 100644 index 00000000000..98a00edf41b --- /dev/null +++ b/Build/source/utils/m-tx/mtx-0.60d/libp2c/p2clib.c @@ -0,0 +1,1117 @@ + +/* Run-time library for use with "p2c", the Pascal to C translator */ + +/* "p2c" Copyright (C) 1989, 1990, 1991, 1992, 1993 Free Software Foundation. + * By Dave Gillespie, daveg@synaptics.com. Version --VERSION--. + * This file may be copied, modified, etc. in any way. It is not restricted + * by the licence agreement accompanying p2c itself. + */ + + + +#include "p2c.h" + + +#ifndef NO_TIME +# include <time.h> +#endif + + +#define Isspace(c) isspace(c) /* or "((c) == ' ')" if preferred */ + + + + +int P_argc; +char **P_argv; + +short P_escapecode; +int P_ioresult; + +long EXCP_LINE; /* Used by Pascal workstation system */ + +Anyptr __MallocTemp__; + +__p2c_jmp_buf *__top_jb; + + + + +void PASCAL_MAIN(argc, argv) +int argc; +char **argv; +{ + P_argc = argc; + P_argv = argv; + __top_jb = NULL; + +#ifdef LOCAL_INIT + LOCAL_INIT(); +#endif +} + + + + + +/* In case your system lacks these... */ + +long my_labs(x) +long x; +{ + return((x > 0) ? x : -x); +} + + +#ifdef __STDC__ +Anyptr my_memmove(Anyptr d, Const Anyptr s, size_t n) +#else +Anyptr my_memmove(d, s, n) +Anyptr d, s; +register int n; +#endif +{ + register char *dd = (char *)d, *ss = (char *)s; + if (dd < ss || dd - ss >= n) { +#if defined(bcopy) && defined(memcpy) + my_memcpy(dd, ss, n); +#else + memcpy(dd, ss, n); +#endif + } else if (n > 0) { + dd += n; + ss += n; + while (n-- > 0) + *--dd = *--ss; + } + return d; +} + + +#ifdef __STDC__ +Anyptr my_memcpy(Anyptr d, Const Anyptr s, size_t n) +#else +Anyptr my_memcpy(d, s, n) +Anyptr d, s; +register int n; +#endif +{ + register char *ss = (char *)s, *dd = (char *)d; + while (n-- > 0) + *dd++ = *ss++; + return d; +} + +#ifdef __STDC__ +int my_memcmp(Const Anyptr s1, Const Anyptr s2, size_t n) +#else +int my_memcmp(s1, s2, n) +Anyptr s1, s2; +register int n; +#endif +{ + register char *a = (char *)s1, *b = (char *)s2; + register int i; + while (n-- > 0) + if ((i = (*a++) - (*b++)) != 0) + return i; + return 0; +} + +#ifdef __STDC__ +Anyptr my_memset(Anyptr d, int c, size_t n) +#else +Anyptr my_memset(d, c, n) +Anyptr d; +register int c; +register int n; +#endif +{ + register char *dd = (char *)d; + while (n-- > 0) + *dd++ = c; + return d; +} + + +int my_toupper(c) +int c; +{ + if (islower(c)) + return _toupper(c); + else + return c; +} + + +int my_tolower(c) +int c; +{ + if (isupper(c)) + return _tolower(c); + else + return c; +} + + + + +long ipow(a, b) +long a, b; +{ + long v; + + if (a == 0 || a == 1) + return a; + if (a == -1) + return (b & 1) ? -1 : 1; + if (b < 0) + return 0; + if (a == 2) + return 1L << b; + v = (b & 1) ? a : 1; + while ((b >>= 1) > 0) { + a *= a; + if (b & 1) + v *= a; + } + return v; +} + + +long P_imax(a, b) +long a, b; +{ + if (a > b) + return a; + else + return b; +} + +long P_imin(a, b) +long a, b; +{ + if (a < b) + return a; + else + return b; +} + + +double P_rmax(a, b) +double a, b; +{ + if (a > b) + return a; + else + return b; +} + +double P_rmin(a, b) +double a, b; +{ + if (a < b) + return a; + else + return b; +} + + + + +/* Common string functions: */ + +/* Store in "ret" the substring of length "len" starting from "pos" (1-based). + Store a shorter or null string if out-of-range. Return "ret". */ + +char *strsub(ret, s, pos, len) +register char *ret, *s; +register int pos, len; +{ + register char *s2; + + if (--pos < 0 || len <= 0) { + *ret = 0; + return ret; + } + while (pos > 0) { + if (!*s++) { + *ret = 0; + return ret; + } + pos--; + } + s2 = ret; + while (--len >= 0) { + if (!(*s2++ = *s++)) + return ret; + } + *s2 = 0; + return ret; +} + + +/* Return the index of the first occurrence of "pat" as a substring of "s", + starting at index "pos" (1-based). Result is 1-based, 0 if not found. */ + +int strpos2(s, pat, pos) +char *s; +register char *pat; +register int pos; +{ + register char *cp, ch; + register int slen; + + if (--pos < 0) + return 0; + slen = strlen(s) - pos; + cp = s + pos; + if (!(ch = *pat++)) + return 0; + pos = strlen(pat); + slen -= pos; + while (--slen >= 0) { + if (*cp++ == ch && !strncmp(cp, pat, pos)) + return cp - s; + } + return 0; +} + + +/* Case-insensitive version of strcmp. */ + +int strcicmp(s1, s2) +register char *s1, *s2; +{ + register unsigned char c1, c2; + + while (*s1) { + if (*s1++ != *s2++) { + if (!s2[-1]) + return 1; + c1 = toupper(s1[-1]); + c2 = toupper(s2[-1]); + if (c1 != c2) + return c1 - c2; + } + } + if (*s2) + return -1; + return 0; +} + + + + +/* HP and Turbo Pascal string functions: */ + +/* Trim blanks at left end of string. */ + +char *strltrim(s) +register char *s; +{ + while (Isspace(*s++)) ; + return s - 1; +} + + +/* Trim blanks at right end of string. */ + +char *strrtrim(s) +register char *s; +{ + register char *s2 = s; + + if (!*s) + return s; + while (*++s2) ; + while (s2 > s && Isspace(*--s2)) + *s2 = 0; + return s; +} + + +/* Store in "ret" "num" copies of string "s". Return "ret". */ + +char *strrpt(ret, s, num) +char *ret; +register char *s; +register int num; +{ + register char *s2 = ret; + register char *s1; + + while (--num >= 0) { + s1 = s; + while ((*s2++ = *s1++)) ; + s2--; + } + return ret; +} + + +/* Store in "ret" string "s" with enough pad chars added to reach "size". */ + +char *strpad(ret, s, padchar, num) +char *ret; +register char *s; +register int padchar, num; +{ + register char *d = ret; + + if (s == d) { + while (*d++) ; + } else { + while ((*d++ = *s++)) ; + } + num -= (--d - ret); + while (--num >= 0) + *d++ = padchar; + *d = 0; + return ret; +} + + +/* Copy the substring of length "len" from index "spos" of "s" (1-based) + to index "dpos" of "d", lengthening "d" if necessary. Length and + indices must be in-range. */ + +void strmove(len, s, spos, d, dpos) +register char *s, *d; +register int len, spos, dpos; +{ + s += spos - 1; + d += dpos - 1; + while (*d && --len >= 0) + *d++ = *s++; + if (len > 0) { + while (--len >= 0) + *d++ = *s++; + *d = 0; + } +} + + +/* Delete the substring of length "len" at index "pos" from "s". + Delete less if out-of-range. */ + +void strdelete(s, pos, len) +register char *s; +register int pos, len; +{ + register int slen; + + if (--pos < 0) + return; + slen = strlen(s) - pos; + if (slen <= 0) + return; + s += pos; + if (slen <= len) { + *s = 0; + return; + } + while ((*s = s[len])) s++; +} + + +/* Insert string "src" at index "pos" of "dst". */ + +void strinsert(src, dst, pos) +register char *src, *dst; +register int pos; +{ + register int slen, dlen; + + if (--pos < 0) + return; + dlen = strlen(dst); + dst += dlen; + dlen -= pos; + if (dlen <= 0) { + strcpy(dst, src); + return; + } + slen = strlen(src); + do { + dst[slen] = *dst; + --dst; + } while (--dlen >= 0); + dst++; + while (--slen >= 0) + *dst++ = *src++; +} + + + + +/* File functions */ + +/* Peek at next character of input stream; return EOF at end-of-file. */ + +int P_peek(f) +FILE *f; +{ + int ch; + + ch = getc(f); + if (ch == EOF) + return EOF; + ungetc(ch, f); + return (ch == '\n') ? ' ' : ch; +} + + +/* Check if at end of file, using Pascal "eof" semantics. End-of-file for + stdin is broken; remove the special case for it to be broken in a + different way. */ + +int P_eof(f) +FILE *f; +{ + register int ch; + + if (feof(f)) + return 1; +#ifdef HAVE_ISATTY + if (isatty(fileno(f))) +#else + if (f == stdin) +#endif + return 0; /* not safe to look-ahead on the keyboard! */ + ch = getc(f); + if (ch == EOF) + return 1; + ungetc(ch, f); + return 0; +} + + +/* Check if at end of line (or end of entire file). */ + +int P_eoln(f) +FILE *f; +{ + register int ch; + + ch = getc(f); + if (ch == EOF) + return 1; + ungetc(ch, f); + return (ch == '\n'); +} + + +/* Skip whitespace (including newlines) in a file. */ + +FILE *_skipnlspaces(f) +FILE *f; +{ + register int ch; + + do { + ch = getc(f); + } while (ch == ' ' || ch == '\t' || ch == '\n'); + if (ch != EOF) + ungetc(ch, f); + return f; +} + + +/* Skip whitespace (not including newlines) in a file. */ + +FILE *_skipspaces(f) +FILE *f; +{ + register int ch; + + do { + ch = getc(f); + } while (ch == ' ' || ch == '\t'); + if (ch != EOF) + ungetc(ch, f); + return f; +} + + +/* Read a packed array of characters from a file. */ + +Void P_readpaoc(f, s, len) +FILE *f; +char *s; +int len; +{ + int ch; + + for (;;) { + if (len <= 0) + return; + ch = getc(f); + if (ch == EOF || ch == '\n') + break; + *s++ = ch; + --len; + } + while (--len >= 0) + *s++ = ' '; + if (ch != EOF) + ungetc(ch, f); +} + +Void P_readlnpaoc(f, s, len) +FILE *f; +char *s; +int len; +{ + int ch; + + for (;;) { + ch = getc(f); + if (ch == EOF || ch == '\n') + break; + if (len > 0) { + *s++ = ch; + --len; + } + } + while (--len >= 0) + *s++ = ' '; +} + + +/* Compute maximum legal "seek" index in file (0-based). */ + +long P_maxpos(f) +FILE *f; +{ + long savepos = ftell(f); + long val; + + if (fseek(f, 0L, SEEK_END)) + return -1; + val = ftell(f); + if (fseek(f, savepos, SEEK_SET)) + return -1; + return val; +} + + +/* Use packed array of char for a file name. */ + +Char *P_trimname(fn, len) +register Char *fn; +register int len; +{ + static Char fnbuf[256]; + register Char *cp = fnbuf; + + while (--len >= 0 && *fn && !isspace(*fn)) + *cp++ = *fn++; + *cp = 0; + return fnbuf; +} + + + + +/* Pascal's "memavail" doesn't make much sense in Unix with virtual memory. + We fix memory size as 10Meg as a reasonable compromise. */ + +long memavail() +{ + return 10000000; /* worry about this later! */ +} + +long maxavail() +{ + return memavail(); +} + + + + +/* Sets are stored as an array of longs. S[0] is the size of the set; + S[N] is the N'th 32-bit chunk of the set. S[0] equals the maximum + I such that S[I] is nonzero. S[0] is zero for an empty set. Within + each long, bits are packed from lsb to msb. The first bit of the + set is the element with ordinal value 0. (Thus, for a "set of 5..99", + the lowest five bits of the first long are unused and always zero.) */ + +/* (Sets with 32 or fewer elements are normally stored as plain longs.) */ + +long *P_setunion(d, s1, s2) /* d := s1 + s2 */ +register long *d, *s1, *s2; +{ + long *dbase = d++; + register int sz1 = *s1++, sz2 = *s2++; + while (sz1 > 0 && sz2 > 0) { + *d++ = *s1++ | *s2++; + sz1--, sz2--; + } + while (--sz1 >= 0) + *d++ = *s1++; + while (--sz2 >= 0) + *d++ = *s2++; + *dbase = d - dbase - 1; + return dbase; +} + + +long *P_setint(d, s1, s2) /* d := s1 * s2 */ +register long *d, *s1, *s2; +{ + long *dbase = d++; + register int sz1 = *s1++, sz2 = *s2++; + while (--sz1 >= 0 && --sz2 >= 0) + *d++ = *s1++ & *s2++; + while (--d > dbase && !*d) ; + *dbase = d - dbase; + return dbase; +} + + +long *P_setdiff(d, s1, s2) /* d := s1 - s2 */ +register long *d, *s1, *s2; +{ + long *dbase = d++; + register int sz1 = *s1++, sz2 = *s2++; + while (--sz1 >= 0 && --sz2 >= 0) + *d++ = *s1++ & ~*s2++; + if (sz1 >= 0) { + while (sz1-- >= 0) + *d++ = *s1++; + } + while (--d > dbase && !*d) ; + *dbase = d - dbase; + return dbase; +} + + +long *P_setxor(d, s1, s2) /* d := s1 / s2 */ +register long *d, *s1, *s2; +{ + long *dbase = d++; + register int sz1 = *s1++, sz2 = *s2++; + while (sz1 > 0 && sz2 > 0) { + *d++ = *s1++ ^ *s2++; + sz1--, sz2--; + } + while (--sz1 >= 0) + *d++ = *s1++; + while (--sz2 >= 0) + *d++ = *s2++; + while (--d > dbase && !*d) ; + *dbase = d - dbase; + return dbase; +} + + +int P_inset(val, s) /* val IN s */ +register unsigned val; +register long *s; +{ + register int bit; + bit = val % SETBITS; + val /= SETBITS; + if (val < *s++ && ((1L<<bit) & s[val])) + return 1; + return 0; +} + + +long *P_addset(s, val) /* s := s + [val] */ +register long *s; +register unsigned val; +{ + register long *sbase = s; + register int bit, size; + bit = val % SETBITS; + val /= SETBITS; + size = *s; + if (++val > size) { + s += size; + while (val > size) + *++s = 0, size++; + *sbase = size; + } else + s += val; + *s |= 1L<<bit; + return sbase; +} + + +long *P_addsetr(s, v1, v2) /* s := s + [v1..v2] */ +register long *s; +register unsigned v1, v2; +{ + register long *sbase = s; + register int b1, b2, size; + if ((int)v1 > (int)v2) + return sbase; + b1 = v1 % SETBITS; + v1 /= SETBITS; + b2 = v2 % SETBITS; + v2 /= SETBITS; + size = *s; + v1++; + if (++v2 > size) { + while (v2 > size) + s[++size] = 0; + s[v2] = 0; + *s = v2; + } + s += v1; + if (v1 == v2) { + *s |= (~((-2L)<<(b2-b1))) << b1; + } else { + *s++ |= (-1L) << b1; + while (++v1 < v2) + *s++ = -1; + *s |= ~((-2L) << b2); + } + return sbase; +} + + +long *P_remset(s, val) /* s := s - [val] */ +register long *s; +register unsigned val; +{ + register int bit; + bit = val % SETBITS; + val /= SETBITS; + if (++val <= *s) { + if (!(s[val] &= ~(1L<<bit))) + while (*s && !s[*s]) + (*s)--; + } + return s; +} + + +int P_setequal(s1, s2) /* s1 = s2 */ +register long *s1, *s2; +{ + register int size = *s1++; + if (*s2++ != size) + return 0; + while (--size >= 0) { + if (*s1++ != *s2++) + return 0; + } + return 1; +} + + +int P_subset(s1, s2) /* s1 <= s2 */ +register long *s1, *s2; +{ + register int sz1 = *s1++, sz2 = *s2++; + if (sz1 > sz2) + return 0; + while (--sz1 >= 0) { + if (*s1++ & ~*s2++) + return 0; + } + return 1; +} + + +long *P_setcpy(d, s) /* d := s */ +register long *d, *s; +{ + register long *save_d = d; + +#ifdef SETCPY_MEMCPY + memcpy(d, s, (*s + 1) * sizeof(long)); +#else + register int i = *s + 1; + while (--i >= 0) + *d++ = *s++; +#endif + return save_d; +} + + +/* s is a "smallset", i.e., a 32-bit or less set stored + directly in a long. */ + +long *P_expset(d, s) /* d := s */ +register long *d; +register long s; +{ + if (s) { + d[1] = s; + *d = 1; + } else + *d = 0; + return d; +} + + +long P_packset(s) /* convert s to a small-set */ +register long *s; +{ + if (*s++) + return *s; + else + return 0; +} + + + + + +/* Oregon Software Pascal extensions, courtesy of William Bader */ + +int P_getcmdline(l, h, line) +int l, h; +Char *line; +{ + int i, len; + char *s; + + h = h - l + 1; + len = 0; + for(i = 1; i < P_argc; i++) { + s = P_argv[i]; + while (*s) { + if (len >= h) return len; + line[len++] = *s++; + } + if (len >= h) return len; + line[len++] = ' '; + } + return len; +} + +Void TimeStamp(Day, Month, Year, Hour, Min, Sec) +int *Day, *Month, *Year, *Hour, *Min, *Sec; +{ +#ifndef NO_TIME + struct tm *tm; + long clock; + + time(&clock); + tm = localtime(&clock); + *Day = tm->tm_mday; + *Month = tm->tm_mon + 1; /* Jan = 0 */ + *Year = tm->tm_year; + if (*Year < 1900) + *Year += 1900; /* year since 1900 */ + *Hour = tm->tm_hour; + *Min = tm->tm_min; + *Sec = tm->tm_sec; +#endif +} + +Void VAXdate(s) +char *s; +{ + long clock; + char *c; + int i; + static int where[] = {8, 9, 0, 4, 5, 6, 0, 20, 21, 22, 23}; + + time(&clock); + c = ctime(&clock); + for (i = 0; i < 11; i++) + s[i] = my_toupper(c[where[i]]); + s[2] = '-'; + s[6] = '-'; +} + +Void VAXtime(s) +char *s; +{ + long clock; + char *c; + int i; + + time(&clock); + c = ctime(&clock); + for (i = 0; i < 8; i++) + s[i] = c[i+11]; + s[8] = '.'; + s[9] = '0'; + s[10] = '0'; +} + + + + +/* SUN Berkeley Pascal extensions */ + +Void P_sun_argv(s, len, n) +register char *s; +register int len, n; +{ + register char *cp; + + if ((unsigned)n < P_argc) + cp = P_argv[n]; + else + cp = ""; + while (*cp && --len >= 0) + *s++ = *cp++; + while (--len >= 0) + *s++ = ' '; +} + + + + +int _OutMem() +{ + return _Escape(-2); +} + +int _CaseCheck() +{ + return _Escape(-9); +} + +int _NilCheck() +{ + return _Escape(-3); +} + + + + + +/* The following is suitable for the HP Pascal operating system. + It might want to be revised when emulating another system. */ + +char *_ShowEscape(buf, code, ior, prefix) +char *buf, *prefix; +int code, ior; +{ + char *bufp; + + if (prefix && *prefix) { + strcpy(buf, prefix); + strcat(buf, ": "); + bufp = buf + strlen(buf); + } else { + bufp = buf; + } + if (code == -10) { + sprintf(bufp, "Pascal system I/O error %d", ior); + switch (ior) { + case 3: + strcat(buf, " (illegal I/O request)"); + break; + case 7: + strcat(buf, " (bad file name)"); + break; + case FileNotFound: /*10*/ + strcat(buf, " (file not found)"); + break; + case FileNotOpen: /*13*/ + strcat(buf, " (file not open)"); + break; + case BadInputFormat: /*14*/ + strcat(buf, " (bad input format)"); + break; + case 24: + strcat(buf, " (not open for reading)"); + break; + case 25: + strcat(buf, " (not open for writing)"); + break; + case 26: + strcat(buf, " (not open for direct access)"); + break; + case 28: + strcat(buf, " (string subscript out of range)"); + break; + case EndOfFile: /*30*/ + strcat(buf, " (end-of-file)"); + break; + case FileWriteError: /*38*/ + strcat(buf, " (file write error)"); + break; + } + } else { + sprintf(bufp, "Pascal system error %d", code); + switch (code) { + case -2: + strcat(buf, " (out of memory)"); + break; + case -3: + strcat(buf, " (reference to NIL pointer)"); + break; + case -4: + strcat(buf, " (integer overflow)"); + break; + case -5: + strcat(buf, " (divide by zero)"); + break; + case -6: + strcat(buf, " (real math overflow)"); + break; + case -8: + strcat(buf, " (value range error)"); + break; + case -9: + strcat(buf, " (CASE value range error)"); + break; + case -12: + strcat(buf, " (bus error)"); + break; + case -20: + strcat(buf, " (stopped by user)"); + break; + } + } + return buf; +} + + +int _Escape(code) +int code; +{ + char buf[100]; + + P_escapecode = code; + if (__top_jb) { + __p2c_jmp_buf *jb = __top_jb; + __top_jb = jb->next; + longjmp(jb->jbuf, 1); + } + if (code == 0) + exit(EXIT_SUCCESS); + if (code == -1) + exit(EXIT_FAILURE); + fprintf(stderr, "%s\n", _ShowEscape(buf, P_escapecode, P_ioresult, "")); + exit(EXIT_FAILURE); +} + +int _EscIO(code) +int code; +{ + P_ioresult = code; + return _Escape(-10); +} + +int _EscIO2(code, name) +int code; +char *name; +{ + P_ioresult = code; + if (!__top_jb && name && *name) { + char buf[100]; + fprintf(stderr, "%s: %s\n", + name, _ShowEscape(buf, P_escapecode, P_ioresult, "")); + exit(EXIT_FAILURE); + } + return _Escape(-10); +} + + + +/* End. */ + + + |