Google
 

Trailing-Edge - PDP-10 Archives - tops10and20_integ_tools_v9_3-aug-86 - 70,6067/decnet/mlib09.mac
There are 4 other files named mlib09.mac in the archive. Click here to see a list.
	TITLE MACLIB -- MACRO SUBROUTINE LIBRARY
	SUBTTL SECTION 9. -- NUMERICAL DATA CONVERSION
;
;+
;	=================================================================
;
;	MAPC	DECSYSTEM-10	MACRO SUBROUTINE LIBRARY
;
;	Developed by R. W. Stamerjohn, DEC-10 Systems Group
;
;	These routines and all related documentation were developed at
;	Monsanto Agricultural Products Company, St. Louis, Mo. 63167.
;
;	=================================================================
;
;	Use the following DECsystem-10 Monitor command to include
;	the MACLIB subroutine library as part of a user program:
;
;	.EX YOURS,REL:MACLIB/SEARCH
;
;	If you do not include the /SEARCH switch, you will load
;	the entire library as part of your program.
;
;
;-
;
COMMENT %
;+


        List of Routines in This Section:
        --------------------------------

    C16T36	Format-Driven PDP-11 to DEC-10 Binary Conversion
    C36T16	Format-Driven DEC-10 to PDP-11 Binary Conversion
    C32T36	Format-Driven VAX-11 to DEC-10 Binary Conversion
    C36T32	Format-Driven DEC-10 to VAX-11 Binary Conversion
    ASCV16/32	ASCII Conversion
    C8CV16/32	C*8 Complex Conversion (Single-Precision)
    I1CV16/32	I*1 Signed Integer Conversion (8-bit)
    I2CV16/32	I*2 Signed Integer Conversion (16-bit)
    I4CV16/32	I*4 Signed Integer Conversion (32-bit)
    IFCV16/32	I*F Signed Integer Conversion (32-bit)
    L1CV16/32	L*1 Logical Conversion (8-bit)
    L2CV16/32	L*2 Logical Conversion (16-bit)
    L4CV16/32	L*4 Logical Conversion (32-bit)
    M1CV16/32	M*1 Unsigned Integer Conversion (8-bit)
    M2CV16/32	M*2 Unsigned Integer Conversion (16-bit)
    M4CV16/32	M*4 Unsigned Integer Conversion (32-bit)
    MFCV16/32	M*F Unsigned Integer Conversion (32-bit)
    R4CV16/32	R*4 Floating Conversion (Single-Precision)
    R8CV16/32	R*8 Floating Conversion (Double-Precision)

;-

	Module Revision History
	------------------------


END COMMENT %

	PRGEND
	TITLE	C16T36
	SUBTTL	Format-Driven PDP-11 to DEC-10 Conversion
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	This subroutine provides format-driven conversion
;			of PDP-11 format numerical data to DECsystem-10
;			notation.
;
;	Usage:		CALL C16T36(array1,size1,array2,size2,format,cnt,error)
;
;	Arguments:	array1	= Array containing PDP-11 format data
;			size1	= Size of "array1" in PDP-11 bytes
;			array2	= Array to receive results of connversion
;			size2	= Size of "array2" in DECsystem-10 words
;			format	= Alphanumeric format string
;			cnt	= Character count of "format" (-1=ASCIZ)
;			error	= Integer error return variable
;
;-
;	Register Definition:
;

	T0=0		;Function return (low)
	T1=1		;Function return (high)
	TP=2		;Temporary AC
	A1=3		;Current array1 address
	A2=4		;Current array2 address
	S1=5		;Size (bytes) of array 1
	S2=6		;Size (words) of array 2
	IX=7		;Index to conversion tables
	RP=10		;Repeat count
	FT=11		;Format string address
	FC=12		;Formate string character count
	AX=13		;Array byte index
	EA=15		;Error return variable address
	A=16		;Fortran argument block pointer
	P=17		;Push-down stack pointer

	ENTRY	C16T36

C16T36:	PUSHJ	P,ARGS..##		;Setup accumulators
	 POPJ	P,			;Exit if no return variable

PXCV.1:	PUSHJ	P,FORM..##		;Get next formatted argument
	 POPJ	P,			;Exit if done or error
	CAIN	IX,ASCIDX		;Was type "AS"
	 JRST	PXCVAS			;Yes, convert ASCII
	CAIN	IX,SKIIDX		;Was type "SI"
	 JRST	PXCVSI			;Yes, skip input bytes
	CAIN	IX,SKOIDX		;Was type "SO"
	 JRST	PXCVSO			;Yes, skip output words

PXCV.2:	MOVEI	TP,BINDSP		;Get binary dispatch table
	ADD	TP,IX			;For dispatch address
	MOVEI	A,ARGLST		;Get function argument list
	PUSHJ	P,@(TP)			;Call conversion function

	HRRZ	TP,SIZTBL(IX)		;Get number of arguments to store
	SOJL	S2,PXCVE3		;Jump if no space
	MOVEM	T0,(A2)			;Store return value
	ADDI	A2,1			;Bump array address
	SOJE	TP,PXCV.3		;Jump if no second argument
	SOJL	S2,PXCVE3		;Jump if no space
	MOVEM	T1,(A2)			;Store return value
	ADDI	A2,1			;Bump array address
PXCV.3:	HLRZ	TP,SIZTBL(IX)		;Get size of converted field
	SUB	S1,TP			;Get bytes remaining in field
	JUMPL	S1,PXCVE2		;Jump if no more
	ADD	AX,TP			;Bump array index
	SOJG	RP,PXCV.2		;Loop if repeated field
	JRST	PXCV.1			;Convert next format

PXCVSI:	SUB	S1,RP			;Get bytes remaining in field
	JUMPL	S1,PXCVE2		;Jump if no more
	ADD	AX,RP			;Bump array index
	JRST	PXCV.1			;Convert next format

PXCVSO:	SUB	S2,RP			;Get words remaining in field
	JUMPL	S2,PXCVE3		;Jump if no more space
	ADD	A2,RP			;Skip space in output array
	JRST	PXCV.1			;Convert next format

PXCVAS:	SOJL	S2,PXCVE3		;Jump if no more space
	SETZM	(A2)			;Zero memory location
	MOVEI	IX,1			;Initialize character position
PXAS.1:	MOVEI	TP,ASCV16##		;Set function routine
	MOVEI	A,ASCLST		;Set argument list
	PUSHJ	P,(TP)			;Call function routine
	ADDM	T0,(A2)			;Store converted character
	SOJL	S1,PXCVE2		;Jump if no more bytes
	AOS	AX			;Bump byte position
	AOS	IX			;Bump character position
	SOJLE	RP,PXAS.2		;Get next format when done
	CAIG	IX,5			;Are we at next word
	 JRST	PXAS.1			;No, convert next character
	AOJA	A2,PXCVAS		;Begin new word

PXAS.2:	AOJA	A2,PXCV.1		;Advance to next word

PXCVE3:	MOVEI	TP,3			;Flag array2 overflow
	MOVEM	TP,(EA)			;Return error
	POPJ	P,			;Return to caller

PXCVE2:	MOVEI	TP,2			;Flag array1 overflow
	MOVEM	TP,(EA)			;Return error
	POPJ	P,			;Return to caller

	-2,,0
ARGLST:	20,,A1
	00,,AX

	-4,,0
ASCLST:	20,,A1
	00,,AX
	00,,00
	00,,IX

BINDSP:	I1CV16##			;I*1 conversion
	I2CV16##			;I*2 conversion
	I4CV16##			;I*4 conversion
	IFCV16##			;I*F conversion
	L1CV16##			;L*1 conversion
	L2CV16##			;L*2 conversion
	L4CV16##			;L*4 conversion
	C8CV16##			;C*8 conversion
	R4CV16##			;R*4 conversion
	R8CV16##			;R*8 conversion
	M1CV16##			;M*1 conversion
	M2CV16##			;M*2 conversion
	M4CV16##			;M*4 conversion
	MFCV16##			;M*F conversion

