PDP-10 Archive: decus/20-153/pd.mac from decuslib20-06

Trailing-Edge - PDP-10 Archives - decuslib20-06 - decus/20-153/pd.mac

There are 9 other files named pd.mac in the archive. Click here to see a list.

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)<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,<a==a!1			;;high order bit of low part goes into
>
			;;low order bit of high part
ifn %s-<a_-43>,< 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,<a==a+1		;;carry...  we just added 2n + 8n to get 10n.
b==b&<1b0-1>		;;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