-
Notifications
You must be signed in to change notification settings - Fork 9
/
Copy pathcogs14a.mlc
165 lines (165 loc) · 6.67 KB
/
cogs14a.mlc
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
PRINT NOGEN
****************************************************************
* FILENAME: COGS14A.MLC *
* AUTHOR : Bill Qualls/z390 adaption by Anthony Delosa *
* SYSTEM : z390 v1703 *
* REMARKS : Create binary data file using COGS.DAT *
****************************************************************
START 0
YREGS
BEGIN SUBENTRY
WTO 'COGS14A ... Begin execution'
BAL R10,SETUP
MAIN EQU *
CLI EOFSW,C'Y'
BE EOJ
BAL R10,PROCESS
B MAIN
EOJ EQU *
BAL R10,WRAPUP
WTO 'COGS14A ... Normal end of program'
RETURN
****************************************************************
* SETUP - Those things which happen one time only, *
* before any records are processed. *
****************************************************************
SETUP EQU *
ST R10,SVSETUP
OPEN (INVENTRY,INPUT)
OPEN (BINARY,OUTPUT)
BAL R10,READ
L R10,SVSETUP
BR R10
****************************************************************
* PROCESS - Those things which happen once per record. *
****************************************************************
PROCESS EQU *
ST R10,SVPROC
BAL R10,FORMAT
BAL R10,WRITE
BAL R10,READ
L R10,SVPROC
BR R10
****************************************************************
* READ - Read a record. *
****************************************************************
READ EQU *
ST R10,SVREAD
GET INVENTRY,IREC Read a single product record
B READX
ATEND EQU *
MVI EOFSW,C'Y'
READX EQU *
L R10,SVREAD
BR R10
****************************************************************
* FORMAT - Format a single detail line. *
****************************************************************
FORMAT EQU *
ST R10,SVFORM
MVC ODESC,IDESC
PACK DBL,ICALIF Convert CALIF to binary
CVB R3,DBL
STH R3,OCALIF
PACK DBL,IILL Convert ILL to binary
CVB R3,DBL
STH R3,OILL
PACK DBL,IUTAH Convert UTAH to binary
CVB R3,DBL
STH R3,OUTAH
PACK DBL,IWISC Convert WISC to binary
CVB R3,DBL
STH R3,OWISC
PACK DBL,IBEGIN Convert BEGIN to binary
CVB R3,DBL
STH R3,OBEGIN
PACK DBL,IPURCH Convert PURCH to binary
CVB R3,DBL
STH R3,OPURCH
PACK DBL,IQOH Convert QOH to binary
CVB R3,DBL
STH R3,OQOH
PACK DBL,ICOST Convert COST to binary
CVB R3,DBL
STH R3,OCOST
PACK DBL,ISELL Convert SELL to binary
CVB R3,DBL
STH R3,OSELL
L R10,SVFORM
BR R10
****************************************************************
* WRITE - Write a single output record. *
****************************************************************
WRITE EQU *
ST R10,SVWRITE
PUT BINARY,OREC
AP #OUT,=P'1'
L R10,SVWRITE
BR R10
****************************************************************
* WRAPUP - Those things which happen one time only, *
* after all records have been processed. *
****************************************************************
WRAPUP EQU *
ST R10,SVWRAP
CLOSE INVENTRY
CLOSE BINARY
WTO 'COGS14A ... Binary file COGSBIN.DAT created.'
ED MSG#OUT,#OUT
WTO MF=(E,WTOBLOCK)
L R10,SVWRAP
BR R10
****************************************************************
* Literals, if any, will go here *
****************************************************************
LTORG
****************************************************************
* File definitions *
****************************************************************
INVENTRY DCB LRECL=39,RECFM=FT,MACRF=R,EODAD=ATEND, X
DDNAME=INVENTRY,RECORD=IREC
BINARY DCB LRECL=28,RECFM=F,MACRF=W, X
DDNAME=INVNTBIN
****************************************************************
* RETURN ADDRESSES *
****************************************************************
SVSETUP DC F'0' SETUP
SVPROC DC F'0' PROCESS
SVREAD DC F'0' READ
SVFORM DC F'0' FORMAT
SVWRITE DC F'0' WRITE
SVWRAP DC F'0' WRAPUP
****************************************************************
* Miscellaneous field definitions *
****************************************************************
EOFSW DC CL1'N' End of file? (Y/N)
#OUT DC PL2'0' Count of records written
DBL DC D'0' To convert packed to binary
COPY COGS
****************************************************************
* Output record definition *
****************************************************************
DS 0H Force halfword alignment
OREC DS 0CL28 1-28 Inventory record
ODESC DS CL10 1-10 Product description
OCALIF DS H 11-12 Units sold in Calif
OILL DS H 13-14 Units sold in Illinois
OUTAH DS H 15-16 Units sold in Utah
OWISC DS H 17-18 Units sold in Wisconsin
OBEGIN DS H 19-20 Beginning inventory
OPURCH DS H 21-22 Purchases throughout year
OQOH DS H 23-24 Actual quantity on hand
OCOST DS H 25-26 Cost (each) 99V99
OSELL DS H 27-28 Sell for (each) 99V99
****************************************************************
* Output message (count of records written) *
****************************************************************
DS 0H
WTOBLOCK EQU *
DC H'36'
DC H'0'
MSG DS 0CL32
DC CL11'COGS14A ...'
MSG#OUT DC XL4'40202120'
DC CL17' records written.'
END BEGIN