SIZTBL:	 1,,1				;I*1 conversion
	 2,,1				;I*2 conversion
	 4,,1				;I*4 conversion
	 4,,1				;I*F conversion
	 1,,1				;L*1 conversion
	 2,,1				;L*2 conversion
	 4,,1				;L*4 conversion
	10,,2				;C*8 conversion
	 4,,1				;R*4 conversion
	10,,2				;R*8 conversion
	 1,,1				;M*1 conversion
	 2,,1				;M*2 conversion
	 4,,1				;M*4 conversion
	 4,,1				;M*F conversion

ASCIDX=.-SIZTBL
SKIIDX=.-SIZTBL+1
SKOIDX=.-SIZTBL+2

	PRGEND
	TITLE	C36T16
	SUBTTL	Format-Driven DEC-10 to PDP-11 Conversion
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	This subroutine provides format-driven conversion
;			of DEC-10 format numerical data to PDP-11 notation.
;
;	Usage:		CALL C36T16(array1,size1,array2,size2,format,cnt,error)
;
;	Arguments:	array1	= Array containing DECsystem-10 format data
;			size1	= Size of "array1" in DECsystem-10 words
;			array2	= Array to receive results of connversion
;			size2	= Size of "array2" in PDP-11 bytes
;			format	= Alphanumeric format string
;			cnt	= Character count of "format" (-1=ASCIZ)
;			error	= Integer error return variable
;
;-
;	Register Definition:
;
	T0=0		;Function return (low)
	T1=1		;Function return (high)
	TP=2		;Temporary AC
	A1=3		;Current array1 address
	A2=4		;Current array2 address
	S1=5		;Size (words) of array 1
	S2=6		;Size (bytes) of array 2
	IX=7		;Index to conversion tables
	RP=10		;Repeat count
	FT=11		;Format string address
	FC=12		;Formate string character count
	AX=13		;Array byte index
	EA=15		;Error return variable address
	A=16		;Fortran argument block pointer
	P=17		;Push-down stack pointer

	ENTRY	C36T16

C36T16:	PUSHJ	P,ARGS..##		;Setup accumulators
	 POPJ	P,			;Exit if no return variable
	ADD	A2,[POINT 8,,7]		;Form byte pointer to output array

PXFT.1:	PUSHJ	P,FORM..##		;Get next formatted argument
	 POPJ	P,			;Exit if done or error
	CAIN	IX,ASCIDX		;Was type "AS"
	 JRST	PXFTAS			;Yes, convert ASCII
	CAIN	IX,SKIIDX		;Was type "SI"
	 JRST	PXFTSI			;Yes, skip input words
	CAIN	IX,SKOIDX		;Was type "SO"
	 JRST	PXFTSO			;Yes, skip output bytes

PXFT.2:	HRRZ	TP,SIZTBL(IX)		;Get number of DECsystem-10 words
	SOJL	S1,PXFTE2		;Jump if no more left
	MOVE	T0,(A1)			;Get next DECsystem-10 word
	AOS	A1			;Bump DECsystem-10 pointer
	SOJE	TP,PXFT.3		;Jump if only one word needed
	SOJL	S1,PXFTE2		;Jump if no more left
	MOVE	T1,(A1)			;Get next DECsystem-10 word
	AOS	A1			;Bump DECsystem-10 pointer
PXFT.3:	MOVEI	TP,4			;Preset conversion error
	PUSHJ	P,@FTMDSP(IX)		;Jump to conversion function

	PUSH	P,T1			;Store any high value
	HLRE	TP,SIZTBL(IX)		;Get bytes to store
	JUMPG	TP,PXFT.4		;If positive, no swap
	LDB	T1,[POINT 16,T0,35]	;Get low word
	LSH	T0,-20			;Shift high word down
	DPB	T1,[POINT 16,T0,19]	;Store low word as high
	MOVN	TP,TP			;Make count positive
PXFT.4:	CAIN	TP,10			;is this a double word
	 MOVEI	TP,4			;Yes, work on only one now
	SUB	S2,TP			;Is there enough room?
	JUMPL	S2,[POP	P,T0
		   JRST	PXFTE3]		;No, declare error
	PUSHJ	P,PXFTDB		;Go deposit word

	POP	P,T0			;Restore high value
	HLRZ	TP,SIZTBL(IX)		;Get bytes to store
	CAIE	TP,-10			;Skip if high value
	 JRST	PXFT.5			;Check repeat count
	LDB	T1,[POINT 16,T0,35]	;Get low word
	LSH	T0,-20			;Shift high word down
	DPB	T1,[POINT 16,T0,19]	;Store low word as high
	MOVEI	TP,4			;Work on one word
	SUB	S2,TP			;Is there enough room?
	JUMPL	S2,PXFTE3		;No, declare error
	PUSHJ	P,PXFTDB		;Go deposit word

PXFT.5:	SOJG	RP,PXFT.2		;Loop on repeat count
	JRST	PXFT.1			;Otherwise, get next argument

PXFTSI:	SUB	S1,RP			;Get words remaining if field
	JUMPL	S1,PXFTE3		;Jump if no more
	ADD	A1,RP			;Skip pass words in array
	JRST	PXFT.1			;Convert next format

PXFTSO:	SUB	S2,RP			;Get bytes remaining in field
	JUMPL	S2,PXFTE3		;Jump if no more
	ADD	AX,RP			;Update byte count
	JRST	PXFT.1			;Convert next format

PXFTAS:	SUB	S2,RP			;Is there enough room?
	JUMPL	S2,PXFTE3		;Declare error if not
	MOVE	T0,RP			;Get repeat count
	IDIVI	T0,5			;Get number of DECsystem-10 words
	SKIPE	T1			;Skip if no remainder
	 AOS	T0			;Bump count to next word
	SUB	S1,T0			;Is there enough room
	JUMPL	S1,PXFTE2		;Declare error if not
	ADD	T0,A1			;Form address of next word
	PUSH	P,T0			;Save for later
	ADD	A1,[POINT 7,,]		;Form point to characters
PXAS.1:	ILDB	T0,A1			;Get next character
	MOVEI	TP,1			;Store one byte
	PUSHJ	P,PXFTDB		;Deposit character
	SOJG	RP,PXAS.1		;Loop till done
	POP	P,A1			;Get next DEcsystem-10 word
	JRST	PXFT.1			;Get next format

PXFTDB:	MOVE	T1,AX			;Copy current index
	ADJBP	T1,A2			;Make pointer to deposit
	DPB	T0,T1			;Deposit byte
	LSH	T0,-10			;Shift down next byte
	AOS	AX			;Bump byte index
	SOJG	TP,PXFTDB		;Loop till finished
	POPJ	P,			;Return to caller

PXFTE3:	MOVEI	TP,3			;Flag array2 overflow
	MOVEM	TP,(EA)			;Return error
	POPJ	P,			;Return to caller

PXFTE2:	MOVEI	TP,2			;Flag array1 overflow
	MOVEM	TP,(EA)			;Return error
	POPJ	P,			;Return to caller

PXFTIF:
PXFTI4:
PXFTI2:
PXFTI1:	MOVN	T1,T0			;Copy negative of value
	SKIPL	T0			;Skip if value negative

PXFTMF:
PXFTM4:
PXFTM2:
PXFTM1:	MOVE	T1,T0			;Get positive value
	TDNE	T1,MSKTBL(IX)		;Is value too large
	 MOVEM	TP,(EA)			;Yes, set conversion error
	POPJ	P,			;Return value

PXFTL4:
PXFTL2:
PXFTL1:	AND	T0,[400000,,000000]	;Clear all but sign bit
	TLZE	T0,400000		;Test size and zero
	 SETO	T0,			;Set to -1
	POPJ	P,			;Return value

