EXIT1 V01L02 1130 PLAN (1130-CX-25X) 08/30/71 * // XEQ X8K EX100020 // ASM EX100040 *XREF EX100060 *LIST EX100080 *MACLIB PMAC1 EX100100 *COMMON 6725 EX100120 ABS EX100140 ORG 510 EX100160 DATE EXIT1 EX100180 HDNG EXIT1 - USER EXIT MODULE FOR EXT PREC EX100200 * EXIT1 - USER EXIT PROGRAM TO COLLECT EXT. PREC. EX100220 ENTPT EQU * EX100240 * SET UP LINKAGES EX100260 CALL IUSER EX100280 *COLLECT EXTENDED PRECISION NUMBER EX100300 NMBER LDX L2 LACC+10 CLEAR EX100320 LDX 3 -11 EX100340 SLT 32 FULL SIZED EX100360 LOOP STO 2 0 TEMPORARY EX100380 EOR SBLNK ACCUMULATOR EX100400 STO 2 9 FIRST HALF EX100420 EOR SBLNK TO BLANK EX100440 MDX 2 -1 SECOND HALF EX100460 MDX 3 1 TO ZERO EX100480 MDX LOOP EX100500 STD L ECOW CLEAR EX100520 STD L SLCOW COUNTERS EX100540 STX NEG SET SIGN POSITIVE EX100560 LDX 2 1 EX100580 STX L2 SLX1+1 EX100600 BSI L QGET GET SIGN AND FIRST CHAR EX100620 LDX L2 *-* EX100640 NEG EQU *-1 EX100660 STX 2 XNEG SAVE SIGN EX100680 STX NEG TURN OFF NEGATIVE EX100700 BSC1 BSC L BSISL,- NUMERIC DO SHIFT LEFT EX100720 EOR L X8040 IF BLANK EX100740 B DQUES GO TEST FOR OTHER CHARS EX100760 BSISL BSI L SLADD SHIFT LEFT AND ADD NEW DIG EX100780 BSI L CGET GET NEXT CHARACTER EX100800 MDX BSC1 EX100820 DQUES EOR XB IS IT DECIMAL POINT EX100840 BSC L EQUES,Z NO, TEST FOR E EX100860 MDX L DCOW,0 DECIMAL ALREADY FOUND EX100880 MDX ALL YES, EXIT FROM SCAN EX100900 LD L SLCOW NO, SAVE CURRENT EX100920 A L ONE EX100940 STO L DCOW DIGIT COUNT EX100960 MDX BSISL+2 GET NEXT CHARACTER EX100980 EQUES EOR X8E IS IT E EX101000 LDX L2 BSC2 SET EXIT FROM SIGN EX101020 STX L2 QGET COLLECT EX101040 BSC L QGET+1,+- ENTER THERE IF E EX101060 EOR X85 RESTORE EX101080 BSC L STEST AND ENTER IF NOT EX101100 STOS STO BOX SAVE DIGIT EX101120 LD ECOW ADD EX101140 M TEN NEW EX101160 SLT 16 DIGIT EX101180 A BOX TO EX101200 STO ECOW E COUNT EX101220 BSI L CGET FETCH NEXT CHAR EX101240 BSC2 BSC L STOS,- LOOP IF DIGIT EX101260 LD NEG EX101280 BSC L ALL,Z IF EX101300 S ECOW NEGATIVE E EX101320 STO ECOW SET,COMPUTE DIGITS EX101340 ALL LD SLCOW EX101360 S DCOW EX101380 A ONE EX101400 MDX L DCOW,0 ANY DECIMAL EX101420 STO DECOW YES, OVERRIDE D EX101440 LD SLCOW COMPUTE EX101460 S SLSAV ADJUSTMENT EX101480 EOR SLCOW IS IT SUPPRESS EX101500 BSC Z YES EX101520 EOR SLCOW NO,RESTORE EX101540 S DECOW DECIMAL EX101560 A ECOW ON EX101580 STO ECOW NUMBER EX101600 LDX 2 1 EX101620 BSC L INCRM,+Z IF NEGATIVE DO RIGHT SHIFT EX101640 BSC L OUT,+ IF ZERO,NO RIGHT SHIFT RQD EX101660 SRA 16 CLEAR EX101680 STO SLSAV OVERFLOW EX101700 BSI L SLADD SHIFT LEFT 1 DECIMAL DIGIT EX101720 BSC L FALSE,Z IF OVERFLOW,TAKE ERROR EX EX101740 MDX L ECOW,-1 ANY MORE SHIFT EX101760 MDX X -9 YES EX101780 MDX OUT NO,EXIT EX101800 SBLNK DC /8040 EX101820 XNEG DC 0 EX101840 * SHIFT NUMBER RIGHT DECIMAL EX101860 RIGHT STO ECOW EX101880 LDX 3 -19 SET EX101900 LD L3 LACC+19 GET WORD EX101920 BSC L SRZ,+- IF ZERO,DON'T DIVIDE EX101940 SLT 16 NOT ZERO,SET ZERO REM EX101960 SRLOP LD L3 LACC+19 GET NEXT WORD FROM ACC EX101980 BSC L ADJST,- EX102000 SLT 16 IS THERE A REMAINDER EX102020 BSC L INCRM,+ NO,GET NEXT SHIFT EX102040 SRT 16 YES,SET WORD TO ZERO EX102060 ADJST SLA 1 COMBINE EX102080 RTE 17 WITH REMAINDER EX102100 D L2 TEN EX102120 STO L3 LACC+19 SAVE QUOTIENT EX102140 MDX 3 1 MORE IN ACC EX102160 MDX SRLOP YES,LOOP EX102180 MDX INCRM NO,TRUNCATE EX102200 SRZ MDX 3 1 ANY LEFT IN ACCUMULATOR EX102220 MDX RIGHT+2 YES,GET NEXT EX102240 INCRM LD ECOW EX102260 A FOUR EX102280 BSC L RIGHT,+ EX102300 LDX 2 0 EX102320 S THREE EX102340 BSC L RIGHT,+ EX102360 OUT LDX 3 -11 SETUP EX102380 LDX L2 LACC+9 LOOP EX102400 LD 2 0 CLEAR EX102420 EOR X8040 UNUSED EX102440 BSC - PORTION EX102460 STO 2 0 OF EX102480 MDX 2 1 ACCUMULATOR EX102500 MDX 3 1 EX102520 MDX X -7 EX102540 LD INITE SET INITIAL SWITCH EX102560 STO ECOW NORMALIZE CHARACTERISTIC EX102580 LDX L3 LACC SET LOOP EX102600 LD 3 0 NEXT WORD EX102620 BSC L SHIFT,Z IF NOT ZERO,NORMALIZE EX102640 MDX 3 1 GET NEXT EX102660 MDX L ECOW,-15 DECREMENT CHARACTERISTIC EX102680 MDX X -7 LOOP IF MORE EX102700 ZERO SLT 32 SET TO ZERO EX102720 STD FCOW RESULT EX102740 STO ECOW AND CHARACTERISTIC EX102760 MDX FALSE EX102780 * DECLARATIVES EX102800 XB DC /B EX102820 X10 DC /10 EX102840 X1E DC /1E EX102860 X2E DC /2E EX102880 X85 DC /85 EX102900 X8E DC /8E EX102920 X8040 DC /8040 EX102940 X8060 DC /8060 EX102960 TEN DC 10 EX102980 DC 10000 EX103000 D16 DC /10 EX103020 BOX DC 0 EX103040 K0 DC 0 EX103060 BSS E 0 EX103080 ECOW DC 0 EX103100 DCOW DC 0 EX103120 ROUND DC 0 EX103140 ONE DC 1 EX103160 BIG DC /7FFF EX103180 DC -1 EX103200 FCOW DC 0 EX103220 DECOW DC 0 EX103240 DWD DEC 0 EX103260 SLCOW DC 0 EX103280 SLSAV DC 0 EX103300 INITE DC 264 EX103320 THREE DC 3 EX103340 FOUR DC 4 EX103360 X7B1E DC /7B1E COMM ARRAY BASE EX103380 HOLD DC *-* EX103400 SHIFT LDX 2 16 GET MOST SIGNIFICANT BIT EX103420 SLCA 2 0 EX103440 STX 2 SLCOW SAVE EX103460 SRA 1 COUNTERS EX103480 STO SLSAV EX103500 LD 3 2 GET EX103520 SRT 15 NEXT EX103540 LD 3 1 TWO WORDS EX103560 SRT 2 0 AND ADJUST EX103580 OR SLSAV INCLUDE HIGH ORDER BITS EX103600 SZ STD FCOW EX103620 LD SLCOW COMPUTE ACTUAL CHARACT EX103640 S D16 EX103660 A ECOW EX103680 BSC L ZERO,+Z IF NEGATIVE,SET TO ZERO EX103700 STO ECOW EX103720 FALSE CALL NUSER EX103740 DC HOLD EX103760 DC QGET EX103780 MDX L QGET,0 EX103800 B STDL EX103820 LD HOLD CALCULATE EX103840 SLA 1 STORAGE EX103860 EOR BIG+1 ADDRESS EX103880 A ONE FOR EX103900 A X7B1E CONVERTED EX103920 STO *+1 VALUE EX103940 LDX L3 *-* EX103960 SLT 32 IS IT EX103980 SD FCOW NO,SET NEGATIVE EX104000 MDX L XNEG,0 NEGATIVE EX104020 LDD FCOW NO,GET VALUE EX104040 STO 3 1 STORE EX104060 SLT 16 DOUBLE EX104080 STO 3 +2 PRECISION EX104100 LD ECOW RESULT EX104120 STO 3 0 EX104140 STDL CALL NUSER EX104160 DC HOLD EX104180 DC QGET EX104200 CALL NUSER EX104220 DC HOLD EX104240 DC QGET EX104260 CSLID LD BOX DID NUMERIC FIELD EX104280 EOR X8040 END ON A EX104300 SLA 1 BLANK, EX104320 BNZ PSRET IF NOT - BRANCH EX104340 BSI CGET GET NEXT CHARACTER EX104360 B CSLID AND BR TO CHECK IT EX104380 PSRET CALL EUSER RETURN TO PSCAN EX104400 DC K0 EX104420 DC K0 EX104440 DC K0 EX104460 * GET SIGN AND SLIDE EX104480 EOR X8060 EX104500 BSC L *-* EXIT FROM QGET EX104520 QGET EQU *-1 EX104540 BSI CGET GET NEXT CHARACTER EX104560 EOR X8040 IF BLANK,SUPPRESS EX104580 BSC L QGET+1,+- EX104600 STEST EOR X10 AMPERSAND EX104620 BSC Z YES EX104640 EOR X1E EBCDIC + EX104660 BSC L SIGN,+- YES EX104680 EOR X2E MINUS EX104700 BSC L QGET-2,Z NO,EXIT EX104720 STO L NEG INDICATE NEGATIVE EX104740 SIGN BSI CGET GET NEXT EX104760 EOR X8040 IF BLANK EX104780 BSC L SIGN,+- SUPPRESS EX104800 EOR X8040 RESTORE EX104820 MDX QGET-1 AND EXIT EX104840 LD BOX RESTORE EX104860 EOR X8000 CHARACTER EX104880 BSC L *-* EXIT EX104900 CGET EQU *-1 EX104920 CALL GUSER GO GET CHAR EX104940 DC BOX EX104960 LD BOX EX104980 S XF0 IS IT A VALID NUMBER EX105000 BSC L CGET-3,+Z NO,EXIT EX105020 S TEN EX105040 BSC L CGET-3,- NO,EXIT EX105060 A TEN EX105080 MDX CGET-1 EX105100 XF0 DC /F0 EX105120 X8000 DC /8000 EX105140 * SHIFT LEFT 1 DECIMAL AND ADD NEW DIGIT EX105160 SLADD DC *-* EX105180 STO DWD+1 SAVE NEW DIGIT EX105200 MDX L SLCOW,+1 DIGIT COUNT EX105220 LD SLSAV HAS AREA OVERFLOWED EX105240 BSC I SLADD,Z YES DONT ADD ANYMORE EX105260 LDX L3 LACC+8 GET EX105280 SLX1 LDX L2 *-* POINTERS EX105300 SLLOP LD 3 0 GET WORD FROM INT PORT A EX105320 M L TEN SHIFT LEFT 1 DECIMAL EX105340 AD L DWD ADD NEW DIGIT EX105360 SLT 1 GET OVERFLOW TO EX105380 STO L DWD+1 NEXT WORD OF ACC EX105400 SLT 16 STORE EX105420 SRA 1 SHIFTED EX105440 STO 3 0 WORD EX105460 MDX 3 -1 GET NEXT EX105480 MDX 2 -1 ARE THERE ANY MORE EX105500 MDX SLLOP YES,LOOP EX105520 LD L DWD+1 ANY OVERFLOW ON LAST WORD EX105540 BSC L LDT,+ NO,TEST ACC FOR OFLO EX105560 MDX L SLX1+1,+1 YES,UP EX105580 MDX SLLOP DO OVERFLOW EX105600 LDT LD LACC EX105620 SRA 11 TOO MANY DIGITS EX105640 BSC I SLADD,+ NO,EXIT EX105660 LD L SLCOW YES,SAVE EX105680 STO L SLSAV COUNT EX105700 BSC I SLADD AND EXIT EX105720 LACC BSS 20 EX105740 END ENTPT EX105760 // DUP EX105780 *DUMP WS CD EXIT1 EX105800 *DELETE EXIT1 EX105820 *STORECI WS UA EXIT1 EX105840