.NLIST TTM,BEX
;======================================================================
;
	.TITLE F2FORM
	.IDENT /121580/
;
;	AUTHOR:	T V ATKINSON
;		DEPARTMENT OF CHEMISTRY
;		MICHIGAN STATE UNIVERSITY
;		EAST LANSING, MI 48824
;
;	DATE:  15-DEC-80
;
;----------------------------------------------------------------------
;
;	THIS ROUTINE INTERCONVERTS BETEEN PDP11 FORTRAN IV REAL(INTEGER)
;	NUMBERS AND OS8 FORTRAN II REAL(INTEGER) NUMBERS AS WRITTEN
;	WITH A6(A2) FORMATS.  THE SAME ROUTINE IS CALLED FOR ALL FOUR
;	COMBINATIONS OF TYPE AND DIRECTION OF CONVERSION.  FLAGS IN THE
;	ARGUMENT LIST DEFINE TYPE AND DIRECTION OF THE CONVERSIONS.
;		REAL NUMBERS ARE STORED IN THE FORMATS SHOWN BELOW.  THE
;	VALUE OF THE REAL NUMBER SO REPRESENTED IS GIVEN BY:
;
;	  REAL VALUE = 2**(E-128) + M(1)*2**(-1) + ... + M(NN)*2**(-NN)
;
;					    NN = 1,K
;
;	WHERE K = 27 FOR OS8 AND K = 24 FOR THE PDP11, E REPRESENTS THE
;	BINARY EXPONENT (E8 - E0), M(NN) REPRESENTS THE NN'TH BIT
;	OF THE BINARY MANTISSA, AND S REPRESENTS THE SIGN OF THE NUMBER.  
;	IN THE ASCII REPRESENTATION OF THE REALS IN OS8, THE "A" BITS
;	ARE APPENDED TO THE SIXBIT BYTES TO FORM AN 8 BIT ASCII CHARACTER.
;	THE VALUE OF THE A BITS DEPEND ON THE SIGN BIT .........
;----------------------------------------------------------------------
;
;	PDP11 FORTRAN IV REAL FORMAT (AS STORED IN CORE):
;
;	:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
;	.   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .
;	. 15. 14. 13. 12. 11. 10.  9.  8.  7.  6.  5.  4.  3.  2.  1.  0.  BIT
;	.   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .
;	:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
;	.   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .
;	. S . E . E . E . E . E . E . E . E . M . M . M . M . M . M . M .  WORD 0
;	.   . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 .
;	.   . 7 . 6 . 5 . 4 . 3 . 2 . 1 . 0 . 2 . 3 . 4 . 5 . 6 . 7 . 8 .
;	.   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .
;	.................................................................
;	.   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .
;	. M . M . M . M . M . M . M . M . M . M . M . M . M . M . M . M .  WORD 1
;	. 0 . 1 . 1 . 1 . 1 . 1 . 1 . 1 . 1 . 1 . 1 . 2 . 2 . 2 . 2 . 2 .
;	. 9 . 0 . 1 . 2 . 3 . 4 . 5 . 6 . 7 . 8 . 9 . 0 . 1 . 2 . 3 . 4 .
;	.   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .
;	.................................................................
;
;----------------------------------------------------------------------
	.PAGE
