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