PXFTC8:	PUSH	P,T1			;Store imaginary value
	PUSHJ	P,PXFTR4		;Convert real part
	POP	P,T1			;Get imaginary value
	PUSH	P,T0			;Store converted real
	MOVE	T0,T1			;Copy imaginary
	PUSHJ	P,PXFTR4		;Convert imaginary part
	MOVE	T1,T0			;Copy converted imaginary
	POP	P,T0			;Get converted real
	POPJ	P,			;Return value

PXFTR4:	JUMPE	T0,PXR4.1		;Just return if zero
	PUSH	P,T0			;Save value
	SKIPG	T0			;Skip if positive
	 MOVN	T0,T0			;Make value positive
	LDB	TP,[POINT 8,T0,8]	;Get mantissa
	ASH	T0,-3			;Shift down exponent
	AND	T0,[000037,,777777]	;Clear extraneous bits
	DPB	TP,[POINT 8,T0,12]	;Deposit mantissa
	POP	P,TP			;Get value
	SKIPG	TP			;Skip if positive
	 TLO	T0,20000		;Turn on sign bit
PXR4.1:	POPJ	P,			;Return value

PXFTR8:	SKIPN	T0			;Skip if non-zero
	 JUMPE	T1,PXR8.1		;Just return if zero
	PUSH	P,T0			;Save value
	SKIPG	T0			;Skip if positive
	 DMOVN	T0,T0			;Make value positive
	LDB	TP,[POINT 8,T0,8]	;Get exponent
	ASHC	T0,-3			;Shift down mantissa
	AND	T0,[000037,,777777]	;Clear extraneous bits
	DPB	TP,[POINT 8,T0,12]	;Deposit exponent
	ASH	T1,-3			;Shift down mantissa
	AND	T1,[037777,,777777]	;Clear extraneous bits
	POP	P,TP			;Get back value
	SKIPG	TP			;Skip if positive
	 TLO	T0,20000		;Turn on sign bit
PXR8.1:	POPJ	P,			;Return value

FTMDSP:	PXFTI1				;I*1 conversion
	PXFTI2				;I*2 conversion
	PXFTI4				;I*4 conversion
	PXFTIF				;I*F conversion
	PXFTL1				;L*1 conversion
	PXFTL2				;L*2 conversion
	PXFTL4				;L*4 conversion
	PXFTC8				;C*8 conversion
	PXFTR4				;R*4 conversion
	PXFTR8				;R*8 conversion
	PXFTM1				;M*1 conversion
	PXFTM2				;M*2 conversion
	PXFTM4				;M*4 conversion
	PXFTMF				;M*F conversion

MSKTBL:	777777,,777400			;I*1 mask
	777777,,600000			;I*2 mask
	740000,,000000			;I*4 mask
	740000,,000000			;I*F mask
	777777,,777777			;L*1 mask
	777777,,777777			;L*2 mask
	777777,,777777			;L*4 mask
	777777,,777777			;C*8 mask
	777777,,777777			;R*4 mask
	777777,,777777			;R*8 mask
	777777,,777400			;M*1 mask
	777777,,600000			;M*2 mask
	740000,,000000			;M*4 mask
	740000,,000000			;M*F mask

SIZTBL:	  1,,1				;I*1 conversion
	  2,,1				;I*2 conversion
	  4,,1				;I*4 conversion
	 -4,,1				;I*F conversion
	  1,,1				;L*1 conversion
	  2,,1				;L*2 conversion
	  4,,1				;L*4 conversion
	-10,,2				;C*8 conversion
	 -4,,1				;R*4 conversion
	-10,,2				;R*8 conversion
	  1,,1				;M*1 conversion
	  2,,1				;M*2 conversion
	  4,,1				;M*4 conversion
	 -4,,1				;M*F conversion

ASCIDX=.-SIZTBL
SKIIDX=.-SIZTBL+1
SKOIDX=.-SIZTBL+2

	PRGEND
	TITLE	C32T36
	SUBTTL	Format-Driven VAX-11 to DEC-10 Conversion
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	This subroutine provides format-driven conversion
;			of VAX-11 format numerical data to DECsystem-10
;			notation.
;
;	Usage:		CALL C32T36(array1,size1,array2,size2,format,cnt,error)
;
;	Arguments:	array1	= Array containing VAX-11 format data
;			size1	= Size of "array1" in VAX-11 bytes
;			array2	= Array to receive results of connversion
;			size2	= Size of "array2" in DECsystem-10 words
;			format	= Alphanumeric format string
;			cnt	= Character count of "format" (-1=ASCIZ)
;			error	= Integer error return variable
;
;-
;	Register Definition:
;

	T0=0		;Function return (low)
	T1=1		;Function return (high)
	TP=2		;Temporary AC
	A1=3		;Current array1 address
	A2=4		;Current array2 address
	S1=5		;Size (bytes) of array 1
	S2=6		;Size (words) of array 2
	IX=7		;Index to conversion tables
	RP=10		;Repeat count
	FT=11		;Format string address
	FC=12		;Formate string character count
	AX=13		;Array byte index
	EA=15		;Error return variable address
	A=16		;Fortran argument block pointer
	P=17		;Push-down stack pointer

	ENTRY	C32T36

C32T36:	PUSHJ	P,ARGS..##		;Setup accumulators
	 POPJ	P,			;Exit if no return variable

PXCV.1:	PUSHJ	P,FORM..##		;Get next formatted argument
	 POPJ	P,			;Exit if done or error
	CAIN	IX,ASCIDX		;Was type "AS"
	 JRST	PXCVAS			;Yes, convert ASCII
	CAIN	IX,SKIIDX		;Was type "SI"
	 JRST	PXCVSI			;Yes, skip input bytes
	CAIN	IX,SKOIDX		;Was type "SO"
	 JRST	PXCVSO			;Yes, skip output words

PXCV.2:	MOVEI	TP,BINDSP		;Get binary dispatch table
	ADD	TP,IX			;For dispatch address
	MOVEI	A,ARGLST		;Get function argument list
	PUSHJ	P,@(TP)			;Call conversion function

	HRRZ	TP,SIZTBL(IX)		;Get number of arguments to store
	SOJL	S2,PXCVE3		;Jump if no space
	MOVEM	T0,(A2)			;Store return value
	ADDI	A2,1			;Bump array address
	SOJE	TP,PXCV.3		;Jump if no second argument
	SOJL	S2,PXCVE3		;Jump if no space
	MOVEM	T1,(A2)			;Store return value
	ADDI	A2,1			;Bump array address
PXCV.3:	HLRZ	TP,SIZTBL(IX)		;Get size of converted field
	SUB	S1,TP			;Get bytes remaining in field
	JUMPL	S1,PXCVE2		;Jump if no more
	ADD	AX,TP			;Bump array index
	SOJG	RP,PXCV.2		;Loop if repeated field
	JRST	PXCV.1			;Convert next format

PXCVSI:	SUB	S1,RP			;Get bytes remaining in field
	JUMPL	S1,PXCVE2		;Jump if no more
	ADD	AX,RP			;Bump array index
	JRST	PXCV.1			;Convert next format

PXCVSO:	SUB	S2,RP			;Get words remaining in field
	JUMPL	S2,PXCVE3		;Jump if no more space
	ADD	A2,RP			;Skip space in output array
	JRST	PXCV.1			;Convert next format

PXCVAS:	SOJL	S2,PXCVE3		;Jump if no more space
	SETZM	(A2)			;Zero memory location
	MOVEI	IX,1			;Initialize character position
PXAS.1:	MOVEI	TP,ASCV16##		;Set function routine
	MOVEI	A,ASCLST		;Set argument list
	PUSHJ	P,(TP)			;Call function routine
	ADDM	T0,(A2)			;Store converted character
	SOJL	S1,PXCVE2		;Jump if no more bytes
	AOS	AX			;Bump byte position
	AOS	IX			;Bump character position
	SOJLE	RP,PXAS.2		;Get next format when done
	CAIG	IX,5			;Are we at next word
	 JRST	PXAS.1			;No, convert next character
	AOJA	A2,PXCVAS		;Begin new word

PXAS.2:	AOJA	A2,PXCV.1		;Advance to next word

