-
Notifications
You must be signed in to change notification settings - Fork 0
/
BITWISE.cob
143 lines (115 loc) · 4.27 KB
/
BITWISE.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
*=========================== BITWISE ============================*
* Authors: Brian D Pead
*
* Description: Subroutine to do bitwise operations on the
* specified fields.
*
* License: MIT
*
* Date Version Description
* ---- ------- -----------
* 2020-02-08 1.0 First release
*================================================================*
IDENTIFICATION DIVISION.
*========================
PROGRAM-ID. BITWISE.
ENVIRONMENT DIVISION.
*=====================
CONFIGURATION SECTION.
*----------------------
SOURCE-COMPUTER.
IBM-Z15.
* IBM-Z15 DEBUGGING MODE.
INPUT-OUTPUT SECTION.
*---------------------
FILE-CONTROL.
/
DATA DIVISION.
*==============
FILE SECTION.
*-------------
WORKING-STORAGE SECTION.
*------------------------
01 W-SUB PIC S9(04) COMP.
01 FILLER PIC X(01) VALUE 'Y'.
88 W-FIRST-CALL VALUE 'Y'.
88 W-NOT-FIRST-CALL VALUE 'N'.
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-SUB-1 PIC S9(04) COMP.
01 FILLER REDEFINES W-SUB-1.
05 FILLER PIC X(01) VALUE X'00'.
05 W-SUB-1-2 PIC X(01).
01 W-SUB-2 PIC S9(04) COMP.
01 FILLER REDEFINES W-SUB-2.
05 FILLER PIC X(01) VALUE X'00'.
05 W-SUB-2-2 PIC X(01).
COPY BITWISEW.
/
LINKAGE SECTION.
*----------------
01 L-PARAMETER. COPY BITWISEL.
01 L-INPUT-1 PIC 9(09) COMP.
01 FILLER REDEFINES L-INPUT-1.
05 L-IN1-BYTE PIC X(01) OCCURS 4.
01 L-INPUT-2 PIC 9(09) COMP.
01 FILLER REDEFINES L-INPUT-2.
05 L-IN2-BYTE PIC X(01) OCCURS 4.
01 L-OUTPUT PIC 9(09) COMP.
01 FILLER REDEFINES L-OUTPUT.
05 L-OUTPUT-BYTE PIC X(01) OCCURS 4.
/
PROCEDURE DIVISION USING L-PARAMETER.
*==================
MAIN.
*-----
PERFORM SUB-1000-START-UP THRU SUB-1000-EXIT
PERFORM SUB-2000-PROCESS THRU SUB-2000-EXIT
VARYING W-SUB FROM 1 BY 1
UNTIL W-SUB > BW-INPUT-LEN
.
MAIN-EXIT.
GOBACK.
/
SUB-1000-START-UP.
*------------------
SET ADDRESS OF L-INPUT-1
TO BW-INPUT-1-PTR
SET ADDRESS OF L-INPUT-2
TO BW-INPUT-2-PTR
SET ADDRESS OF L-OUTPUT
TO BW-OUTPUT-PTR
IF W-NOT-FIRST-CALL
GO TO SUB-1000-EXIT
END-IF
SET W-NOT-FIRST-CALL TO TRUE
MOVE FUNCTION WHEN-COMPILED
TO W-COMPILED-DATE
DISPLAY 'BITWISE 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
.
SUB-1000-EXIT.
EXIT.
/
SUB-2000-PROCESS.
*-----------------
MOVE L-IN1-BYTE(W-SUB) TO W-SUB-1-2
MOVE L-IN2-BYTE(W-SUB) TO W-SUB-2-2
MOVE W-BW-OP-VALUE(W-SUB-1 + 1, W-SUB-2 + 1)
(BW-OPERATION : 1)
TO L-OUTPUT-BYTE(W-SUB)
.
SUB-2000-EXIT.
EXIT.