;----------------------------------------------------------------------
;
;	OS8 FORTRAN II REAL FORMAT (AS STORED IN MEMORY):
;
;	:::::::::::::::::::::::::::::::::::::::::::::::::
;	.   .   .   .   .   .   .   .   .   .   .   .   .
;	. 11. 10.  9.  8.  7.  6.  5.  4.  3.  2.  1.  0.  BIT
;	.   .   .   .   .   .   .   .   .   .   .   .   .
;	:::::::::::::::::::::::::::::::::::::::::::::::::
;	.   .   .   .   .   .   .   .   .   .   .   .   .
;	. S . E . E . E . E . E . E . E . E . M . M . M .
;	.   . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 . 0 .  WORD 0
;	.   . 7 . 6 . 5 . 4 . 3 . 2 . 1 . 0 . 1 . 2 . 3 .
;	.   .   .   .   .   .   .   .   .   .   .   .   .
;	.................................................
;	.   .   .   .   .   .   .   .   .   .   .   .   .
;	. M . M . M . M . M . M . M . M . M . M . M . M .
;	. 0 . 0 . 0 . 0 . 0 . 0 . 1 . 1 . 1 . 1 . 1 . 1 .  WORD 1
;	. 4 . 5 . 6 . 7 . 8 . 9 . 0 . 1 . 2 . 3 . 4 . 5 .
;	.   .   .   .   .   .   .   .   .   .   .   .   .
;	.................................................
;	.   .   .   .   .   .   .   .   .   .   .   .   .
;	. M . M . M . M . M . M . M . M . M . M . M . M .
;	. 1 . 1 . 1 . 1 . 2 . 2 . 2 . 2 . 2 . 2 . 2 . 2 .  WORD 2
;	. 6 . 7 . 8 . 9 . 0 . 1 . 2 . 3 . 4 . 5 . 6 . 7 .
;	.   .   .   .   .   .   .   .   .   .   .   .   .
;	.................................................
;
;
;----------------------------------------------------------------------
;
;	OS8 FORTRAN II REAL VARIABLES (AS OUTPUT WITH A6 FORMAT)
;
;	:::::::::::::::::::::::::::::::::	:::::::::::::::::::::::::::::::::
;	.   .   .   .   .   .   .   .   .	.   .   .   .   .   .   .   .   .
;	.  7.  6.  5.  4.  3.  2.  1.  0.	.  7.  6.  5.  4.  3.  2.  1.  0.
;	.   .   .   .   .   .   .   .   .	.   .   .   .   .   .   .   .   .
;	:::::::::::::::::::::::::::::::::	:::::::::::::::::::::::::::::::::
;	.   .   .   .   .   .   .   .   .	.   .   .   .   .   .   .   .   .
;	. A . A . S . E . E . E . E . E .	. A . A . E . E . E . M . M . M .
;	.   .   .   . 0 . 0 . 0 . 0 . 0 .	.   .   . 0 . 0 . 0 . 0 . 0 . 0 .
;	.   .   .   . 7 . 6 . 5 . 4 . 3 .	.   .   . 2 . 1 . 0 . 1 . 2 . 3 .
;	.   .   .   .   .   .   .   .   .	.   .   .   .   .   .   .   .   .
;	.................................	.................................
;
;		BYTE 0						BYTE 1
	.PAGE
;
;	.................................	.................................
;	.   .   .   .   .   .   .   .   .	.   .   .   .   .   .   .   .   .
;	. A . A . M . M . M . M . M . M .	. A . A . M . M . M . M . M . M .
;	.   .   . 0 . 0 . 0 . 0 . 0 . 0 .	.   .   . 1 . 1 . 1 . 1 . 1 . 1 .
;	.   .   . 4 . 5 . 6 . 7 . 8 . 9 .	.   .   . 0 . 1 . 2 . 3 . 4 . 5 .
;	.   .   .   .   .   .   .   .   .	.   .   .   .   .   .   .   .   .
;	.................................	.................................
;
;		BYTE 2						BYTE 3
;
;	.................................	.................................
;	.   .   .   .   .   .   .   .   .	.   .   .   .   .   .   .   .   .
;	. A . A . M . M . M . M . M . M .	. A . A . M . M . M . M . M . M .
;	.   .   . 1 . 1 . 1 . 1 . 2 . 2 .	.   .   . 2 . 2 . 2 . 2 . 2 . 2 .
;	.   .   . 6 . 7 . 8 . 9 . 0 . 1 .	.   .   . 2 . 3 . 4 . 5 . 6 . 7 .
;	.   .   .   .   .   .   .   .   .	.   .   .   .   .   .   .   .   .
;	.................................	.................................
;
;		BYTE 4						BYTE 5
;
;
;----------------------------------------------------------------------
;
;	CALLING SEQUENCE:
;   
;	FORTRAN:
;
;		CALL F2FORM   (ISTRING,VALUE,IREAL,IPACK)
;
;	MACRO:
;
;		JSR	PC,F2FORM
;		BR	1$
;		.WORD	ISTRING			; -> BYTE STRING WITH ASCII 
;						;    6 BYTES FOR REAL CONVERSIONS
;						;    2 BYTES FOR INTEGER CONVERSIONS
;		.WORD	VALUE			; -> VARIABLE FOR PDP11 VALUE
;						;    INTEGER FOR INTEGER CONVERSIONS
;						;    REAL VARIABLE FOR REAL CONV.
;		.WORD	IREAL			; -> REAL/INTEGER FLAG
;						;    .EQ.0  INTEGER CONVERSION
;						;    .NE.0  REAL CONVERSION
;		.WORD	IPACK			; -> PACK/UNPACK FLAG
;						;    .EQ.0  PDP11 TO OS8 
;						;    .NE.0  OS8 TO PDP11
;		1$:				; CONTINUE
;
;
;========================================================================
	.PAGE
	.SBTTL  MAIN
	.GLOBL  F2FORM
	.PSECT  F2FORM
