-
Notifications
You must be signed in to change notification settings - Fork 0
/
TESTIO2.cob
217 lines (178 loc) · 6.71 KB
/
TESTIO2.cob
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
*========================== TESTIO2 =============================*
* Authors: Brian D Pead
*
* License: MIT
*
* Description: Test writing a variable length record
* sequential file. This shows that GnuCOBOL creates RDWs
* similar to the IBM mainframe (when COB_VARSEQ_FORMAT=0, the
* default), but the RDW record length does not include itself,
* i.e. it is 4 less than the mainframe.
*
* Environment name: COB_VARSEQ_FORMAT
* Parameter name: varseq_format
* Purpose: Declare format used for variable length
* sequential files
* - different types and lengths precede each
* record
* - length is the data length, does not
* include the prefix
* Type: 0 means 2 byte record length (big-endian) + 2 NULs
* 1 means 4 byte record length (big-endian)
* 2 means 4 byte record length (local machine int)
* 3 means 2 byte record length (big-endian)
* Default: 0
*
* Date Version Description
* ---- ------- -----------
* 2020-02-08 1.0 First release
*================================================================*
IDENTIFICATION DIVISION.
*========================
PROGRAM-ID. TESTIO2.
ENVIRONMENT DIVISION.
*=====================
CONFIGURATION SECTION.
*----------------------
SOURCE-COMPUTER.
IBM-Z15.
* IBM-Z15 DEBUGGING MODE.
INPUT-OUTPUT SECTION.
*---------------------
FILE-CONTROL.
SELECT TESTIO2O ASSIGN 'Data\TESTIO2.Output.bin'
ORGANIZATION SEQUENTIAL.
/
DATA DIVISION.
*==============
FILE SECTION.
*-------------
FD TESTIO2O
RECORD VARYING 25 TO 15000
DEPENDING W-RECLEN.
01 TESTIO2O-REC.
05 TO-CHAR PIC X OCCURS 25 TO 15000
DEPENDING W-RECLEN
INDEXED TO-DX.
WORKING-STORAGE SECTION.
*------------------------
01 W-TESTIO2O-RECS PIC 9(09) COMP VALUE 0.
01 W-RANDOM-NO PIC V9(09) COMP.
01 W-RECLEN PIC S9(09) COMP.
01 W-RECLEN-MIN PIC S9(09) COMP VALUE 25.
01 W-RECLEN-MAX PIC S9(09) COMP VALUE 15000.
01 W-OUTPUT-MIN PIC 9(09) COMP VALUE 999999999.
01 W-OUTPUT-MAX PIC 9(09) COMP VALUE 0.
01 W-QUOTIENT PIC 9(09) COMP.
01 W-REMAINDER PIC 9(09) COMP.
01 W-DISP-NUM PIC ZZ,ZZZ,ZZ9.
01 W-ERROR-MSG PIC X(21) VALUE
'**** TESTIO2 error: '.
01 W-COMPILED-DATE.
05 W-COMPILED-DATE-YYYY
PIC X(04).
05 W-COMPILED-DATE-MM PIC X(02).
05 W-COMPILED-DATE-DD PIC X(02).
05 W-COMPILED-TIME-HH PIC X(02).
05 W-COMPILED-TIME-MM PIC X(02).
05 W-COMPILED-TIME-SS PIC X(02).
05 FILLER PIC X(07).
01 W-CHAR-BIN PIC S9(04) COMP.
01 FILLER REDEFINES W-CHAR-BIN.
05 FILLER PIC X.
05 W-CHAR PIC X.
/
PROCEDURE DIVISION.
*===================
MAIN.
*-----
PERFORM SUB-1000-START-UP THRU SUB-1000-EXIT
PERFORM SUB-2000-PROCESS THRU SUB-2000-EXIT
UNTIL W-TESTIO2O-RECS >= 12345
PERFORM SUB-3000-SHUT-DOWN THRU SUB-3000-EXIT
.
MAIN-EXIT.
STOP RUN.
/
SUB-1000-START-UP.
*------------------
MOVE FUNCTION WHEN-COMPILED
TO W-COMPILED-DATE
DISPLAY 'TESTIO2 compiled on '
W-COMPILED-DATE-YYYY '/'
W-COMPILED-DATE-MM '/'
W-COMPILED-DATE-DD ' at '
W-COMPILED-TIME-HH ':'
W-COMPILED-TIME-MM ':'
W-COMPILED-TIME-SS
OPEN OUTPUT TESTIO2O
.
SUB-1000-EXIT.
EXIT.
/
SUB-2000-PROCESS.
*-----------------
MOVE FUNCTION RANDOM TO W-RANDOM-NO
COMPUTE W-RECLEN = W-RANDOM-NO
* (W-RECLEN-MAX
- W-RECLEN-MIN
+ 1)
+ W-RECLEN-MIN
* DISPLAY 'W-RECLEN = '
* W-RECLEN
IF W-RECLEN < W-OUTPUT-MIN
MOVE W-RECLEN TO W-OUTPUT-MIN
END-IF
IF W-RECLEN > W-OUTPUT-MAX
MOVE W-RECLEN TO W-OUTPUT-MAX
END-IF
PERFORM SUB-2100-POPULATE-REC THRU SUB-2100-EXIT
PERFORM SUB-9100-WRITE-TESTIO2O THRU SUB-9100-EXIT
.
SUB-2000-EXIT.
EXIT.
/
SUB-2100-POPULATE-REC.
*----------------------
COMPUTE W-CHAR-BIN = FUNCTION RANDOM * 256
PERFORM VARYING TO-DX FROM 1 BY 1
UNTIL TO-DX > W-RECLEN
MOVE W-CHAR TO TO-CHAR(TO-DX)
END-PERFORM
.
SUB-2100-EXIT.
EXIT.
/
SUB-3000-SHUT-DOWN.
*-------------------
CLOSE TESTIO2O
MOVE W-OUTPUT-MIN TO W-DISP-NUM
DISPLAY 'Shortest record length: '
W-DISP-NUM
MOVE W-OUTPUT-MAX TO W-DISP-NUM
DISPLAY 'Longest record length: '
W-DISP-NUM
MOVE W-TESTIO2O-RECS TO W-DISP-NUM
DISPLAY 'TESTIO2O records written: '
W-DISP-NUM
DISPLAY 'TESTIO2 completed'
.
SUB-3000-EXIT.
EXIT.
/
SUB-9100-WRITE-TESTIO2O.
*------------------------
WRITE TESTIO2O-REC
ADD 1 TO W-TESTIO2O-RECS
DIVIDE W-TESTIO2O-RECS BY 10000
GIVING W-QUOTIENT
REMAINDER W-REMAINDER
IF W-REMAINDER = 0
MOVE W-TESTIO2O-RECS
TO W-DISP-NUM
DISPLAY ' Records written: '
W-DISP-NUM
END-IF
.
SUB-9100-EXIT.
EXIT.