PXCVE3:	MOVEI	TP,3			;Flag array2 overflow
	MOVEM	TP,(EA)			;Return error
	POPJ	P,			;Return to caller

PXCVE2:	MOVEI	TP,2			;Flag array1 overflow
	MOVEM	TP,(EA)			;Return error
	POPJ	P,			;Return to caller

	-2,,0
ARGLST:	20,,A1
	00,,AX

	-4,,0
ASCLST:	20,,A1
	00,,AX
	00,,00
	00,,IX

BINDSP:	I1CV32##			;I*1 conversion
	I2CV32##			;I*2 conversion
	I4CV32##			;I*4 conversion
	IFCV32##			;I*F conversion
	L1CV32##			;L*1 conversion
	L2CV32##			;L*2 conversion
	L4CV32##			;L*4 conversion
	C8CV32##			;C*8 conversion
	R4CV32##			;R*4 conversion
	R8CV32##			;R*8 conversion
	M1CV32##			;M*1 conversion
	M2CV32##			;M*2 conversion
	M4CV32##			;M*4 conversion
	MFCV32##			;M*F conversion

SIZTBL:	 1,,1				;I*1 conversion
	 2,,1				;I*2 conversion
	 4,,1				;I*4 conversion
	 4,,1				;I*F conversion
	 1,,1				;L*1 conversion
	 2,,1				;L*2 conversion
	 4,,1				;L*4 conversion
	10,,2				;C*8 conversion
	 4,,1				;R*4 conversion
	10,,2				;R*8 conversion
	 1,,1				;M*1 conversion
	 2,,1				;M*2 conversion
	 4,,1				;M*4 conversion
	 4,,1				;M*F conversion

ASCIDX=.-SIZTBL
SKIIDX=.-SIZTBL+1
SKOIDX=.-SIZTBL+2

	PRGEND
	TITLE	C36T32
	SUBTTL	Format-Driven DEC-10 to VAX-11 Conversion
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	This subroutine provides format-driven conversion
;			of DEC-10 format numerical data to VAX-11 notation.
;
;	Usage:		CALL C36T16(array1,size1,array2,size2,format,cnt,error)
;
;	Arguments:	array1	= Array containing DECsystem-10 format data
;			size1	= Size of "array1" in DECsystem-10 words
;			array2	= Array to receive results of connversion
;			size2	= Size of "array2" in VAX-11 bytes
;			format	= Alphanumeric format string
;			cnt	= Character count of "format" (-1=ASCIZ)
;			error	= Integer error return variable
;
;-
;	Register Definition:
;
	T0=0		;Function return (low)
	T1=1		;Function return (high)
	TP=2		;Temporary AC
	A1=3		;Current array1 address
	A2=4		;Current array2 address
	S1=5		;Size (words) of array 1
	S2=6		;Size (bytes) of array 2
	IX=7		;Index to conversion tables
	RP=10		;Repeat count
	FT=11		;Format string address
	FC=12		;Formate string character count
	AX=13		;Array byte index
	EA=15		;Error return variable address
	A=16		;Fortran argument block pointer
	P=17		;Push-down stack pointer

	ENTRY	C36T32

C36T32:	PUSHJ	P,ARGS..##		;Setup accumulators
	 POPJ	P,			;Exit if no return variable
	ADD	A2,[POINT 8,,7]		;Form byte pointer to output array

PXFT.1:	PUSHJ	P,FORM..##		;Get next formatted argument
	 POPJ	P,			;Exit if done or error
	CAIN	IX,ASCIDX		;Was type "AS"
	 JRST	PXFTAS			;Yes, convert ASCII
	CAIN	IX,SKIIDX		;Was type "SI"
	 JRST	PXFTSI			;Yes, skip input words
	CAIN	IX,SKOIDX		;Was type "SO"
	 JRST	PXFTSO			;Yes, skip output bytes

PXFT.2:	HRRZ	TP,SIZTBL(IX)		;Get number of DECsystem-10 words
	SOJL	S1,PXFTE2		;Jump if no more left
	MOVE	T0,(A1)			;Get next DECsystem-10 word
	AOS	A1			;Bump DECsystem-10 pointer
	SOJE	TP,PXFT.3		;Jump if only one word needed
	SOJL	S1,PXFTE2		;Jump if no more left
	MOVE	T1,(A1)			;Get next DECsystem-10 word
	AOS	A1			;Bump DECsystem-10 pointer
PXFT.3:	MOVEI	TP,4			;Preset conversion error
	PUSHJ	P,@FTMDSP(IX)		;Jump to conversion function

	PUSH	P,T1			;Store any high value
	HLRE	TP,SIZTBL(IX)		;Get bytes to store
	JUMPG	TP,PXFT.4		;If positive, no swap
	LDB	T1,[POINT 16,T0,35]	;Get low word
	LSH	T0,-20			;Shift high word down
	DPB	T1,[POINT 16,T0,19]	;Store low word as high
	MOVN	TP,TP			;Make count positive
PXFT.4:	CAIN	TP,10			;is this a double word
	 MOVEI	TP,4			;Yes, work on only one now
	SUB	S2,TP			;Is there enough room?
	JUMPL	S2,PXFTE3		;No, declare error
	PUSHJ	P,PXFTDB		;Go deposit word

	POP	P,T0			;Restore high value
	HLRZ	TP,SIZTBL(IX)		;Get bytes to store
	CAIE	TP,-10			;Skip if high value
	 JRST	PXFT.5			;Check repeat count
	LDB	T1,[POINT 16,T0,35]	;Get low word
	LSH	T0,-20			;Shift high word down
	DPB	T1,[POINT 16,T0,19]	;Store low word as high
	MOVEI	TP,4			;Work on one word
	SUB	S2,TP			;Is there enough room?
	JUMPL	S2,PXFTE3		;No, declare error
	PUSHJ	P,PXFTDB		;Go deposit word

PXFT.5:	SOJG	RP,PXFT.2		;Loop on repeat count
	JRST	PXFT.1			;Otherwise, get next argument

PXFTSI:	SUB	S1,RP			;Get words remaining if field
	JUMPL	S1,PXFTE3		;Jump if no more
	ADD	A1,RP			;Skip pass words in array
	JRST	PXFT.1			;Convert next format

PXFTSO:	SUB	S2,RP			;Get bytes remaining in field
	JUMPL	S2,PXFTE3		;Jump if no more
	ADD	AX,RP			;Update byte count
	JRST	PXFT.1			;Convert next format

PXFTAS:	SUB	S2,RP			;Is there enough room?
	JUMPL	S2,PXFTE3		;Declare error if not
	MOVE	T0,RP			;Get repeat count
	IDIVI	T0,5			;Get number of DECsystem-10 words
	SKIPE	T1			;Skip if no remainder
	 AOS	T0			;Bump count to next word
	SUB	S1,T0			;Is there enough room
	JUMPL	S1,PXFTE2		;Declare error if not
	ADD	T0,A1			;Form address of next word
	PUSH	P,T0			;Save for later
	ADD	A1,[POINT 7,,]		;Form point to characters
PXAS.1:	ILDB	T0,A1			;Get next character
	MOVEI	TP,1			;Store one byte
	PUSHJ	P,PXFTDB		;Deposit character
	SOJG	RP,PXAS.1		;Loop till done
	POP	P,A1			;Get next DEcsystem-10 word
	JRST	PXFT.1			;Get next format

PXFTDB:	MOVE	T1,AX			;Copy current index
	ADJBP	T1,A2			;Make pointer to deposit
	DPB	T0,T1			;Deposit byte
	LSH	T0,-10			;Shift down next byte
	AOS	AX			;Bump byte index
	SOJG	TP,PXFTDB		;Loop till finished
	POPJ	P,			;Return to caller

PXFTE3:	MOVEI	TP,3			;Flag array2 overflow
	MOVEM	TP,(EA)			;Return error
	POPJ	P,			;Return to caller

