¿Creíais que esto estaba muerto? Bueno, teníais algo de razón... no quiero excusarme, solo diré que he andado muy pillado de tiempo, pero siempre hay una parte de mi que piensa "tengo que actualizar el blog, puñetas", así que, aquí estamos.
Vamos a terminar el proyectillo de SHA1 en COBOL, aunque ya sé que dije que iban a ser cuatro entradas...
¡Vamos allá!
Lo primero sería definir el funcionamiento técnico de SHA1, que a continuación os dejo.
- El programa solo funciona con texto ASCII, pasado en formato X(n).
- El texto (input) se convierte en bytes.
- Entonces, el texto se mueve a 16 "palabras" de 32 bits, siguiendo el algoritmo definido
- Mover 1 a la posición "n + 1", donde "n" es la longitud del texto.
- Mover 0 hasta la "palabra" nº 14
- Las "palabras" 15 y 16 son para colocar el valor hexadecimal de la longitud del texto original.
- Se amplía el dato a 80 "palabras" de 32 bytes. De la "palabra" 17 a la 80, se procede como sigue:
- W(t) = S^1(W(t-3) XOR W(t-8) XOR W(t-14) XOR W(t-16))
- Se calcula el output siguiendo el algoritmo
- TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t);
- E = D;
- D = C;
- C = S^30(B);
- B = A;
- A = TEMP;
- Finalmente, se recalculan los registros "H":
- H0 = H0 + A
- H1 = H1 + B
- H2 = H2 + C
- H3 = H3 + D
- H4 = H4 + E
- El mensaje final es la concatenación de las cinco "H".
Ahora mismo, estaréis intentando digerir (chistaco) toda esta info... os intento ayudar
- Los registros "H" son cinco registros predefinidos, con los siguientes valores
- 01100111010001010010001100000001
- 11101111110011011010101110001001
- 10011000101110101101110011111110
- 00010000001100100101010001110110
- 11000011110100101110000111110000
- K(t) son unos valores, que dependiendo del valor de "t" obtienen el siguiente valor
- 01011010100000100111100110011001
- 01101110110110011110101110100001
- 10001111000110111011110011011100
- 11001010011000101100000111010110
- f(t) se refiere a una serie de funciones, que varían en función de "t"
- f(t;B,C,D) = (B AND C) OR ((NOT B) AND D)
- f(t;B,C,D) = B XOR C XOR D
- f(t;B,C,D) = (B AND C) OR (B AND D) OR (C AND D)
- f(t;B,C,D) = B XOR C XOR D
- W(t) se refiere a la "palabra" referenciada por "t".
- A, B, C, D, E, y TEMP son seis registros de 32 bytes.
Y finalmente, os dejo aquí el código (que es bastante gigantesco), así como un enlace a su ubicación final.
Get Raw
0001 *****************************************************************
0002 * Secure Hash Algorithm - 1 (SHA1) COBOL Implementation. *
0003 * *
0004 * This code was written by David O. Solé González (aka DoHITB). *
0005 * *
0006 * The implementation was made following rfc3174 official text. *
0007 * You can find the mentioned rfc on the Internet for free, on *
0008 * http://www.ietf.org/rfc/rfc3174.txt *
0009 * *
0010 * For any comment, suggestion or similar, you can reach me via *
0011 * mail on "doscar.sole@gmail.com" *
0012 * *
0013 * General lines and commentaries: *
0014 * - This programs only works on ASCII data passed as X(n). *
0015 * *
0016 * - Once the input arrived, its transofmed into bytes. *
0017 * *
0018 * - Then, the data is padded to 16 32-bit word, following *
0019 * the rfc algorithm: *
0020 * * Add 1 on position n + 1 where n is the length of *
0021 * the original string. *
0022 * *
0023 * * Fill with 0's until #14 word. *
0024 * *
0025 * * Words #15 and #16 are for putting the HEX value *
0026 * of the original length. In our case, as the *
0027 * original input is limited to 256, #15 word will *
0028 * be always 0's, and also the first half of #16. *
0029 * *
0030 * - After padding, the data is being amplied to 80 32-bytes *
0031 * words. Each word from #17 to #80 is filled according to *
0032 * the rfc: *
0033 * * W(t) = S^1(W(t-3) XOR W(t-8) *
0034 * XOR W(t-14) XOR W(t-16)) *
0035 * *
0036 * - Finally, the output is calculated, according to rfc: *
0037 * * TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t); *
0038 * E = D; D = C; C = S^30(B); B = A; A = TEMP; *
0039 * *
0040 * - After all this process, we rearrange the H's data: *
0041 * * H0 = H0 + A *
0042 * * H1 = H1 + B *
0043 * * H2 = H2 + C *
0044 * * H3 = H3 + D *
0045 * * H4 = H4 + E *
0046 * *
0047 * - The concatenation of all H's is the message digest. *
0048 *****************************************************************
0049 ID DIVISION.
0050 PROGRAM-ID. SHA1HEX.
0052 DATA DIVISION.
0053 WORKING-STORAGE SECTION.
0054 01 WS-I PIC 9(3).
0055 01 WS-STM PIC 9(8).
0056 01 WS-ETM PIC 9(8).
0058 *Max length of block
0059 77 CNS-BLOCK-L PIC 9(03) VALUE 512.
0061 *Max length of the padding (512 - 16 - 1)
0062 77 CNS-BLOCK-T PIC 9(03) VALUE 496.
0063
0064 *Max length of processing blocks
0065 77 CNS-PROCESSING-MAX PIC 9(02) VALUE 80.
0067 *Max length of HEX2BIN table
0068 77 CNS-HEX2BIN-MAX PIC 9(02) VALUE 16.
0069
0070 *Max length of DEC2HEX table
0071 77 CNS-DEC2HEX-MAX PIC 9(03) VALUE 256.
0072
0073 *Max length of XOR input
0074 77 CNS-XOR-MAX PIC 9(02) VALUE 32.
0075
0076 *Max length of NOT input
0077 77 CNS-NOT-MAX PIC 9(02) VALUE 32.
0078
0079 *Max length of AND input
0080 77 CNS-AND-MAX PIC 9(02) VALUE 32.
0081
0082 *Max length of OR input
0083 77 CNS-OR-MAX PIC 9(02) VALUE 32.
0084
0085 *Max length of SUM input
0086 77 CNS-SUM-MAX PIC 9(02) VALUE 32.
0087
0088 *Max length of SL input
0089 77 CNS-SL-MAX PIC 9(02) VALUE 32.
0090
0091 *Max length of H's HEX chars
0092 77 CNS-HS-MAX PIC 9(01) VALUE 8.
0093
0094 *Original length of padding
0095 77 CNS-PADDING-ORI-LENGTH PIC 9(03) VALUE ZEROES.
0096
0097 *K's (Already in binary)
0098 77 CNS-K0 PIC X(32)
0099 VALUE '01011010100000100111100110011001'.
0100 77 CNS-K1 PIC X(32)
0101 VALUE '01101110110110011110101110100001'.
0102 77 CNS-K2 PIC X(32)
0103 VALUE '10001111000110111011110011011100'.
0104 77 CNS-K3 PIC X(32)
0105 VALUE '11001010011000101100000111010110'.
0107 * Hex calculation
0108 77 CNS-B1 PIC 9(01) VALUE 1.
0109 77 CNS-B2 PIC 9(02) VALUE 2.
0110 77 CNS-B3 PIC 9(02) VALUE 4.
0111 77 CNS-B4 PIC 9(02) VALUE 8.
0112
0113 01 WS-VAR.
0114 * Input text length
0115 05 WS-TEXT-INDEX PIC 9(03) VALUE ZEROES.
0116 05 WS-TEXT-LENGTH PIC 9(03) VALUE ZEROES.
0117 05 WS-TEXT-ASCII-LEN PIC 9(03) VALUE ZEROES.
0119 * Input text
0120 05 WS-RAW-TEXT PIC X(256) VALUE SPACES.
0121 05 WS-RAW-CHAR REDEFINES WS-RAW-TEXT
0122 OCCURS 256 PIC X(01).
0123 05 CHAR-BLOCK.
0124 10 FILLER PIC X(01).
0125 10 CHAR PIC X(01).
0126 05 HEX-CHAR REDEFINES CHAR-BLOCK
0127 PIC 9(04) BINARY.
0128 05 NUM-CHAR PIC 9(03).
0129
0130 * Calculation vars
0131 05 WS-HEX-VAL-1 PIC 9(02).
0132 05 WS-HEX-VAL-2 PIC 9(02).
0133 05 WS-BIN-BYTE-FULL.
0134 10 WS-BIN-BYTE OCCURS 4 PIC 9(01).
0135 05 WS-WORD-BYTE-FULL-1.
0136 10 WS-WORD-BYTE-1 OCCURS 8 PIC X(04).
0137 05 WS-WORD-BYTE-FULL-2.
0138 10 WS-WORD-BYTE-2 OCCURS 8 PIC X(04).
0139 05 WS-HEX-TABLE-KEY OCCURS 2 PIC X(02).
0140
0141 * Text
0142 05 WS-TEXT PIC X(512) VALUE SPACES.
0143 05 WS-TEXT-HEX REDEFINES WS-TEXT
0144 OCCURS 512 PIC X(01).
0145 05 WS-TEXT-PAIR REDEFINES WS-TEXT
0146 OCCURS 256 PIC X(02).
0147
0148 * Padding data
0149 05 WS-PADDING-LENGTH PIC 9(03) VALUE ZEROES.
0150 05 WS-PADDING-INDEX PIC 9(03) VALUE ZEROES.
0151 05 WS-PADDING-TEXT PIC X(512) VALUE SPACES.
0152 05 WS-PADDING-BIT REDEFINES WS-PADDING-TEXT
0153 OCCURS 512 PIC X(01).
0154 05 WS-PADDING-HEX REDEFINES WS-PADDING-TEXT
0155 OCCURS 128 PIC X(04).
0156 05 WS-PADDING-FULL REDEFINES WS-PADDING-TEXT
0157 OCCURS 64 PIC X(08).
0158 05 WS-PADDING-WORD REDEFINES WS-PADDING-TEXT
0159 OCCURS 16 PIC X(32).
0160
0161 * Processing data
0162 05 WS-PROCESSING-INDEX PIC 9(04) VALUE ZEROES.
0163 05 WS-PROCESSING PIC X(2560).
0164 05 WS-PROCESSING-WORD REDEFINES WS-PROCESSING
0165 OCCURS 80 PIC X(32).
0166
0167 * Temporary values to make the process
0168 05 WS-A PIC X(32) VALUE SPACES.
0169 05 WS-B PIC X(32) VALUE SPACES.
0170 05 WS-C PIC X(32) VALUE SPACES.
0171 05 WS-D PIC X(32) VALUE SPACES.
0172 05 WS-E PIC X(32) VALUE SPACES.
0173 05 WS-T PIC X(32) VALUE SPACES.
0174
0175 * Temporal indexes for logical operations
0176 05 WS-XOR-INDEX-1 PIC 9(02) VALUE ZEROES.
0177 05 WS-XOR-INDEX-2 PIC 9(02) VALUE ZEROES.
0178 05 WS-XOR-INDEX PIC 9(02) VALUE ZEROES.
0179 05 WS-NOT-INDEX PIC 9(02) VALUE ZEROES.
0180 05 WS-AND-INDEX PIC 9(02) VALUE ZEROES.
0181 05 WS-OR-INDEX PIC 9(02) VALUE ZEROES.
0182 05 WS-SUM-INDEX PIC 9(02) VALUE ZEROES.
0183 05 WS-SL-INDEX-1 PIC 9(02) VALUE ZEROES.
0184 05 WS-SL-INDEX-2 PIC 9(02) VALUE ZEROES.
0185
0186 * XOR keys & values
0187 05 WS-XOR-KEY-1 PIC X(32) VALUE SPACES.
0188 05 WS-XOR-KEY-1-X REDEFINES WS-XOR-KEY-1
0189 OCCURS 32 PIC 9(01).
0190 05 WS-XOR-KEY-2 PIC X(32) VALUE SPACES.
0191 05 WS-XOR-KEY-2-X REDEFINES WS-XOR-KEY-2
0192 OCCURS 32 PIC 9(01).
0193 05 WS-XOR-RESULT PIC X(32) VALUE SPACES.
0194 05 WS-XOR-RESULT-X REDEFINES WS-XOR-RESULT
0195 OCCURS 32 PIC X(01).
0196
0197 * NOT keys & values
0198 05 WS-NOT-KEY PIC X(32) VALUE SPACES.
0199 05 WS-NOT-KEY-X REDEFINES WS-NOT-KEY
0200 OCCURS 32 PIC X(01).
0201 05 WS-NOT-RESULT PIC X(32) VALUE SPACES.
0202 05 WS-NOT-RESULT-X REDEFINES WS-NOT-RESULT
0203 OCCURS 32 PIC X(01).
0204
0205 * OR keys & values
0206 05 WS-OR-KEY-1 PIC X(32) VALUE SPACES.
0207 05 WS-OR-KEY-1-X REDEFINES WS-OR-KEY-1
0208 OCCURS 32 PIC 9(01).
0209 05 WS-OR-KEY-2 PIC X(32) VALUE SPACES.
0210 05 WS-OR-KEY-2-X REDEFINES WS-OR-KEY-2
0211 OCCURS 32 PIC 9(01).
0212 05 WS-OR-RESULT PIC X(32) VALUE SPACES.
0213 05 WS-OR-RESULT-X REDEFINES WS-OR-RESULT
0214 OCCURS 32 PIC X(01).
0215
0216 * AND keys & values
0217 05 WS-AND-KEY-1 PIC X(32) VALUE SPACES.
0218 05 WS-AND-KEY-1-X REDEFINES WS-AND-KEY-1
0219 OCCURS 32 PIC 9(01).
0220 05 WS-AND-KEY-2 PIC X(32) VALUE SPACES.
0221 05 WS-AND-KEY-2-X REDEFINES WS-AND-KEY-2
0222 OCCURS 32 PIC 9(01).
0223 05 WS-AND-RESULT PIC X(32) VALUE SPACES.
0224 05 WS-AND-RESULT-X REDEFINES WS-AND-RESULT
0225 OCCURS 32 PIC X(01).
0226 05 WS-AND-RESULT-1 PIC X(32) VALUE SPACES.
0227 05 WS-AND-RESULT-2 PIC X(32) VALUE SPACES.
0228 05 WS-AND-RESULT-3 PIC X(32) VALUE SPACES.
0229
0230 * SUM keys & values
0231 05 WS-SUM-KEY-1 PIC X(32) VALUE SPACES.
0232 05 WS-SUM-KEY-1-X REDEFINES WS-SUM-KEY-1
0233 OCCURS 32 PIC 9(01).
0234 05 WS-SUM-KEY-2 PIC X(32) VALUE SPACES.
0235 05 WS-SUM-KEY-2-X REDEFINES WS-SUM-KEY-2
0236 OCCURS 32 PIC 9(01).
0237 05 WS-SUM-RESULT PIC X(32) VALUE SPACES.
0238 05 WS-SUM-RESULT-X REDEFINES WS-SUM-RESULT
0239 OCCURS 32 PIC X(01).
0240
0241 * S^l keys & values
0242 05 WS-SL-KEY PIC X(32) VALUE SPACES.
0243 05 WS-SL-KEY-X REDEFINES WS-SL-KEY
0244 OCCURS 32 PIC X(01).
0245 05 WS-SL-RESULT PIC X(32) VALUE SPACES.
0246 05 WS-SL-RESULT-X REDEFINES WS-SL-RESULT
0247 OCCURS 32 PIC X(01).
0248
0249 * Indexes for functions
0250 05 WS-MAIN-INDEX PIC 9(02) VALUE ZEROES.
0251 05 WS-HS-INDEX PIC 9(01) VALUE ZEROES.
0252
0253 * Function-Fn results
0254 05 WS-FN-RESULT PIC X(32) VALUE SPACES.
0255
0256 * Display variable
0257 05 WS-DISPLAY PIC X(40) VALUE SPACES.
0258 05 WS-DISPLAY-X REDEFINES WS-DISPLAY
0259 OCCURS 40 PIC X(01).
0261 01 WS-HS-TABLE.
0262 * H's (already in binary)
0263 05 WS-HS.
0264 10 WS-H0 PIC X(32)
0265 VALUE '01100111010001010010001100000001'.
0266 10 WS-H0-FULL REDEFINES WS-H0
0267 OCCURS 8 PIC X(04).
0268 10 WS-H1 PIC X(32)
0269 VALUE '11101111110011011010101110001001'.
0270 10 WS-H1-FULL REDEFINES WS-H1
0271 OCCURS 8 PIC X(04).
0272 10 WS-H2 PIC X(32)
0273 VALUE '10011000101110101101110011111110'.
0274 10 WS-H2-FULL REDEFINES WS-H2
0275 OCCURS 8 PIC X(04).
0276 10 WS-H3 PIC X(32)
0277 VALUE '00010000001100100101010001110110'.
0278 10 WS-H3-FULL REDEFINES WS-H3
0279 OCCURS 8 PIC X(04).
0280 10 WS-H4 PIC X(32)
0281 VALUE '11000011110100101110000111110000'.
0282 10 WS-H4-FULL REDEFINES WS-H4
0283 OCCURS 8 PIC X(04).
0284
0285 01 WS-TABLE.
0286 * HEX2BIN
0287 05 WS-HEX2BIN-INDEX PIC 9(02) VALUE ZEROES.
0288 05 WS-HEX-KEY PIC X(01) VALUE SPACES.
0289 05 WS-BIN-KEY PIC X(04) VALUE SPACES.
0290 05 WS-HEX2BIN OCCURS 16.
0291 10 WS-HEX PIC X(01) VALUE SPACES.
0292 10 WS-BIN PIC X(04) VALUE SPACES.
0293
0294 * DEC2HEX
0295 05 WS-DEC2HEX-INDEX PIC 9(03) VALUE ZEROES.
0296 05 WS-HEXX-KEY PIC X(02) VALUE SPACES.
0297 05 WS-DEC-KEY PIC X(03) VALUE SPACES.
0298 05 WS-DEC2HEX OCCURS 256.
0299 10 WS-DEC PIC X(03) VALUE SPACES.
0300 10 WS-HEXX PIC X(02) VALUE SPACES.
0301
0302 * K's TABLE (READONLY)
0303 05 WS-KS OCCURS 80.
0304 10 WS-KS-VAL PIC X(32) VALUE SPACES.
0305
0306 * Text table
0307 05 WS-ENTRY-TABLE OCCURS 256.
0308 10 ENTRY-ASCII PIC X(01) VALUE SPACES.
0309 10 ENTRY-HEX.
0310 15 ENTRY-HEX-1 PIC X(01) VALUE SPACES.
0311 15 ENTRY-HEX-2 PIC X(01) VALUE SPACES.
0312 10 ENTRY-DEC PIC 9(03) VALUE ZEROES.
0313 10 ENTRY-BIN.
0314 15 ENTRY-BIN-1 PIC X(04) VALUE SPACES.
0315 15 ENTRY-BIN-2 PIC X(04) VALUE SPACES.
0317 * Switches
0318 01 WS-SWITCH.
0319 05 SW-XOR PIC 9(01) VALUE ZEROES.
0320 88 SW-XOR-FALSE VALUE 0, 2.
0321 88 SW-XOR-TRUE VALUE 1.
0322 05 SW-AND PIC 9(01) VALUE ZEROES.
0323 88 SW-AND-FALSE VALUE 0, 1.
0324 88 SW-AND-TRUE VALUE 2.
0325 05 SW-OR PIC 9(01) VALUE ZEROES.
0326 88 SW-OR-FALSE VALUE 0.
0327 88 SW-OR-TRUE VALUE 1, 2.
0328 05 SW-SUM PIC 9(01) VALUE ZEROES.
0329 88 SW-ZERO VALUE 0.
0330 88 SW-ONE VALUE 1.
0331 88 SW-ACC-OFF VALUE 0, 1.
0332 88 SW-ACC-ON VALUE 2, 3.
0333 05 SW-ACC PIC 9(01) VALUE ZEROES.
0334 88 SW-ACC-TRUE VALUE 1.
0335 88 SW-ACC-FALSE VALUE ZEROES.
0337 LINKAGE SECTION.
0338 01 LS-SECTION.
0339 05 LS-HEX-TEXT PIC X(512).
0340 05 LS-HEX-LENGTH PIC 9(003).
0341
0342 PROCEDURE DIVISION USING LS-SECTION.
0343 MAINLINE.
0344 *****************************************************************
0345 * P A D D I N G S E C T I O N I N I *
0346 *****************************************************************
0347 INITIALIZE WS-VAR.
0348
0349 DISPLAY 'SHA-1 Prototype - Made By DoHITB'.
0350 DISPLAY SPACE.
0351
0352 PERFORM FILL-TABLES.
0353
0354 * Move linkage var to "official" var
0355 MOVE LS-HEX-TEXT TO WS-RAW-TEXT.
0356 MOVE LS-HEX-LENGTH TO WS-TEXT-LENGTH
0357 WS-TEXT-ASCII-LEN.
0358
0359 * Transform ASCII into HEX
0360 *
0361 * The "SUBTRACT" is a kind of bug, when converting it gives
0362 * the collate sequence - 192, so I adjusted it.
0363 * - Update: it's because COBOL works with EDIBDC, so making
0364 * the SUBTRACT will adapt it to ASCII collating sequence.
0365 *
0366 PERFORM VARYING WS-TEXT-INDEX FROM 1 BY 1 UNTIL
0367 WS-TEXT-INDEX > WS-TEXT-LENGTH
0368 MOVE WS-RAW-CHAR(WS-TEXT-INDEX)
0369 TO CHAR
0370 MOVE HEX-CHAR TO NUM-CHAR
0371 SUBTRACT 192 FROM NUM-CHAR
0372
0373 * Get HEX value from ASCII char
0374 MOVE NUM-CHAR TO WS-DEC-KEY
0375
0376 PERFORM DEC2HEX
0377
0378 MOVE WS-HEXX-KEY TO WS-TEXT-PAIR(WS-TEXT-INDEX)
0379
0380 * Get BIN value from HEX char
0381 DIVIDE 16 INTO NUM-CHAR
0382 GIVING WS-HEX-VAL-1
0383 REMAINDER WS-HEX-VAL-2
0384
0385 * Move data to internal table
0386 MOVE CHAR TO ENTRY-ASCII(WS-TEXT-INDEX)
0387 MOVE NUM-CHAR TO ENTRY-DEC(WS-TEXT-INDEX)
0388 MOVE WS-HEX-VAL-1 TO WS-HEX2BIN-INDEX
0389
0390 PERFORM BINVALUE
0391
0392 MOVE WS-HEX-VAL-1 TO WS-HEX2BIN-INDEX
0393
0394 PERFORM HEXVALUE
0395
0396 MOVE WS-BIN-KEY TO ENTRY-BIN-1(WS-TEXT-INDEX)
0397 MOVE WS-HEX-KEY TO ENTRY-HEX-1(WS-TEXT-INDEX)
0398 MOVE WS-HEX-VAL-2 TO WS-HEX2BIN-INDEX
0399
0400 PERFORM BINVALUE
0401
0402 MOVE WS-HEX-VAL-2 TO WS-HEX2BIN-INDEX
0403
0404 PERFORM HEXVALUE
0405
0406 MOVE WS-BIN-KEY TO ENTRY-BIN-2(WS-TEXT-INDEX)
0407 MOVE WS-HEX-KEY TO ENTRY-HEX-2(WS-TEXT-INDEX)
0408 END-PERFORM.
0409
0410 * Duplicate the value of length, because every char is 2-hex long.
0411 ADD WS-TEXT-LENGTH TO WS-TEXT-LENGTH.
0412
0413 PERFORM INPUT-TO-PADDING.
0414
0415 * Store original length for futher actions
0416 MOVE WS-PADDING-LENGTH TO CNS-PADDING-ORI-LENGTH
0418 * We need to start from the next char
0419 ADD 1 TO WS-PADDING-LENGTH.
0421 * Now we move a "1" after padding
0422 MOVE '1' TO WS-PADDING-BIT(WS-PADDING-LENGTH).
0424 * We need to start from the next char
0425 ADD 1 TO WS-PADDING-LENGTH.
0427 PERFORM VARYING WS-PADDING-INDEX FROM WS-PADDING-LENGTH BY 1
0428 UNTIL WS-PADDING-INDEX > CNS-BLOCK-T
0429 MOVE '0' TO WS-PADDING-BIT(WS-PADDING-INDEX)
0430 END-PERFORM.
0431
0432 * At this point, we only need to calculate the final blocks.
0433 * As we are working with a MAXLEN of 256, the first block
0434 * will be '00000000'. But I will fill it out of the main
0435 * proc. just for the future, in case I make it accept more
0436 * than 256-MAXLEN.
0437 *
0438 MOVE ALL ZEROES TO WS-PADDING-WORD(15)
0439 WS-PADDING-WORD(16).
0440
0441 * Transform CNS-PADDING-ORI-LENGTH to HEX(02).
0442 *
0443 DIVIDE 16 INTO CNS-PADDING-ORI-LENGTH
0444 GIVING WS-HEX-VAL-1
0445 REMAINDER WS-HEX-VAL-2 .
0446
0447 * Now, transform that HEX into BIN
0448 *
0449 MOVE WS-HEX-VAL-1 TO WS-HEX2BIN-INDEX.
0450
0451 PERFORM BINVALUE.
0452
0453 MOVE WS-BIN-KEY TO WS-PADDING-HEX(127).
0454 MOVE WS-HEX-VAL-2 TO WS-HEX2BIN-INDEX.
0455
0456 PERFORM BINVALUE.
0457
0458 MOVE WS-BIN-KEY TO WS-PADDING-HEX(128).
0459
0460 * At this point, the padding is done
0461 *****************************************************************
0462 * P A D D I N G S E C T I O N E N D *
0463 *****************************************************************
0464 * P R O C E S S S E C T I O N I N I *
0465 *****************************************************************
0466 * F I L L I N G S E C T I O N I N I *
0467 *****************************************************************
0468 * Once the padding is done, we need to fill a 80 * 8 structure
0469 * Fist, move the padding to filling
0470 *
0471 MOVE WS-PADDING-TEXT TO WS-PROCESSING.
0472
0473 * Now, as rfc3174 specifies, we proceed like this:
0474 * For t = 16 to 79 let
0475 * W(t) = S^1(W(t-3) XOR W(t-8) XOR W(t-14) XOR W(t-16))
0476 *
0477 PERFORM VARYING WS-PROCESSING-INDEX FROM 17 BY 1
0478 UNTIL WS-PROCESSING-INDEX > CNS-PROCESSING-MAX
0479 * W(t - 3) XOR W(t - 8) = W'
0480 MOVE WS-PROCESSING-INDEX TO WS-XOR-INDEX-1
0481 WS-XOR-INDEX-2
0482
0483 SUBTRACT 3 FROM WS-XOR-INDEX-1
0484 SUBTRACT 8 FROM WS-XOR-INDEX-2
0485
0486 MOVE WS-PROCESSING-WORD(WS-XOR-INDEX-1)
0487 TO WS-XOR-KEY-1
0488 MOVE WS-PROCESSING-WORD(WS-XOR-INDEX-2)
0489 TO WS-XOR-KEY-2
0490
0491 PERFORM XOR
0492
0493 * W' XOR W(t - 14) = W''
0494 MOVE 0 TO WS-XOR-INDEX-1
0495
0496 * XOR-INDEX-2 is -8, so only -6 needed to become -14
0497 SUBTRACT 6 FROM WS-XOR-INDEX-2
0498
0499 MOVE WS-XOR-RESULT TO WS-XOR-KEY-1
0500 MOVE WS-PROCESSING-WORD(WS-XOR-INDEX-2)
0501 TO WS-XOR-KEY-2
0502
0503 PERFORM XOR
0504
0505 * W'' XOR W(t - 16) = W'''
0506 * XOR-INDEX-2 is -14, so only -2 needed to become -16
0507 SUBTRACT 2 FROM WS-XOR-INDEX-2
0508
0509 MOVE WS-XOR-RESULT TO WS-XOR-KEY-1
0510 MOVE WS-PROCESSING-WORD(WS-XOR-INDEX-2)
0511 TO WS-XOR-KEY-2
0512
0513 PERFORM XOR
0514
0515 * S^1(W''')
0516 MOVE WS-XOR-RESULT TO WS-SL-KEY
0517
0518 PERFORM LEFT-SHIFT
0519
0520 MOVE WS-SL-RESULT TO WS-PROCESSING-WORD
0521 (WS-PROCESSING-INDEX)
0522 END-PERFORM.
0523
0524 * At this point, we have a 80 word matrix ready to parse
0525 *****************************************************************
0526 * F I L L I N G S E C T I O N E N D *
0527 *****************************************************************
0528 * F U N C T I O N S S E C T I O N I N I *
0529 *****************************************************************
0530 * From rfc3174:
0531 * Let A = H0, B = H1, C = H2, D = H3, E = H4
0532 *
0533 MOVE WS-H0 TO WS-A.
0534 MOVE WS-H1 TO WS-B.
0535 MOVE WS-H2 TO WS-C.
0536 MOVE WS-H3 TO WS-D.
0537 MOVE WS-H4 TO WS-E.
0538 MOVE SPACES TO WS-T.
0539
0540 * From rfc3174:
0541 * For t = 0 to 79 do
0542 * TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t);
0543 * E = D; D = C; C = S^30(B); B = A; A = TEMP;
0544 *
0545 * I will do it in four loops, so I can optimize the function
0546 * to choose without making a EVALUATE function that will
0547 * trigger 80 times.
0548 *
0549 MOVE 1 TO WS-MAIN-INDEX.
0550
0551 PERFORM 20 TIMES
0552 * S^5(A)
0553 MOVE WS-A TO WS-SL-KEY
0554
0555 PERFORM 5 TIMES
0556 PERFORM LEFT-SHIFT
0557
0558 MOVE WS-SL-RESULT TO WS-SL-KEY
0559 END-PERFORM
0560
0561 * f(t;B,C,D)
0562 PERFORM FUNCTION-F1
0563
0564 * TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t);
0565 PERFORM FUNCTION-SUM
0566
0567 * E = D; D = C; C = S^30(B); B = A; A = TEMP;
0568 MOVE WS-D TO WS-E
0569 MOVE WS-C TO WS-D
0570
0571 MOVE WS-B TO WS-SL-KEY
0572
0573 * S^30(B)
0574 PERFORM 30 TIMES
0575 PERFORM LEFT-SHIFT
0576
0577 MOVE WS-SL-RESULT TO WS-SL-KEY
0578 END-PERFORM
0579
0580 MOVE WS-SL-RESULT TO WS-C
0581 MOVE WS-A TO WS-B
0582 MOVE WS-T TO WS-A
0583
0584 ADD 1 TO WS-MAIN-INDEX
0585 END-PERFORM.
0586
0587 PERFORM 20 TIMES
0588 * S^5(A)
0589 MOVE WS-A TO WS-SL-KEY
0590
0591 PERFORM 5 TIMES
0592 PERFORM LEFT-SHIFT
0593
0594 MOVE WS-SL-RESULT TO WS-SL-KEY
0595 END-PERFORM
0596
0597 * f(t;B,C,D)
0598 PERFORM FUNCTION-F2
0599
0600 * TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t);
0601 PERFORM FUNCTION-SUM
0602
0603 * E = D; D = C; C = S^30(B); B = A; A = TEMP;
0604 MOVE WS-D TO WS-E
0605 MOVE WS-C TO WS-D
0606
0607 MOVE WS-B TO WS-SL-KEY
0608
0609 * S^30(B)
0610 PERFORM 30 TIMES
0611 PERFORM LEFT-SHIFT
0612
0613 MOVE WS-SL-RESULT TO WS-SL-KEY
0614 END-PERFORM
0615
0616 MOVE WS-SL-RESULT TO WS-C
0617 MOVE WS-A TO WS-B
0618 MOVE WS-T TO WS-A
0619
0620 ADD 1 TO WS-MAIN-INDEX
0621 END-PERFORM.
0622
0623 PERFORM 20 TIMES
0624 * S^5(A)
0625 MOVE WS-A TO WS-SL-KEY
0626
0627 PERFORM 5 TIMES
0628 PERFORM LEFT-SHIFT
0629
0630 MOVE WS-SL-RESULT TO WS-SL-KEY
0631 END-PERFORM
0632
0633 * f(t;B,C,D)
0634 PERFORM FUNCTION-F3
0635
0636 * TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t);
0637 PERFORM FUNCTION-SUM
0638
0639 * E = D; D = C; C = S^30(B); B = A; A = TEMP;
0640 MOVE WS-D TO WS-E
0641 MOVE WS-C TO WS-D
0642
0643 MOVE WS-B TO WS-SL-KEY
0644
0645 * S^30(B)
0646 PERFORM 30 TIMES
0647 PERFORM LEFT-SHIFT
0648
0649 MOVE WS-SL-RESULT TO WS-SL-KEY
0650 END-PERFORM
0651
0652 MOVE WS-SL-RESULT TO WS-C
0653 MOVE WS-A TO WS-B
0654 MOVE WS-T TO WS-A
0655
0656 ADD 1 TO WS-MAIN-INDEX
0657 END-PERFORM.
0658
0659 PERFORM 20 TIMES
0660 * S^5(A)
0661 MOVE WS-A TO WS-SL-KEY
0662
0663 PERFORM 5 TIMES
0664 PERFORM LEFT-SHIFT
0665
0666 MOVE WS-SL-RESULT TO WS-SL-KEY
0667 END-PERFORM
0668
0669 * f(t;B,C,D)
0670 PERFORM FUNCTION-F4
0671
0672 * TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t);
0673 PERFORM FUNCTION-SUM
0674
0675 * E = D; D = C; C = S^30(B); B = A; A = TEMP;
0676 MOVE WS-D TO WS-E
0677 MOVE WS-C TO WS-D
0678
0679 MOVE WS-B TO WS-SL-KEY
0680
0681 * S^30(B)
0682 PERFORM 30 TIMES
0683 PERFORM LEFT-SHIFT
0684
0685 MOVE WS-SL-RESULT TO WS-SL-KEY
0686 END-PERFORM
0687
0688 MOVE WS-SL-RESULT TO WS-C
0689 MOVE WS-A TO WS-B
0690 MOVE WS-T TO WS-A
0691
0692 ADD 1 TO WS-MAIN-INDEX
0693 END-PERFORM.
0694
0695 * At this point, all the functions are processed.
0696 *****************************************************************
0697 * F U N C T I O N S S E C T I O N E N D *
0698 *****************************************************************
0699 * R E A R R A N G E S E C T I O N I N I *
0700 *****************************************************************
0701 * I will now rearrange the bytes sections.
0702 *
0703 * From rfc3174:
0704 * Let H0 = H0 + A,
0705 * H1 = H1 + B,
0706 * H2 = H2 + C,
0707 * H3 = H3 + D,
0708 * H4 = H4 + E.
0709 *
0711 * H0 = H0 + A
0712 MOVE WS-H0 TO WS-SUM-KEY-1.
0713 MOVE WS-A TO WS-SUM-KEY-2.
0714
0715 PERFORM BIN-SUM.
0716
0717 MOVE WS-SUM-RESULT TO WS-H0.
0718
0719 * H1 = H1 + B
0720 MOVE WS-H1 TO WS-SUM-KEY-1.
0721 MOVE WS-B TO WS-SUM-KEY-2.
0722
0723 PERFORM BIN-SUM.
0724
0725 MOVE WS-SUM-RESULT TO WS-H1.
0726
0727 * H2 = H2 + C
0728 MOVE WS-H2 TO WS-SUM-KEY-1.
0729 MOVE WS-C TO WS-SUM-KEY-2.
0730
0731 PERFORM BIN-SUM.
0732
0733 MOVE WS-SUM-RESULT TO WS-H2.
0734
0735 * H3 = H3 + D
0736 MOVE WS-H3 TO WS-SUM-KEY-1.
0737 MOVE WS-D TO WS-SUM-KEY-2.
0738
0739 PERFORM BIN-SUM.
0740
0741 MOVE WS-SUM-RESULT TO WS-H3.
0742
0743 * H4 = H4 + E
0744 MOVE WS-H4 TO WS-SUM-KEY-1.
0745 MOVE WS-E TO WS-SUM-KEY-2.
0746
0747 PERFORM BIN-SUM.
0748
0749 MOVE WS-SUM-RESULT TO WS-H4.
0750
0751 * At this point, everything is ready, but in binary.
0752 *****************************************************************
0753 * R E A R R A N G E S E C T I O N E N D *
0754 *****************************************************************
0755 * T R A N S L A T E S E C T I O N I N I *
0756 *****************************************************************
0757 * For translating, I will take every 4-byte piece of every H
0758 * then pass it to HEX into DISPLAY variable.
0759 *
0760 MOVE 1 TO WS-MAIN-INDEX.
0761
0762 * H0
0763 PERFORM VARYING WS-HS-INDEX FROM 1 BY 1
0764 UNTIL WS-HS-INDEX > CNS-HS-MAX
0765 MOVE WS-H0-FULL(WS-HS-INDEX) TO WS-BIN-KEY
0766
0767 PERFORM BIN2HEX
0768
0769 MOVE WS-HEX-KEY TO
0770 WS-DISPLAY-X(WS-MAIN-INDEX)
0771
0772 ADD 1 TO WS-MAIN-INDEX
0773 END-PERFORM.
0774
0775 * H1
0776 PERFORM VARYING WS-HS-INDEX FROM 1 BY 1
0777 UNTIL WS-HS-INDEX > CNS-HS-MAX
0778 MOVE WS-H1-FULL(WS-HS-INDEX) TO WS-BIN-KEY
0779
0780 PERFORM BIN2HEX
0781
0782 MOVE WS-HEX-KEY TO
0783 WS-DISPLAY-X(WS-MAIN-INDEX)
0784
0785 ADD 1 TO WS-MAIN-INDEX
0786 END-PERFORM.
0787
0788 * H2
0789 PERFORM VARYING WS-HS-INDEX FROM 1 BY 1
0790 UNTIL WS-HS-INDEX > CNS-HS-MAX
0791 MOVE WS-H2-FULL(WS-HS-INDEX) TO WS-BIN-KEY
0792
0793 PERFORM BIN2HEX
0794
0795 MOVE WS-HEX-KEY TO
0796 WS-DISPLAY-X(WS-MAIN-INDEX)
0797
0798 ADD 1 TO WS-MAIN-INDEX
0799 END-PERFORM.
0800
0801 * H3
0802 PERFORM VARYING WS-HS-INDEX FROM 1 BY 1
0803 UNTIL WS-HS-INDEX > CNS-HS-MAX
0804 MOVE WS-H3-FULL(WS-HS-INDEX) TO WS-BIN-KEY
0805
0806 PERFORM BIN2HEX
0807
0808 MOVE WS-HEX-KEY TO
0809 WS-DISPLAY-X(WS-MAIN-INDEX)
0810
0811 ADD 1 TO WS-MAIN-INDEX
0812 END-PERFORM.
0813
0814 * H4
0815 PERFORM VARYING WS-HS-INDEX FROM 1 BY 1
0816 UNTIL WS-HS-INDEX > CNS-HS-MAX
0817 MOVE WS-H4-FULL(WS-HS-INDEX) TO WS-BIN-KEY
0818
0819 PERFORM BIN2HEX
0820
0821 MOVE WS-HEX-KEY TO
0822 WS-DISPLAY-X(WS-MAIN-INDEX)
0823
0824 ADD 1 TO WS-MAIN-INDEX
0825 END-PERFORM.
0826
0827 * At this point we have all ready to display and go.
0828 *****************************************************************
0829 * T R A N S L A T E S E C T I O N E N D *
0830 *****************************************************************
0831 * P R O C E S S S E C T I O N E N D *
0832 *****************************************************************
0833 * DISPLAY 'Result: ' WS-DISPLAY.
0834
0835 GOBACK.
0837 INPUT-TO-PADDING.
0838 PERFORM VARYING WS-PADDING-INDEX FROM 1 BY 1
0839 UNTIL WS-PADDING-INDEX > WS-TEXT-ASCII-LEN
0840
0841 * Binary data is stored for S^l conversion
0842 MOVE ENTRY-BIN(WS-PADDING-INDEX) TO
0843 WS-PADDING-FULL(WS-PADDING-INDEX)
0844 END-PERFORM.
0845
0846 * Padding lenght is HEX length multiplied by 4.
0847 MULTIPLY 4 BY WS-TEXT-LENGTH
0848 GIVING WS-PADDING-LENGTH.
0849
0850 BIN2HEX.
0851 MOVE WS-BIN-KEY TO WS-BIN-BYTE-FULL.
0852
0853 COMPUTE WS-HEX2BIN-INDEX = (WS-BIN-BYTE(4) * CNS-B1) +
0854 (WS-BIN-BYTE(3) * CNS-B2) +
0855 (WS-BIN-BYTE(2) * CNS-B3) +
0856 (WS-BIN-BYTE(1) * CNS-B4).
0857
0858 PERFORM HEXVALUE.
0859
0860 BINVALUE.
0861 * No loop needed here. The HEX2BIN table is filled in order
0862 * That every HEX is in BIN+1 position
0863 *
0864 ADD 1 TO WS-HEX2BIN-INDEX.
0865 MOVE WS-BIN(WS-HEX2BIN-INDEX) TO WS-BIN-KEY.
0866
0867 HEXVALUE.
0868 * No loop needed here. The HEX2BIN table is filled in order
0869 * That every HEX is in BIN+1 position
0870 *
0871 ADD 1 TO WS-HEX2BIN-INDEX.
0872 MOVE WS-HEX(WS-HEX2BIN-INDEX) TO WS-HEX-KEY.
0873
0874 DEC2HEX.
0875 * No loop needed here. The DEC2HEX table is filled in order
0876 * That every DEC is in HEX+1 position
0877 * For example:
0878 * In position 1 we have DEC:0, HEX:0
0879 * In position 17 we have DEC:16, HEX:F
0880 *
0881 * So if we're searching for DEC:0, we need to acces pos(1).
0882 *
0883 MOVE WS-DEC-KEY TO WS-DEC2HEX-INDEX.
0884
0885 ADD 1 TO WS-DEC2HEX-INDEX.
0886 MOVE WS-HEXX(WS-DEC2HEX-INDEX) TO WS-HEXX-KEY.
0887
0888 XOR.
0889 * How it works:
0890 * For 1 to 32, makes XOR-KEY-1(n) + XOR-KEY-2(n)
0891 * IF result = 1, move 1; else, move 0.
0892 *
0893 * x1 | x2 | x1 + x2 | xr |
0894 * ----|----|---------|----|
0895 * 0 | 0 | 0 | 0 |
0896 * 0 | 1 | 1 | 1 |
0897 * 1 | 0 | 1 | 1 |
0898 * 1 | 1 | 2 | 0 |
0899 *
0900 MOVE SPACES TO WS-XOR-RESULT.
0901
0902 PERFORM VARYING WS-XOR-INDEX FROM 1 BY 1
0903 UNTIL WS-XOR-INDEX > CNS-XOR-MAX
0904 MOVE WS-XOR-KEY-1-X(WS-XOR-INDEX) TO SW-XOR
0905 ADD WS-XOR-KEY-2-X(WS-XOR-INDEX) TO SW-XOR
0906
0907 IF SW-XOR-TRUE
0908 MOVE '1' TO
0909 WS-XOR-RESULT-X(WS-XOR-INDEX)
0910 ELSE
0911 MOVE '0' TO
0912 WS-XOR-RESULT-X(WS-XOR-INDEX)
0913 END-IF
0914 END-PERFORM.
0915
0916 F-NOT.
0917 * How it works:
0918 * For 1 to 32, if NOT-KEY(n) = 1 then move 0;
0919 * move 1 otherwise.
0920 *
0921 * NOTE: It could be done re-using "-KEY" value, but in order
0922 * to maintain "-KEY" and "-RESULT" correlation, I'll use both.
0923 *
0924 MOVE SPACES TO WS-NOT-RESULT.
0925
0926 PERFORM VARYING WS-NOT-INDEX FROM 1 BY 1
0927 UNTIL WS-NOT-INDEX > CNS-NOT-MAX
0928 IF WS-NOT-KEY-X(WS-NOT-INDEX) = '0'
0929 MOVE '1' TO WS-NOT-RESULT-X(WS-NOT-INDEX)
0930 ELSE
0931 MOVE '0' TO WS-NOT-RESULT-X(WS-NOT-INDEX)
0932 END-IF
0933 END-PERFORM.
0934
0935 F-AND.
0936 * How it works:
0937 * For 1 to 32, makes AND-KEY-1(n) + AND-KEY-2(n)
0938 * IF result = 2, move 1; else, move 0.
0939 *
0940 * x1 | x2 | x1 + x2 | xr |
0941 * ----|----|---------|----|
0942 * 0 | 0 | 0 | 0 |
0943 * 0 | 1 | 1 | 0 |
0944 * 1 | 0 | 1 | 0 |
0945 * 1 | 1 | 2 | 1 |
0946 *
0947 MOVE SPACES TO WS-AND-RESULT.
0948
0949 PERFORM VARYING WS-AND-INDEX FROM 1 BY 1
0950 UNTIL WS-AND-INDEX > CNS-AND-MAX
0951 MOVE WS-AND-KEY-1-X(WS-AND-INDEX) TO SW-AND
0952 ADD WS-AND-KEY-2-X(WS-AND-INDEX) TO SW-AND
0953
0954 IF SW-AND-TRUE
0955 MOVE '1' TO
0956 WS-AND-RESULT-X(WS-AND-INDEX)
0957 ELSE
0958 MOVE '0' TO
0959 WS-AND-RESULT-X(WS-AND-INDEX)
0960 END-IF
0961 END-PERFORM.
0963 F-OR.
0964 * How it works:
0965 * For 1 to 32, makes OR-KEY-1(n) + OR-KEY-2(n)
0966 * IF result = 1 or 2, move 1; else, move 0.
0967 *
0968 * x1 | x2 | x1 + x2 | xr |
0969 * ----|----|---------|----|
0970 * 0 | 0 | 0 | 0 |
0971 * 0 | 1 | 1 | 1 |
0972 * 1 | 0 | 1 | 1 |
0973 * 1 | 1 | 2 | 1 |
0974 *
0975 MOVE SPACES TO WS-OR-RESULT.
0976
0977 PERFORM VARYING WS-OR-INDEX FROM 1 BY 1
0978 UNTIL WS-OR-INDEX > CNS-OR-MAX
0979 MOVE WS-OR-KEY-1-X(WS-OR-INDEX) TO SW-OR
0980 ADD WS-OR-KEY-2-X(WS-OR-INDEX) TO SW-OR
0981
0982 IF SW-OR-TRUE
0983 MOVE '1' TO
0984 WS-OR-RESULT-X(WS-OR-INDEX)
0985 ELSE
0986 MOVE '0' TO
0987 WS-OR-RESULT-X(WS-OR-INDEX)
0988 END-IF
0989 END-PERFORM.
0990
0991 BIN-SUM.
0992 * How it works:
0993 * For 32 to 1, makes SUM-KEY-1(n) + SUM-KEY-2(n)
0994 *
0995 * xa | x1 | x2 | x1 + x2 | xr | xa |
0996 * ----|----|----|---------|----|----|
0997 * 0 | 0 | 0 | 0 | 0 | 0 |
0998 * 0 | 0 | 1 | 1 | 1 | 0 |
0999 * 0 | 1 | 0 | 1 | 1 | 0 |
1000 * 0 | 1 | 1 | 2 | 0 | 1 |
1001 * 1 | 0 | 0 | 1 | 1 | 0 |
1002 * 1 | 0 | 1 | 2 | 0 | 1 |
1003 * 1 | 1 | 0 | 2 | 0 | 1 |
1004 * 1 | 1 | 1 | 3 | 1 | 1 |
1005 *
1006 SET SW-ACC-FALSE TO TRUE
1007
1008 PERFORM VARYING WS-SUM-INDEX FROM CNS-SUM-MAX BY -1
1009 UNTIL WS-SUM-INDEX < 1
1010 MOVE WS-SUM-KEY-1-X(WS-SUM-INDEX) TO SW-SUM
1011 ADD WS-SUM-KEY-2-X(WS-SUM-INDEX) TO SW-SUM
1012
1013 IF SW-ACC-TRUE
1014 ADD 1 TO SW-SUM
1015 SET SW-ACC-FALSE TO TRUE
1016 END-IF
1017
1018 IF SW-ACC-ON
1019 IF SW-SUM = 2
1020 MOVE '0' TO
1021 WS-SUM-RESULT-X(WS-SUM-INDEX)
1022 ELSE
1023 MOVE '1' TO
1024 WS-SUM-RESULT-X(WS-SUM-INDEX)
1025 END-IF
1026
1027 SET SW-ACC-TRUE TO TRUE
1028 ELSE
1029 MOVE SW-SUM TO
1030 WS-SUM-RESULT-X(WS-SUM-INDEX)
1031 SET SW-ACC-FALSE TO TRUE
1032 END-IF
1033 END-PERFORM.
1034
1035 * Awesome fact:
1036 * In order to make a modular sum, the last byte can be
1037 * neglected. That's because when aplying modular sum in bin
1038 * we find a thing.
1039 *
1040 * Let's supouse we work with 4-byte only, and we have this:
1041 *
1042 * 0111 + 1111 = 10110
1043 *
1044 * That's a 5 digit-long data. To trim it into 4-byte, we make:
1045 *
1046 * 10110 - 10000
1047 *
1048 * Using 2-complement:
1049 *
1050 * 10000 XOR 11111 = 01111 + 1 = 10000
1051 *
1052 * So, the subtraction becomes:
1053 *
1054 * 10110 + 10000
1055 *
1056 * As all digits on second operan are 0's, only the leftmost
1057 * digit will change, making a 0 + 1 acc, so it gives
1058 *
1059 * 00110
1060 *
1061 * That's the correct result, but if in first instance we
1062 * won't take the final ACC, we will get same result!
1063 *
1064
1065 LEFT-SHIFT.
1066 * How it works:
1067 * First, move SL-KEY(1) to SL-KEY(32)
1068 * Then, For 2 to 32, moves SL-KEY(n) to SL-KEY(n - 1)
1069 *
1070 MOVE WS-SL-KEY-X(1) TO WS-SL-RESULT-X(CNS-SL-MAX).
1071 MOVE 1 TO WS-SL-INDEX-2.
1072
1073 PERFORM VARYING WS-SL-INDEX-1 FROM 2 BY 1
1074 UNTIL WS-SL-INDEX-1 > CNS-SL-MAX
1075 MOVE WS-SL-KEY-X(WS-SL-INDEX-1) TO
1076 WS-SL-RESULT-X(WS-SL-INDEX-2)
1077
1078 ADD 1 TO WS-SL-INDEX-2
1079 END-PERFORM.
1080
1081 FUNCTION-F1.
1082 * From rfc3174:
1083 * f(t;B,C,D) = (B AND C) OR ((NOT B) AND D)
1084 *
1085
1086 * NOT B
1087 MOVE WS-B TO WS-NOT-KEY.
1088
1089 PERFORM F-NOT.
1090
1091 * ((NOT B) AND D)
1092 MOVE WS-NOT-RESULT TO WS-AND-KEY-1.
1093 MOVE WS-D TO WS-AND-KEY-2.
1094
1095 PERFORM F-AND.
1096
1097 MOVE WS-AND-RESULT TO WS-AND-RESULT-1.
1098
1099 * (B AND C)
1100 MOVE WS-B TO WS-AND-KEY-1.
1101 MOVE WS-C TO WS-AND-KEY-2.
1102
1103 PERFORM F-AND.
1104
1105 MOVE WS-AND-RESULT TO WS-AND-RESULT-2
1106
1107 * (B AND C) OR ((NOT B) AND D)
1108 MOVE WS-AND-RESULT-2 TO WS-OR-KEY-1.
1109 MOVE WS-AND-RESULT-1 TO WS-OR-KEY-2.
1110
1111 PERFORM F-OR.
1112
1113 MOVE WS-OR-RESULT TO WS-FN-RESULT.
1114
1115 FUNCTION-F2.
1116 * From rfc3174:
1117 * f(t;B,C,D) = B XOR C XOR D
1118 *
1119
1120 * B XOR C
1121 MOVE WS-B TO WS-XOR-KEY-1.
1122 MOVE WS-C TO WS-XOR-KEY-2.
1123
1124 PERFORM XOR.
1125
1126 * B XOR C XOR D
1127 MOVE WS-XOR-RESULT TO WS-XOR-KEY-1.
1128 MOVE WS-D TO WS-XOR-KEY-2.
1129
1130 PERFORM XOR.
1131
1132 MOVE WS-XOR-RESULT TO WS-FN-RESULT.
1133
1134 FUNCTION-F3.
1135 * From rfc3174:
1136 * f(t;B,C,D) = (B AND C) OR (B AND D) OR (C AND D)
1137 *
1138
1139 * (B AND C)
1140 MOVE WS-B TO WS-AND-KEY-1.
1141 MOVE WS-C TO WS-AND-KEY-2.
1142
1143 PERFORM F-AND.
1144
1145 MOVE WS-AND-RESULT TO WS-AND-RESULT-1.
1146
1147 * (B AND D) - B is already charged
1148 MOVE WS-D TO WS-AND-KEY-2.
1149
1150 PERFORM F-AND.
1151
1152 MOVE WS-AND-RESULT TO WS-AND-RESULT-2.
1153
1154 * (C AND D)
1155 MOVE WS-C TO WS-AND-KEY-1.
1156 MOVE WS-D TO WS-AND-KEY-2.
1157
1158 PERFORM F-AND.
1159
1160 MOVE WS-AND-RESULT TO WS-AND-RESULT-3.
1161
1162 * (B AND C) OR (B AND D)
1163 MOVE WS-AND-RESULT-1 TO WS-OR-KEY-1.
1164 MOVE WS-AND-RESULT-2 TO WS-OR-KEY-2.
1165
1166 PERFORM F-OR.
1167
1168 * (B AND C) OR (B AND D) OR (C AND D)
1169 MOVE WS-OR-RESULT TO WS-OR-KEY-1.
1170 MOVE WS-AND-RESULT-3 TO WS-OR-KEY-2.
1171
1172 PERFORM F-OR.
1173
1174 MOVE WS-OR-RESULT TO WS-FN-RESULT.
1175
1176 FUNCTION-F4.
1177 * From rfc3174:
1178 * f(t;B,C,D) = B XOR C XOR D
1179 *
1180 PERFORM FUNCTION-F2.
1181
1182 FUNCTION-SUM.
1183 * From rfc3174:
1184 * TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t)
1185 * I already have S^5(A) value on SL-RESULT
1186 * I already have f(t;B,C,D) value on FN-RESULT
1187 * E is on WS-E
1188 * W(t) can be obtained with MAIN-INDEX
1189 * K(t) can be obtained with MAIN-INDEX
1190 *
1191 * NOTE: All the "+" signs here refers to modular sum.
1192 *
1193
1194 * S^5(A) + f(t;B,C,D)
1195 MOVE WS-SL-RESULT TO WS-SUM-KEY-1.
1196 MOVE WS-FN-RESULT TO WS-SUM-KEY-2.
1197
1198 PERFORM BIN-SUM.
1199
1200 * S^5(A) + f(t;B,C,D) + E
1201 MOVE WS-SUM-RESULT TO WS-SUM-KEY-1.
1202 MOVE WS-E TO WS-SUM-KEY-2.
1203
1204 PERFORM BIN-SUM.
1205
1206 * S^5(A) + f(t;B,C,D) + E + W(t)
1207 MOVE WS-SUM-RESULT TO WS-SUM-KEY-1.
1208 MOVE WS-PROCESSING-WORD(WS-MAIN-INDEX) TO WS-SUM-KEY-2.
1209
1210 PERFORM BIN-SUM.
1211
1212 * S^5(A) + f(t;B,C,D) + E + W(t) + K(t)
1213 MOVE WS-SUM-RESULT TO WS-SUM-KEY-1.
1214 MOVE WS-KS-VAL(WS-MAIN-INDEX) TO WS-SUM-KEY-2.
1215
1216 PERFORM BIN-SUM.
1217
1218 MOVE WS-SUM-RESULT TO WS-T.
1219
1220 FILL-TABLES.
1221 * Fill HEX2BIN
1222 MOVE '0' TO WS-HEX(01).
1223 MOVE '1' TO WS-HEX(02).
1224 MOVE '2' TO WS-HEX(03).
1225 MOVE '3' TO WS-HEX(04).
1226 MOVE '4' TO WS-HEX(05).
1227 MOVE '5' TO WS-HEX(06).
1228 MOVE '6' TO WS-HEX(07).
1229 MOVE '7' TO WS-HEX(08).
1230 MOVE '8' TO WS-HEX(09).
1231 MOVE '9' TO WS-HEX(10).
1232 MOVE 'A' TO WS-HEX(11).
1233 MOVE 'B' TO WS-HEX(12).
1234 MOVE 'C' TO WS-HEX(13).
1235 MOVE 'D' TO WS-HEX(14).
1236 MOVE 'E' TO WS-HEX(15).
1237 MOVE 'F' TO WS-HEX(16).
1239 MOVE '0000' TO WS-BIN(01).
1240 MOVE '0001' TO WS-BIN(02).
1241 MOVE '0010' TO WS-BIN(03).
1242 MOVE '0011' TO WS-BIN(04).
1243 MOVE '0100' TO WS-BIN(05).
1244 MOVE '0101' TO WS-BIN(06).
1245 MOVE '0110' TO WS-BIN(07).
1246 MOVE '0111' TO WS-BIN(08).
1247 MOVE '1000' TO WS-BIN(09).
1248 MOVE '1001' TO WS-BIN(10).
1249 MOVE '1010' TO WS-BIN(11).
1250 MOVE '1011' TO WS-BIN(12).
1251 MOVE '1100' TO WS-BIN(13).
1252 MOVE '1101' TO WS-BIN(14).
1253 MOVE '1110' TO WS-BIN(15).
1254 MOVE '1111' TO WS-BIN(16).
1256 * Fill DEC2HEX
1257 MOVE '000' TO WS-DEC(001).
1258 MOVE '001' TO WS-DEC(002).
1259 MOVE '002' TO WS-DEC(003).
1260 MOVE '003' TO WS-DEC(004).
1261 MOVE '004' TO WS-DEC(005).
1262 MOVE '005' TO WS-DEC(006).
1263 MOVE '006' TO WS-DEC(007).
1264 MOVE '007' TO WS-DEC(008).
1265 MOVE '008' TO WS-DEC(009).
1266 MOVE '009' TO WS-DEC(010).
1267 MOVE '010' TO WS-DEC(011).
1268 MOVE '011' TO WS-DEC(012).
1269 MOVE '012' TO WS-DEC(013).
1270 MOVE '013' TO WS-DEC(014).
1271 MOVE '014' TO WS-DEC(015).
1272 MOVE '015' TO WS-DEC(016).
1273 MOVE '016' TO WS-DEC(017).
1274 MOVE '017' TO WS-DEC(018).
1275 MOVE '018' TO WS-DEC(019).
1276 MOVE '019' TO WS-DEC(020).
1277 MOVE '020' TO WS-DEC(021).
1278 MOVE '021' TO WS-DEC(022).
1279 MOVE '022' TO WS-DEC(023).
1280 MOVE '023' TO WS-DEC(024).
1281 MOVE '024' TO WS-DEC(025).
1282 MOVE '025' TO WS-DEC(026).
1283 MOVE '026' TO WS-DEC(027).
1284 MOVE '027' TO WS-DEC(028).
1285 MOVE '028' TO WS-DEC(029).
1286 MOVE '029' TO WS-DEC(030).
1287 MOVE '030' TO WS-DEC(031).
1288 MOVE '031' TO WS-DEC(032).
1289 MOVE '032' TO WS-DEC(033).
1290 MOVE '033' TO WS-DEC(034).
1291 MOVE '034' TO WS-DEC(035).
1292 MOVE '035' TO WS-DEC(036).
1293 MOVE '036' TO WS-DEC(037).
1294 MOVE '037' TO WS-DEC(038).
1295 MOVE '038' TO WS-DEC(039).
1296 MOVE '039' TO WS-DEC(040).
1297 MOVE '040' TO WS-DEC(041).
1298 MOVE '041' TO WS-DEC(042).
1299 MOVE '042' TO WS-DEC(043).
1300 MOVE '043' TO WS-DEC(044).
1301 MOVE '044' TO WS-DEC(045).
1302 MOVE '045' TO WS-DEC(046).
1303 MOVE '046' TO WS-DEC(047).
1304 MOVE '047' TO WS-DEC(048).
1305 MOVE '048' TO WS-DEC(049).
1306 MOVE '049' TO WS-DEC(050).
1307 MOVE '050' TO WS-DEC(051).
1308 MOVE '051' TO WS-DEC(052).
1309 MOVE '052' TO WS-DEC(053).
1310 MOVE '053' TO WS-DEC(054).
1311 MOVE '054' TO WS-DEC(055).
1312 MOVE '055' TO WS-DEC(056).
1313 MOVE '056' TO WS-DEC(057).
1314 MOVE '057' TO WS-DEC(058).
1315 MOVE '058' TO WS-DEC(059).
1316 MOVE '059' TO WS-DEC(060).
1317 MOVE '060' TO WS-DEC(061).
1318 MOVE '061' TO WS-DEC(062).
1319 MOVE '062' TO WS-DEC(063).
1320 MOVE '063' TO WS-DEC(064).
1321 MOVE '064' TO WS-DEC(065).
1322 MOVE '065' TO WS-DEC(066).
1323 MOVE '066' TO WS-DEC(067).
1324 MOVE '067' TO WS-DEC(068).
1325 MOVE '068' TO WS-DEC(069).
1326 MOVE '069' TO WS-DEC(070).
1327 MOVE '070' TO WS-DEC(071).
1328 MOVE '071' TO WS-DEC(072).
1329 MOVE '072' TO WS-DEC(073).
1330 MOVE '073' TO WS-DEC(074).
1331 MOVE '074' TO WS-DEC(075).
1332 MOVE '075' TO WS-DEC(076).
1333 MOVE '076' TO WS-DEC(077).
1334 MOVE '077' TO WS-DEC(078).
1335 MOVE '078' TO WS-DEC(079).
1336 MOVE '079' TO WS-DEC(080).
1337 MOVE '080' TO WS-DEC(081).
1338 MOVE '081' TO WS-DEC(082).
1339 MOVE '082' TO WS-DEC(083).
1340 MOVE '083' TO WS-DEC(084).
1341 MOVE '084' TO WS-DEC(085).
1342 MOVE '085' TO WS-DEC(086).
1343 MOVE '086' TO WS-DEC(087).
1344 MOVE '087' TO WS-DEC(088).
1345 MOVE '088' TO WS-DEC(089).
1346 MOVE '089' TO WS-DEC(090).
1347 MOVE '090' TO WS-DEC(091).
1348 MOVE '091' TO WS-DEC(092).
1349 MOVE '092' TO WS-DEC(093).
1350 MOVE '093' TO WS-DEC(094).
1351 MOVE '094' TO WS-DEC(095).
1352 MOVE '095' TO WS-DEC(096).
1353 MOVE '096' TO WS-DEC(097).
1354 MOVE '097' TO WS-DEC(098).
1355 MOVE '098' TO WS-DEC(099).
1356 MOVE '099' TO WS-DEC(100).
1357 MOVE '100' TO WS-DEC(101).
1358 MOVE '101' TO WS-DEC(102).
1359 MOVE '102' TO WS-DEC(103).
1360 MOVE '103' TO WS-DEC(104).
1361 MOVE '104' TO WS-DEC(105).
1362 MOVE '105' TO WS-DEC(106).
1363 MOVE '106' TO WS-DEC(107).
1364 MOVE '107' TO WS-DEC(108).
1365 MOVE '108' TO WS-DEC(109).
1366 MOVE '109' TO WS-DEC(110).
1367 MOVE '110' TO WS-DEC(111).
1368 MOVE '111' TO WS-DEC(112).
1369 MOVE '112' TO WS-DEC(113).
1370 MOVE '113' TO WS-DEC(114).
1371 MOVE '114' TO WS-DEC(115).
1372 MOVE '115' TO WS-DEC(116).
1373 MOVE '116' TO WS-DEC(117).
1374 MOVE '117' TO WS-DEC(118).
1375 MOVE '118' TO WS-DEC(119).
1376 MOVE '119' TO WS-DEC(120).
1377 MOVE '120' TO WS-DEC(121).
1378 MOVE '121' TO WS-DEC(122).
1379 MOVE '122' TO WS-DEC(123).
1380 MOVE '123' TO WS-DEC(124).
1381 MOVE '124' TO WS-DEC(125).
1382 MOVE '125' TO WS-DEC(126).
1383 MOVE '126' TO WS-DEC(127).
1384 MOVE '127' TO WS-DEC(128).
1385 MOVE '128' TO WS-DEC(129).
1386 MOVE '129' TO WS-DEC(130).
1387 MOVE '130' TO WS-DEC(131).
1388 MOVE '131' TO WS-DEC(132).
1389 MOVE '132' TO WS-DEC(133).
1390 MOVE '133' TO WS-DEC(134).
1391 MOVE '134' TO WS-DEC(135).
1392 MOVE '135' TO WS-DEC(136).
1393 MOVE '136' TO WS-DEC(137).
1394 MOVE '137' TO WS-DEC(138).
1395 MOVE '138' TO WS-DEC(139).
1396 MOVE '139' TO WS-DEC(140).
1397 MOVE '140' TO WS-DEC(141).
1398 MOVE '141' TO WS-DEC(142).
1399 MOVE '142' TO WS-DEC(143).
1400 MOVE '143' TO WS-DEC(144).
1401 MOVE '144' TO WS-DEC(145).
1402 MOVE '145' TO WS-DEC(146).
1403 MOVE '146' TO WS-DEC(147).
1404 MOVE '147' TO WS-DEC(148).
1405 MOVE '148' TO WS-DEC(149).
1406 MOVE '149' TO WS-DEC(150).
1407 MOVE '150' TO WS-DEC(151).
1408 MOVE '151' TO WS-DEC(152).
1409 MOVE '152' TO WS-DEC(153).
1410 MOVE '153' TO WS-DEC(154).
1411 MOVE '154' TO WS-DEC(155).
1412 MOVE '155' TO WS-DEC(156).
1413 MOVE '156' TO WS-DEC(157).
1414 MOVE '157' TO WS-DEC(158).
1415 MOVE '158' TO WS-DEC(159).
1416 MOVE '159' TO WS-DEC(160).
1417 MOVE '160' TO WS-DEC(161).
1418 MOVE '161' TO WS-DEC(162).
1419 MOVE '162' TO WS-DEC(163).
1420 MOVE '163' TO WS-DEC(164).
1421 MOVE '164' TO WS-DEC(165).
1422 MOVE '165' TO WS-DEC(166).
1423 MOVE '166' TO WS-DEC(167).
1424 MOVE '167' TO WS-DEC(168).
1425 MOVE '168' TO WS-DEC(169).
1426 MOVE '169' TO WS-DEC(170).
1427 MOVE '170' TO WS-DEC(171).
1428 MOVE '171' TO WS-DEC(172).
1429 MOVE '172' TO WS-DEC(173).
1430 MOVE '173' TO WS-DEC(174).
1431 MOVE '174' TO WS-DEC(175).
1432 MOVE '175' TO WS-DEC(176).
1433 MOVE '176' TO WS-DEC(177).
1434 MOVE '177' TO WS-DEC(178).
1435 MOVE '178' TO WS-DEC(179).
1436 MOVE '179' TO WS-DEC(180).
1437 MOVE '180' TO WS-DEC(181).
1438 MOVE '181' TO WS-DEC(182).
1439 MOVE '182' TO WS-DEC(183).
1440 MOVE '183' TO WS-DEC(184).
1441 MOVE '184' TO WS-DEC(185).
1442 MOVE '185' TO WS-DEC(186).
1443 MOVE '186' TO WS-DEC(187).
1444 MOVE '187' TO WS-DEC(188).
1445 MOVE '188' TO WS-DEC(189).
1446 MOVE '189' TO WS-DEC(190).
1447 MOVE '190' TO WS-DEC(191).
1448 MOVE '191' TO WS-DEC(192).
1449 MOVE '192' TO WS-DEC(193).
1450 MOVE '193' TO WS-DEC(194).
1451 MOVE '194' TO WS-DEC(195).
1452 MOVE '195' TO WS-DEC(196).
1453 MOVE '196' TO WS-DEC(197).
1454 MOVE '197' TO WS-DEC(198).
1455 MOVE '198' TO WS-DEC(199).
1456 MOVE '199' TO WS-DEC(200).
1457 MOVE '200' TO WS-DEC(201).
1458 MOVE '201' TO WS-DEC(202).
1459 MOVE '202' TO WS-DEC(203).
1460 MOVE '203' TO WS-DEC(204).
1461 MOVE '204' TO WS-DEC(205).
1462 MOVE '205' TO WS-DEC(206).
1463 MOVE '206' TO WS-DEC(207).
1464 MOVE '207' TO WS-DEC(208).
1465 MOVE '208' TO WS-DEC(209).
1466 MOVE '209' TO WS-DEC(210).
1467 MOVE '210' TO WS-DEC(211).
1468 MOVE '211' TO WS-DEC(212).
1469 MOVE '212' TO WS-DEC(213).
1470 MOVE '213' TO WS-DEC(214).
1471 MOVE '214' TO WS-DEC(215).
1472 MOVE '215' TO WS-DEC(216).
1473 MOVE '216' TO WS-DEC(217).
1474 MOVE '217' TO WS-DEC(218).
1475 MOVE '218' TO WS-DEC(219).
1476 MOVE '219' TO WS-DEC(220).
1477 MOVE '220' TO WS-DEC(221).
1478 MOVE '221' TO WS-DEC(222).
1479 MOVE '222' TO WS-DEC(223).
1480 MOVE '223' TO WS-DEC(224).
1481 MOVE '224' TO WS-DEC(225).
1482 MOVE '225' TO WS-DEC(226).
1483 MOVE '226' TO WS-DEC(227).
1484 MOVE '227' TO WS-DEC(228).
1485 MOVE '228' TO WS-DEC(229).
1486 MOVE '229' TO WS-DEC(230).
1487 MOVE '230' TO WS-DEC(231).
1488 MOVE '231' TO WS-DEC(232).
1489 MOVE '232' TO WS-DEC(233).
1490 MOVE '233' TO WS-DEC(234).
1491 MOVE '234' TO WS-DEC(235).
1492 MOVE '235' TO WS-DEC(236).
1493 MOVE '236' TO WS-DEC(237).
1494 MOVE '237' TO WS-DEC(238).
1495 MOVE '238' TO WS-DEC(239).
1496 MOVE '239' TO WS-DEC(240).
1497 MOVE '240' TO WS-DEC(241).
1498 MOVE '241' TO WS-DEC(242).
1499 MOVE '242' TO WS-DEC(243).
1500 MOVE '243' TO WS-DEC(244).
1501 MOVE '244' TO WS-DEC(245).
1502 MOVE '245' TO WS-DEC(246).
1503 MOVE '246' TO WS-DEC(247).
1504 MOVE '247' TO WS-DEC(248).
1505 MOVE '248' TO WS-DEC(249).
1506 MOVE '249' TO WS-DEC(250).
1507 MOVE '250' TO WS-DEC(251).
1508 MOVE '251' TO WS-DEC(252).
1509 MOVE '252' TO WS-DEC(253).
1510 MOVE '253' TO WS-DEC(254).
1511 MOVE '254' TO WS-DEC(255).
1512 MOVE '255' TO WS-DEC(256).
1514 MOVE '00' TO WS-HEXX(001).
1515 MOVE '01' TO WS-HEXX(002).
1516 MOVE '02' TO WS-HEXX(003).
1517 MOVE '03' TO WS-HEXX(004).
1518 MOVE '04' TO WS-HEXX(005).
1519 MOVE '05' TO WS-HEXX(006).
1520 MOVE '06' TO WS-HEXX(007).
1521 MOVE '07' TO WS-HEXX(008).
1522 MOVE '08' TO WS-HEXX(009).
1523 MOVE '09' TO WS-HEXX(010).
1524 MOVE '0A' TO WS-HEXX(011).
1525 MOVE '0B' TO WS-HEXX(012).
1526 MOVE '0C' TO WS-HEXX(013).
1527 MOVE '0D' TO WS-HEXX(014).
1528 MOVE '0E' TO WS-HEXX(015).
1529 MOVE '0F' TO WS-HEXX(016).
1530 MOVE '10' TO WS-HEXX(017).
1531 MOVE '11' TO WS-HEXX(018).
1532 MOVE '12' TO WS-HEXX(019).
1533 MOVE '13' TO WS-HEXX(020).
1534 MOVE '14' TO WS-HEXX(021).
1535 MOVE '15' TO WS-HEXX(022).
1536 MOVE '16' TO WS-HEXX(023).
1537 MOVE '17' TO WS-HEXX(024).
1538 MOVE '18' TO WS-HEXX(025).
1539 MOVE '19' TO WS-HEXX(026).
1540 MOVE '1A' TO WS-HEXX(027).
1541 MOVE '1B' TO WS-HEXX(028).
1542 MOVE '1C' TO WS-HEXX(029).
1543 MOVE '1D' TO WS-HEXX(030).
1544 MOVE '1E' TO WS-HEXX(031).
1545 MOVE '1F' TO WS-HEXX(032).
1546 MOVE '20' TO WS-HEXX(033).
1547 MOVE '21' TO WS-HEXX(034).
1548 MOVE '22' TO WS-HEXX(035).
1549 MOVE '23' TO WS-HEXX(036).
1550 MOVE '24' TO WS-HEXX(037).
1551 MOVE '25' TO WS-HEXX(038).
1552 MOVE '26' TO WS-HEXX(039).
1553 MOVE '27' TO WS-HEXX(040).
1554 MOVE '28' TO WS-HEXX(041).
1555 MOVE '29' TO WS-HEXX(042).
1556 MOVE '2A' TO WS-HEXX(043).
1557 MOVE '2B' TO WS-HEXX(044).
1558 MOVE '2C' TO WS-HEXX(045).
1559 MOVE '2D' TO WS-HEXX(046).
1560 MOVE '2E' TO WS-HEXX(047).
1561 MOVE '2F' TO WS-HEXX(048).
1562 MOVE '30' TO WS-HEXX(049).
1563 MOVE '31' TO WS-HEXX(050).
1564 MOVE '32' TO WS-HEXX(051).
1565 MOVE '33' TO WS-HEXX(052).
1566 MOVE '34' TO WS-HEXX(053).
1567 MOVE '35' TO WS-HEXX(054).
1568 MOVE '36' TO WS-HEXX(055).
1569 MOVE '37' TO WS-HEXX(056).
1570 MOVE '38' TO WS-HEXX(057).
1571 MOVE '39' TO WS-HEXX(058).
1572 MOVE '3A' TO WS-HEXX(059).
1573 MOVE '3B' TO WS-HEXX(060).
1574 MOVE '3C' TO WS-HEXX(061).
1575 MOVE '3D' TO WS-HEXX(062).
1576 MOVE '3E' TO WS-HEXX(063).
1577 MOVE '3F' TO WS-HEXX(064).
1578 MOVE '40' TO WS-HEXX(065).
1579 MOVE '41' TO WS-HEXX(066).
1580 MOVE '42' TO WS-HEXX(067).
1581 MOVE '43' TO WS-HEXX(068).
1582 MOVE '44' TO WS-HEXX(069).
1583 MOVE '45' TO WS-HEXX(070).
1584 MOVE '46' TO WS-HEXX(071).
1585 MOVE '47' TO WS-HEXX(072).
1586 MOVE '48' TO WS-HEXX(073).
1587 MOVE '49' TO WS-HEXX(074).
1588 MOVE '4A' TO WS-HEXX(075).
1589 MOVE '4B' TO WS-HEXX(076).
1590 MOVE '4C' TO WS-HEXX(077).
1591 MOVE '4D' TO WS-HEXX(078).
1592 MOVE '4E' TO WS-HEXX(079).
1593 MOVE '4F' TO WS-HEXX(080).
1594 MOVE '50' TO WS-HEXX(081).
1595 MOVE '51' TO WS-HEXX(082).
1596 MOVE '52' TO WS-HEXX(083).
1597 MOVE '53' TO WS-HEXX(084).
1598 MOVE '54' TO WS-HEXX(085).
1599 MOVE '55' TO WS-HEXX(086).
1600 MOVE '56' TO WS-HEXX(087).
1601 MOVE '57' TO WS-HEXX(088).
1602 MOVE '58' TO WS-HEXX(089).
1603 MOVE '59' TO WS-HEXX(090).
1604 MOVE '5A' TO WS-HEXX(091).
1605 MOVE '5B' TO WS-HEXX(092).
1606 MOVE '5C' TO WS-HEXX(093).
1607 MOVE '5D' TO WS-HEXX(094).
1608 MOVE '5E' TO WS-HEXX(095).
1609 MOVE '5F' TO WS-HEXX(096).
1610 MOVE '60' TO WS-HEXX(097).
1611 MOVE '61' TO WS-HEXX(098).
1612 MOVE '62' TO WS-HEXX(099).
1613 MOVE '63' TO WS-HEXX(100).
1614 MOVE '64' TO WS-HEXX(101).
1615 MOVE '65' TO WS-HEXX(102).
1616 MOVE '66' TO WS-HEXX(103).
1617 MOVE '67' TO WS-HEXX(104).
1618 MOVE '68' TO WS-HEXX(105).
1619 MOVE '69' TO WS-HEXX(106).
1620 MOVE '6A' TO WS-HEXX(107).
1621 MOVE '6B' TO WS-HEXX(108).
1622 MOVE '6C' TO WS-HEXX(109).
1623 MOVE '6D' TO WS-HEXX(110).
1624 MOVE '6E' TO WS-HEXX(111).
1625 MOVE '6F' TO WS-HEXX(112).
1626 MOVE '70' TO WS-HEXX(113).
1627 MOVE '71' TO WS-HEXX(114).
1628 MOVE '72' TO WS-HEXX(115).
1629 MOVE '73' TO WS-HEXX(116).
1630 MOVE '74' TO WS-HEXX(117).
1631 MOVE '75' TO WS-HEXX(118).
1632 MOVE '76' TO WS-HEXX(119).
1633 MOVE '77' TO WS-HEXX(120).
1634 MOVE '78' TO WS-HEXX(121).
1635 MOVE '79' TO WS-HEXX(122).
1636 MOVE '7A' TO WS-HEXX(123).
1637 MOVE '7B' TO WS-HEXX(124).
1638 MOVE '7C' TO WS-HEXX(125).
1639 MOVE '7D' TO WS-HEXX(126).
1640 MOVE '7E' TO WS-HEXX(127).
1641 MOVE '7F' TO WS-HEXX(128).
1642 MOVE '80' TO WS-HEXX(129).
1643 MOVE '81' TO WS-HEXX(130).
1644 MOVE '82' TO WS-HEXX(131).
1645 MOVE '83' TO WS-HEXX(132).
1646 MOVE '84' TO WS-HEXX(133).
1647 MOVE '85' TO WS-HEXX(134).
1648 MOVE '86' TO WS-HEXX(135).
1649 MOVE '87' TO WS-HEXX(136).
1650 MOVE '88' TO WS-HEXX(137).
1651 MOVE '89' TO WS-HEXX(138).
1652 MOVE '8A' TO WS-HEXX(139).
1653 MOVE '8B' TO WS-HEXX(140).
1654 MOVE '8C' TO WS-HEXX(141).
1655 MOVE '8D' TO WS-HEXX(142).
1656 MOVE '8E' TO WS-HEXX(143).
1657 MOVE '8F' TO WS-HEXX(144).
1658 MOVE '90' TO WS-HEXX(145).
1659 MOVE '91' TO WS-HEXX(146).
1660 MOVE '92' TO WS-HEXX(147).
1661 MOVE '93' TO WS-HEXX(148).
1662 MOVE '94' TO WS-HEXX(149).
1663 MOVE '95' TO WS-HEXX(150).
1664 MOVE '96' TO WS-HEXX(151).
1665 MOVE '97' TO WS-HEXX(152).
1666 MOVE '98' TO WS-HEXX(153).
1667 MOVE '99' TO WS-HEXX(154).
1668 MOVE '9A' TO WS-HEXX(155).
1669 MOVE '9B' TO WS-HEXX(156).
1670 MOVE '9C' TO WS-HEXX(157).
1671 MOVE '9D' TO WS-HEXX(158).
1672 MOVE '9E' TO WS-HEXX(159).
1673 MOVE '9F' TO WS-HEXX(160).
1674 MOVE 'A0' TO WS-HEXX(161).
1675 MOVE 'A1' TO WS-HEXX(162).
1676 MOVE 'A2' TO WS-HEXX(163).
1677 MOVE 'A3' TO WS-HEXX(164).
1678 MOVE 'A4' TO WS-HEXX(165).
1679 MOVE 'A5' TO WS-HEXX(166).
1680 MOVE 'A6' TO WS-HEXX(167).
1681 MOVE 'A7' TO WS-HEXX(168).
1682 MOVE 'A8' TO WS-HEXX(169).
1683 MOVE 'A9' TO WS-HEXX(170).
1684 MOVE 'AA' TO WS-HEXX(171).
1685 MOVE 'AB' TO WS-HEXX(172).
1686 MOVE 'AC' TO WS-HEXX(173).
1687 MOVE 'AD' TO WS-HEXX(174).
1688 MOVE 'AE' TO WS-HEXX(175).
1689 MOVE 'AF' TO WS-HEXX(176).
1690 MOVE 'B0' TO WS-HEXX(177).
1691 MOVE 'B1' TO WS-HEXX(178).
1692 MOVE 'B2' TO WS-HEXX(179).
1693 MOVE 'B3' TO WS-HEXX(180).
1694 MOVE 'B4' TO WS-HEXX(181).
1695 MOVE 'B5' TO WS-HEXX(182).
1696 MOVE 'B6' TO WS-HEXX(183).
1697 MOVE 'B7' TO WS-HEXX(184).
1698 MOVE 'B8' TO WS-HEXX(185).
1699 MOVE 'B9' TO WS-HEXX(186).
1700 MOVE 'BA' TO WS-HEXX(187).
1701 MOVE 'BB' TO WS-HEXX(188).
1702 MOVE 'BC' TO WS-HEXX(189).
1703 MOVE 'BD' TO WS-HEXX(190).
1704 MOVE 'BE' TO WS-HEXX(191).
1705 MOVE 'BF' TO WS-HEXX(192).
1706 MOVE 'C0' TO WS-HEXX(193).
1707 MOVE 'C1' TO WS-HEXX(194).
1708 MOVE 'C2' TO WS-HEXX(195).
1709 MOVE 'C3' TO WS-HEXX(196).
1710 MOVE 'C4' TO WS-HEXX(197).
1711 MOVE 'C5' TO WS-HEXX(198).
1712 MOVE 'C6' TO WS-HEXX(199).
1713 MOVE 'C7' TO WS-HEXX(200).
1714 MOVE 'C8' TO WS-HEXX(201).
1715 MOVE 'C9' TO WS-HEXX(202).
1716 MOVE 'CA' TO WS-HEXX(203).
1717 MOVE 'CB' TO WS-HEXX(204).
1718 MOVE 'CC' TO WS-HEXX(205).
1719 MOVE 'CD' TO WS-HEXX(206).
1720 MOVE 'CE' TO WS-HEXX(207).
1721 MOVE 'CF' TO WS-HEXX(208).
1722 MOVE 'D0' TO WS-HEXX(209).
1723 MOVE 'D1' TO WS-HEXX(210).
1724 MOVE 'D2' TO WS-HEXX(211).
1725 MOVE 'D3' TO WS-HEXX(212).
1726 MOVE 'D4' TO WS-HEXX(213).
1727 MOVE 'D5' TO WS-HEXX(214).
1728 MOVE 'D6' TO WS-HEXX(215).
1729 MOVE 'D7' TO WS-HEXX(216).
1730 MOVE 'D8' TO WS-HEXX(217).
1731 MOVE 'D9' TO WS-HEXX(218).
1732 MOVE 'DA' TO WS-HEXX(219).
1733 MOVE 'DB' TO WS-HEXX(220).
1734 MOVE 'DC' TO WS-HEXX(221).
1735 MOVE 'DD' TO WS-HEXX(222).
1736 MOVE 'DE' TO WS-HEXX(223).
1737 MOVE 'DF' TO WS-HEXX(224).
1738 MOVE 'E0' TO WS-HEXX(225).
1739 MOVE 'E1' TO WS-HEXX(226).
1740 MOVE 'E2' TO WS-HEXX(227).
1741 MOVE 'E3' TO WS-HEXX(228).
1742 MOVE 'E4' TO WS-HEXX(229).
1743 MOVE 'E5' TO WS-HEXX(230).
1744 MOVE 'E6' TO WS-HEXX(231).
1745 MOVE 'E7' TO WS-HEXX(232).
1746 MOVE 'E8' TO WS-HEXX(233).
1747 MOVE 'E9' TO WS-HEXX(234).
1748 MOVE 'EA' TO WS-HEXX(235).
1749 MOVE 'EB' TO WS-HEXX(236).
1750 MOVE 'EC' TO WS-HEXX(237).
1751 MOVE 'ED' TO WS-HEXX(238).
1752 MOVE 'EE' TO WS-HEXX(239).
1753 MOVE 'EF' TO WS-HEXX(240).
1754 MOVE 'F0' TO WS-HEXX(241).
1755 MOVE 'F1' TO WS-HEXX(242).
1756 MOVE 'F2' TO WS-HEXX(243).
1757 MOVE 'F3' TO WS-HEXX(244).
1758 MOVE 'F4' TO WS-HEXX(245).
1759 MOVE 'F5' TO WS-HEXX(246).
1760 MOVE 'F6' TO WS-HEXX(247).
1761 MOVE 'F7' TO WS-HEXX(248).
1762 MOVE 'F8' TO WS-HEXX(249).
1763 MOVE 'F9' TO WS-HEXX(250).
1764 MOVE 'FA' TO WS-HEXX(251).
1765 MOVE 'FB' TO WS-HEXX(252).
1766 MOVE 'FC' TO WS-HEXX(253).
1767 MOVE 'FD' TO WS-HEXX(254).
1768 MOVE 'FE' TO WS-HEXX(255).
1769 MOVE 'FF' TO WS-HEXX(256).
1770
1771 * Fill K's table
1772 MOVE CNS-K0 TO WS-KS-VAL(01).
1773 MOVE CNS-K0 TO WS-KS-VAL(02).
1774 MOVE CNS-K0 TO WS-KS-VAL(03).
1775 MOVE CNS-K0 TO WS-KS-VAL(04).
1776 MOVE CNS-K0 TO WS-KS-VAL(05).
1777 MOVE CNS-K0 TO WS-KS-VAL(06).
1778 MOVE CNS-K0 TO WS-KS-VAL(07).
1779 MOVE CNS-K0 TO WS-KS-VAL(08).
1780 MOVE CNS-K0 TO WS-KS-VAL(09).
1781 MOVE CNS-K0 TO WS-KS-VAL(10).
1782 MOVE CNS-K0 TO WS-KS-VAL(11).
1783 MOVE CNS-K0 TO WS-KS-VAL(12).
1784 MOVE CNS-K0 TO WS-KS-VAL(13).
1785 MOVE CNS-K0 TO WS-KS-VAL(14).
1786 MOVE CNS-K0 TO WS-KS-VAL(15).
1787 MOVE CNS-K0 TO WS-KS-VAL(16).
1788 MOVE CNS-K0 TO WS-KS-VAL(17).
1789 MOVE CNS-K0 TO WS-KS-VAL(18).
1790 MOVE CNS-K0 TO WS-KS-VAL(19).
1791 MOVE CNS-K0 TO WS-KS-VAL(20).
1792 MOVE CNS-K1 TO WS-KS-VAL(21).
1793 MOVE CNS-K1 TO WS-KS-VAL(22).
1794 MOVE CNS-K1 TO WS-KS-VAL(23).
1795 MOVE CNS-K1 TO WS-KS-VAL(24).
1796 MOVE CNS-K1 TO WS-KS-VAL(25).
1797 MOVE CNS-K1 TO WS-KS-VAL(26).
1798 MOVE CNS-K1 TO WS-KS-VAL(27).
1799 MOVE CNS-K1 TO WS-KS-VAL(28).
1800 MOVE CNS-K1 TO WS-KS-VAL(29).
1801 MOVE CNS-K1 TO WS-KS-VAL(30).
1802 MOVE CNS-K1 TO WS-KS-VAL(31).
1803 MOVE CNS-K1 TO WS-KS-VAL(32).
1804 MOVE CNS-K1 TO WS-KS-VAL(33).
1805 MOVE CNS-K1 TO WS-KS-VAL(34).
1806 MOVE CNS-K1 TO WS-KS-VAL(35).
1807 MOVE CNS-K1 TO WS-KS-VAL(36).
1808 MOVE CNS-K1 TO WS-KS-VAL(37).
1809 MOVE CNS-K1 TO WS-KS-VAL(38).
1810 MOVE CNS-K1 TO WS-KS-VAL(39).
1811 MOVE CNS-K1 TO WS-KS-VAL(40).
1812 MOVE CNS-K2 TO WS-KS-VAL(41).
1813 MOVE CNS-K2 TO WS-KS-VAL(42).
1814 MOVE CNS-K2 TO WS-KS-VAL(43).
1815 MOVE CNS-K2 TO WS-KS-VAL(44).
1816 MOVE CNS-K2 TO WS-KS-VAL(45).
1817 MOVE CNS-K2 TO WS-KS-VAL(46).
1818 MOVE CNS-K2 TO WS-KS-VAL(47).
1819 MOVE CNS-K2 TO WS-KS-VAL(48).
1820 MOVE CNS-K2 TO WS-KS-VAL(49).
1821 MOVE CNS-K2 TO WS-KS-VAL(50).
1822 MOVE CNS-K2 TO WS-KS-VAL(51).
1823 MOVE CNS-K2 TO WS-KS-VAL(52).
1824 MOVE CNS-K2 TO WS-KS-VAL(53).
1825 MOVE CNS-K2 TO WS-KS-VAL(54).
1826 MOVE CNS-K2 TO WS-KS-VAL(55).
1827 MOVE CNS-K2 TO WS-KS-VAL(56).
1828 MOVE CNS-K2 TO WS-KS-VAL(57).
1829 MOVE CNS-K2 TO WS-KS-VAL(58).
1830 MOVE CNS-K2 TO WS-KS-VAL(59).
1831 MOVE CNS-K2 TO WS-KS-VAL(60).
1832 MOVE CNS-K3 TO WS-KS-VAL(61).
1833 MOVE CNS-K3 TO WS-KS-VAL(62).
1834 MOVE CNS-K3 TO WS-KS-VAL(63).
1835 MOVE CNS-K3 TO WS-KS-VAL(64).
1836 MOVE CNS-K3 TO WS-KS-VAL(65).
1837 MOVE CNS-K3 TO WS-KS-VAL(66).
1838 MOVE CNS-K3 TO WS-KS-VAL(67).
1839 MOVE CNS-K3 TO WS-KS-VAL(68).
1840 MOVE CNS-K3 TO WS-KS-VAL(69).
1841 MOVE CNS-K3 TO WS-KS-VAL(70).
1842 MOVE CNS-K3 TO WS-KS-VAL(71).
1843 MOVE CNS-K3 TO WS-KS-VAL(72).
1844 MOVE CNS-K3 TO WS-KS-VAL(73).
1845 MOVE CNS-K3 TO WS-KS-VAL(74).
1846 MOVE CNS-K3 TO WS-KS-VAL(75).
1847 MOVE CNS-K3 TO WS-KS-VAL(76).
1848 MOVE CNS-K3 TO WS-KS-VAL(77).
1849 MOVE CNS-K3 TO WS-KS-VAL(78).
1850 MOVE CNS-K3 TO WS-KS-VAL(79).
1851 MOVE CNS-K3 TO WS-KS-VAL(80).
Y con esto, damos por concluído este pequeño gran proyecto.
¡Hasta la próxima!
No hay comentarios:
Publicar un comentario