TITLE PD FOR LIBOL V10 AND RPGLIB V1 SUBTTL CONVERT BINARY TO DISPLAY 15-DEC-74 /ACK ;COPYRIGHT 1974, 1975, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. ;ALL MODIFICATIONS FOR RPGII COPYRIGHT 1976, BOB CURRIER AND CERRITOS COLLEGE ;REVISION HISTORY: ;V10 ***** ; 15-DEC-74 /ACK CREATION. ; 5/15/75 /DBT BIS ;***** SEARCH RPGPRM ;DEFINE PARAMETERS. %%LBLP==:%%LBLP EBCMP.==:EBCMP. BIS==:BIS EXTERN EASTB. ;FORCE EASTBL TO BE LOADED. HISEG COMMENT \ THIS ROUTINE CONVERTS A ONE OR TWO WORD BINARY NUMBER TO A DISPLAY ITEM. CALL: MOVE 16,[Z AC,PARAMETER ADDRESS] PUSHJ 17,PD6./PD7./PD9. PARAMETERS: THE ACCUMULATOR FIELD OF AC 16 CONTAINS THE AC WHICH CONTAINS THE FIRST WORD OF THE NUMBER TO BE CONVERTED. THE SECOND WORD, IF IT EXISTS, IS IN THE FOLLOWING AC. THE RIGHT HALF OF AC 16 POINTS TO A WORD IN THE FOLLOWING FORMAT: BITS 0-5 BYTE RESIDUE FOR OUTPUT FIELD. BIT 6 1 IF THE FIELD IS SIGNED. BITS 7-17 SIZE OF THE OUTPUT FIELD. BITS 18-35 ADDRESS OF THE FIRST CHARACTER OF THE OUTPUT FIELD. RETURNS: CALL+1 ALWAYS. REGISTERS USED: T1, CPTR, IPTR (CALLED OPTR), SW, CNT, T2, MASK, JAC, SAV10 \ EXTERN SET1. ;ROUTINE TO PICK UP THE PARAMETERS. EXTERN PACFL. ;POINTER TO THE NUMBER OF THE AC INTO ; WHICH WE ARE TO PLACE THE RESULT. ENTRY PD6. ;IF THE INPUT IS SIXBIT. ENTRY PD7. ;IF THE INPUT IS ASCII. ENTRY PD9. ;IF THE INPUT IS EBCDIC. IFE BIS,< ;LOCAL AC DEFINITIONS: OPTR==IPTR CPTR==PARM SAV10==TAC5 MASK==TAC4 T1==TAC2 T2==TAC3 PD6.: JSP T2, PD ;ENTER HERE IF THE OUTPUT IS SIXBIT, PD7.: JSP T2, PD ; HERE IF IT IN ASCII AND IFN EBCMP.,< PD9.: JSP T2, PD ; HERE IF IT IS IN EBCDIC. > PD: MOVEM CH, .SVCH## ;save CH MOVE CH, T2 ;GET INTO PROPER AC FOR SET1. SUBI CH, PD6.-5 ;FIND OUT WHAT THE INPUT LOOKS LIKE. JSP JAC, SET1. ;GO SET UP THE PARAMETERS. MOVE CH, .SVCH ;restore AC5 LDB T2, PACFL. ;FIND OUT WHERE THE INPUT ; OPERAND IS. HRRZ MASK, NCVTMS-6(SW) ;SELECT THE APPROPRIATE MASK. MOVE CPTR, SDDPTR-6(SW) ;SELECT THE APPROPRIATE POINTER ; FOR THE SIGN CHAR. MOVE T1, (T2) ;PICK UP THE FIRST WORD OF THE OPERAND. CAILE CNT, ^D10 ;ONE OR TWO WORDS? JRST PD4 ;TWO WORD OPERAND. ;HERE WE CONVERT A SINGLE PRECISION BINARY NUMBER TO DISPLAY. JUMPGE T1, PD1 ;IS IT NEGATIVE? ADDI CPTR, ^D10 ;YES, USE NEGATIVE SIGNS. MOVMS T1 ;MAKE IT POSITIVE. PD1: JRST PD6 ;IF WE HAVE TO WORRY ABOUT SIGNS, ; GO DO SO. ;CONVERSION ROUTINE: PD2: IDIV T1, DECTAB(CNT) ;LEFT TRUNCATE IF THE OPERAND ; IS TOO BIG. PD3: MOVE T1, T1+1 ;GET THE REMAINING DIGITS. PD3A: IDIV T1, DECTAB-1(CNT) ;GET THE NEXT DIGIT. IORI T1, (MASK) ;CONVERT IT. IDPB T1, OPTR ;STASH IT. SOJG CNT, PD3 ;LOOP IF THERE ARE MORE DIGITS. POPJ PP, ;OTHERWISE RETURN. ;COME HERE TO CONVERT A DOUBLE PRECISION BINARY NUMBER TO DISPLAY. PD4: MOVE T2, 1(T2) ;PICK UP THE SECOND WORD OF THE ; OPERAND. JUMPGE T1, PD5 ;IS IT NEGATIVE? ADDI CPTR, ^D10 ;YES, USE NEGATIVE SIGNS. SETCA T1, T1 ;NEGATE THE HIGH ORDER WORD. MOVNS T2 ;NEGATE THE LOW ORDER WORD. TLZ T2, (1B0) ;CLEAR THE SIGN BIT OF THE LOW ORDER WORD. SKIPN T2 ;IF THE LOW ORDER WORD IS ZERO. ADDI T1, 1 ;BUMP THE HIGH ORDER WORD. PD5: DIV T1, DEC10 ;BREAK OFF THE LAST TEN DIGITS. MOVE SAV10, T2 ;SAVE THEM. MOVEI CNT, -^D10(CNT) ;REDUCE THE COUNT BY 10. PUSHJ PP, PD2 ;CONVERT THE FIRST N DIGITS. MOVE T1, SAV10 ;GET BACK THE LAST TEN DIGITS. MOVEI CNT, ^D10 ;SET UP CNT. ;COME HERE IF WE HAVE TO WORRY ABOUT SIGNS. PD6: PUSHJ PP, PD2 ;CONVERT THE REMAINING N DIGITS. ANDI T1, 17 ;RESTORE THE NUMBER. LDB T1, CPTR ;PICK UP THE APPROPRIATE SIGNED DIGIT. DPB T1, IPTR ;STASH IT. POPJ PP, ;AND RETURN. SUBTTL TABLES. ;MASKS TO MAKE A BINARY DIGIT INTO A DISPLAY DIGIT. NCVTMS: EXP 20 ;SIXBIT. EXP 60 ;ASCII. IFN EBCMP.,< EXP 360 ;EBCDIC. > > ;END OF NON-BIS DC.TB1:: DECTAB:: DEC 1 DEC 10 DEC 100 DEC 1000 DEC 10000 DEC 100000 DEC 1000000 DEC 10000000 DEC 100000000 DEC 1000000000 DEC10: DEC 10000000000 DC.TB2:: OCT 2 ;11 OCT 351035564000 OCT 35 ;12 OCT 032451210000 OCT 443 ;13 OCT 011634520000 OCT 5536 ;14 OCT 142036440000 OCT 70657 ;15 OCT 324461500000 OCT 1070336 ;16 OCT 115760200000 OCT 13064257 ;17 OCT 013542400000 OCT 157013326 ;18 OCT 164731000000 ;TABLE OF SIGNED DISPLAY DIGITS: IFE BIS,< DEFINE SDD(A, B, C, D)< BYTE (6)B(7)C(8)D> > IFN BIS,< ; PRODUCE TRANSLATION TABLES FOR BIS WITH NEGATIVE OVERPUNCH IN LEFT ; AND POSITIVE IN RIGHT DEFINE IMAGE(A,B) %IDXX==0 DEFINE SDD(A,B,C,D) < .XCREF IFL %IDXX-^D10,< IMAGE(SP,\%IDXX)==B ;;SIXBIT POS IMAGE(AP,\%IDXX)==C ;;ASCII POS IMAGE(EP,\%IDXX)==D+60 ;;EBCDIC POS > IFGE %IDXX-^D10,< %IDXXX==%IDXX-^D10 IMAGE(SM,\%IDXXX)==B ;;NEG SIXBIT IMAGE(AM,\%IDXXX)==C ;;NEG ASCII IMAGE(EM,\%IDXXX)==D ;;NEG EBCDIC > IFGE %IDXX-^D20,<%IDXX==-1> ;;REINITIALIZE %IDXX==%IDXX+1 ;;INCREMENT .CREF > ; TABLE BUILDING MACRO DEFINE CVBDTB(SRC) < .XCREF %IDX==0 REPEAT ^D10,< XWD IMAGE(SRC'M,\%IDX), IMAGE(SRC'P,\%IDX) %IDX==%IDX+1 > .CREF > > ;END BIS TABLES SDDTBL: SDD +0,20,60,300 SDD +1,21,61,301 SDD +2,22,62,302 SDD +3,23,63,303 SDD +4,24,64,304 SDD +5,25,65,305 SDD +6,26,66,306 SDD +7,27,67,307 SDD +8,30,70,310 SDD +9,31,71,311 SDD -0,75,135,320 SDD -1,52,112,321 SDD -2,53,113,322 SDD -3,54,114,323 SDD -4,55,115,324 SDD -5,56,116,325 SDD -6,57,117,326 SDD -7,60,120,327 SDD -8,61,121,330 SDD -9,62,122,331 IFN BIS,< ;NOW DEFINE THE TABLES CVBD.6: CVBDTB(S) ;SIXBIT CVBD.7: CVBDTB(A) ;ASCII CVBD.9: CVBDTB(E) ;EBCDIC > IFE BIS,< ;POINTERS TO THE SIGNED DISPLAY DIGITS: SDDPTR: POINT 6,SDDTBL(T1),5 POINT 7,SDDTBL(T1),12 IFN EBCMP.,< POINT 8,SDDTBL(T1),20 > > IFN BIS,< PD6.: JSP BISCH, PD ;SIXBIT PD7.: JSP BISCH, PD ;ASCII BLOCK 1 PD9.: JSP BISCH, PD ;EBCDIC PD: SUBI BISCH, PD6.-5 ;CONVERT TO BYTE SIZE LDB BIST0, PACFL.## ;GET SOURCE AC FOR LATER MOVE DSTPT, (PARM) ;GET DESTINATION POINTER LDB DSTCNT, BSLPT2## ;GET COUNT TLZN DSTPT,3777 ;CLEAR BYTE POINTER POPJ PP, ;RETURN IF ZERO ;ONE OR TWO WORDS?? CAILE DSTCNT, ^D10 JRST PD2WD ;TWO ;ONE WORD TLZE DSTPT,4000 ;SIGNED?? SKIPA SRCHI,(BIST0) ;YES - TAKE IT AS IS MOVM SRCHI,(BIST0) ;NO - GET MAGNITUDE ASHC SRCHI,-^D35 ;EXTEND SIGN JRST PDGO ;GO PD2WD: ;TWO WORDS TLZN DSTPT,4000 ;SIGNED FIELD?? JRST PD2NS ;NO DMOVE SRCHI,(BIST0) ;YES JRST PDGO ;GO PD2NS: ;UNSIGNED FIELD - TAKE MAGNITUDE SKIPL SRCHI,(BIST0) ;NEGATIVE SKIPA SRCLO,1(BIST0) ;NO DMOVN SRCHI,(BIST0) ;YES - NEGATE AGAIN PDGO: ;NOW WE ARE READY ; TEMPORARY CHANGE TO AVOID BAD DPB ; DPB BISCH,BPTOBS## ;STORE BYTE SIZE IN OUTPUT POINTER LSH BISCH,6 TLO DSTPT,(BISCH) LSH BISCH,-6 LSH BISCH,1 ;MULTIPLY INDEX BY 2 PDGOO: HRLI BD.FLG,BFLG.S ;TURN ON FOR RIGHT JUSTIFY. EXTEND B.FLAG, CVBD.T-14(BISCH) ;CONVERT JRST OVFLO ;OVERFLOW TLNE BISCH,-1 CAIE BISCH,22 ;IF IT ISN'T EBCDIC, POPJ PP, ; RETURN. MOVE BISCH,(PARM) ;GET THE PARAMETER. TLNN BISCH,4000 ;IF THE RESULT IS UNSIGNED, POPJ PP, ; RETURN. LDB BISCH,DSTPT ;REGET THE LAST CHAR. TRNE BISCH,40 ;IF THE NUMBER IS POSITVE, TRZ BISCH,60 ; OVERPUNCH A "+". DPB BISCH,DSTPT ;STASH THE CHAR. POPJ PP, ;RETURN. CVBD.T: XWD CVTBDT, CVBD.6 ;SIXBIT XWD Z, SP0 XWD CVTBDT, CVBD.7 ;ASCII XWD Z, AP0 XWD 0, 0 XWD 0, 0 XWD CVTBDT, CVBD.9 ;EBCDIC XWD Z, EP0 ;THERE WAS AN OVERFLO SO WE MUST GO THROUGH A VARIETY ; OF MASCENATIONS TO GET COBOLS VERSION OF OVERFLOW WHICH ; THROWS AWAY THE EXCESS HIGH ORDER DIGITS AND KEEPS THE REST T1==SRCCNT-2 T2==SRCCNT-1 OVFLO: SKIPN PARM ;HAVE WE BEEN HERE BEFORE JRST ERROR ;YES SETZI PARM, PUSH PP,T1 ;SAVE REGS PUSH PP,T2 LSH DSTCNT,1 ;MULTIPLY COUNT BY 2 ;SO IT WILL INDEX INTO THE ;DOUBLE WORD CONSTANT TABLE SKIPL SRCHI ;NEGATIVE?? TDZA T1,T1 ;NO ZERO SIGN EXTEND SETOI T1, ;YES MOVE T2,T1 DDIV T1,DTAB(DSTCNT) ;DIVIDE BY LARGEST NUMBER THAT ;WILL FIT AND KEEP THE REMAINDER LSH DSTCNT,-1 ;RESTORE COUNTER POP PP,T2 POP PP,T1 JRST PDGOO ;TRY AGAIN SUBTTL double macro to generate double-word integers define shift(a,b)< ;macro to simulate ashc a,1. treats b as low part. %s==a_-43 ;;%s contains sign of number a==a_1 ;;shift high part b==b_1 ;;shift low part ifl b, ;;low order bit of high part ifn %s-,< printx shift overflowed !! ;;sign change means overflow > b==b&<1b0-1> ;;clear low order sign bit > define dmul10(a,b)< ;;macro to multiply double word integer in a and b by ten. %a==a %b==b ;;make copy of number shift(%a,%b) ;;multiply number by 2 %%a==%a %%b==%b ;;make copy of 2*n shift(%a,%b) shift(%a,%b) ;;produce 8*n in %a and %b b==%b+%%b ;;add low order parts a==%a+%%a ;;add high order parts ifl b, ;;turn off high order bit > > define .dbl(number) ;;generates double word decimal number < %high==<%low==0> irpc number< dmul10 (%high,%low) ;;multiply by ten %low==%low+number ;;add in next digit ifl %low,<%high==%high+1 ;;maybe carry > ifl %high,< printx decimal quantity too large. !! stopi > %low==%low&<1b0-1> ;;clear carry bit > ;;end of irpc %high %low ;;store number in core > ;;end of definition DTAB: .dbl 1 .dbl 10 .dbl 100 .dbl 1000 .dbl 10000 .dbl 100000 .dbl 1000000 .dbl 10000000 .dbl 100000000 .dbl 1000000000 .dbl 10000000000 .dbl 100000000000 .dbl 1000000000000 .dbl 10000000000000 .dbl 100000000000000 .dbl 1000000000000000 .dbl 10000000000000000 .dbl 100000000000000000 .dbl 1000000000000000000 .dbl 10000000000000000000 .dbl 100000000000000000000 .dbl 1000000000000000000000 ERROR: OUTSTR [ASCIZ '?LIBOL PD.N ERROR '] POPJ PP, > ;END OF BIS END