PXFTE2:	MOVEI	TP,2			;Flag array1 overflow
	MOVEM	TP,(EA)			;Return error
	POPJ	P,			;Return to caller

PXFTIF:
PXFTI4:
PXFTI2:
PXFTI1:	MOVN	T1,T0			;Copy negative of value
	SKIPL	T0			;Skip if value negative

PXFTMF:
PXFTM4:
PXFTM2:
PXFTM1:	MOVE	T1,T0			;Get positive value
	TDNE	T1,MSKTBL(IX)		;Is value too large
	 MOVEM	TP,(EA)			;Yes, set conversion error
	POPJ	P,			;Return value

PXFTL4:
PXFTL2:
PXFTL1:	AND	T0,[400000,,000000]	;Clear all but sign bit
	TLZE	T0,400000		;Test size and zero
	 SETO	T0,			;Set to -1
	POPJ	P,			;Return value

PXFTC8:	PUSH	P,T1			;Store imaginary value
	PUSHJ	P,PXFTR4		;Convert real part
	POP	P,T1			;Get imaginary value
	PUSH	P,T0			;Store converted real
	MOVE	T0,T1			;Copy imaginary
	PUSHJ	P,PXFTR4		;Convert imaginary part
	MOVE	T1,T0			;Copy converted imaginary
	POP	P,T0			;Get converted real
	POPJ	P,			;Return value

PXFTR4:	JUMPE	T0,PXR4.1		;Just return if zero
	PUSH	P,T0			;Save value
	SKIPG	T0			;Skip if positive
	 MOVN	T0,T0			;Make value positive
	LDB	TP,[POINT 8,T0,8]	;Get mantissa
	ASH	T0,-3			;Shift down exponent
	AND	T0,[000037,,777777]	;Clear extraneous bits
	DPB	TP,[POINT 8,T0,12]	;Deposit mantissa
	POP	P,TP			;Get value
	SKIPG	TP			;Skip if positive
	 TLO	T0,20000		;Turn on sign bit
PXR4.1:	POPJ	P,			;Return value

PXFTR8:	SKIPN	T0			;Skip if non-zero
	 JUMPE	T1,PXR8.1		;Just return if zero
	PUSH	P,T0			;Save value
	SKIPG	T0			;Skip if positive
	 DMOVN	T0,T0			;Make value positive
	LDB	TP,[POINT 8,T0,8]	;Get exponent
	ASHC	T0,-3			;Shift down mantissa
	AND	T0,[000037,,777777]	;Clear extraneous bits
	DPB	TP,[POINT 8,T0,12]	;Deposit exponent
	ASH	T1,-3			;Shift down mantissa
	AND	T1,[037777,,777777]	;Clear extraneous bits
	POP	P,TP			;Get back value
	SKIPG	TP			;Skip if positive
	 TLO	T0,20000		;Turn on sign bit
PXR8.1:	POPJ	P,			;Return value

FTMDSP:	PXFTI1				;I*1 conversion
	PXFTI2				;I*2 conversion
	PXFTI4				;I*4 conversion
	PXFTIF				;I*F conversion
	PXFTL1				;L*1 conversion
	PXFTL2				;L*2 conversion
	PXFTL4				;L*4 conversion
	PXFTC8				;C*8 conversion
	PXFTR4				;R*4 conversion
	PXFTR8				;R*8 conversion
	PXFTM1				;M*1 conversion
	PXFTM2				;M*2 conversion
	PXFTM4				;M*4 conversion
	PXFTMF				;M*F conversion

MSKTBL:	777777,,777400			;I*1 mask
	777777,,600000			;I*2 mask
	740000,,000000			;I*4 mask
	740000,,000000			;I*F mask
	777777,,777777			;L*1 mask
	777777,,777777			;L*2 mask
	777777,,777777			;L*4 mask
	777777,,777777			;C*8 mask
	777777,,777777			;R*4 mask
	777777,,777777			;R*8 mask
	777777,,777400			;M*1 mask
	777777,,600000			;M*2 mask
	740000,,000000			;M*4 mask
	740000,,000000			;M*F mask

SIZTBL:	  1,,1				;I*1 conversion
	  2,,1				;I*2 conversion
	  4,,1				;I*4 conversion
	 -4,,1				;I*F conversion
	  1,,1				;L*1 conversion
	  2,,1				;L*2 conversion
	  4,,1				;L*4 conversion
	-10,,2				;C*8 conversion
	 -4,,1				;R*4 conversion
	-10,,2				;R*8 conversion
	  1,,1				;M*1 conversion
	  2,,1				;M*2 conversion
	  4,,1				;M*4 conversion
	 -4,,1				;M*F conversion

ASCIDX=.-SIZTBL
SKIIDX=.-SIZTBL+1
SKOIDX=.-SIZTBL+2

	PRGEND
	TITLE	ARGS..
	SUBTTL	Setup Format-Driven Accumulators
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	This subroutine sets up the accumulators for the
;			format-driven subroutines.
;
;	Usage:		PUSHJ	P,ARGS..
;			 <error return>
;			<normal return>
;
;	Arguments:	A	= Fortran argument list
;
;-
;	Register Definition:
;
	T0=0		;Temporary AC
	T1=1		;Temporary AC
	TP=2		;Temporary AC
	A1=3		;Current array1 address
	A2=4		;Current array2 address
	S1=5		;Size of array 1
	S2=6		;Size of array 2
	FT=11		;Format string address
	FC=12		;Format string character count
	AX=13		;Array byte index
	EA=15		;Error return variable address
	A=16		;Fortran argument block pointer
	P=17		;Push-down stack pointer

	ENTRY	ARGS..

ARGS..:	MOVS	TP,-1(A)		;Get number of arguments
	CAIE	TP,-7			;Where seven arguments specified?
	 POPJ	P,			;No, take error exit

	MOVEI	A1,@0(A)		;Load address of array1
	MOVE	S1,@1(A)		;Load size of array1
	MOVEI	A2,@2(A)		;Load address of array2
	MOVE	S2,@3(A)		;Load size of array2
	MOVEI	T1,4(A)			;Load address of format string
	MOVE	FC,@5(A)		;Load character count
	MOVEI	EA,@6(A)		;Load error return address

	SETZ	AX,			;Zero array byte index
	SETZM	(EA)			;Zero error return

	PUSHJ	P,CKSA..##		;Get type for format string
	MOVE	FT,T1			;Copy byte pointer
	JUMPGE	FC,ARGS.2		;If counted string, no need to count
	MOVE	FC,TP			;Assume CKSA count is correct
	CAIN	T0,15			;Is this F77 string?
	 JRST	ARGS.2			;Yes, jump

	PUSH	P,FT			;Save pointer
	SETZ	FC,			;Zero the character count
ARGS.1:	ILDB	TP,FT			;Load next format character
	SKIPE	TP			;Skip if end of format
	AOJA	FC,ARGS.1		;Count character and loop
	POP	P,FT			;Restore format array pointer

ARGS.2:	AOS	(P)			;Bump return address
	POPJ	P,			;Return to caller

	PRGEND
	TITLE	FORM..
	SUBTTL	Get Next Format-Driven Field
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	This subroutine gets the next format argument.
;
;	Usage:		PUSHJ	P,FORM..
;			 <error return>
;			<normal return>
;
;	Arguments:	See C16T36/C36T16
;
;-
;	Register Definition:
;
	T1=1		;Function return
	TP=2		;Temporary AC
	IX=7		;Index to conversion tables
	RP=10		;Repeat count
	FT=11		;Format string address
	FC=12		;Formate string character count
	EA=15		;Error return variable address
	A=16		;Fortran argument block pointer
	P=17		;Push-down stack pointer

	ENTRY	FORM..

FORM..:	JUMPLE	FC,FORM.X		;Exit if no more
	SETZ	RP,			;Zero repeat count
