CVT TITLE 'DMKCVT (CP) VM/370 - RELEASE 6' 00001000
ISEQ 73,80 00002000
*. 00003000
* MODULE NAME - 00004000
* 00005000
* DMKCVT 00006000
* 00007000
* CONTENTS - 00008000
* 00009000
* DMKCVTBH - BINARY TO EBCDIC HEX 00010000
* DMKCVTHB - EBCDIC HEX TO BINARY 00011000
* DMKCVTFP - FLOATING POINT HEX TO EBCDIC DECIMAL 00012000
* DMKCVTDB - EBCDIC DECIMAL TO BINARY 00013000
* DMKCVTBD - BINARY TO EBCDIC DECIMAL 00014000
* DMKCVTDT - DATE AND TIME 00015000
* 00016000
*. 00017000
EJECT 00018000
COPY OPTIONS 00019000
EJECT 00020000
COPY LOCAL OPTIONS 00021000
EJECT 00022000
DMKCVT CSECT 00023000
SPACE 2 00024000
ENTRY DMKCVTBH 00025000
ENTRY DMKCVTHB 00026000
ENTRY DMKCVTBD 00027000
ENTRY DMKCVTDB 00028000
ENTRY DMKCVTFP 00029000
ENTRY DMKCVTDT 00030000
ENTRY DMKCVTAB @VA04301 00030100
SPACE 3 00031000
USING PSA,R0 00032000
EJECT 00033000
*. 00034000
* SUBROUTINE NAME - 00035000
* 00036000
* DMKCVTBH 00037000
* 00038000
* FUNCTION - 00039000
* 00040000
* CONVERTS A WORD OF BINARY INFORMATION INTO A DOUBLE- 00041000
* WORD OF EBCDIC HEX DIGITS 00042000
* 00043000
* ATTRIBUTES - 00044000
* 00045000
* SERIALLY REUSABLE, RESIDENT, CALLED VIA BALR 00046000
* 00047000
* ENTRY POINT - 00048000
* 00049000
* DMKCVTBH - CONVERT BINARY TO EBCDIC HEX 00050000
* 00051000
* ENTRY CONDITIONS - 00052000
* 00053000
* GPR1 = WORD OF BINARY INFORMATION TO BE CONVERTED 00054000
* GPR15 = BASE ADDRESS 00055000
* 00056000
* EXIT CONDITIONS - 00057000
* 00058000
* GPR0, GPR1 = DOUBLEWORD OF EBCDIC HEX DIGITS 00059000
* 00060000
* CALLS TO OTHER ROUTINES - 00061000
* 00062000
* NONE 00063000
* 00064000
* EXTERNAL REFERENCES - 00065000
* 00066000
* NONE 00067000
* 00068000
* TABLES / WORK AREAS - 00069000
* 00070000
* TEMPSAVE 00071000
* 00072000
* REGISTER USAGE - 00073000
* 00074000
* GPR14 = RETURN REGISTER 00075000
* GPR15 = BASE REGISTER 00076000
* 00077000
* GPR0, GPR1 = WORK REGISTERS 00078000
* 00079000
* ALL OTHER REGISTERS ARE NOT USED 00080000
* 00081000
* NOTES - 00082000
* 00083000
* NONE 00084000
* 00085000
EJECT 00086000
* OPERATION - 00087000
* 00088000
* 1. UNPACK BINARY INFORMATION. 00089000
* 2. TRANSLATE TO HEX EBCDIC DIGITS. 00090000
* 00091000
*. 00092000
SPACE 3 00093000
DMKCVTBH DS 0H 00094000
USING *,R15 00095000
ST R1,TEMPSAVE BINARY 00096000
UNPK TEMPSAVE+8(9),TEMPSAVE(5) UNPACK 00097000
TR TEMPSAVE+8(8),DMPTAB-C'0' TRANSLATE 00098000
LM R0,R1,TEMPSAVE+8 RETURN VALUE IN R0 AND R1 00099000
BR R14 RETURN 00100000
DROP R15 00101000
EJECT 00102000
*. 00103000
* SUBROUTINE NAME - 00104000
* 00105000
* DMKCVTHB 00106000
* 00107000
* FUNCTION - 00108000
* 00109000
* CONVERTS THE EBCDIC HEX FIELD DESIGNATED TO A FULL WORD 00110000
* OF BINARY 00111000
* 00112000
* ATTRIBUTES - 00113000
* 00114000
* SERIALLY REUSABLE, RESIDENT, CALLED VIA BALR 00115000
* 00116000
* ENTRY POINTS - 00117000
* 00118000
* DMKCVTHB - CONVERT EBCDIC HEX TO BINARY 00119000
* 00120000
* ENTRY CONDITIONS - 00121000
* 00122000
* GPR0 = LENGTH OF FIELD 00123000
* GPR1 = ADDRESS OF THE FIRST BYTE OF THE FIELD 00124000
* 00125000
* EXIT CONDITIONS - 00126000
* 00127000
* GPR1 = FULL WORD OF BINARY; IF ERROR GPR1 = 0 00128000
* 00129000
* CC = 0; IF ERROR CC ¬= 0 00130000
* 00131000
* CALLS TO OTHER ROUTINES - 00132000
* 00133000
* NONE 00134000
* 00135000
* EXTERNAL REFERENCES - 00136000
* 00137000
* NONE 00138000
* 00139000
* TABLES / WORK AREAS - 00140000
* 00141000
* BALRSAVE 00142000
* 00143000
* REGISTER USAGE - 00144000
* 00145000
* GPR14 = RETURN REGISTER 00146000
* GPR15 = BASE REGISTER 00147000
* 00148000
* GPR0, GPR1, GPR2, GPR3 = WORK REGISTERS 00149000
* 00150000
* ALL OTHER REGISTERS ARE NOT USED 00151000
* 00152000
* NOTES - 00153000
* 00154000
* NONE 00155000
* 00156000
EJECT 00157000
* OPERATION - 00158000
* 00159000
* 1. SAVE REGISTERS. 00160000
* 2. GET NEXT EBCDIC HEX DIGIT. 00161000
* 3. IF DIGIT GREATER THAN "0" AND LESS THAN "9" SUBTRACT X'F0'; 00162000
* OTHERWISE IF GREATER THAN "A" SUBTRACT X'B7'; 00163000
* OTHERWISE INDICATE CHARACTER ERROR IN FIELD. 00164000
* 4. ACCUMULATE BINARY DIGITS IN GPR0. 00165000
* 5. LOOP THROUGH ENTIRE FIELD. 00166000
* 6. RESTORE REGISTERS. 00167000
* 00168000
*. 00169000
SPACE 3 00170000
DMKCVTHB DS 0H 00171000
USING *,R15 00172000
STM R0,R3,BALRSAVE SAVE REGISTERS 00173000
LR R3,R0 SAVE FIELD LENGTH 00174000
SR R2,R2 CLEAR REG 00175000
LR R0,R2 ... 00176000
L1 IC R2,0(,R1) GET DIGIT 00177000
CLI 0(R1),C'0' GREATER THAN ZERO? 00178000
BL L3 NO TRY A-F 00179000
CLI 0(R1),C'9' GREATER THAN NINE? 00180000
BH ERR2 YES ERROR 00181000
S R2,F240 (=A(C'0')) MAKE DIGIT A HEX NUMBER 00182000
B L2 CONTINUE 00183000
L3 CLI 0(R1),C'A' LESS THAN "A"? 00184000
BL ERR2 YES ERROR 00185000
CLI 0(R1),C'F' GREATER THAN "F"? 00186000
BH ERR2 YES ERROR 00187000
SH R2,=AL2(C'A'-10) MAKE CHAR A HEX NUMBER 00188000
L2 SLL R0,4 ASSEMBLE NEXT DIGIT 00189000
AR R0,R2 ... 00190000
LA R1,1(,R1) BUMP PTR 00191000
BCT R3,L1 LOOP THROUGH ENTIRE FIELD 00192000
ST R0,BALR1 RETURN RESULT IN R1 00193000
SR R0,R0 SET CC=0 00194000
LM R0,R3,BALRSAVE RESTORE REGISTERS 00195000
BR R14 RETURN 00196000
* 00197000
ERR2 DS 0H 00198000
LM R0,R3,BALRSAVE RESTORE REGISTERS 00199000
LA R1,0 RETURN ZERO WITHOUT DISTURBING CC 00200000
BR R14 00201000
DROP R15 00202000
EJECT 00203000
*. 00204000
* SUBROUTINE NAME - 00205000
* 00206000
* DMKCVTFP 00207000
* 00208000
* FUNCTION - 00209000
* 00210000
* CONVERT FLOATING HEX TO 17 BYTES OF EBCDIC DECIMAL 00211000
* 00212000
* ATTRIBUTES - 00213000
* 00214000
* SERIALLY REUSABLE, RESIDENT, CALLED VIA BALR 00215000
* 00216000
* ENTRY POINTS - 00217000
* 00218000
* DMKCVTFP - CONVERT FLOATING HEX TO EBCDIC DECIMAL 00219000
* 00220000
* ENTRY CONDITIONS - 00221000
* 00222000
* GPR1 = ADDRESS OF RESULT LOCATION 00223000
* GPR2 = ADDRESS OF FLOATING HEX DOUBLEWORD 00224000
* 00225000
* EXIT CONDITIONS - 00226000
* 00227000
* SAME AS FOR ENTRY CONDITIONS 00228000
* 00229000
* CALLS TO OTHER ROUTINES - 00230000
* 00231000
* NONE 00232000
* 00233000
* EXTERNAL REFERENCES - 00234000
* 00235000
* NONE 00236000
* 00237000
* TABLES / WORK AREAS - 00238000
* 00239000
* BALRSAVE 00240000
* 00241000
* REGISTER USAGE - 00242000
* 00243000
* GPR1 = ADDRESS OF RESULT LOCATION 00244000
* GPR2 = ADDRESS OF FLOATING HEX DOUBLEWORD 00245000
* GPR14 = RETURN REGISTER 00246000
* GPR15 = BASE REGISTER 00247000
* 00248000
* GPR5, GPR6, GPR7, GPR8, GPR9, GPR10 = WORK REGISTERS 00249000
* 00250000
* ALL OTHER REGISTERS ARE NOT USED 00251000
* 00252000
* 00253000
* NOTES - 00254000
* 00255000
* NONE 00256000
* 00257000
EJECT 00258000
* OPERATION - 00259000
* 00260000
* 1. SAVE REGISTERS 00261000
* 2. SET FRACTION SIGN. 00262000
* 3. NORMALIZE & ADJUST FRACTION SO THAT ALL DIGITS ARE TO 00263000
* THE RIGHT OF THE DECIMAL POINT. 00264000
* 4. SET EXPONENT SIGN. 00265000
* 5. CONVERT EXPONENT TO EBCDIC DECIMAL. 00266000
* 6. CONVERT FRACTION TO EBCDIC DECIMAL. 00267000
* 7. RESTORE REGISTERS. 00268000
* 00269000
*. 00270000
SPACE 00271000
DMKCVTFP DS 0H 00272000
USING *,R15 00273000
STM R5,R10,BALRSAVE 00274000
LM R6,R7,0(R2) GET FLOATING POINT NUMBER 00275000
SLR R9,R9 CLEAR 00276000
LR R8,R7 ISOLATE FRACTION IN GPR 7 & 8 00277000
SRDA R6,24 ISOLATE EXPONENT IN GPR 6 00278000
SRL R7,4 ... 00279000
STM R7,R9,HIGH STORE FRACTION 00280000
MVC DMPPST(2,R1),K2 SET FRACTION SIGN & POINT 00281000
LA R7,X'40' LOAD EXPONENT CORRECTION FACTOR 00282000
BM CVT3 BRANCH IF NEGATIVE FRACTION 00283000
MVI DMPPST(R1),C' ' CORRECT FRACTION SIGN TO POSITIVE 00284000
LCR R7,R7 COMPLEMENT EXPONENT CORRECTION 00285000
CVT3 EQU * 00286000
AR R6,R7 SET FRACTION SIGN POSITIVE 00287000
STH R6,HEXEXP STORE HEX. EXPONENT. 00288000
STH R9,DECEXP INITIAL DEC. EXPONENT. 00289000
NI HIGH+4,X'0F' CORRECT FRACTION 00290000
LA R5,1 SET BASE PT. TO DECIMAL 00291000
CLC HIGH(8),HIGH+1 IS FRACTION ZERO? 00292000
BNE CVT1B NO 00293000
SLR R6,R6 SET EXPONENT .EQ. 0 00294000
SLR R7,R7 ... 00295000
MVI DMPPST(R1),C' ' SET FRACTION SIGN POSITIVE 00296000
B STOREZ 00297000
CVT1B EQU * 00298000
BALR R8,0 SET RETURN VECTOR HERE 00299000
SLR R6,R6 CLEAR 00300000
LPR R5,R5 SET BASE TO DECIMAL 00301000
CH R9,HEXEXP TEST HEX. EXPONENT. 00302000
BE NORMAL ZERO -- NORMALIZED 00303000
BH *+6 00304000
LCR R5,R5 SWITCH BASE TO HEX 00305000
CLI HIGH,0 TEST FRACTION 00306000
ADJUST EQU * 00307000
LA R9,12 SET LOOP INDEX 00308000
BH DIV BRANCH IF DIVIDE NEEDED 00309000
MULT EQU * 00310000
L R7,HIGH-4(R9) MULTIPLY FRACTION. 00311000
USING DMKCVTFP+1,R15 TO PREVENT ASSEMBLY ALIGNMENT ERRORS 00312000
MH R7,BASE+2(R5) USE SELECTED BASE 00313000
USING DMKCVTFP,R15 00314000
AR R6,R7 CATCH OVERFLOW HERE 00315000
SRDL R6,28 ... 00316000
SRL R7,4 ... 00317000
ST R7,HIGH-4(R9) ... 00318000
S R9,F4 00319000
BH MULT REPEAT FOR 3 WORDS 00320000
SLR R7,R7 SET R7 .EQ. -1 00321000
BCTR R7,0 ... 00322000
B ADJEXP 00323000
DIV EQU * 00324000
LCR R5,R5 SWITCH BASES 00325000
USING DMKCVTFP+1,R15 TO PREVENT ASSEMBLY ALIGNMENT ERRORS 00326000
LH R10,BASE+2(R5) LOAD PROPER DIVISOR 00327000
USING DMKCVTFP,R15 00328000
LCR R9,R9 NEGATE LOOP INDEX 00329000
DIV2 EQU * 00330000
L R7,LOW+4(R9) DIVIDE FRACTION BY SELECTED BASE 00331000
SLL R7,4 AND DECREMENT EXPONENT COUNT 00332000
SRDL R6,4 ... 00333000
DR R6,R10 ... 00334000
ST R7,LOW+4(R9) ... 00335000
A R9,F4 00336000
BM DIV2 REPEAT FOR 3 WORDS 00337000
LA R7,1 GET CONSTANT OF 1 00338000
ADJEXP EQU * 00339000
USING PSA+1,R5 TO PREVENT ASSEMBLY ALIGNMENT ERRORS 00340000
AH R7,HEXEXP+2 CHANGE SELECTED EXPONENT 00341000
STH R7,HEXEXP+2 ... 00342000
DROP R5 00343000
BR R8 00344000
NORMAL EQU * 00345000
BALR R8,0 SET RETURN VECTOR HERE 00346000
LTR R6,R6 ANY OVERFLOW ? 00347000
BZ ADJUST NO -- FORCE OVERFLOW TO OBTAIN FIRST *00348000
DECIMAL DIGIT 00349000
A R7,F1 NO - CORRECT DECIMAL EXPONENT 00350000
STOREZ EQU * 00351000
MVC DMPPST+19(3,R1),K1 SET E- IN OUTPUT 00352000
BM CVT2 BRANCH IF EXPONENT IS NEGATIVE 00353000
MVI DMPPST+21(R1),C' ' SET EXPONENT SIGN POSITIVE 00354000
CVT2 EQU * 00355000
CVD R7,DMPCOT .. 00356000
UNPK DMPPST+22(2,R1),DMPCOT+6(2) 00357000
MVZ DMPPST+23(1,R1),DMPPST+22(R1) 00358000
LA R7,16 INITIALIZE DIGIT INDEX 00359000
STH R7,DECEXP .. 00360000
BALR R8,0 SET RETURN VECTOR HERE 00361000
IC R9,F240+3 (=C'0') GET ZONE BITS 00362000
AR R6,R9 COMBINE WITH DIGIT 00363000
LCR R7,R7 COMPLEMENT DIGIT INDEX 00364000
STC R6,DMPPST+18(R7,R1) STORE DIGIT IN OUTPUT 00365000
BM ADJUST BRANCH IF INDEX .LT. 0 00366000
LM R5,R10,BALRSAVE RESTORE REG. 00367000
BR R14 RETURN 00368000
DROP R15 00369000
SPACE 3 00370000
DMPPST EQU 0 WORK AREA AND AREA FOR ANSWER 00371000
SPACE 1 00372000
BASE DC H'16' 00373000
DC H'10' 00374000
K1 DC C' E' 00375000
K2 DC C'-.' 00376000
EJECT 00377000
*. 00378000
* SUBROUTINE NAME - 00379000
* 00380000
* DMKCVTDB 00381000
* 00382000
* FUNCTION - 00383000
* 00384000
* CONVERTS THE EBCDIC DECIMAL FIELD DESIGNATED TO A FULL WORD 00385000
* OF BINARY 00386000
* 00387000
* ATTRIBUTES - 00388000
* 00389000
* SERIALLY REUSABLE, RESIDENT, CALLED VIA BALR 00390000
* 00391000
* ENTRY POINTS - 00392000
* 00393000
* DMKCVTDB - CONVERT EBCDIC DECIMAL TO BINARY 00394000
* 00395000
* ENTRY CONDITIONS - 00396000
* 00397000
* GPR0 = LENGTH OF FIELD 00398000
* GPR1 = ADDRESS OF THE FIRST BYTE OF THE FIELD 00399000
* 00400000
* EXIT CONDITIONS - 00401000
* 00402000
* GPR1 = FULL WORD OF BINARY; IF ERROR GPR1 = 0 00403000
* 00404000
* CC = 0; IF ERROR CC ¬= 0 00405000
* 00406000
* CALLS TO OTHER ROUTINES - 00407000
* 00408000
* NONE 00409000
* 00410000
* EXTERNAL REFERENCES - 00411000
* 00412000
* NONE 00413000
* 00414000
* TABLES / WORK AREAS - 00415000
* 00416000
* TEMPSAVE 00417000
* 00418000
* REGISTER USAGE - 00419000
* 00420000
* GPR14 = RETURN REGISTER 00421000
* GPR15 = BASE REGISTER 00422000
* 00423000
* GPR0, GPR1, GPR2 = WORK REGISTERS 00424000
* 00425000
EJECT 00426000
* ALL OTHER REGISTERS ARE NOT USED 00427000
* 00428000
* NOTES - 00429000
* 00430000
* NONE 00431000
* 00432000
* OPERATION - 00433000
* 00434000
* 1. SAVE REGISTERS. 00435000
* 2. IF GPR0 GREATER THAN 10 DIGITS INDICATE ERROR. 00436000
* 3. VALIDITY CHECK ALL EBCDIC DECIMAL DIGITS. 00437000
* 4. PACK FIELD. 00438000
* 5. IF RESULT IS GREATER THAN 2**31-1 INDICATE ERROR. 00439000
* 6. CONVERT RESULT TO BINARY. 00440000
* 7. RESTORE REGISTERS. 00441000
* 00442000
*. 00443000
SPACE 3 00444000
DMKCVTDB DS 0H 00445000
USING *,R15 00446000
STM R1,R2,BALR1 SAVE REGS R1 AND R2 00447000
C R0,F10 GREATER THAN 10 DIGITS ? 00448000
BH ERR3 00449000
LR R2,R0 GET LENGTH OF FIELD 00450000
BCTR R2,0 DECREMENT FOR EX 00451000
DECCHK CLI 0(1),C'0' 00452000
BL ERR3 00453000
CLI 0(1),C'9' 00454000
BH ERR3 00455000
LA R1,1(,R1) 00456000
BCT R0,DECCHK 00457000
L R1,BALR1 RESTORE R1 00458000
EX R2,PACK ... 00459000
CP TEMPSAVE(8),=PL8'2147483647' GREATER THAN 2**31-1 ? 00460000
BH ERR3 BRANCH IF YES 00461000
CVB R1,TEMPSAVE CONVERT TO BINARY 00462000
SR R2,R2 SET CONDITION CODE 0 00463000
ERR3 EQU * 00464000
L R2,BALR2 RESTORE R2 00465000
BR R14 RETURN 00466000
DROP R15 00467000
SPACE 1 00468000
PACK PACK TEMPSAVE(8),0(0,R1) EXECUTED PACK INSTRUCTION 00469000
EJECT 00470000
*. 00471000
* SUBROUTINE NAME - 00472000
* 00473000
* DMKCVTBD 00474000
* 00475000
* FUNCTION - 00476000
* 00477000
* CONVERT A WORD OF BINARY INFORMATION INTO A DOUBLE- 00478000
* WORD OF EBCDIC DECIMAL DIGITS 00479000
* 00480000
* ATTRIBUTES - 00481000
* 00482000
* SERIALLY REUSABLE, RESIDENT, CALLED VIA BALR 00483000
* 00484000
* ENTRY POINT - 00485000
* 00486000
* DMKCVTBD - CONVERT BINARY TO EBCDIC DECIMAL 00487000
* 00488000
* ENTRY CONDITIONS - 00489000
* 00490000
* GPR1 = WORD OF BINARY INFORMATION TO BE CONVERTED 00491000
* 00492000
* EXIT CONDITIONS - 00493000
* 00494000
* GPR0, GPR1 = DOUBLEWORD OF EBCDIC DECIMAL DIGITS 00495000
* 00496000
* CALLS TO OTHER ROUTINES - 00497000
* 00498000
* NONE 00499000
* 00500000
* EXTERNAL REFERENCES - 00501000
* 00502000
* NONE 00503000
* 00504000
* TABLES / WORK AREAS - 00505000
* 00506000
* TEMPSAVE 00507000
* 00508000
* REGISTER USAGE - 00509000
* 00510000
* GPR14 = RETURN REGISTER 00511000
* GPR15 = BASE REGISTER 00512000
* 00513000
* GPR0, GPR1 = WORK REGISTERS 00514000
* 00515000
* ALL OTHER REGISTERS ARE NOT USED 00516000
* 00517000
* NOTES - 00518000
* 00519000
* NONE 00520000
* 00521000
EJECT 00522000
* OPERATION - 00523000
* 00524000
* 1. CONVERT BINARY INFORMATION TO DECIMAL. 00525000
* 2. UNPACK DECIMAL INFORMATION. 00526000
* 3. SET SIGN TO POSITIVE. 00527000
* 00528000
*. 00529000
SPACE 3 00530000
DMKCVTBD DS 0H 00531000
USING *,R15 00532000
CVD R1,TEMPSAVE BINARY TO PACKED DECIMAL 00533000
UNPK TEMPSAVE+8(8),TEMPSAVE+3(5) UNPACK 00534000
OI TEMPSAVE+15,X'F0' MAKE UP FOR HARDWARE DEFICIENCIES 00535000
LM R0,R1,TEMPSAVE+8 RETURN VALUE IN R0 AND R1 00536000
BR R14 RETURN 00537000
DROP R15 00538000
EJECT 00539000
*. 00540000
* SUBROUTINE NAME - 00541000
* 00542000
* DMKCVTDT 00543000
* 00544000
* FUNCTION - 00545000
* 00546000
* SETS TIME AND DATE IN EBCDIC 00547000
* 00548000
* ATTRIBUTES - 00549000
* 00550000
* SERIALLY REUSABLE, RESIDENT, CALLED VIA BALR 00551000
* 00552000
* ENTRY POINTS - 00553000
* 00554000
* DMKCVTDT - SET TIME AND DATE IN EBCDIC 00555000
* DMKCVTAB - EXTERNAL ENTRY TO FORCE CVT001 ABEND 00555100
* 00556000
* ENTRY CONDITIONS - 00557000
* 00558000
* GPR1 = ADDRESS WHERE DOUBLEWORD DATE SHOULD BE STORED 00559000
* GPR2 = ADDRESS WHERE DOUBLEWORD TIME SHOULD BE STORED 00560000
* IF EITHER GPR1 OR GPR2 IS NON-POSITIVE, THE CORRESPONDING 00561000
* DATA IS NOT STORED. 00562000
* 00563000
* EXIT CONDITIONS - 00564000
* 00565000
* SAME AS FOR ENTRY CONDITIONS 00566000
* 00567000
* CALLS TO OTHER ROUTINES - NONE 00568000
* 00569000
* EXTERNAL REFERENCES - NONE 00570000
* 00571000
* TABLES / WORK AREAS - 00572000
* 00573000
* BALRSAVE 00574000
* TEMPSAVE 00575000
* 00576000
* REGISTER USAGE - 00577000
* 00578000
* GPR1 = PTR TO OUTPUT AREA FOR DATE (IF WANTED) 00579000
* GPR2 = PTR TO OUTPUT AREA FOR TIME (IF WANTED) 00580000
* GPR14 = RETURN REGISTER 00581000
* GPR15 = BASE REGISTER 00582000
* 00583000
* GPR0, GPR1 = WORK REGISTERS 00584000
* 00585000
* ALL OTHER REGISTERS ARE NOT USED 00586000
* 00587000
* NOTES - NONE 00588000
* 00589000
EJECT 00590000
* OPERATION - 00591000
* 00592000
* 1. TEST IF DATE WANTED AND MOVE DATE FROM PSA TO OUTPUT 00593000
* LOCATION IF IT IS. 00594000
* 2. TEST IF TIME WANTED; IF NOT EXIT. 00595000
* 3. SAVE REGISTERS. 00596000
* 4. STORE TIME OF DAY CLOCK INTO TEMPSAVE. 00597000
* 5. SUBTRACT NUMBER OF MICROSECONDS FROM JAN 1, 1900 00598000
* 0000 HOURS TILL MIDNIGHT THIS MORNING PLUS 00599000
* TIME ZONE CORRECTION CONSTANT. 00600000
* 6. GET NUMBER OF MICROSECONDS PAST MIDNIGHT. 00601000
* 7. GET NUMBER OF SECONDS PAST MIDNIGHT. 00602000
* 8. GET NUMBER OF HOURS, MINUTES, AND SECONDS PAST 00603000
* MIDNIGHT PLACING THE RESULTS IN THE LOCATION SPECIFIED 00604000
* BY GPR2. 00605000
* 9. RESTORE REGISTERS AND EXIT. 00606000
*. 00607000
SPACE 3 00608000
DMKCVTDT DS 0H 00609000
USING *,R15 00610000
LTR 1,1 00611000
BNP DATENO 00612000
MVC 0(8,R1),DATE MOVE DATE TO OUTPUT LOCATION 00613000
DATENO LTR 2,2 00614000
BNP DATEXIT 00615000
STM R0,R1,BALRSAVE SAVE REGS R0 AND R1 00616000
MIDWAIT EQU * HERE TO SPIN TILL MIDNIGHT @VA07949 00616500
STCK TEMPSAVE STORE TOD CLOCK 00617000
BNZ CHKCLOK CLOCK IS NOT RUNNING RIGHT @VA02553 00618000
LM R0,R1,TEMPSAVE TOD CLOCK VALUE TO GR0,GR1 @VA02553 00619000
SL R1,TODATE+4 SUBTRACT CORRECT TIME AT MIDNIGHT 00620000
BC 11,*+8 ... 00621000
SL R0,F1 ... 00622000
SL R0,TODATE ... 00623000
LTR R0,R0 IS IT REALLY PAST MIDNIGHT @VA07949 00623100
BM MIDWAIT NO-NOT QUITE MIDNIGHT,LOOP @VA07949 00623200
SRDL R0,12 GET NUMBER OF MICROSECONDS PAST MIDNIGHT 00624000
D R0,=F'1000000' GET NUMBER OF SECONDS PAST MIDNIGHT 00625000
SR R0,R0 IGNORE REMAINDER 00626000
D R0,=F'3600' GET NUMBER OF HOURS PAST MIDNIGHT 00627000
CVD R1,TEMPSAVE CONVERT NUMBER OF HOURS TO DECIMAL 00628000
UNPK 0(4,R2),TEMPSAVE+6(3) UNPACK 00629000
MVI 2(R2),C':' NEATEN UP 00630000
LR R1,R0 GET REMAINDER FROM LAST DEVIDE 00631000
SR R0,R0 CLEAR 00632000
D R0,F60 GET NUMBER OF MINUTES PAST THIS HOUR 00633000
CVD R1,TEMPSAVE CONVERT NUMBER OF MINUTES TO DECIMAL 00634000
UNPK 3(4,R2),TEMPSAVE+6(3) UNPACK 00635000
MVI 5(R2),C':' NEATEN UP 00636000
CVD R0,TEMPSAVE CONVERT NUMBER OF SECONDS TO DECIMAL 00637000
UNPK 6(2,R2),TEMPSAVE+6(2) UNPACK 00638000
OI 7(R2),X'F0' MAKE UP FOR HARDWARE DEFICIENCIES 00639000
LM R0,R1,BALRSAVE RESTORE REGS R0 AND R1 00640000
DATEXIT DS 0H 00641000
BR R14 RETURN 00642000
SPACE 2 00643000
CHKCLOK EQU * CLOCK NOT SET OR DAMAGED @VA02553 00644000
CLC CPID(4),=C'CPCP' HAVE WE FINISHED IPL YET ? @VA02553 00645000
BE CVT1 YES - TAKE THE SYSTEM DOWN @VA02553 00646000
MVC 0(8,R2),=C'00:00:00' HARMLESS NON-TIME @VA02553 00647000
BR R14 EXIT TO CALLER (REGS UNCHANGED) @VA02553 00648000
SPACE 00649000
DMKCVTAB DS 0D ENTRY TO FORCE CVT001 ABEND @VA04301 00649500
ABEND 1 ANYBODY KNOW WHAT TIME IT IS ? @VA02553 00650000
DROP R15 00651000
DMPTAB DC C'0123456789ABCDEF' TRANSLATE TABLE 00652000
* 00653000
EJECT 00654000
LTORG 00655000
EJECT 00656000
PSA , @V306638 00657000
COPY EQU @V306638 00658000
HIGH EQU TEMPSAVE+4 00659000
LOW EQU HIGH+8 00660000
DMPCOT EQU LOW+4 00661000
HEXEXP EQU TEMPSAVE 00662000
DECEXP EQU HEXEXP+2 00663000
END 00664000