F2FORM:	MOV	R0,-(SP)		; ENTRY, SAVE REG.
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	MOV	2(R5),R0		; R0 -> BYTE 0
	TST	@6(R5)			; REAL?
	BNE	1$			; YES, BRANCH
	TST	@10(R5)			; PACK?
	BNE	UNINT			; NO, BRANCH
	BR	PKINT
1$:	TST	@10(R5)			; PACK?
	BEQ	PKREAL			; YES, BRANCH
;----------------------------------------------------------------------
;
;	UNPACK OS8 REALS(IN A6 FORMAT) TO DOS/BATCH REALS
;
;----------------------------------------------------------------------
;
;	MOVE IN MANTISSA IN 6 BIT PACKETS
;
UNREAL:	CLR	R2			; R2 AND R3 WILL HOLD ASSEMBLED REAL
	CLR	R3
	MOV	#5,R1			; R1 = COUNTER
	MOV	2(R5),R0		; R0 -> BYTE 0
	INC	R0			; R0 -> BYTE 1
2$:	ASHC	#6,R2			; SHIFT [R2:R3] LEFT 6
	MOVB	(R0)+,R4		; OR IN NEXT SIXBIT BYTE
	BIC	#177700,R4
	BIS	R4,R3
	SOB	R1,2$			; DO FIVE
	ASHC	#-3,R2			; DISCARD LEAST THREE BITS
	MOV	R2,-(SP)		; SAVE HIDDEN BIT
	BIC	#177600,R2		; CLEAR HIDDEN BIT, "S", AND "E"
	MOV	4(R5),R4		; R4 -> DOS/BATCH REAL VARIABLE (TARGET)
	MOV	R3,2(R4)		; STORE WORD 1
;
;	DO SIGN AND EXPONENT
;
	MOV	2(R5),R0		; R0 -> BYTE 0
	MOVB	(R0)+,R3		; R3 <<<< BYTE 0
	ASH	#6,R3			; SHIFT LEFT 6 BITS
	MOVB	(R0),R1			; "OR" IN BYTE 1
	BIC	#177700,R1
	BIS	R1,R3
	ASH	#4,R3			; SHIFT LEFT 4 BITS
	BIC	#177,R3			; CLEAR OUT LOWER 7 BITS
	BIS	R3,R2			; R3 <<<< S,E "OR" M(02) TO M(08)
	BIT	#200,(SP)+		; HIDDEN BIT = 0?
	BNE	3$			; NO, BRANCH
	CLR	R2
3$:	MOV	R2,(R4)			; STORE WORD 0
	BR	EXIT			; DONE
;----------------------------------------------------------------------
;
;	PACK DOS/BATCH REALS INTO OS8 REALS(A6 FORMAT)
;
;----------------------------------------------------------------------
PKREAL:	ADD	#6,R0			; R0 -> BYTE 5 + 1
	MOV	4(R5),R4		; R4 -> WORD 0
	MOV	(R4)+,R2		; R2 <<<< WORD 0
	MOV	(R4),R3			; R3 <<<< WORD 1
;
;	PUT IN ZEROS FOR M(25), M(26), M(27)
;
	ASHC	#3,R2			; SHIFT [R2:R3] LEFT 3 BITS 
;
;	DO BYTES 2 TO 5
;
	MOV	#4,R1			; R1 = COUNTER
