ibm:vm370-lib:cp:dmkcvt.assemble_src
Table of Contents
DMKCVT Source
References
- Fixes Applied : 0
- This Source Date : Thursday, December 7, 1978
- Last Fix ID : [Unmodified]
Source Listing
- DMKCVT.ASSEMBLE.txt
- 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
ibm/vm370-lib/cp/dmkcvt.assemble_src.txt · Last modified: 2023/08/06 13:36 by Site Administrator