version 0.73.0
This commit is contained in:
@@ -0,0 +1,48 @@
|
||||
# Generated automatically from Makefile.in by configure.
|
||||
SHELL=/bin/sh
|
||||
|
||||
|
||||
|
||||
prefix=/usr/local
|
||||
exec_prefix=${prefix}
|
||||
#subdirs= cobpp
|
||||
subdirs= cobf2f
|
||||
|
||||
INSTALL=/usr/bin/install -c
|
||||
|
||||
INSTBIN=${prefix}/bin
|
||||
|
||||
PROG1 = htcobdispcv.tcl
|
||||
PROG2 = htcobviscomp.tcl
|
||||
|
||||
all:
|
||||
@for i in ${subdirs}; do \
|
||||
echo Making all in $$i ; \
|
||||
(cd $$i; ${MAKE} all) ; \
|
||||
done
|
||||
|
||||
install:
|
||||
@for i in ${subdirs}; do \
|
||||
echo Installing in $$i ; \
|
||||
(cd $$i; ${MAKE} install) ; \
|
||||
done
|
||||
${INSTALL} -m 755 $(PROG1) $(INSTBIN)/$(PROG1)
|
||||
${INSTALL} -m 755 $(PROG2) $(INSTBIN)/$(PROG2)
|
||||
|
||||
depend:
|
||||
@for i in ${subdirs}; do \
|
||||
echo Depending in $$i ; \
|
||||
(cd $$i; ${MAKE} depend) ; \
|
||||
done
|
||||
|
||||
clean:
|
||||
@for i in ${subdirs}; do \
|
||||
echo Cleaning in $$i ; \
|
||||
(cd $$i; ${MAKE} clean) ; \
|
||||
done
|
||||
|
||||
distclean cleandist:
|
||||
@for i in ${subdirs}; do \
|
||||
echo Cleaning in $$i ; \
|
||||
(cd $$i; ${MAKE} clean; rm -f Makefile) ; \
|
||||
done
|
||||
@@ -0,0 +1,47 @@
|
||||
SHELL=/bin/sh
|
||||
|
||||
@SET_MAKE@
|
||||
|
||||
prefix=@prefix@
|
||||
exec_prefix=@exec_prefix@
|
||||
#subdirs= cobpp
|
||||
subdirs= cobf2f
|
||||
|
||||
INSTALL=@INSTALL@
|
||||
|
||||
INSTBIN=@cobbin_default@
|
||||
|
||||
PROG1 = htcobdispcv.tcl
|
||||
PROG2 = htcobviscomp.tcl
|
||||
|
||||
all:
|
||||
@for i in ${subdirs}; do \
|
||||
echo Making all in $$i ; \
|
||||
(cd $$i; ${MAKE} all) ; \
|
||||
done
|
||||
|
||||
install:
|
||||
@for i in ${subdirs}; do \
|
||||
echo Installing in $$i ; \
|
||||
(cd $$i; ${MAKE} install) ; \
|
||||
done
|
||||
${INSTALL} -m 755 $(PROG1) $(INSTBIN)/$(PROG1)
|
||||
${INSTALL} -m 755 $(PROG2) $(INSTBIN)/$(PROG2)
|
||||
|
||||
depend:
|
||||
@for i in ${subdirs}; do \
|
||||
echo Depending in $$i ; \
|
||||
(cd $$i; ${MAKE} depend) ; \
|
||||
done
|
||||
|
||||
clean:
|
||||
@for i in ${subdirs}; do \
|
||||
echo Cleaning in $$i ; \
|
||||
(cd $$i; ${MAKE} clean) ; \
|
||||
done
|
||||
|
||||
distclean cleandist:
|
||||
@for i in ${subdirs}; do \
|
||||
echo Cleaning in $$i ; \
|
||||
(cd $$i; ${MAKE} clean; rm -f Makefile) ; \
|
||||
done
|
||||
@@ -0,0 +1,33 @@
|
||||
Set of COBOL utility programs.
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
cobf2f: by David Essex
|
||||
|
||||
Utility program that will convert from/to fixed to/from free-form COBOL formats.
|
||||
|
||||
Usage: htcobf2f [<options>] [-i input file ] [-o output file ]
|
||||
where <options> are:
|
||||
-h This help screen
|
||||
-V Print out version
|
||||
-x Convert source to X/Open free format (Default)
|
||||
-f Convert source to Standard fixed column format
|
||||
-m <num> Fixed format line number multiplier (Default = 10)
|
||||
-i <filename> Input filename (Default is standard input)
|
||||
-o <filename> Output filename (Default is standard output)
|
||||
|
||||
Note: Tab expandtion not supported (Hint: Use expand utility).
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
viscomp.tcl: by Rildo Pragana
|
||||
|
||||
Visual parser tool for stepping through compiler operation and general use gdb
|
||||
frontend.
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
dispcv.tcl: by Rildo Pragana
|
||||
|
||||
A tcl script to convert "DISPLAY (X, Y) ..." syntax to our supported syntax
|
||||
"DISPLAY LINE/POS ...".
|
||||
@@ -0,0 +1,6 @@
|
||||
Authors in aphabetic order.
|
||||
|
||||
David Essex <dessex@arvotek.net>
|
||||
|
||||
Laura Tweedy <tweedy@lusars.net>
|
||||
|
||||
@@ -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
|
||||
|
||||
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.
|
||||
|
||||
<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.
|
||||
@@ -0,0 +1,12 @@
|
||||
|
||||
These files are part of cobf2f, a utility to convert COBOL files
|
||||
from/to free/fixed form format.
|
||||
|
||||
These files, originally part of the Cob2C project, were
|
||||
modified to create the cobf2f utility.
|
||||
|
||||
Copyright (C) 1999, 2000, 2001 David Essex.
|
||||
Copyright (C) 1998, 1999 Laura Tweedy.
|
||||
|
||||
The cobpp program is licensed under the GNU General Public License.
|
||||
See COPYING for details.
|
||||
@@ -0,0 +1,62 @@
|
||||
# Generated automatically from Makefile.in by configure.
|
||||
#
|
||||
# Makefile.in for cobf2f, the COBOL format (free/fixed) convert utility
|
||||
#
|
||||
|
||||
SHELL=/bin/sh
|
||||
|
||||
|
||||
|
||||
prefix=/usr/local
|
||||
exec_prefix=${prefix}
|
||||
|
||||
INSTALL=/usr/bin/install -c
|
||||
|
||||
LEX=flex
|
||||
CCX=gcc
|
||||
|
||||
RM= rm -f
|
||||
|
||||
INSTBIN=${prefix}/bin
|
||||
|
||||
#
|
||||
INCLUDES= -I. -I../../
|
||||
CCXFLAGS=${INCLUDES}
|
||||
LIBS=-L/usr/lib -L/usr/local/lib
|
||||
LDFLAGS=
|
||||
MAKEDEPEND=@MAKEDEPEND@
|
||||
|
||||
#
|
||||
# Rules for compiling .c .l sources
|
||||
#
|
||||
.SUFFIX: .c .o
|
||||
.c.o:
|
||||
$(CCX) $(CCXFLAGS) -c $<
|
||||
|
||||
#
|
||||
|
||||
|
||||
SRCS = cobf2f.c lexyy.c
|
||||
|
||||
OBJS = $(SRCS:.c=.o)
|
||||
|
||||
PROG = htcobf2f
|
||||
|
||||
|
||||
all: $(PROG)
|
||||
|
||||
|
||||
${PROG}: ${OBJS}
|
||||
$(CCX) -o $@ ${OBJS} $(LDFLAGS) $(LIBS)
|
||||
# strip $@
|
||||
|
||||
|
||||
lexyy.c: scanner.l
|
||||
$(LEX) -o$@ $<
|
||||
|
||||
clean:
|
||||
@$(RM) $(PROG) $(OBJS) lexyy.c
|
||||
|
||||
install: $(PROG)
|
||||
strip $(PROG)
|
||||
${INSTALL} -m 755 $(PROG) $(INSTBIN)/$(PROG)
|
||||
@@ -0,0 +1,61 @@
|
||||
#
|
||||
# Makefile.in for cobf2f, the COBOL format (free/fixed) convert utility
|
||||
#
|
||||
|
||||
SHELL=/bin/sh
|
||||
|
||||
@SET_MAKE@
|
||||
|
||||
prefix=@prefix@
|
||||
exec_prefix=@exec_prefix@
|
||||
|
||||
INSTALL=@INSTALL@
|
||||
|
||||
LEX=@LEX@
|
||||
CCX=@CC@
|
||||
|
||||
RM= rm -f
|
||||
|
||||
INSTBIN=@cobbin_default@
|
||||
|
||||
#
|
||||
INCLUDES= -I. -I../../
|
||||
CCXFLAGS=${INCLUDES} @CCXFLAGS@
|
||||
LIBS=@LIBS@
|
||||
LDFLAGS=@LDFLAGS@
|
||||
MAKEDEPEND=@MAKEDEPEND@
|
||||
|
||||
#
|
||||
# Rules for compiling .c .l sources
|
||||
#
|
||||
.SUFFIX: .c .o
|
||||
.c.o:
|
||||
$(CCX) $(CCXFLAGS) -c $<
|
||||
|
||||
#
|
||||
|
||||
|
||||
SRCS = cobf2f.c lexyy.c
|
||||
|
||||
OBJS = $(SRCS:.c=.o)
|
||||
|
||||
PROG = htcobf2f
|
||||
|
||||
|
||||
all: $(PROG)
|
||||
|
||||
|
||||
${PROG}: ${OBJS}
|
||||
$(CCX) -o $@ ${OBJS} $(LDFLAGS) $(LIBS)
|
||||
# strip $@
|
||||
|
||||
|
||||
lexyy.c: scanner.l
|
||||
$(LEX) -o$@ $<
|
||||
|
||||
clean:
|
||||
@$(RM) $(PROG) $(OBJS) lexyy.c
|
||||
|
||||
install: $(PROG)
|
||||
strip $(PROG)
|
||||
${INSTALL} -m 755 $(PROG) $(INSTBIN)/$(PROG)
|
||||
@@ -0,0 +1,13 @@
|
||||
Utility program that will convert from/to fixed to/from free-form COBOL formats.
|
||||
|
||||
|
||||
$htcobf2f -h
|
||||
Usage: htcobf2f [<options>] [-i input file ] [-o output file ]
|
||||
where <options> are:
|
||||
-h This help screen
|
||||
-V Print out version
|
||||
-t <num> Expand tabs to <num> space(s) (Default = 8)
|
||||
-x Convert source to X/Open free format (Default)
|
||||
-f Convert source to Standard fixed column format
|
||||
-i <filename> Input filename (Default is standard input)
|
||||
-o <filename> Output filename (Default is standard output)
|
||||
@@ -0,0 +1,314 @@
|
||||
//
|
||||
// Copyright (C) 1999 - 2003 David Essex
|
||||
//
|
||||
// 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 software; see the file COPYING. If not, write to
|
||||
// the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
// Boston, MA 02111-1307 USA
|
||||
//
|
||||
|
||||
/*
|
||||
* Program to convert fixed to/from free COBOL format.
|
||||
*
|
||||
*/
|
||||
|
||||
//#define GLOBAL_DEF
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <getopt.h>
|
||||
//#include <errno.h>
|
||||
#include <assert.h>
|
||||
|
||||
#include <sys/types.h>
|
||||
#include <sys/stat.h>
|
||||
|
||||
#include "htconfig.h"
|
||||
#include "cobf2f.h"
|
||||
|
||||
#define EXPAND_CMD COBPP_EXPAND_CMD_PATH" -t "
|
||||
|
||||
extern FILE *yyin;
|
||||
extern FILE *yyout;
|
||||
|
||||
/* Global Env struct due to yywrap, yylex */
|
||||
|
||||
int main( int ac , char** av ) {
|
||||
|
||||
int argc=ac, rc = 0;
|
||||
char **argv=av;
|
||||
char argtmp[MAXLINE];
|
||||
char *cmdstr = NULL;
|
||||
|
||||
globalEnvPtr = &globalEnv ;
|
||||
rc = setDefaults( &globalEnv );
|
||||
if ( rc != 0 ){
|
||||
fprintf(stderr,"Error in setDefaults\n");
|
||||
return 9;
|
||||
}
|
||||
|
||||
rc = setOptions( &globalEnv, argc, argv );
|
||||
/* error, or help/version printed */
|
||||
if ( rc == 1 ) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* print mini help */
|
||||
if ( globalEnv.errFlag != 0 ) {
|
||||
printHelp();
|
||||
return 2;
|
||||
}
|
||||
|
||||
/* everything ok, continue and parse file */
|
||||
|
||||
if (( globalEnv.ifname != NULL ) &&
|
||||
( globalEnv.ofname != NULL )) {
|
||||
if ( strcmp(globalEnv.ifname, globalEnv.ofname) == 0 ) {
|
||||
fprintf(stderr,
|
||||
"Error: input file name \'%s\' is the same as output file name \'%s\'\n",
|
||||
globalEnv.ifname, globalEnv.ofname);
|
||||
return 8;
|
||||
}
|
||||
}
|
||||
|
||||
if ( globalEnv.ifname != NULL ) {
|
||||
yyin = fopen( globalEnv.ifname, "r");
|
||||
if ( yyin == NULL ) {
|
||||
fprintf(stderr,
|
||||
"Error: input file \'%s\' not found or not readable\n"
|
||||
,globalEnv.ifname
|
||||
);
|
||||
|
||||
return 8;
|
||||
}
|
||||
}
|
||||
else {
|
||||
yyin = stdin;
|
||||
}
|
||||
|
||||
if ( globalEnv.ofname != NULL ) {
|
||||
yyout = fopen( globalEnv.ofname, "w");
|
||||
if ( yyout == NULL ) {
|
||||
fprintf(stderr,
|
||||
"Error: open failed for output file \'%s\'\n"
|
||||
,globalEnv.ofname
|
||||
);
|
||||
|
||||
return 9;
|
||||
}
|
||||
}
|
||||
else {
|
||||
yyout = stdout;
|
||||
}
|
||||
|
||||
yylex();
|
||||
|
||||
if ( globalEnvPtr->format == 0 ) {
|
||||
if ( yyout == stdout ) {
|
||||
fprintf(yyout, "\n");
|
||||
}
|
||||
}
|
||||
|
||||
return rc;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Initalize the Env struct passed to this fucntion
|
||||
*/
|
||||
int setDefaults( Env* gEnv ) {
|
||||
|
||||
gEnv->format = 0; /* free == 0, fixed == 1 */
|
||||
gEnv->debug = 0; /* off -delete "^D.*" lines */
|
||||
gEnv->errFlag = 0; /* no error state by default */
|
||||
gEnv->tab2space = 0; /* expand tabs - not implimented */
|
||||
gEnv->linemul = 0; /* Fixed format line number multiplier (Default = 10) */
|
||||
gEnv->progName = NULL;
|
||||
gEnv->ifname = NULL;
|
||||
gEnv->ofname = NULL;
|
||||
|
||||
return atexit(CleanUp);
|
||||
};
|
||||
|
||||
/*
|
||||
* Function to clean up memory allocated in program.
|
||||
*
|
||||
*/
|
||||
void CleanUp( void ) {
|
||||
|
||||
Env *gEnv = globalEnvPtr;
|
||||
int i;
|
||||
void * tempItem;
|
||||
|
||||
|
||||
globalEnvPtr = NULL;
|
||||
if ( gEnv->progName != NULL )
|
||||
free(gEnv->progName);
|
||||
|
||||
if ( gEnv->ifname != NULL )
|
||||
free( gEnv->ifname );
|
||||
|
||||
if ( gEnv->ofname != NULL )
|
||||
free( gEnv->ofname );
|
||||
|
||||
}
|
||||
|
||||
/*
|
||||
* Read in command line options and set up the Env struct passed in
|
||||
* Alloc memory for program name string in Env struct.
|
||||
*
|
||||
*/
|
||||
int setOptions( Env* gEnv, int argc, char** argv ) {
|
||||
|
||||
/* Read in args for option settings. */
|
||||
|
||||
int option, opt, r=0;
|
||||
int temp, len;
|
||||
char * tempChar;
|
||||
|
||||
/*
|
||||
* Check argc for number of args equal to zero
|
||||
* don't bother to check options, just error out.
|
||||
*/
|
||||
if ( argc < 2 ) {
|
||||
gEnv->errFlag++;
|
||||
}
|
||||
|
||||
tempChar = strdup( (char*)argv[0] );
|
||||
if( tempChar != NULL )
|
||||
gEnv->progName = tempChar;
|
||||
else
|
||||
gEnv->progName = PRGNAME;
|
||||
|
||||
opterr = 0;
|
||||
|
||||
// while ((opt = getopt (argc, argv, "hvt:xfi:o:")) != EOF) {
|
||||
while ((opt = getopt (argc, argv, option_list)) != EOF) {
|
||||
|
||||
switch (opt) {
|
||||
|
||||
/* Print version */
|
||||
case COBF2F_OPT_VERSION:
|
||||
printVersion(argv[0]);
|
||||
return 1;
|
||||
break;
|
||||
|
||||
/* Set tabs expand factor */
|
||||
case COBF2F_OPT_FLINEMUL:
|
||||
gEnv->linemul = atoi(optarg);
|
||||
break;
|
||||
|
||||
// /* Set tabs expand factor */
|
||||
// case COBF2F_OPT_TABS:
|
||||
// if ( gEnv->tab2space != 0 ) {
|
||||
// gEnv->tab2space= atoi(optarg);
|
||||
// }
|
||||
// break;
|
||||
|
||||
/* Input fixed format */
|
||||
case COBF2F_OPT_FIXED_FORMAT:
|
||||
gEnv->format = 1; /* free == 0, fixed == 1 */
|
||||
break;
|
||||
|
||||
/* Input free-format */
|
||||
case COBF2F_OPT_FREE_FORMAT:
|
||||
gEnv->format = 0; /* free == 0, fixed == 1 */
|
||||
break;
|
||||
|
||||
/* Output file name */
|
||||
case COBF2F_OPT_INPUT_FILE:
|
||||
/* Input file name */
|
||||
if (gEnv->ifname != NULL) {
|
||||
fprintf(stderr, "error: duplicate input file name '%s' ... aborting\n", optarg);
|
||||
gEnv->errFlag++;
|
||||
r = 20;
|
||||
return r;
|
||||
}
|
||||
len = strlen(optarg);
|
||||
// fprintf(stderr, "cobf2f debug: optarg=%s: len=%d\n", optarg, len);
|
||||
gEnv->ifname = (char*)malloc(len + 2);
|
||||
if (gEnv->ifname == NULL) {
|
||||
gEnv->errFlag++;
|
||||
r = 21;
|
||||
return r;
|
||||
}
|
||||
strncpy(gEnv->ifname, optarg, len+1);
|
||||
// fprintf(stderr, "cobf2f debug: input file name :%s:, len=%d\n", gEnv->ifname, len);
|
||||
break;
|
||||
|
||||
/* Output file name */
|
||||
case COBF2F_OPT_OUTPUT_FILE:
|
||||
if (gEnv->ofname != NULL) {
|
||||
fprintf(stderr, "error: duplicate output file name '%s' ... aborting\n", optarg);
|
||||
gEnv->errFlag++;
|
||||
r = 40;
|
||||
return r;
|
||||
}
|
||||
len = strlen(optarg);
|
||||
gEnv->ofname = (char*)malloc(len + 2);
|
||||
if (gEnv->ofname == NULL) {
|
||||
gEnv->errFlag++;
|
||||
r = 41;
|
||||
return r;
|
||||
}
|
||||
strncpy(gEnv->ofname, optarg, len+1);
|
||||
// fprintf(stderr, "cobpp debug: output file name '%s', len=%d\n", gEnv->ofname, len);
|
||||
break;
|
||||
|
||||
/* help/default */
|
||||
case COBF2F_OPT_HELP:
|
||||
default:
|
||||
// printVersion(argv[0]);
|
||||
printHelp();
|
||||
return 1;
|
||||
break;
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
// if ( gEnv->ifname == NULL )
|
||||
// {
|
||||
// fprintf(stderr,"%s: No input files\n", gEnv->progName);
|
||||
// gEnv->errFlag++;
|
||||
// }
|
||||
|
||||
return 0;
|
||||
|
||||
}
|
||||
|
||||
/* Print out the version and copy information
|
||||
*
|
||||
*/
|
||||
void printVersion( char* pname ) {
|
||||
|
||||
fprintf(stdout, "%s %s\n%s\n",
|
||||
COBF2F_NAME,
|
||||
COBF2F_VERSION,
|
||||
COBF2F_COPYWR);
|
||||
}
|
||||
|
||||
/*
|
||||
* Print out help
|
||||
*
|
||||
*/
|
||||
void printHelp( void ){
|
||||
|
||||
fprintf (stderr,
|
||||
"Usage: %s %s%s",
|
||||
globalEnvPtr->progName,
|
||||
usage_list0,
|
||||
usage_list1
|
||||
);
|
||||
}
|
||||
|
||||
@@ -0,0 +1,92 @@
|
||||
//
|
||||
// Copyright (C) 1999 - 2003 David Essex
|
||||
//
|
||||
// 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 software; see the file COPYING. If not, write to
|
||||
// the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
// Boston, MA 02111-1307 USA
|
||||
//
|
||||
|
||||
#ifndef _COBPP_H
|
||||
#define _COBPP_H
|
||||
|
||||
#define MAXLINE 256
|
||||
#define PRGNAME "htcobf2f"
|
||||
|
||||
#define COBF2F_VERSION "0.89.3 (alpha)"
|
||||
#define COBF2F_NAME "COBOL format conversion utility version"
|
||||
#define COBF2F_COPYWR "Copyright (C) 1999-2003 David Essex"
|
||||
|
||||
#define COBF2F_OPT_HELP 'h'
|
||||
#define COBF2F_OPT_VERSION 'V'
|
||||
#define COBF2F_OPT_TABS 't'
|
||||
#define COBF2F_OPT_FLINEMUL 'm'
|
||||
#define COBF2F_OPT_FIXED_FORMAT 'x'
|
||||
#define COBF2F_OPT_FREE_FORMAT 'f'
|
||||
#define COBF2F_OPT_OUTPUT_FILE 'o'
|
||||
#define COBF2F_OPT_INPUT_FILE 'i'
|
||||
|
||||
//#include <stdlib.h>
|
||||
//#include <stdio.h>
|
||||
|
||||
/* command line options */
|
||||
static char option_list[] = { "hVm:xfi:o:" };
|
||||
|
||||
/* -t <num> Expand tabs to <num> space(s) (Default = 8)\n\*/
|
||||
/* Usage list */
|
||||
/* Usage: htcobf2f [<options>] [-i input_file ] [-o output_file ]"*/
|
||||
static char usage_list0[] = { "[<options>] [-i input file ] [-o output file ]\n" };
|
||||
static char usage_list1[] = { "where <options> are:\n\
|
||||
-h This help screen\n\
|
||||
-V Print out version\n\
|
||||
-x Convert source to X/Open free format (Default)\n\
|
||||
-f Convert source to Standard fixed column format\n\
|
||||
-m <num> Fixed format line number multiplier (Default is blanks)\n\
|
||||
-i <filename> Input filename (Default is standard input)\n\
|
||||
-o <filename> Output filename (Default is standard output)\n\
|
||||
\n\
|
||||
Note: Tab expansion not supported (Hint: Use expand utility).\n\
|
||||
" };
|
||||
|
||||
typedef short bool;
|
||||
|
||||
struct s_Env {
|
||||
bool fixedFormat;
|
||||
bool freeFormat;
|
||||
bool format; /* 1 is free , 0 is fixed */
|
||||
bool debug;
|
||||
int errFlag;
|
||||
int tab2space;
|
||||
int linemul;
|
||||
char *progName;
|
||||
char *ifname;
|
||||
char *ofname;
|
||||
};
|
||||
|
||||
typedef struct s_Env Env;
|
||||
|
||||
Env globalEnv;
|
||||
Env *globalEnvPtr;
|
||||
|
||||
/* lexyy.c */
|
||||
int yylex(void);
|
||||
int yywrap(void);
|
||||
|
||||
/* cobf2f.c */
|
||||
int setOptions( Env*, int, char** );
|
||||
int setDefaults( Env* );
|
||||
void printVersion( char* );
|
||||
void printHelp( void );
|
||||
void CleanUp( void );
|
||||
|
||||
#endif
|
||||
@@ -0,0 +1,354 @@
|
||||
/*
|
||||
* Copyright (C) 1999 - 2003 David Essex
|
||||
*
|
||||
* 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 software; see the file COPYING. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*/
|
||||
|
||||
%{
|
||||
|
||||
#undef yywrap
|
||||
|
||||
#include <stdio.h>
|
||||
#include <assert.h>
|
||||
|
||||
#include "cobf2f.h"
|
||||
|
||||
int i;
|
||||
unsigned long columnLen;
|
||||
unsigned long columnCount = 1;
|
||||
unsigned long lineCount = 1;
|
||||
char lineout[80];
|
||||
|
||||
void lineExpand(void) ;
|
||||
void tabExpand(void) ;
|
||||
//void lexError( char * msg ) ;
|
||||
|
||||
%}
|
||||
|
||||
eol [\n]
|
||||
tab [\t]
|
||||
blank [ ]
|
||||
Quote ['"]
|
||||
ws [ \n]
|
||||
|
||||
%x INITAL FREE FIXED FIXED_7 FIXED_A FIXED_LC COMMENT
|
||||
|
||||
%%
|
||||
if ( globalEnvPtr->format == 0 ) {
|
||||
/* free == 0, fixed == 1 */
|
||||
if (globalEnvPtr->linemul != 0) {
|
||||
fprintf(yyout, "%06d", lineCount*globalEnvPtr->linemul);
|
||||
}
|
||||
else {
|
||||
fprintf(yyout, " ");
|
||||
}
|
||||
BEGIN( FREE ) ;}
|
||||
else if ( globalEnvPtr->format == 1)
|
||||
BEGIN( FIXED ) ;
|
||||
else {
|
||||
assert(1);
|
||||
}
|
||||
<*>{tab} { tabExpand(); }
|
||||
|
||||
<FREE>{eol} {
|
||||
lineCount++;
|
||||
columnCount=0;
|
||||
if (globalEnvPtr->linemul != 0) {
|
||||
fprintf(yyout, "\n%06d", lineCount*globalEnvPtr->linemul);
|
||||
}
|
||||
else {
|
||||
fprintf(yyout, "\n ");
|
||||
}
|
||||
}
|
||||
<FREE>{Quote}{ws}+"&"{ws}+{Quote} { /*remove for concatination */; }
|
||||
<FREE>^"*".*$ { ECHO; /* remove line */ ; }
|
||||
|
||||
<FREE>^[^ ] {
|
||||
columnCount++;
|
||||
fprintf(stderr,
|
||||
"%s:%lu: Invaild character (%c) in"
|
||||
"column 7.\n"
|
||||
,globalEnvPtr->ifname
|
||||
,lineCount
|
||||
,yytext[0]
|
||||
);
|
||||
/* remove line */ }
|
||||
<FREE>^"/".*$ { /* remove line */ ; }
|
||||
<FREE>^"D".*$ { if ( globalEnvPtr->debug == 1 ) {
|
||||
yytext[0]=' ';
|
||||
ECHO;
|
||||
} /* else remove line */
|
||||
}
|
||||
<FREE>^"$".*$ { fprintf(stderr,
|
||||
"%s:%lu: Warning: Directive ignored.\n"
|
||||
,globalEnvPtr->ifname
|
||||
,lineCount);
|
||||
globalEnvPtr->errFlag++;
|
||||
}
|
||||
<FREE>.* {
|
||||
columnLen = strlen(yytext);
|
||||
/* Ensure that position 7 is blank */
|
||||
if( columnCount == 0 ) {
|
||||
if( yytext[0] != ' ' ) {
|
||||
fprintf(yyout, " ");
|
||||
columnCount++;
|
||||
}
|
||||
}
|
||||
if ( columnLen > 66 ) {
|
||||
lineExpand();
|
||||
}
|
||||
else {
|
||||
columnCount = columnCount + columnLen;
|
||||
ECHO;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
<FIXED,FIXED_A>{eol} {
|
||||
lineCount++;
|
||||
columnCount=0;
|
||||
ECHO;
|
||||
BEGIN(FIXED);
|
||||
}
|
||||
<COMMENT>{eol} {
|
||||
lineCount++;
|
||||
columnCount=0;
|
||||
ECHO;
|
||||
BEGIN(FIXED);
|
||||
}
|
||||
<COMMENT>. {
|
||||
columnCount++;
|
||||
if ( columnCount > 72 ) {
|
||||
BEGIN(FIXED_LC);
|
||||
}
|
||||
else {
|
||||
ECHO;
|
||||
/*
|
||||
fprintf(stderr, "debug: <COMMENT>: char=%s, columnCount=%d, lineCount=%d\n",
|
||||
yytext,
|
||||
columnCount,
|
||||
lineCount
|
||||
);
|
||||
*/
|
||||
}
|
||||
}
|
||||
<FIXED_LC>. { /* eat comments */ /*printf("*")*/ ; }
|
||||
<FIXED_LC>{eol} {
|
||||
ECHO;
|
||||
lineCount++;
|
||||
columnCount=0;
|
||||
BEGIN(FIXED);
|
||||
}
|
||||
<FIXED_LC>{eol}.{6}"-"{blank}{4,58}{Quote} {
|
||||
/* Continuation line remove */
|
||||
lineCount++;
|
||||
/*columnCount=12;*/
|
||||
/* columnCount=0; */
|
||||
columnCount = yyleng - 1;
|
||||
BEGIN(FIXED_A);
|
||||
}
|
||||
|
||||
|
||||
<FIXED>^.{6} {
|
||||
/* remove sequence number */
|
||||
columnCount+=6 ;
|
||||
BEGIN(FIXED_7);
|
||||
/*
|
||||
fprintf(stderr, "debug: <FIXED>^.{6}: columnCount=%d, lineCount=%d\n",
|
||||
columnCount,
|
||||
lineCount
|
||||
);
|
||||
*/
|
||||
}
|
||||
<FIXED_7>"*" |
|
||||
<FIXED_7>"/" |
|
||||
<FIXED_7>"$" {
|
||||
/* comment line remove */
|
||||
ECHO;
|
||||
columnCount++;
|
||||
BEGIN(COMMENT);
|
||||
}
|
||||
|
||||
<FIXED_7>"D" {
|
||||
columnCount++;
|
||||
if ( globalEnvPtr->debug == 1 )
|
||||
BEGIN(FIXED_A);
|
||||
else
|
||||
BEGIN(COMMENT);
|
||||
|
||||
}
|
||||
|
||||
<FIXED_7>[\n] { BEGIN(FIXED); lineCount++; columnCount=0; ECHO; }
|
||||
<FIXED_7>[ ] { columnCount++; BEGIN(FIXED_A); ECHO; }
|
||||
<FIXED_7>[^ \n] {
|
||||
globalEnvPtr->errFlag++;
|
||||
fprintf(stderr,
|
||||
"%s:%lu: Invaild character (%c) in"
|
||||
"column 7.\n"
|
||||
,globalEnvPtr->ifname
|
||||
,lineCount
|
||||
,yytext[0]
|
||||
);
|
||||
BEGIN(COMMENT);
|
||||
}
|
||||
|
||||
<FIXED_A>{eol}.{6}"-"{blank}{4,58}{Quote} {
|
||||
/* Continuation line remove */
|
||||
lineCount++;
|
||||
/* columnCount=0; */
|
||||
columnCount = yyleng - 1;
|
||||
BEGIN(FIXED_A);
|
||||
}
|
||||
|
||||
<FIXED_A>{Quote}{eol}.{6}"-"{blank}{4,58}{Quote} {
|
||||
/* Continuation line remove */
|
||||
lineCount++;
|
||||
/* columnCount=0; */
|
||||
columnCount = yyleng - 1;
|
||||
BEGIN(FIXED_A);
|
||||
}
|
||||
|
||||
<FIXED,FIXED_A>. {
|
||||
/* any other line */
|
||||
columnCount++;
|
||||
/* don't echo */
|
||||
if ( columnCount > 72 ) {
|
||||
BEGIN(FIXED_LC);
|
||||
}
|
||||
/* }else if ( columnCount > 80 ){
|
||||
* lexError( "Record Exceeded 80 cols!"); }
|
||||
*/
|
||||
else {
|
||||
ECHO;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
%%
|
||||
/*
|
||||
* Expand line.
|
||||
*/
|
||||
void lineExpand(void) {
|
||||
int nlines, j;
|
||||
char *s = yytext, delm = '0';
|
||||
|
||||
for(j=0; j<columnLen; j++) {
|
||||
if( (yytext[j] == '\'') || (yytext[j] == '"') ) {
|
||||
delm = yytext[j];
|
||||
j = columnLen + 3;
|
||||
}
|
||||
}
|
||||
if(delm == '0') {
|
||||
fprintf(stderr, "Error: literal quote/double expected in \'%s\', not found\n", s);
|
||||
return;
|
||||
}
|
||||
strncpy(lineout, s, 66);
|
||||
lineout[66] = '\0';
|
||||
fprintf(yyout, "%s", lineout);
|
||||
columnCount = 66;
|
||||
s = yytext + 66;
|
||||
nlines = ((columnLen - 66) / 60) + 1;
|
||||
|
||||
for(j=1; j<nlines; j++) {
|
||||
sprintf(lineout, "- %c", delm);
|
||||
strncat(lineout, s, 60);
|
||||
lineout[66] = '\0';
|
||||
s = s + 60;
|
||||
columnCount = columnCount + 66;
|
||||
lineCount++;
|
||||
if (globalEnvPtr->linemul != 0) {
|
||||
fprintf(yyout, "\n%06d%s", lineCount*10, lineout);
|
||||
}
|
||||
else {
|
||||
fprintf(yyout, "\n %s", lineout);
|
||||
}
|
||||
}
|
||||
|
||||
if( (j = strlen(s)) > 0) {
|
||||
sprintf(lineout, "- %c", delm);
|
||||
strncat(lineout, s, j);
|
||||
lineout[6 + j] = '\0';
|
||||
lineCount++;
|
||||
if (globalEnvPtr->linemul != 0) {
|
||||
fprintf(yyout, "\n%06d%s", lineCount*10, lineout);
|
||||
}
|
||||
else {
|
||||
fprintf(yyout, "\n %s", lineout);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
fprintf(stderr,
|
||||
"%s: Character (%c) in column %d, line %lu.\n",
|
||||
globalEnvPtr->ifname,
|
||||
yytext[0],
|
||||
columnCount,
|
||||
lineCount);
|
||||
*/
|
||||
}
|
||||
|
||||
/* print error on tab and stop. */
|
||||
void tabExpand(void) {
|
||||
|
||||
/*
|
||||
* Check the warning level settings
|
||||
* output the appropriate message.
|
||||
*
|
||||
*/
|
||||
/*
|
||||
if ( globalEnvPtr->tab2space == 0 ) {
|
||||
*/
|
||||
/* now is a tab always an error?? yes? */
|
||||
/* (void)fprintf(stderr,
|
||||
"%s:%lu: Error tab in column %lu\n"
|
||||
,globalEnvPtr->ifname
|
||||
, lineCount, columnCount
|
||||
);
|
||||
globalEnvPtr->errFlag++;
|
||||
return;
|
||||
*/
|
||||
/*
|
||||
}
|
||||
*/
|
||||
globalEnvPtr->errFlag++;
|
||||
fprintf(stderr,
|
||||
"error: tabs exapntion is not supported ...aborting\n"
|
||||
"Hint: use expand utility to process tabs\n"
|
||||
);
|
||||
return;
|
||||
|
||||
}
|
||||
|
||||
// void lexError( char * msg ) {
|
||||
//
|
||||
// (void)fprintf(stderr,
|
||||
// "%s:%lu: %s\n"
|
||||
// ,globalEnvPtr->ifname
|
||||
// ,lineCount
|
||||
// ,msg
|
||||
// );
|
||||
// globalEnvPtr->errFlag++;
|
||||
// return;
|
||||
// }
|
||||
|
||||
int yywrap(void) {
|
||||
|
||||
/* yywrap will be called to open files from the List of Files in the
|
||||
* Global Env struct.
|
||||
*/
|
||||
return 1;
|
||||
}
|
||||
|
||||
@@ -0,0 +1,95 @@
|
||||
#!/bin/sh
|
||||
#
|
||||
# Utility to convert Cobol display statements from the
|
||||
# "DISPLAY (X, Y) A B C ..." format to
|
||||
# the format "DISPLAY A B C ... LINE X POSITION Y"
|
||||
#
|
||||
# * keeps the period after the statement
|
||||
# * requires that "display" and "(X, Y)" be at the same line
|
||||
# * case insensitive
|
||||
# * only variables declared are checked (no copybooks), so please
|
||||
# substitute copy statements with the preprocessor first.
|
||||
#
|
||||
# Recife, Brazil 2001 -- Rildo Pragana <rpragana@acm.org>
|
||||
#
|
||||
# usage: ./htcobdispcv.tcl < original.cob > converted.cob
|
||||
# \
|
||||
exec tclsh "$0" "$@"
|
||||
|
||||
set div none
|
||||
set varlist {}
|
||||
set redisp {^(display|accept)[ \t]*\([ \t]*([0-9]+)[ \t]*,[ \t]*([0-9]+)[ \t]*\)(.*)}
|
||||
set reword {^(([a-zA-Z][a-zA-Z0-9-]*)([ \t]*\([^\)]*\))*)(.*)}
|
||||
set line ""
|
||||
|
||||
while {![eof stdin]} {
|
||||
if {$line == ""} {
|
||||
gets stdin line
|
||||
}
|
||||
if {[regexp -nocase {data[ \t]*division} $line]} {
|
||||
puts "* begin data division"
|
||||
set div data
|
||||
}
|
||||
if {[regexp -nocase {procedure[ \t]*division} $line]} {
|
||||
puts "* begin procedure division"
|
||||
set div procedure
|
||||
puts "* VARLIST: $varlist"
|
||||
}
|
||||
if {$div == "data"} {
|
||||
if {[regexp {^[ \t]*[0-9]+[ \t]*([a-zA-Z][a-zA-Z0-9-]*)} $line m var]} {
|
||||
lappend varlist $var
|
||||
}
|
||||
}
|
||||
if {$div == "procedure"} {
|
||||
set line [string trim $line]
|
||||
if {[regexp -nocase $redisp $line m cmd lin pos tail]} {
|
||||
puts "*** converted [string toupper $cmd] statement"
|
||||
puts "\t$cmd "
|
||||
set line $tail
|
||||
set add_period 0
|
||||
while {1} {
|
||||
if {$line == ""} {
|
||||
gets stdin line
|
||||
}
|
||||
set line [string trim $line]
|
||||
if {[regexp $reword $line m xtok tok stok tail]} {
|
||||
if {([lsearch -exact $varlist $tok] < 0) && \
|
||||
![regexp -nocase {^(in|of)} $tok]} {
|
||||
if {$add_period} {
|
||||
puts "\t\t\tline $lin position $pos\n\t."
|
||||
} else {
|
||||
puts "\t\t\tline $lin position $pos"
|
||||
}
|
||||
break
|
||||
} else {
|
||||
#puts "***** tok: $tok // tail: $tail"
|
||||
puts "\t\t${xtok}"
|
||||
set line $tail
|
||||
}
|
||||
} elseif {[regexp {^(\"[^\"]*\")(.*)} \
|
||||
$line m tok tail]} {
|
||||
puts "\t\t${tok}"
|
||||
set line $tail
|
||||
} elseif {[regexp {^([0-9.,]+)(.*)} \
|
||||
$line m tok tail]} {
|
||||
if {($tok != ",") && ($tok != ".")} {
|
||||
puts "\t\t${tok}"
|
||||
} elseif {$tok == "."} {
|
||||
set add_period 1
|
||||
}
|
||||
set line $tail
|
||||
} else {
|
||||
puts "\t\t\tline $lin position $pos"
|
||||
break
|
||||
}
|
||||
}
|
||||
} else {
|
||||
puts $line
|
||||
set line ""
|
||||
}
|
||||
} else {
|
||||
puts $line
|
||||
set line ""
|
||||
}
|
||||
}
|
||||
|
||||
@@ -0,0 +1,562 @@
|
||||
#!/bin/sh
|
||||
# Rildo Pragana -- Recife, 2001
|
||||
#\
|
||||
exec wish "$0" "$@"
|
||||
|
||||
# change the folowing to your cobol compile arguments
|
||||
set gdb(cobol_args) "-D -I. -L../lib -L/usr/local/lib -ldb"
|
||||
# set your compiler path here
|
||||
set gdb(compiler_path) "../compiler"
|
||||
# set list of lval casts to be chosen from
|
||||
set gdb(cast_list) {
|
||||
{struct sym *}
|
||||
{int}
|
||||
{struct lit *}
|
||||
{unsigned long}
|
||||
{char *}
|
||||
{condition}
|
||||
{struct vref *}
|
||||
{struct refmod *}
|
||||
{struct string_from *}
|
||||
{struct unstring_delimited *}
|
||||
{struct unstring_destinations *}
|
||||
{struct tallying_list *}
|
||||
{struct tallying_for_list *}
|
||||
{struct replacing_list *}
|
||||
{struct replacing_by_list *}
|
||||
{struct inspect_before_after *}
|
||||
{struct scr_info *}
|
||||
{struct perf_info *}
|
||||
{struct perform_info *}
|
||||
{struct sortfile_node *}
|
||||
{struct selsubject *}
|
||||
{struct list *}
|
||||
{struct coord_pair}
|
||||
}
|
||||
|
||||
#####################################################
|
||||
### please, don't touch anything below
|
||||
|
||||
option add *Scrollbar.width 10
|
||||
option add *Scrollbar.borderWidth 1
|
||||
|
||||
set gdb(sourcefile) "tdb03.cob"
|
||||
set gdb(asmfile) ""
|
||||
set gdb(fd) -1
|
||||
set history {step}
|
||||
tcl_wordBreakAfter "Rildo Pragana" 0 ;# force loading package first
|
||||
set tcl_wordchars {[a-zA-Z0-9_-]}
|
||||
set tcl_nonwordchars {[^a-zA-Z0-9_-]}
|
||||
|
||||
### communication with gdb
|
||||
proc gdbReceive {} {
|
||||
global gdb
|
||||
if {$gdb(ready)} {
|
||||
set gdb(answer) ""
|
||||
set gdb(ready) 0
|
||||
}
|
||||
set line [gets $gdb(fd)]
|
||||
if {[string compare $line **READY**]} {
|
||||
append gdb(answer) $line\n
|
||||
} else {
|
||||
incr gdb(ready)
|
||||
}
|
||||
puts "answer: $gdb(answer)"
|
||||
}
|
||||
|
||||
proc sendgdb {cmd {wait 1}} {
|
||||
global gdb
|
||||
set gdb(answer) ""
|
||||
set gdb(ready) 0
|
||||
puts "gdb cmd: $cmd"
|
||||
puts $gdb(fd) $cmd
|
||||
if {$wait} {
|
||||
while {!$gdb(ready)} {
|
||||
update
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc ask_load_first {} {
|
||||
tk_messageBox -message "Please load a source file first!"
|
||||
}
|
||||
|
||||
proc load {} {
|
||||
global gdb win
|
||||
set gdb(sourcefile) [tk_getOpenFile \
|
||||
-filetypes {{{Cobol source} .cob} {{All files} *}} \
|
||||
-defaultextension cob]
|
||||
if {$gdb(sourcefile) == ""} {
|
||||
return
|
||||
}
|
||||
wm title . "Compiling $gdb(sourcefile)"
|
||||
# locate breakpoints and create a list
|
||||
set bkps {}
|
||||
#set lines [split [exec grep -n 'yynewstate:|yybackup:|yyreduce:' \
|
||||
# [file join $gdb(compiler_path) htcobol.tab.c]] \n]
|
||||
|
||||
set lines [split [exec grep -n {yystate[ \t]*=[ \t]*yyn.*} \
|
||||
[file join $gdb(compiler_path) htcobol.tab.c]] \n]
|
||||
|
||||
foreach line $lines {
|
||||
regexp {([0-9]+):.*} $line match bkp
|
||||
lappend bkps $bkp
|
||||
}
|
||||
#puts $bkps
|
||||
# prepare connection to gdb task
|
||||
set gdb(asmfile) [file rootname $gdb(sourcefile)].s
|
||||
set gdb(asmpos) 0
|
||||
set gdb(tok) ""
|
||||
set gdb(state) 0
|
||||
set gdb(lineno) 1
|
||||
set gdb(ready) 1
|
||||
set gdb(fd) [open "|gdb -nx -q 2>@stdout" w+]
|
||||
fconfigure $gdb(fd) -blocking 0 -buffering line
|
||||
fileevent $gdb(fd) readable gdbReceive
|
||||
sendgdb "set prompt **READY**\\n" 0
|
||||
sendgdb "set confirm off" 1
|
||||
sendgdb "set width 0" 1
|
||||
sendgdb "file [file join $gdb(compiler_path) htcobol]" 1
|
||||
sendgdb "set args $gdb(cobol_args) [file tail $gdb(sourcefile)]" 1
|
||||
foreach bkp $bkps {
|
||||
sendgdb "b htcobol.tab.c:$bkp" 1
|
||||
}
|
||||
sendgdb "r" 1
|
||||
# load cobol source modified by the preprocessor
|
||||
sendgdb "c" 1
|
||||
$win(source) delete 0.0 end
|
||||
#set inputname ""
|
||||
set inputname $gdb(sourcefile)
|
||||
#sendgdb "p input_filename" 1
|
||||
#regexp {[^\"]*\"([^\"]*)\"} $gdb(answer) match inputname
|
||||
set f [open $inputname r]
|
||||
set n 0
|
||||
while {![eof $f]} {
|
||||
$win(source) insert end "[format %04d [incr n]]: [gets $f]\n"
|
||||
}
|
||||
close $f
|
||||
# setup parser display variables
|
||||
sendgdb "display source_lineno" 1
|
||||
#sendgdb "display *yyssp" 1
|
||||
sendgdb "display yystate" 1
|
||||
sendgdb "display yytext" 1
|
||||
.status.loaded config -bg red
|
||||
}
|
||||
|
||||
### parse y.output file
|
||||
|
||||
proc parse_yacc_states {fname yname} {
|
||||
global state action arule win
|
||||
set f [open $yname r]
|
||||
$win(grammar) delete 1.0 end
|
||||
$win(grammar) insert end [read $f]
|
||||
close $f
|
||||
## read grammar rules table
|
||||
set f [open $fname r]
|
||||
while {1} {
|
||||
gets $f line
|
||||
if {[string trim $line] == "Grammar"} {
|
||||
break
|
||||
}
|
||||
}
|
||||
while {1} {
|
||||
gets $f line
|
||||
if {[regexp {[ \t]+([0-9]+)[ \t]+([0-9]+)[ \t]+.*} $line]} {
|
||||
break
|
||||
}
|
||||
}
|
||||
while {1} {
|
||||
if {[regexp {[ \t]+([0-9]+)[ \t]+([0-9]+)[ \t]+.*} $line \
|
||||
match rulen actn]} {
|
||||
set arule($rulen) $actn
|
||||
} else {
|
||||
break
|
||||
}
|
||||
gets $f line
|
||||
}
|
||||
close $f
|
||||
#puts [array get arule]
|
||||
### create an indexed positions array for each line
|
||||
set f [open $yname r]
|
||||
set n 0
|
||||
while {![eof $f]} {
|
||||
set yline([incr n]) [tell $f]
|
||||
gets $f
|
||||
}
|
||||
close $f
|
||||
set f [open $yname r]
|
||||
foreach {ix val} [array get arule] {
|
||||
seek $f $yline($val)
|
||||
gets $f line
|
||||
while {[string first \{ $line] < 0} {
|
||||
gets $f line1
|
||||
append line \n$line1
|
||||
}
|
||||
set i [string first \{ $line]
|
||||
set action($ix) [string range $line $i end]
|
||||
while {![info complete $action($ix)]} {
|
||||
gets $f line
|
||||
append action($ix) $line\n
|
||||
}
|
||||
}
|
||||
close $f
|
||||
### reread y.output to get the state descriptions
|
||||
set f [open $fname r]
|
||||
while {![eof $f]} {
|
||||
gets $f line
|
||||
if {[regexp {state[ \t]*([0-9]+)$} $line match st]} {
|
||||
set state($st) ""
|
||||
gets $f line
|
||||
if {[string trim $line] == ""} {
|
||||
gets $f line
|
||||
}
|
||||
set rule ""
|
||||
while {[regexp {[^\(]+\(rule ([0-9]+)\).*$} $line match rule1]} {
|
||||
append state($st) [string trimleft $line]\n
|
||||
gets $f line
|
||||
set rule $rule1
|
||||
}
|
||||
#if {$rule != "" && [info exists action($rule)]} {
|
||||
# append state($st) $action($rule)
|
||||
#}
|
||||
}
|
||||
}
|
||||
close $f
|
||||
}
|
||||
|
||||
proc next {{update 1}} {
|
||||
global gdb win state
|
||||
sendgdb "c"
|
||||
if {![regexp {.*source_lineno *= *([0-9]+).*} $gdb(answer) \
|
||||
match gdb(lineno)]} {
|
||||
.status.loaded config -bg blue
|
||||
return
|
||||
}
|
||||
if {$update} {
|
||||
#regexp {.*yyssp *= *([0-9]+).*} $gdb(answer) match gdb(state)
|
||||
regexp {.*yystate *= *([0-9]+).*} $gdb(answer) match gdb(state)
|
||||
regexp {.*yytext *= *[^\"]*\"([^\n]*)\n.*} $gdb(answer) match gdb(tok)
|
||||
set gdb(tok) [string range $gdb(tok) 0 end-1]
|
||||
$win(state) delete 0.0 end
|
||||
#$win(state) insert end $state($gdb(state))
|
||||
if {[info exists state($gdb(state))]} {
|
||||
show_state $win(state) $state($gdb(state))
|
||||
}
|
||||
sendgdb "p ftell(o_src)"
|
||||
regexp {.*= *([0-9]+)} $gdb(answer) match pos
|
||||
if {![info exists pos]} {
|
||||
#.status.loaded config -bg blue
|
||||
return -1
|
||||
}
|
||||
if {$pos != $gdb(asmpos)} {
|
||||
sendgdb "p fflush(o_src)"
|
||||
set f [open $gdb(asmfile) r]
|
||||
seek $f $gdb(asmpos) start
|
||||
$win(asm) tag remove last 0.0 end
|
||||
while {![eof $f]} {
|
||||
gets $f line
|
||||
$win(asm) insert end $line\n last
|
||||
}
|
||||
close $f
|
||||
$win(asm) see end
|
||||
set gdb(asmpos) $pos
|
||||
}
|
||||
}
|
||||
$win(source) tag remove line 0.0 end
|
||||
set n $gdb(lineno)
|
||||
$win(source) tag add line $n.0 $n.end
|
||||
$win(source) see [expr $n+3].0
|
||||
$win(source) see $n.0
|
||||
if {$update} {
|
||||
show_lvals 0
|
||||
}
|
||||
return $gdb(state)
|
||||
}
|
||||
|
||||
proc show_state {w st} {
|
||||
global action arule win
|
||||
set i [string first " . " $st]
|
||||
if {$i > 0} {
|
||||
$w insert end [string range $st 0 [expr $i]] normal \
|
||||
" " highlight [string range $st [expr $i+2] end] normal
|
||||
} else {
|
||||
$w insert end $st
|
||||
}
|
||||
set rule ""
|
||||
if {[regexp {[^\(]+\(rule ([0-9]+)\).*$} $st match rule]} {
|
||||
if {$rule != ""} {
|
||||
$win(grammar) see $arule($rule).0
|
||||
}
|
||||
}
|
||||
# show mid-of-rule actions found
|
||||
#while {[regexp {\$\$([0-9]+)[ \t]*:(.*)} $st match actn st]} {
|
||||
# if {[info exists action($actn)]} {
|
||||
# $w insert end "\$\$$actn: $action($actn)\n" action
|
||||
# }
|
||||
#}
|
||||
}
|
||||
|
||||
proc run {} {
|
||||
global gdb
|
||||
if {$gdb(fd) < 0} {
|
||||
ask_load_first
|
||||
return
|
||||
}
|
||||
set until [.ctrl.until get]
|
||||
if {$until != ""} {
|
||||
while {$gdb(lineno) < $until} {
|
||||
next 0
|
||||
}
|
||||
next
|
||||
set gdb(until) ""
|
||||
} else {
|
||||
#set state $gdb(state)
|
||||
#while {$state == $gdb(state)} {
|
||||
# if {[next] < 0} break
|
||||
#}
|
||||
next
|
||||
}
|
||||
}
|
||||
|
||||
proc gdbsh {} {
|
||||
global gdb
|
||||
if {![winfo exists .gdb]} {
|
||||
toplevel .gdb
|
||||
pack [frame .gdb.t] -fill both -expand 1
|
||||
pack [frame .gdb.b] -fill x
|
||||
pack \
|
||||
[button .gdb.b.close -text close -command {wm withdraw .gdb}] \
|
||||
[label .gdb.b.lb -text \
|
||||
"Press right mouse button to get cmd history or \
|
||||
use the keys <up>,<down>"] \
|
||||
-side left
|
||||
set t [create_text .gdb.t 18]
|
||||
set gdb(shprompt) "gdb> "
|
||||
$t tag config answer -foreground navy
|
||||
$t insert insert $gdb(shprompt)
|
||||
$t mark set limit insert
|
||||
$t mark gravity limit left
|
||||
focus $t
|
||||
bind gdb <Up> { gdbHistory %W 1 ; break }
|
||||
bind gdb <Down> { gdbHistory %W 0 ; break }
|
||||
bind gdb <Return> { gdbEval %W ; break }
|
||||
bind gdb <Any-Key> {
|
||||
if [%W compare insert < limit] {
|
||||
%W mark set insert end
|
||||
}
|
||||
}
|
||||
bind gdb <3> { popupHistory %W %X %Y ; break }
|
||||
bindtags $t [list gdb Text $t all]
|
||||
} else {
|
||||
wm deiconify .gdb
|
||||
}
|
||||
}
|
||||
|
||||
proc popupHistory { t x y } {
|
||||
global gdb history
|
||||
if {![winfo exists .popup]} {
|
||||
toplevel .popup
|
||||
wm transient .popup .gdb
|
||||
wm geometry .popup +$x+$y
|
||||
pack [button .popup.cancel -text cancel -command {
|
||||
wm withdraw .popup }] -side bottom
|
||||
pack [set lb \
|
||||
[listbox .popup.lb -yscrollcommand {.popup.sb set}]] \
|
||||
[scrollbar .popup.sb -orient vertical -command {.popup.lb yview}] \
|
||||
-side left -fill y
|
||||
bindtags $lb [list Listbox all $lb]
|
||||
bind $lb <1> [list executeHistory $t %W]
|
||||
}
|
||||
.popup.lb delete 0 end
|
||||
foreach it $history {
|
||||
.popup.lb insert 0 $it
|
||||
}
|
||||
wm deiconify .popup
|
||||
wm geometry .popup +$x+$y
|
||||
}
|
||||
|
||||
proc executeHistory {t lb} {
|
||||
global history
|
||||
$t delete limit end
|
||||
$t insert insert [string trimright [$lb get [$lb curselection]]]
|
||||
wm withdraw .popup
|
||||
gdbEval $t
|
||||
}
|
||||
|
||||
proc gdbHistory { t up } {
|
||||
global gdb history
|
||||
if {$up} {
|
||||
$t delete limit end
|
||||
$t insert insert [lindex $history end]
|
||||
set history [concat \
|
||||
[lrange $history end end] [lrange $history 0 end-1]]
|
||||
} else {
|
||||
$t delete limit end
|
||||
$t insert insert [lindex $history 0]
|
||||
set history [concat \
|
||||
[lrange $history 1 end] [lrange $history 0 0]]
|
||||
}
|
||||
}
|
||||
|
||||
proc gdbEval { t } {
|
||||
global gdb history
|
||||
set command [string trimright [$t get limit end]]
|
||||
if {$command != ""} {
|
||||
lappend history $command
|
||||
set history [lrange $history 0 100]
|
||||
}
|
||||
$t insert insert \n
|
||||
sendgdb $command
|
||||
if {[string length $gdb(answer)] > 0} {
|
||||
$t insert insert $gdb(answer)\n answer
|
||||
}
|
||||
$t insert insert $gdb(shprompt)
|
||||
$t see insert
|
||||
$t mark set limit insert
|
||||
}
|
||||
|
||||
proc show_lvals {{update 1}} {
|
||||
global gdb history
|
||||
if {$gdb(fd) < 0} {
|
||||
ask_load_first
|
||||
return
|
||||
}
|
||||
if {$update && ![winfo exists .lvals]} {
|
||||
toplevel .lvals
|
||||
grid \
|
||||
[listbox .lvals.lb1 -yscrollcommand {.lvals.sb1 set}] \
|
||||
[scrollbar .lvals.sb1 -orient vertical \
|
||||
-command {.lvals.lb1 yview}] \
|
||||
[listbox .lvals.lb -yscrollcommand {.lvals.sb set}] \
|
||||
[scrollbar .lvals.sb -orient vertical -command {.lvals.lb yview}] \
|
||||
[text .lvals.t -width 60 -height 12 -takefocus 0] \
|
||||
-stick nsew
|
||||
grid [button .lvals.close -text close -command {
|
||||
wm withdraw .lvals }] -stick w
|
||||
foreach cast $gdb(cast_list) {
|
||||
.lvals.lb1 insert end $cast
|
||||
}
|
||||
foreach lb {.lvals.lb .lvals.lb1} {
|
||||
bindtags $lb [list Listbox all $lb]
|
||||
bind $lb <1> [list showLval $lb]
|
||||
}
|
||||
}
|
||||
if {![winfo exists .lvals] || !$update && ![winfo ismapped .lvals]} {
|
||||
return
|
||||
}
|
||||
#wm withdraw .lvals
|
||||
.lvals.lb delete 0 end
|
||||
sendgdb "p &yyvs"
|
||||
regexp {.*(0x[0-9xa-fA-F]+).*} $gdb(answer) match start
|
||||
sendgdb "p yyvsp"
|
||||
regexp {,*(0x[0-9a-fA-F]+).*} $gdb(answer) match end
|
||||
set values {}
|
||||
for {set i [expr ($end-$start)/8]} {$i >= 0} {incr i -1} {
|
||||
sendgdb "p yyvs\[$i]"
|
||||
regexp { ival = ([0-9a-fA-Fx]+).*} $gdb(answer) match lval
|
||||
lappend values 0x[format %x $lval]
|
||||
}
|
||||
eval .lvals.lb insert 0 $values
|
||||
wm deiconify .lvals
|
||||
}
|
||||
|
||||
proc showLval {lb} {
|
||||
global gdb
|
||||
$lb activate [$lb curselection]
|
||||
if {[.lvals.lb get active] == {} ||
|
||||
[.lvals.lb1 get active] == {}} { return }
|
||||
set cast [.lvals.lb1 get active]
|
||||
set var [.lvals.lb get active]
|
||||
if {[string index $cast end] == "*"} {
|
||||
sendgdb "p *($cast) $var"
|
||||
} else {
|
||||
sendgdb "p ($cast) $var"
|
||||
}
|
||||
set result [string range $gdb(answer) \
|
||||
[expr [string first = $gdb(answer)]+1] end]
|
||||
set result [string trimleft $result " \t\n\{"]
|
||||
set result [string trimright $result " \t\n\}"]
|
||||
.lvals.t delete 0.0 end
|
||||
foreach item [split $result ,] {
|
||||
foreach {lhs rhs} [split [string trim $item] =] {}
|
||||
.lvals.t insert end $lhs\t$rhs\n
|
||||
}
|
||||
}
|
||||
|
||||
proc show_value {var} {
|
||||
global gdb
|
||||
if {[string first "-" $var]} {
|
||||
sendgdb "p '$var'"
|
||||
} else {
|
||||
sendgdb "p $var"
|
||||
}
|
||||
tk_messageBox -type ok -message "Inspect $var\n$gdb(answer)"
|
||||
}
|
||||
|
||||
proc create_text {w {height 10} {width 40}} {
|
||||
text $w.t -width $width -height $height -wrap word \
|
||||
-yscrollcommand "$w.sv set" -xscrollcommand "$w.sh set"
|
||||
scrollbar $w.sv -orient vertical -command "$w.t yview"
|
||||
scrollbar $w.sh -orient horizontal -command "$w.t xview"
|
||||
pack $w.sh -side bottom -fill x
|
||||
pack $w.sv -side right -fill y
|
||||
pack $w.t -side left -fill both -expand 1
|
||||
bindtags $w.t [list Text $w.t . all]
|
||||
bind $w.t <Double-1> {show_value [%W get sel.first sel.last]}
|
||||
bind $w.t <Control-1> {show_value [%W get sel.first sel.last]}
|
||||
return $w.t
|
||||
}
|
||||
|
||||
set w [frame .ctrl]
|
||||
# [label $w.lab1 -text Source:] \
|
||||
# [entry $w.sourcef -width 20 -textvariable gdb(sourcefile)] \
|
||||
#
|
||||
pack \
|
||||
[button $w.load -command load -text load] \
|
||||
[button $w.run -command run -text "run until"] \
|
||||
[entry $w.until -width 4 -textvariable gdb(until)] \
|
||||
[button $w.gdbsh -command gdbsh -text gdbsh] \
|
||||
[button $w.lval -command show_lvals -text "lval stack"] \
|
||||
[button $w.exit -command exit -text exit] \
|
||||
-side left -pady 10 -padx 5
|
||||
set w [frame .status]
|
||||
pack \
|
||||
[label $w.lab2 -text Line:] \
|
||||
[label $w.lab3 -relief sunken -bd 2 -width 4 -textvariable gdb(lineno)] \
|
||||
[label $w.lab4 -text State:] \
|
||||
[label $w.lab5 -relief sunken -bd 2 -width 4 -textvariable gdb(state)] \
|
||||
[label $w.lab6 -text Token:] \
|
||||
[label $w.lab7 -relief sunken -bd 2 -width 20 -textvariable gdb(tok)] \
|
||||
[frame $w.loaded -relief sunken -bd 2 -width 10 -height 10] \
|
||||
-side left -pady 10 -padx 5
|
||||
|
||||
panedwindow .pw1 -orient horizontal
|
||||
panedwindow .pw2 -orient vertical
|
||||
panedwindow .pw3 -orient vertical
|
||||
.pw1 add .pw2
|
||||
.pw1 add .pw3
|
||||
set win(source) [create_text [frame .f1]]
|
||||
set win(state) [create_text [frame .f2] 8]
|
||||
set win(asm) [create_text [frame .f3] 10]
|
||||
set win(grammar) [create_text [frame .f4] 6]
|
||||
.pw2 add .f2
|
||||
.pw2 add .f4
|
||||
.pw3 add .f1
|
||||
.pw3 add .f3
|
||||
pack .ctrl .status -fill both
|
||||
pack .pw1 -fill both -expand 1
|
||||
|
||||
$win(state) tag config highlight -background red
|
||||
$win(state) tag config action -foreground darkgreen
|
||||
$win(state) tag config normal -foreground black
|
||||
$win(asm) tag config last -foreground maroon
|
||||
$win(source) tag config line -background navy -foreground yellow
|
||||
|
||||
update idletasks
|
||||
parse_yacc_states [file join $gdb(compiler_path) htcobol.output] \
|
||||
[file join $gdb(compiler_path) htcobol.y]
|
||||
|
||||
bind all <Control-r> run
|
||||
bind all <Control-c> exit
|
||||
wm title . "NO COBOL SOURCE LOADED"
|
||||
|
||||
@@ -0,0 +1,10 @@
|
||||
# Extract all the keywords (except Intrinsic) and reformat them
|
||||
./xtr_rw ../compiler/reswords.c >tc.tok
|
||||
# Convert the yacc grammar into EBNF with some optimisation.
|
||||
./y2l -O2 -p -ttc.tok ../compiler/htcobol.y >tc.ebnf
|
||||
# Output the file tc.ps (implicit from tc.ebnf and -singlefile).
|
||||
#Diagrams -singlefile -Scale 0.8 0.8 tc.ebnf
|
||||
Diagrams -singlefile tc.ebnf
|
||||
# Update the files in info
|
||||
cp -f tc.ebnf tc.ps ../info
|
||||
rm -f tc.tok tc.ebnf tc.ps
|
||||
@@ -0,0 +1,52 @@
|
||||
#!/usr/bin/awk -f
|
||||
BEGIN {
|
||||
IFS=",";
|
||||
skipping = 1;
|
||||
}
|
||||
{
|
||||
if (($2 == "0," && $3 == "0,") || ($1 == "{\"\",0,0,0}")) {
|
||||
skipping = 1;
|
||||
}
|
||||
if (skipping == 0) {
|
||||
token_len = match($1, ",");
|
||||
if (substr($1, 1, 2) == "{\"") {
|
||||
tok_start = 3;
|
||||
token_len = token_len - 3;
|
||||
}
|
||||
else
|
||||
tok_start = 1;
|
||||
token = substr($1, tok_start, token_len - 1);
|
||||
value_len = match($2, ",");
|
||||
value = substr($2, 1, value_len - 1);
|
||||
if (substr($1, 1, 2) == "/*" ||
|
||||
value == "USAGENUM" ||
|
||||
value == "CONDITIONAL" ||
|
||||
value == "PORTNUM") {
|
||||
}
|
||||
else {
|
||||
printf "%s %s\n", value, token
|
||||
}
|
||||
}
|
||||
if ($0 == "struct reserved_symbol reserved_symbols[] = {")
|
||||
skipping = 0;
|
||||
}
|
||||
END {
|
||||
# And ends up with providing some pseudo-terminal
|
||||
print "LISTSEP ,"
|
||||
print "LPAR )"
|
||||
print "PERIOD_TOK ."
|
||||
print "POW_OP **"
|
||||
print "STRING string"
|
||||
print "VARIABLE variable"
|
||||
print "SUBSCVAR subscripted-variable"
|
||||
print "VARCOND condition-variable"
|
||||
print "CONDITIONAL condition-name"
|
||||
print "CLITERAL alphanumeric-literal"
|
||||
print "NLITERAL numeric-literal"
|
||||
print "CHAR picture-char"
|
||||
print "MULTIPLIER numeric-literal"
|
||||
print "LABELSTR paragraph-name"
|
||||
print "USAGENUM usage-type"
|
||||
print "PORTNUM portnum"
|
||||
print "IDSTRING idstring"
|
||||
}
|
||||
Reference in New Issue
Block a user