1$:	MOV	R3,R4			; DO NEXT BYTE
	JSR	PC,ASCY			; CONVERT TO ASCII
2$:	MOVB	R4,-(R0)		; STORE BYTE
	ASHC	#-6,R2			; RIGHT JUSTIFY NEXT 6 BITS IN R3
	SOB	R1,1$			; DO 4
;
;	REPLACE "HIDDEN BIT"
;
	MOV	@4(R5),R2		; GET WORD 0 AGAIN
	CLR	R3
	ASHC	#-7,R2			; LEFT JUSTIFY E00, M02,M03 IN R3
	CLC				; CLEAR CARRY
	TST	@4(R5)			; REAL = 0.0?
	BEQ	7$			; NO, BRANCH
	SEC				; SET CARRY
7$:	ROL	R2			; ROTATE CARRY("HIDDEN BIT") INTO R2
	ASHC	#2,R2			; SHIFT M02,M03 BACK INTO R2
;
;	DO BYTES 1,0
;
	MOV	#2,R1			; R1 = COUNTER
3$:	MOV	R2,R4			; DUPLICATE R2
	JSR	PC,ASCY			; CONVERT TO ASCII
4$:	MOVB	R4,-(R0)		; STORE BYTE
	ASHC	#-6,R2			; RIGHT JUSTIFY NEXT 6 BITS IN R3
	SOB	R1,3$			; DO TWO
	BR	EXIT			; DONE
;----------------------------------------------------------------------
;
;	UNPACK OS8 INTEGERS (A2 FORMAT) TO DOS/BATCH INTEGERS
;		RIGHT JUSTIFIED, SIGN EXTENDED
;
;----------------------------------------------------------------------
UNINT:	MOVB	(R0)+,R2		; R2 <<<< BYTE 0
	BIC	#177700,R2		; LEAVE LEFT 6 BITS
	ASH	#6,R2			; MOVE TO BITS 6 TO 11
	MOVB	(R0)+,R3		; R3 <<<< BYTE 1
	BIC	#177700,R3		; LEAVE LOWER 6 BITS
	BIS	R3,R2			; PUT TWO 6 BIT BYTES TOGETHER
	CMP	#4000,R2		; NEGATIVE?
	BHI	1$			; NO, BRANCH
	BIS	#170000,R2		; YES, SET UPPER 4 BITS
1$:	MOV	R2,@4(R5)		; STORE INTEGER
	BR	EXIT			; DONE
;----------------------------------------------------------------------
;
;	PACK DOS/BATCH INTEGERS INTO OS8 INTEGERS (A2 FORMAT)
;			ROUNDED TO 12 BITS
;
;----------------------------------------------------------------------
PKINT:	MOV	@4(R5),R2		; GET INTEGER
	CMP	#3777,R2		; .GT. 2048?
	BGT	1$			; NO, BRANCH
	MOV	#3777,R2		; YES, SET TO 3777
	BR	2$
1$:	CMP	#-2047.,R2		; .LT. -2047?
	BLT	2$			; NO, BRANCH
	MOV	#4000,R2		; YES, SET TO -2047
2$:	MOV	R2,R4			; DUPLICATE R4
	JSR	PC,ASCY			; CONVERT TO ASCII
	MOVB	R4,1(R0)		; STORE BYTE 1
	ASH	#-6,R2			; RIGHT JUSTIFY BYTE 0
	MOV	R2,R4
	JSR	PC,ASCY			; CONVERT TO ASCII
	MOVB	R4,(R0)			; STORE BYTE 0
;
;	RETURN TO CALLING PROGRAM
;
EXIT:	MOV	(SP)+,R4
	MOV	(SP)+,R3		; RESTORE REG.
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RTS	PC			; RETURN
;
;	SUBROUTINE ASCY:  CONVERT LOWER 6 BITS OF R4 INTO ASCII
;
ASCY:	BIC	#177700,R4		; CLEAR ALL BUT RIGHT 6 BITS
	CMP	#40,R4			; SIGN EXTEND; BIT 5 = 1?
	BLE	1$			; YES, BRANCH
	BIS	#100,R4			; NO, INVERTED SIGN EXTEND
1$:	BIS	#200,R4			; CONVERT TO 8BIT ASCII
	RTS	PC
	.END