FORM.1:	SOJL	FC,FORM.E		;Count character and jump on error
	ILDB	TP,FT			;Get next format character
	CAIL	TP,"0"			;Skip if not number
	 CAILE	TP,"9"			;Skip if number
	  JRST	FORM.2			;Go convert format code
	IMULI	RP,^D10			;Multiple current repeat count
	SUBI	TP,"0"			;Get decimal digit
	ADD	RP,TP			;Add to total repeat count
	JRST	FORM.1			;Continue repeat count loop

FORM.2:	SKIPN	RP			;Skip if count non-zero
	 MOVEI	RP,1			;Set default count to one

	SOJL	FC,FORM.E		;Count character and jump on error
	ILDB	T1,FT			;Get next character
	LSH	TP,7			;Shift first character
	ADD	TP,T1			;Form conversion character
	MOVE	IX,[-KEYSIZ,,KEYVAL]	;Get index to name table
FORM.3:	CAMN	TP,(IX)			;Do names match?
	 JRST	FORM.4			;Jump if yes
	AOBJN	IX,FORM.3		;Loop till done
	JRST	FORM.E			;Not found, declare error

FORM.4:	HRRZ	IX,IX			;Zero high part of index
	SUBI	IX,KEYVAL		;Form conversion index

FORM.5:	SOJLE	FC,FORM.6		;Count char and jump if empty
	ILDB	TP,FT			;Get next character
	CAIN	TP,","			;Skip if not comma
	 JRST	FORM.6			;Comma, take skip return
	CAIN	TP," "			;Skip if not blank
	 JRST	FORM.5			;Blank, loop on next char
	JRST	FORM.E			;Error, neither comma nor blank
FORM.6:	AOS	(P)			;Take skip return
	POPJ	P,			;Return to caller

FORM.E:	MOVEI	TP,1			;Declare format error
	MOVEM	TP,(EA)			;[2]Return error code
FORM.X:	POPJ	P,			;Take non-skip return

KEYVAL:	"I1"				;I*1 conversion
	"I2"				;I*2 conversion
	"I4"				;I*4 conversion
	"IF"				;I*F conversion
	"L1"				;L*1 conversion
	"L2"				;L*2 conversion
	"L4"				;L*4 conversion
	"C8"				;C*8 conversion
	"R4"				;R*4 conversion
	"R8"				;R*8 conversion
	"M1"				;M*1 conversion
	"M2"				;M*2 conversion
	"M4"				;M*4 conversion
	"MF"				;M*F conversion
	"AS"				;AS  conversion
	"SI"				;SI  conversion
	"SO"				;SO  conversion
KEYSIZ=.-KEYVAL

	PRGEND
	TITLE	I1CV??
	SUBTTL	I*1 Signed Integer Conversion (8-bit)
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	Functions to convert one 8-bit signed integer to
;			DECsystem-10 signed integer.
;
;	Usage:		ivar = I1CV16 (array,ptr)
;			ivar = I1CV32 (array,ptr)
;
;	Arguments:	array	= Array containing byte-oriented data
;			ptr	= Starting byte number within array to convert
;
;-
;	Register Definition:
;
	T0=0
	A=16
	P=17

	ENTRY	I1CV16
	ENTRY	I1CV32

I1CV16:
I1CV32:	PUSHJ	P,M1CV16##		;Get numerical argument in T0
	AND	T0,[000000,,000377]	;Clear sign extension
	TRNE	T0,200			;Is sign of I*1 on?
	 IOR	T0,[777777,,777400]	;Yes, set sign extension
	POPJ	P,			;Return

	PRGEND
	TITLE	I2CV??
	SUBTTL	I*2 Signed Integer Conversion (16-bit)
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	Functions to convert one 16-bit signed integer to
;			DECsystem-10 signed integer.
;
;	Usage:		ivar = I2CV16 (array,ptr)
;			ivar = I2CV32 (array,ptr)
;
;	Arguments:	array	= Array containing byte-oriented data
;			ptr	= Starting byte number within array to convert
;
;			Note, the byte ordering in 'array' for I2CV??
;			is assumed to be 0,1 where 0 is the least
;			significant byte of the 16-bit integer.
;
;-
;	Register Definition:
;
	T0=0
	A=16
	P=17

	ENTRY	I2CV16
	ENTRY	I2CV32

I2CV16:
I2CV32:	PUSHJ	P,M2CV16##		;Get numerical argument in T0
	AND	T0,[000000,,177777]	;Clear sign extension
	TRNE	T0,100000		;Is sign of I*1 on?
	 IOR	T0,[777777,,600000]	;Yes, set sign extension
	POPJ	P,			;Return

	PRGEND
	TITLE	I4CV??
	SUBTTL	I*4 Signed Integer Conversion (32-bit)
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	Functions to convert one 32-bit signed integer,
;			ordered (low,high), to DECsystem-10 signed integer.
;
;	Usage:		ivar = I4CV16 (array,ptr)
;			ivar = I4CV32 (array,ptr)
;
;	Arguments:	array	= Array containing byte-oriented data
;			ptr	= Starting byte number within array to convert
;
;			Note, the byte ordering in 'array' for I4CV??
;			is assumed to be 0,1,2,3 where 0 is the least
;			significant byte of the 32-bit integer.
;
;-
;	Register Definition:
;
	T0=0
	A=16
	P=17

	ENTRY	I4CV16
	ENTRY	I4CV32

I4CV16:
I4CV32:	PUSHJ	P,M4CV16##		;Get numerical argument in T0
	AND	T0,[037777,,777777]	;Clear sign extension
	TLNE	T0,20000		;Is sign of I*4 on?
	 IOR	T0,[740000,,000000]	;Yes, set sign extension
	POPJ	P,			;Return

	PRGEND
	TITLE	IFCV??
	SUBTTL	I*F Signed Integer Conversion (32-bit)
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	Functions to convert one 32-bit signed integer,
;			ordered (high,low), to DECsystem-10 signed integer.
;
;	Usage:		ivar = IFCV16 (array,ptr)
;			ivar = IFCV32 (array,ptr)
;
;	Arguments:	array	= Array containing byte-oriented data
;			ptr	= Starting byte number within array to convert
;
;			Note, the byte ordering in 'array' for IFCV??
;			is assumed to be 2,3,0,1 where 0 is the least
;			byte.
;
;-
;	Register Definition:
;
	T0=0
	A=16
	P=17

	ENTRY	IFCV16
	ENTRY	IFCV32

IFCV16:
IFCV32:	PUSHJ	P,MFCV16##		;Get numerical argument in T0
	AND	T0,[037777,,777777]	;Clear sign extension
	TLNE	T0,20000		;Is sign of I*4 on?
	 IOR	T0,[740000,,000000]	;Yes, set sign extension
	POPJ	P,			;Return

	PRGEND
	TITLE	L1CV??
	SUBTTL	L*1 Logical Conversion (8-bit)
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	Functions to convert one 8-bit VAX/PDP-11 logical 
;			value to DECsystem-10 logical value.
;
;	Usage:		lvar = L1CV16 (array,ptr)
;			lvar = L1CV32 (array,ptr)
;
;	Arguments:	array	= Array containing byte-oriented data
;			ptr	= Starting byte number within array to convert
;
;-
;	Register Definition:
;
	T0=0
	A=16
	P=17

	ENTRY	L1CV16
	ENTRY	L1CV32

L1CV16:	PUSHJ	P,M1CV16##		;Get numerical argument in T0
	AND	T0,[000000,,000200]	;Clear all but sign
	TRZE	T0,200			;Is sign of L*1 on?
	 SETO	T0,			;Yes, set return to -1
	POPJ	P,			;Return

L1CV32:	PUSHJ	P,M1CV16##		;Get numerical argument in T0
	AND	T0,[000000,,000001]	;Clear all but lsb
	TRZE	T0,1			;Is lsb of L*1 set?
	 SETO	T0,			;Yes, set return to -1
	POPJ	P,			;Return

	PRGEND
	TITLE	L2CV??
	SUBTTL	L*2 Logical Conversion (16-bit)
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	Functions to convert one 16-bit VAX/PDP-11
;			logical value to DECsystem-10 logical value.
;
;	Usage:		lvar = L2CV16 (array,ptr)
;			lvar = L2CV32 (array,ptr)
;
;	Arguments:	array	= Array containing byte-oriented data
;			ptr	= Starting byte number within array to convert
;
;			Note, the byte ordering in 'array' for L2CV??
;			is assumed to be 0,1 where 0 is the least
;			significant byte of the 16-bit logical.
;
;-
;	Register Definition:
;
	T0=0
	A=16
	P=17

	ENTRY	L2CV16
	ENTRY	L2CV32

