PDP-10 Archive: cobol-source/pd.mac from BB-Z759A-SM

Trailing-Edge - PDP-10 Archives - BB-Z759A-SM - cobol-source/pd.mac

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

; UPD ID= 1338 on 8/2/83 at 4:07 PM by NIXON                            
TITLE	PD FOR COBOTS
SUBTTL	CONVERT BINARY TO DISPLAY	/ACK

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION

	SEARCH	LBLPRM		;DEFINE PARAMETERS.
	%%LBLP==:%%LBLP

	EXTERN	EASTB.		;FORCE EASTBL TO BE LOADED.
	HISEG
	.COPYRIGHT		;Put standard copyright statement in REL file
	SALL

;REVISION HISTORY:
;V12B *****
;	13-Jan-82	JEH	[1012] non-BIS display of low-values, [400000,,000000], is wrong

;V10 *****
;	15-DEC-74	/ACK	CREATION.
;	5/15/75		/DBT	BIS
;	8/5/77		/DAW	BIS: EXTEND DONE INLINE, ADD CBDOV.
;	4/20/78		/DAW	BIS: SETO IN GENERATED CODE NOT NECESSARY
;*****

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.
	BIT	7	1 IF SEPARATE SIGN [ANS-74]
	BIT	8	1 IF LEADING SIGN [ANS-74]
	BITS	9-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	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.
	INTERN	CVBD.6		;TRANSLATE ROUTINES
	INTERN	CVBD.7
	INTERN	CVBD.9


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:

; 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)<
	BYTE	(6)B(7)C(8)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
>


	BYTE	(6)'-'(7)"-"(8)140	;NEGATIVE SIGN
	BYTE	(6)'+'(7)"+"(8)116	;POSITIVE SIGN

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


;NOW DEFINE THE TABLES

CVBD.6:	CVBDTB(S)		;SIXBIT
CVBD.7:	CVBDTB(A)		;ASCII
CVBD.9:	CVBDTB(E)		;EBCDIC


;POINTERS TO THE SIGNED DISPLAY DIGITS:

SDDPTR:	POINT	6,SDDTBL(SRCHI),5
	POINT	7,SDDTBL(SRCHI),12
	0
	POINT	8,SDDTBL(SRCHI),20

	POINT	6,SDDTBL+^D10(SRCHI),5
	POINT	7,SDDTBL+^D10(SRCHI),12
	0
	POINT	8,SDDTBL+^D10(SRCHI),20

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
	TRNN	DSTCNT,(1B7!1B8)	;SPECIAL SIGN?
	JRST	PD1WD			;NO, NORMAL TRAILING OVERPUNCH
	TLZ	DSTPT,4000		;CLEAR SIGN
	DPB	BISCH,BPTOBS		;BUILD BYTE PTR
	PUSH	PP,SRCHI		;GET A FREE ACC
	TRZE	DSTCNT,(1B7)		;SEPARATE SIGN?
	JRST	PD1			;YES
	TRZ	DSTCNT,(1B8)		;NO, LEADING OVERPUNCH
	SKIPGE	(BIST0)
	SKIPA	SRCHI,SDDPTR-2(BISCH)	;NEGATIVE 
	MOVE	SRCHI,SDDPTR-6(BISCH)	;POSITIVE
	EXCH	SRCHI,0(PP)		;SAVE SIGN PTR
	PUSH	PP,[EXP 20,60,0,360]-6(BISCH)	;SAVE MASK
	PUSH	PP,DSTPT		;SAVE INITIAL PTR
	PUSHJ	PP,PD1WD		;CONVERT
	POP	PP,DSTPT		;GET BYTE PTR
	POP	PP,BIST0		;GET MASK
	ILDB	SRCHI,DSTPT		;GET 1ST BYTE
	SUBI	SRCHI,(BIST0)		;GET DIGIT
	POP	PP,BIST0		;GET SIGN PTR
	LDB	SRCHI,BIST0		;CONVERT
	DPB	SRCHI,DSTPT		;STORE BACK
	POPJ	PP,

PD1:	SKIPGE	(BIST0)			;POSITIVE?
	SKIPA	SRCHI,[EXP '-',"-",0,140]-6(BISCH)	;NEGATIVE
	MOVE	SRCHI,[EXP '+',"+",0,116]-6(BISCH)	;POSITIVE
	TRZN	DSTCNT,(1B8)		;LEADING SIGN?
	JRST	PD2			;NO
	IDPB	SRCHI,DSTPT		;YES, STORE SIGN
	POP	PP,SRCHI		;RESTORE
	JRST	PD1WD			;CONTINUE

PD2:	EXCH	SRCHI,0(PP)		;SAVE SIGN
	PUSHJ	PP,PD1WD		;CONVERT
	POP	PP,SRCHI
	IDPB	SRCHI,DSTPT		;STORE IT
	POPJ	PP,

	;ONE OR TWO WORDS??

PD1WD:	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
	DPB	BISCH,BPTOBS##		;STORE BYTE SIZE IN OUTPUT POINTER

	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:	CVTBDT		CVBD.6		;SIXBIT
	XWD	Z,	SP0
	CVTBDT		CVBD.7		;ASCII
	XWD	Z,	AP0
	XWD	0,	0
	XWD	0,	0
	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:

	JUMPE	PARM,ERROR		;ERROR IF WE HAVE BEEN HERE BEFORE

	SETZ	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


ERROR:	OUTSTR	[ASCIZ	'?COBOTS PD.N error
']
	POPJ	PP,

; HERE IS ROUTINE TO HANDLE OVERFLOW IF EXTEND DONE INLINE
	ENTRY	CBDOV.		;FOR BIS OVERFLOW
;CALL:
;	MOVEI	AC7,DEST.SIZE
;	MOVEI	AC10,DEST.BYTE.PTR
;	EXTEND	AC4,[CVTBDT @ CVBD.6
;			XWD 0, FILL.CHR]
;	 PUSHJ	PP,CBDOV.##
;	<END CODE>
;

CBDOV.:	PUSH	PP,T1
	PUSH	PP,T2

	LSH	DSTCNT,1
	SKIPL	SRCHI
	TDZA	T1,T1
	SETOI	T1,

	MOVE	T2,T1
	DDIV	T1,DTAB(DSTCNT)
	LSH	DSTCNT,-1

	POP	PP,T2
	HRRZ	T1,-1(PP)	;POINT TO RETURN ADDRESS
	MOVE	T1,-2(T1)	;FETCH EXTEND INSTRUCTION
	EXCH	T1,(PP)		;RESTORE OLD T1, "PUSH" INSTRUCTION
	POP	PP,(PP)		;FIX STACK
	HRLI	BD.FLG,BFLG.S

	XCT	1(PP)		;TRY THE EXTEND AGAIN
	 JRST	ERROR		;? NO GOOD
	POPJ	PP,		;OK THIS TIME, RETURN

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


	END