diff --git a/gcc/cobol/ccc/many b/gcc/cobol/ccc/many
index 68354ca348b8dd0481b44c5771862c434965ac9e..d37141152ff68f5b301fe693565b1dee02e6f0b4 100755
--- a/gcc/cobol/ccc/many
+++ b/gcc/cobol/ccc/many
@@ -5,99 +5,148 @@ import sys
fout = None
def xprint(str):
- global fout
- # print(str)
- fout.write(str)
- fout.write("\n")
+ global fout
+ # print(str)
+ fout.write(str)
+ fout.write("\n")
def cobol_code():
- global fout
- nlines = int(sys.argv[1])
+ global fout
+ # print("We are doing ", sys.argv[1])
+ nlines = int(sys.argv[1])
- fout = open("test.cbl", "w")
+ fout = open("test.cbl", "w")
- xprint(" IDENTIFICATION DIVISION.")
- xprint(" PROGRAM-ID. test.")
- xprint(" ")
- xprint(" DATA DIVISION.")
- xprint(" WORKING-STORAGE SECTION.")
- xprint(" ")
+ xprint(" identification division.")
+ xprint(" program-id. nlines_cobol.")
+ xprint(" data division.")
+ xprint(" working-storage section.")
- for i in range(1, nlines+1):
- xprint(" 01 VAR{:05d} PIC X(12) VALUES \"Hi!\".".format(i))
+ for i in range(1, nlines+1):
+ xprint(" 77 var{:d} pic 9999v9999 comp-5.".format(i))
- xprint(" ")
- xprint(" PROCEDURE DIVISION.")
- xprint(" ")
+ xprint(" procedure division.")
- for i in range(1, nlines+1):
- xprint(" DISPLAY VAR{:05d}".format(i))
+ for i in range(1, nlines+1):
+ xprint(" display var{:d}".format(i))
- xprint(" ")
- xprint(" STOP RUN.")
- xprint(" END PROGRAM test.")
+ xprint(" stop run.")
+ xprint(" end program nlines_cobol.")
- fout.close();
+ fout.close();
def c_code():
- global fout
- nlines = int(sys.argv[1])
-
- fout = open("ccc.c", "w")
-
- # Establish the structure
- xprint("#include <stdio.h>")
- xprint("#include <stdlib.h>")
- xprint("#include <string.h>")
- xprint("")
- xprint("typedef struct cblc_field_t")
- xprint(" {")
- xprint(" unsigned char *ref_data; // The runtime data. There is no null terminator")
- xprint(" char *name; // The null-terminated name of this variable")
- xprint(" char *picture; // The null-terminated picture string.")
- xprint(" char *initial; // The null_terminated initial value")
- xprint(" struct cblc_field_t *parent; // This field's immediate parent field")
- xprint(" struct cblc_field_t *depending_on;")
- xprint(" size_t offset; // Offset from our ancestor")
- xprint(" size_t occurs_lower; // non-zero for a table")
- xprint(" size_t occurs_upper; // non-zero for a table")
- xprint(" int ref_capacity; // The size of \"ref_data\"")
- xprint(" int type; // A copy of cbl_field_t.symbol_type_t")
- xprint(" int level; // This variable's level in the naming heirarchy")
- xprint(" int digits; // Digits specified in PIC string; e.g. 5 for 99v999")
- xprint(" int rdigits; // Digits to the right of the decimal point. 3 for 99v999")
- xprint(" int attr; // See cbl_field_attr_t")
- xprint(" } cblc_field_t;")
- xprint("")
-
- # Establish the initializer
- xprint("int initializer( cblc_field_t *field)")
- xprint(" {")
- xprint(" memset(field->ref_data, ' ', field->ref_capacity);");
- xprint(" memcpy(field->ref_data, field->initial, strlen(field->initial)+1);");
- xprint(" }")
- xprint("")
-
- # Establish the principal routine()
- xprint("int foo()")
- xprint(" {")
-
- for i in range(1, nlines+1):
- xprint(" static unsigned char data{:05d}[12];".format(i))
- xprint(" static struct cblc_field_t var{:05d} = {{data{:05d}, \"Name\", \"Picture\", \"Hi!\", NULL, NULL, 0, 0, 0, 12, 1, 1, 0, 0, 0 }};".format(i,i))
- xprint(" initializer(&var{:05d});".format(i))
-
- xprint("")
-
- for i in range(1, nlines+1):
- xprint(" printf(\"%-12.12s\\n\", var{:05d}.ref_data);" .format(i))
-
- xprint(" }")
- xprint("")
- xprint("int main(){foo();}")
- xprint("")
-
- fout.close();
+ global fout
+
+ # To make the generation of C similar to the generation of COBOL, we add 14
+ # variables to compensate for the COBOL boilerplate of
+ # counter 1 DEBUG-ITEM
+ # counter 2 DEBUG-LINE
+ # counter 3 FILLER
+ # counter 4 DEBUG-NAME
+ # counter 5 FILLER
+ # counter 6 DEBUG-SUB-1
+ # counter 7 FILLER
+ # counter 8 DEBUG-SUB-2
+ # counter 9 FILLER
+ # counter 10 DEBUG-SUB-3
+ # counter 11 FILLER
+ # counter 12 DEBUG-CONTENTS
+ # counter 13 _literaln_1 "1"
+ # counter 14 _literaln_2 "0"
+ nlines = int(sys.argv[1]) + 14
+
+ fout = open("ccc.c", "w")
+
+ xprint("#include <stdio.h>")
+ xprint("#include <stdlib.h>")
+ xprint("#include <string.h>")
+
+ # Establish the structure ")
+ xprint("typedef struct cblc_field_t ")
+ xprint(" { ")
+ xprint(" // This structure must match the code in structs.cc ")
+ xprint(" unsigned char *data; // The runtime data. There is no null terminator ")
+ xprint(" unsigned long capacity; // The size of data ")
+ xprint(" unsigned long allocated; // The number of bytes available for capacity ")
+ xprint(" unsigned long offset; // Offset from our ancestor (see note below) ")
+ xprint(" char *name; // The null-terminated name of this variable ")
+ xprint(" char *picture; // The null-terminated picture string. ")
+ xprint(" char *initial; // The null_terminated initial value ")
+ xprint(" struct cblc_field_t *parent; // This field's immediate parent field ")
+ xprint(" struct cblc_field_t *depending_on;// The subject of a DEPENDING ON clause ")
+ xprint(" struct cblc_field_t *depends_on; // Points downward in heirachy to the subordinate DEPENDING ON ")
+ xprint(" unsigned long occurs_lower; // non-zero for a table ")
+ xprint(" unsigned long occurs_upper; // non-zero for a table ")
+ xprint(" unsigned long attr; // See cbl_field_attr_t ")
+ xprint(" signed char type; // A one-byte copy of cbl_field_type_t ")
+ xprint(" signed char level; // This variable's level in the naming heirarchy ")
+ xprint(" signed char digits; // Digits specified in PIC string; e.g. 5 for 99v999 ")
+ xprint(" signed char rdigits; // Digits to the right of the decimal point. 3 for 99v999 ")
+ xprint(" int dummy; // Fills out to a four-byte boundary ")
+ xprint(" } cblc_field_t; ")
+
+ # Establish the initializer
+ xprint("unsigned long ")
+ xprint("__gg__initialize_variable(cblc_field_t *var_ref, ")
+ xprint(" int is_redefined, ")
+ xprint(" unsigned int nsubscripts, ")
+ xprint(" int explicitly) ")
+ xprint(" { ")
+ xprint("#if 1 ")
+ xprint(" // This code emulates the call GCOBOL has to make to libgcobol.so in order ")
+ xprint(" // to create and iniailize a variable ")
+ xprint(" // It is based on an environment variable, which means that the ")
+ xprint(" // C optimizer can't easily just wish it away. ")
+ xprint(" unsigned long retval; ")
+ xprint(" int n = atoi(getenv(\"banana\")); ")
+ xprint(" switch(n) ")
+ xprint(" { ")
+ xprint(" case 1: ")
+ xprint(" retval = (unsigned long)(&var_ref); ")
+ xprint(" break; ")
+ xprint(" case 2: ")
+ xprint(" retval = is_redefined; ")
+ xprint(" break; ")
+ xprint(" case 3: ")
+ xprint(" retval = nsubscripts; ")
+ xprint(" break; ")
+ xprint(" default: ")
+ xprint(" retval = explicitly; ")
+ xprint(" break; ")
+ xprint(" } ")
+ xprint("#endif ")
+ xprint(" } ")
+
+ # Establish the principal routine()
+ xprint("int nlines_c()")
+ xprint(" {")
+ xprint(" int i = atoi(getenv(\"banana\"));")
+
+ for i in range(1, nlines+1):
+ xprint(" static unsigned char vardata{:d}[4];".format(i))
+
+ for i in range(1, nlines+1):
+ xprint(" static cblc_field_t var{0:d} = {{vardata{0:d}, 4, 4, 0, \"var{0:d}\", 0, 0, 0, 0, 0, 0, 0, 0, 6, 77, 8, 4}};".format(i))
+
+ xprint(" unsigned long n = 0;")
+ xprint(" n += 0")
+
+ for i in range(1, nlines+1):
+ xprint(" + __gg__initialize_variable(&var{:d}, i?1:0, 3, i?4:5)".format(i))
+ xprint(" ;")
+ xprint(" return n")
+
+ for i in range(1, nlines+1):
+ xprint(" + (unsigned long)(&var{:d}) ".format(i))
+ xprint(" ;")
+ xprint(" }")
+
+ xprint("")
+ xprint("int main(){nlines_c();}")
+ xprint("")
+
+ fout.close();
cobol_code()
c_code()
diff --git a/gcc/cobol/ccc/node2dot b/gcc/cobol/ccc/node2dot
new file mode 100755
index 0000000000000000000000000000000000000000..48390a9045d8c59ec66efb9eac301d8241c95895
--- /dev/null
+++ b/gcc/cobol/ccc/node2dot
@@ -0,0 +1,48 @@
+#!/usr/bin/python3
+
+import sys
+
+def main():
+ if len(sys.argv) != 2:
+ print("Usage: single parameter is the .nodes filename")
+ sys.exit(1)
+
+ filename:str = sys.argv[1]
+ all_lines:list = open(filename).read().split("\n")
+
+ shape:str = "box"
+
+ print("digraph G")
+ print("{")
+
+ node_texts:dict = {}
+
+ node:int
+ daughter:int
+ for line in all_lines:
+ if line.find("***********************************") == 0:
+ node = int(line[53:])
+ continue
+ if line.find("tree_code:") == 0:
+ tokens:list = line.split()
+ node_text:str = 'N{0} [shape={1},label="N{0}\\n{2}"]'.format(node, shape, tokens[1])
+ node_texts[node] = node_text
+ print(node_text);
+
+ print("")
+
+ for line in all_lines:
+ if line.find("***********************************") == 0:
+ node = int(line[53:])
+ continue;
+ tokens:list = line.split()
+ if len(tokens) > 1:
+ if tokens[1].find("NodeNumber") >= 0:
+ daughter = int(tokens[1][10:])
+ if node != daughter:
+ print("N{0} -> N{1}".format(node, daughter))
+ continue
+
+ print("}")
+
+main()
\ No newline at end of file
diff --git a/gcc/cobol/nist/Makefile b/gcc/cobol/nist/Makefile
index 8c2429cb0d662985d2dd580005d5cdba580f35b5..751364fcf8d5958a8f12e7c0217d5ddfb7f6cafb 100644
--- a/gcc/cobol/nist/Makefile
+++ b/gcc/cobol/nist/Makefile
@@ -472,11 +472,13 @@ newcob.val: newcob.val.Z
cp .$^ $^
touch -r $@ $^
-URL = http://www.itl.nist.gov/div897/ctg/suites/newcob.val.Z
-newcob.val.Z:
-# The file from NIST doesn't exist, so we need to download it.
- wget -O $@~ $(URL) || cp -v $(HOME)/$@ $@~
- @mv $@~ $@
+### As of 2024-04-24, newcob.val.Z seems to be unfindable at nist.gov I have
+### added a copy to the git repository.
+#URL = http://www.itl.nist.gov/div897/ctg/suites/newcob.val.Z
+#newcob.val.Z:
+## The file from NIST doesn't exist, so we need to download it.
+# wget -O $@~ $(URL) || cp -v $(HOME)/$@ $@~
+# @mv $@~ $@
#
diff --git a/gcc/cobol/nist/newcob.val.Z b/gcc/cobol/nist/newcob.val.Z
new file mode 100644
index 0000000000000000000000000000000000000000..83cec83f5f2b74d84be14facd381846b1bdc959a
Binary files /dev/null and b/gcc/cobol/nist/newcob.val.Z differ