L2CV16:	PUSHJ	P,M2CV16##		;Get numerical argument in T0
	AND	T0,[000000,,100000]	;Clear all but sign
	TRZE	T0,100000		;Is sign of L*2	 on?
	 SETO	T0,			;Yes, set return to -1
	POPJ	P,			;Return

L2CV32:	PUSHJ	P,M2CV16##		;Get numerical argument in T0
	AND	T0,[000000,,000001]	;Clear all but lsb
	TRZE	T0,1			;Is lsb set?
	 SETO	T0,			;Yes, set return to -1
	POPJ	P,			;Return

	PRGEND
	TITLE	L4CV??
	SUBTTL	L*4 Logical Conversion (32-bit)
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	Functions to convert one 32-bit VAX/PDP-11 logical
;			value to DECsystem-10 logical value.
;
;	Usage:		lvar = L4CV16 (array,ptr)
;			lvar = L4CV32 (array,ptr)
;
;	Arguments:	array	= Array containing byte-oriented data
;			ptr	= Starting byte number within array to convert
;
;			Note, the byte ordering in 'array' for L4CV??
;			is assumed to be 0,1,2,3 where 0 is the least
;			significant byte of the 32-bit logical.
;
;-
;	Register Definition:
;
	T0=0
	A=16
	P=17

	ENTRY	L4CV16
	ENTRY	L4CV32

L4CV16:	PUSHJ	P,M4CV16##		;Get numerical argument in T0
	AND	T0,[020000,,000000]	;Clear all but sign
	TLZE	T0,20000		;Is sign of L*4	 on?
	 SETO	T0,			;Yes, set return to -1
	POPJ	P,			;Return

L4CV32:	PUSHJ	P,M4CV16##		;Get numerical argument in T0
	AND	T0,[000000,,000001]	;Clear all but lsb
	TRZE	T0,1			;Is lsb of L*4  on?
	 SETO	T0,			;Yes, set return to -1
	POPJ	P,			;Return

	PRGEND
	TITLE	C8CV??
	SUBTTL	C*8 Complex Conversion (Single-Precision)
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	Functions to convert two 32-bit VAX/PDP-11 real values
;			to DECsystem-10 complex value.
;
;	Usage:		cvar = C8CV16 (array,ptr)
;			cvar = C8CV32 (array,ptr)
;
;	Arguments:	array	= Array containing byte-oriented data
;			ptr	= Starting byte number within array to convert
;
;			Note, the byte ordering in 'array' for C8CV??
;			is assumed to be 0,1,..7 where 0 is the first
;			byte of the two 32-bit floating PDP-11 numbers.
;
;-
;	Register Definition:
;
	T0=0
	T1=1
	P0=2
	P1=3
	A=16
	P=17

	ENTRY	C8CV16
	ENTRY	C8CV32

C8CV16:
C8CV32:	PUSH	P,P0			;Save a worker
	PUSH	P,P1			;Save a worker
	MOVEI	P0,@0(A)		;Get array address
	MOVE	P1,@1(A)		;Get byte index
	ADDI	P1,4			;Get imaginary part
	MOVEI	A,ARGLST		;Get fortran arguments
	PUSHJ	P,R4CV16##		;Convert to DECsystem-10 real
	PUSH	P,T0			;Save imaginary part
	SUBI	P1,4			;Get real part
	PUSHJ	P,R4CV16##		;Convert to DECsystem-10 real
	POP	P,T1			;Get imaginary part
	POP	P,P1			;Restore worker
	POP	P,P0			;Restore worker
	POPJ	P,			;Return

	-2,,0
ARGLST:	20,,P0
	00,,P1

	PRGEND
	TITLE	R4CV??
	SUBTTL	R*4 Real Conversion (Single-Precision)
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	Function to convert 32-bit VAX/PDP-11 floating value
;			to DECsystem-10 real value.
;
;	Usage:		rvar = R4CV16 (array,ptr)
;	Usage:		rvar = R4CV32 (array,ptr)
;
;	Arguments:	array	= Array containing byte-oriented data
;			ptr	= Starting byte number within array to convert
;
;			Note, the byte ordering in 'array' for R4CV??
;			is assumed to be 0,1,2,3 where 0 is the first
;			byte of the 32-bit VAX/PDP-11 floating PDP-11 number.
;
;-
;	Register Definition:
;
	T0=0
	T1=1
	A=16
	P=17

	ENTRY	R4CV16
	ENTRY	R4CV32

R4CV16:
R4CV32:	PUSHJ	P,MFCV16##		;Get numerical argument in T0
	JUMPE	T0,R4CV.1		;Just return if zero
	PUSH	P,T0			;Save PDP-11 value
	LDB	T1,[POINT 8,T0,12]	;Get PDP-11 exponent
	AND	T0,[000037,,777777]	;Clear all but PDP-11 mantissa
	IOR	T0,[000040,,000000]	;Set PDP-11 hidden bit
	ASH	T0,3			;Shift into DECsystem-10 mantissa
	DPB	T1,[POINT 8,T0,8]	;Store DECsystem-10 exponent
	POP	P,T1			;Restore PDP-11 value
	TLNE	T1,20000		;Test if value was negative?
	 MOVN	T0,T0			;Yes, set DECsystem-10 negative
R4CV.1:	POPJ	P,			;Return

	PRGEND
	TITLE	R8CV??
	SUBTTL	R*8 Real Conversion (Double-Precision)
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	Functions to convert 64-bit VAX/PDP-11 floating value
;			to DECsystem-10 floating value.
;
;	Usage:		rvar = R8CV16 (array,ptr)
;	Usage:		rvar = R8CV32 (array,ptr)
;
;	Arguments:	array	= Array containing byte-oriented data
;			ptr	= Starting byte number within array to convert
;
;			Note, the byte ordering in 'array' for R8CV??
;			is assumed to be 0,1,..7 where 0 is the first
;			byte of the 64-bit floating VAX/PDP-11 number.
;
;-
;	Register Definition:
;
	T0=0
	T1=1
	P0=2
	P1=3
	A=16
	P=17

	ENTRY	R8CV16
	ENTRY	R8CV32

R8CV16:
R8CV32:	PUSH	P,P0			;Save a worker
	PUSH	P,P1			;Save a worker
	MOVEI	P0,@0(A)		;Get array address
	MOVE	P1,@1(A)		;Get byte index
	ADDI	P1,4			;Get low part
	MOVEI	A,ARGLST		;Get fortran arguments
	PUSHJ	P,MFCV16##		;Get low part in T0
	PUSH	P,T0			;Save imaginary part
	SUBI	P1,4			;Get high part
	PUSHJ	P,MFCV16##		;Get numerical argument in T0,T1
	POP	P,T1			;Now have number in T0,T1
	SKIPN	T1			;Skip if non-zero
	 JUMPE	T0,R8CV.1		;Just return if zero
	PUSH	P,T0			;Save PDP-11 value
	LDB	P1,[POINT 8,T0,12]	;Get PDP-11 exponent
	AND	T0,[000037,,777777]	;Clear all but PDP-11 mantissa
	IOR	T0,[000040,,000000]	;Set PDP-11 hidden bit
	ASH	T1,3			;Shift low-order mantissa
	ASHC	T0,3			;Shift combined mantissa
	DPB	P1,[POINT 8,T0,8]	;Store DECsystem-10 exponent
	POP	P,P1			;Restore PDP-11 value
	TLNE	P1,20000		;Test if value was negative?
	 DMOVN	T0,T0			;Yes, set DECsystem-10 negative
	POP	P,P0			;Restore worker
	POP	P,P1			;Restore worker
R8CV.1:	POPJ	P,			;Return


	-2,,0
ARGLST:	20,,P0
	00,,P1

	PRGEND
	TITLE	ASCV??
	SUBTTL	ASCII Character Conversion
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	Function to convert one VAX/PDP-11 character from
;			byte array to DECsystem-10 character.
;
;	Usage:		ivar = ASCV16 (array,ptr,possrc,postgt)
;
;	Arguments:	array	= Array containing byte-oriented data
;			ptr	= Byte number within array to convert
;			possrc	= Position of source charactare (ignore)
;			postgt	= Position (1-5) to store character
;
;			The possrc value is always one for the VAX/PDP-11
;			and is ignored by this routine. The postgt argument
;			is position in the DEC-10 word to store the character.
;
;-
;	Register Definition:
;
	T0=0
	T1=1
	A=16
	P=17

	ENTRY	ASCV16
	ENTRY	ASCV32

ASCV16:
ASCV32:	PUSHJ	P,M1CV16##	;Get numerical argument in T0
	MOVE	T1,@3(A)	;Get position of character
	IMUL	T1,[-7]		;Get negative bits/character
	ADDI	T1,^D36		;Get number shifts needed
	LSH	T0,(T1)		;Shift character to position
	POPJ	P,		;Return

	PRGEND
	TITLE	M1CV??
	SUBTTL	M*1 Unsigned Integer Conversion (8-bit)
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	Functions to convert one VAX/PDP-11 byte from
;			byte array to DECsystem-10 integer.
;
;			No sign extension performed.
;
;	Usage:		ivar = M1CV16 (array,ptr)
;			ivar = M1CV32 (array,ptr)
;
;	Arguments:	array	= Array containing byte-oriented data
;			ptr	= Byte number within array to convert
;
;-
;	Register Definition:
;
	T0=0
	T1=1
	A=16
	P=17

	ENTRY	M1CV16
	ENTRY	M1CV32

M1CV16:
M1CV32:	MOVE	T0,@1(A)	;Get byte index
	MOVEI	T1,1		;Set byte count
	PUSHJ	P,BYTE..##	;Input binary bytes
	POPJ	P,		;Return

	PRGEND
	TITLE	M2CV??
	SUBTTL	M*2 Unsigned Integer Conversion (16-bit)
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	Function to convert two VAX/PDP-11 bytes from
;			byte array to DECsystem-10 integer.
;
;			No sign extension performed.
;
;	Usage:		ivar = M2CV16 (array,ptr)
;			ivar = M2CV32 (array,ptr)
;
;	Arguments:	array	= Array containing byte-oriented data
;			ptr	= Starting byte number within array to convert
;
;			Note, the byte ordering in 'array' for M2CV??
;			is assumed to be 0 and 1 where 0 is the first
;			8-bit byte of the set.
;
;			These same bytes will appear in 'ivar' as:
;
;			------------------------------------
;			|xx|xxxxxxx|xxxxxxx|   1   |   0   |
;			------------------------------------
;-
;	Register Definition:
;
	T0=0
	T1=1
	A=16
	P=17

	ENTRY	M2CV16
	ENTRY	M2CV32

M2CV16:
M2CV32:	MOVE	T0,@1(A)	;Get byte index
	MOVEI	T1,2		;Set byte count
	PUSHJ	P,BYTE..##	;Input binary bytes
	POPJ	P,		;Return

	PRGEND
	TITLE	M4CV??
	SUBTTL	M*4 Unsigned Integer Conversion (32-bit)
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	Function to convert four VAX/PDP-11 bytes from
;			byte array to DECsystem-10 integer. Assume order
;			is (low,high).
;
;			No sign extension performed.
;
;	Usage:		ivar = M4CV16 (array,ptr)
;			ivar = M4CV32 (array,ptr)
;
;	Arguments:	array	= Array containing byte-oriented data
;			ptr	= Starting byte number within array to convert
;
;			Note, the byte ordering in 'array' for M4CV??
;			is assumed to be 0,1,2,3 where 0 is the first
;			8-bit byte of the set.
;
;			These same bytes will appear in 'ivar' as:
;
;			------------------------------------
;			|xx|   3   |   2   |   1   |   0   |
;			------------------------------------
;-
;	Register Definition:
;
	T0=0
	T1=1
	A=16
	P=17

	ENTRY	M4CV16
	ENTRY	M4CV32

M4CV16:
M4CV32:	MOVE	T0,@1(A)	;Get byte index
	MOVEI	T1,4		;Set byte count
	PUSHJ	P,BYTE..##	;Input binary bytes
	POPJ	P,		;Return

	PRGEND
	TITLE	MFCV??
	SUBTTL	M*F Unsigned Integer Conversion (32-bit)
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	Function to convert four VAX/PDP-11 bytes from
;			byte array to DECsystem-10 integer. Assume order
;			is (high,low).
;
;			No sign extension performed.
;
;	Usage:		ivar = MFCV16 (array,ptr)
;	Usage:		ivar = MFCV32 (array,ptr)
;
;	Arguments:	array	= Array containing byte-oriented data
;			ptr	= Starting byte number within array to convert
;
;			Note, the byte ordering in 'array' for MFCV??
;			is assumed to be 0,1,2,3 where 0 is the first
;			8-bit byte of the set.
;
;			These same bytes will appear in 'ivar' as:
;
;			------------------------------------
;			|xx|   1   |   0   |   3   |   2   |
;			------------------------------------
;
;-
;	Register Definition:
;
	T0=0
	T1=1
	A=16
	P=17

	ENTRY	MFCV16
	ENTRY	MFCV32

MFCV16:
MFCV32:	MOVE	T0,@1(A)	;Get byte index
	MOVEI	T1,4		;Set byte count
	PUSHJ	P,BYTE..##	;Input binary bytes
	MOVE	T1,T0		;Copy return value
	ANDI	T0,177777	;Clear all but low word
	LSH	T0,20		;Shift lower to upper
	LSH	T1,-20		;Shift upper to lower
	ADD	T0,T1		;Form result
	POPJ	P,		;Return

	PRGEND
	TITLE	BYTE..
	SUBTTL	Get Array Mode Bytes
;
;	Author:		R. W. Stamerjohn,	MAPC DEC-10 Systems Group
;	Written:	05-Apr-83
;
;+
;	Purpose:	Get bytes from Array Mode array.
;
;	Usage:		PUSHJ	P,BYTE..
;
;	Arguments:	T0	= Index into array
;			T1	= Number of bytes
;			0(A)	= Address of array
;
;-
;	Register Definition:
;
	T0=0
	T1=1
	P1=2
	P2=3
	P3=4
	P4=5
	A=16
	P=17

	ENTRY	BYTE..

BYTE..:	PUSH	P,P1			;Save a worker
	PUSH	P,P2			;Save a worker
	PUSH	P,P3			;Save a worker
	PUSH	P,P4			;Save a worker
	MOVE	P1,T0			;Copy byte index
	SETZ	T0,			;Zero final result
	MOVEI	P2,@0(A)		;Get address of array
	ADD	P2,[POINT 8,,7]		;Form point to first byte
	MOVN	P3,T1			;Get negative of count
	HRLZ	P3,P3			;Put in upper half
BYTE.1:	MOVE	P4,P1			;Get current index
	ADJBP	P4,P2			;Form pointer to byte
	LDB	T1,P4			;Get desired byte
	HRRZ	P4,P3			;Get current position
	IMULI	P4,10			;Get bits to shift
	LSH	T1,(P4)			;Shift byte to correct position
	ADD	T0,T1			;Add to final result
	AOS	P1			;Bump index
	AOBJN	P3,BYTE.1		;Add one and loop
	POP	P,P4			;Restore worker
	POP	P,P3			;Restore worker
	POP	P,P2			;Restore worker
	POP	P,P1			;Restore worker
	POPJ	P,			;Return

	END