Directory of image this file is from
This file as a plain text file

/ 8K FORTRAN INTEGER MATH PACKAGE   *** INTEGR.04 ***

/				OCTOBER 21, 1970

/COPYRIGHT 1969,1970		DIGITAL EQUIPMENT CORP.
/				MAYNARD, MASS.

/
/
	ENTRY	IREM
	ENTRY	IABS
	ENTRY	DIV
	ENTRY	MPY
	ENTRY	IRDSW
	ENTRY	CLEAR
	ENTRY	SUBSC

/THE FOLLOWING DEFINITIONS ARE TO ENABLE LIBRARY
/OPTIMIZATIONS WHERE CRITICAL TIMING CONSIDERATIONS
/EXIST.  THEY SHOULD BE USED WITH EXTREME CAUTION,
/AND MUST REFERENCE CURRENT PAGE AND PAGE ZERO SYMBOLS
/ONLY.

	OPDEF	TADI	1400
	OPDEF	DCAI	3400
	OPDEF	JMSI	4400
	OPDEF	JMPI	5400

	LAP		/LV AUTO PAGING FOR PAL-III LIKE CODE

AC,	0		/LOCATIONS USED BY MPY & DIV
MQ,	0
SIGN,	0
CTR,	0
LOC,	0
SAV,	0

MPY,	BLOCK	2	/INTEGER MULTIPLY SUBROUTINE
	DCA	MQ	/ CALL 1,MPY
	TAD	MPY	/ ARG <NUMBER>
	DCA	MPY1
MPY1,	NOP		/REPLACED BY CDF
	TADI	MPY#
	INC	MPY#
	DCA	MPY2
	TADI	MPY#
	INC	MPY#
	DCA	DIV
MPY2,	NOP		/REPLACED BY CDF
	TADI	DIV
	JMS	MPYSB
	RETRN	MPY

MPYSB,	0		/INTERNAL MULTIPLICATION SUBR
	DCA	DIV
	TAD	(-14
	DCA	CTR
BACK,	CLL RAL
	DCA	AC
	TAD	MQ
	CLL RAL
	DCA	MQ
	SZL
	TAD	DIV
	TAD	AC
	ISZ	CTR
	JMP	BACK
	JMPI	MPYSB
/
	CPAGE	4
DIVZA,	DIVZ
DVERR,	4411			/"DIVZ" ERROR
	2632
DIV,	BLOCK	2	/INTEGER DIVIDE SUBROUTINE
	SMA		/ CALL 1,DIV
	JMP	AD1	/ ARG <DIVISOR>
	INC	SIGN
	CIA
AD1,	DCA	MQ
	TAD	DIV
	DCA	DIV1
DIV1,	NOP		/REPLACED BY CDF
	TADI	DIV#
	INC	DIV#
	DCA	DIV2
	TADI	DIV#
	INC	DIV#
	DCA	MPY
DIV2,	NOP
	TADI	MPY
	SNA
	JMPI	DIVZA	     /ATTEMPTING TO DIVIDE BY ZERO
	SMA
	JMP	LOOP1
	INC	SIGN
	CIA
LOOP1,	CLL RAL
	INC	CTR
	SMA
	JMP	LOOP1
	CLL RAR
	DCA	LOC
	TAD	LOC
	CIA
	DCA	MPY
	TAD	CTR
	CMA
	DCA	CTR
	TAD	CTR
	DCA	SAV
	DCA	AC
	TAD	MQ
LOOP2,	TAD	MPY
LOOP3,	ISZ	CTR
	SKP
	JMP	DONE
	STL
	SPA
	CLL
	DCA	MQ
	TAD	AC
	RAL
	DCA	AC
	TAD	MQ
	CLL RAL
	SNL
	JMP	LOOP2
	TAD	LOC
	JMP	LOOP3
DONE,	CLA
	TAD	SIGN
	RAR
	CLA
	DCA	SIGN
	TAD	AC
	SZL
	CIA
	RETRN	DIV

IREM,	BLOCK	2	/INTEGER REMAINDER SUBROUTINE
	CLA		/ CALL 1,IREM
	INC	IREM#	/ ARG <UNUSED VARIABLE>
	INC	IREM#
	INC	SAV	/IREM MUST HAVE AN ARGUMENT
	TAD	MQ	/BECAUSE IT IS A FUNCTION.
	SPA		/IREM CAN BE CALLED ONLY ONCE
	TAD	LOC	/AFTER EACH DIVISION ...
	SKP		/SUBSEQUENT CALLS WILL RETURN ZERO.
LOP,	CLL RAR
	ISZ	SAV
	JMP	LOP
	RETRN	IREM
/
	PAGE

IABS,	BLOCK	2	/INTEGER ABS VALUE FUNCTION
	TAD	IABS	/ CALL 1,IABS
	DCA	IAB1	/ ARG <INTEGER VARIABLE>
IAB1,	NOP
	TADI	IABS#
	INC	IABS#
	DCA	IAB2
	TADI	IABS#
	INC	IABS#
	DCA	IRDSW
IAB2,	NOP		/CDF TO ARGUMENT FIELD
	TADI	IRDSW
	SPA
	CIA
	RETRN	IABS

IRDSW,	BLOCK	2	/READ SWITCH REGISTER FUNCTION
	CLA OSR
	INC	IRDSW#
	INC	IRDSW#
	RETRN	IRDSW

DIVZ,   CALL    1,ERROR	/ZERO DIVIDE ERROR
        ARG     DVERR
	CLA CLL CMA RAR
        RETRN   DIV

/THE FLOATING POINT CLEAR ROUTINE WAS ADDED TO "INTEGR"
/SO THAT PROGRAMS WHICH DO NOT USE FLOATING POINT MATH
/CAN RUN WITHOUT LOADING THE F.P. MATH PACKAGE.

CLEAR,	BLOCK	2	/FLOATING POINT CLEAR FUNCTION
	DCA	IRDSW
	DCA	ACH
	DCA	ACM
	DCA	ACL
	TAD	IRDSW
	RETRN	CLEAR


/ THE FOLLOWING CAN BE USED FOR DOUBLY OR SINGLY
/ SUBSCRIPTED ARRAYS.  ON ENTRY THE AC SHOULD BE
/ NEGATIVE FOR FLOATING POINT VARIABLES.  THIS MAY
/ BE ANY NEGATIVE NUMBER FOR SINGLY SUBSCRIPTED
/ VARIABLES, AND MUST BE THE FIRST DIMENSION FOR
/ DOUBLY SUBSCRIPTED VARIABLES.  SOME EXAMPLES
/ FOLLOW:	(TO LOAD THE I,JTH ELEMENT OF AN FP ARRAY)

/	TAD (-M		/DIMENSIONS ARE M BY N
/	CALL 3,SUBSC
/	ARG J
/	ARG I
/	ARG ARRAY
/	LOC		/MUST BE A DUMMY VARIABLE
/	CALL 1,IFAD
/	ARG LOC

/ TO LOAD THE JTH ELEMENT OF AN INTEGER ARRAY:

/	CALL 2,SUBSC
/	ARG J
/	ARG INTARR
/	LOC		/STILL A DUMMY VARIABLE
/	TAD I LOC


S1,	BLOCK 1		/ADDR OF 1ST SUBSC
S2,	BLOCK 1		/ADDR OF 2ND SUBSC
A,	BLOCK 2		/ADDR OF ARRAY
R,	BLOCK 1		/ADDR FOR RESULT
TM,	0
FL,	0		/DOUBLE SUBSC FLAG
N,	0		/DIMENSION -- NEGATIVE IF FLOATING
MQA,	MQ		/FOR INDIRECT DCA

SUBSC,	BLOCK 2		/FORTRAN SUBSCRIPTING ROUTINE
	DCA N		/SAVE THE DIMENSION
	TAD N
	SPA		/... ALSO ABS VALUE
	CMA
	DCAI MQA	/WARNING **THIS ASSUMES DF=CURR FIELD**
	CLA CLL CMA RAL /HOW MANY ARGS?
	TAD SUBSC#
	DCA 10
	TAD SUBSC
	DCA SUB1
SUB1,	NOP		/REPLACED BY CDF
	TADI 10
	AND (100
	SNA CLA		/DOUBLE SUBSCRIPTS?
	JMP SB0
	TADI 10		/YES, PICK UP ARGS...
	DCA SB2
	TADI 10
	DCA S2
	CMA
SB0,	DCA FL		/SET DBL SUBSC FLAG
	TADI 10
	DCA SB1
	TADI 10
	DCA S1
	TADI 10
	DCA A
	TADI 10
	DCA A#
	TAD SUBSC
	DCA SUB2
	TADI 10
	DCA R
	TAD 10
	IAC
	DCA SUBSC#
	ISZ FL		/DBL SUBSCRIPTING?
	JMP SB1
	CLA CMA		/GET THE 2ND SUBSC
SB2,	NOP		/CDF TO FIELD OF 2ND SUBSCRIPT
	TADI S2
	SZA		/IS IT A 1?
	JMSI MPYSBA	/NO, MULTIPLY BY DIMENSION
SB1,	NOP		/CDF TO FIELD OF 1ST SUBSCRIPT
	TADI S1
	TAD (-1		/MINUS ONE
	DCA TM
SUB2,	NOP		/REPLACED BY CDF
	TAD A
	DCAI R
	INC R
	TAD N
	SPA CLA		/FIXED OR FLOATING
	TAD TM
	CLL RAL
	TAD TM
	TAD A#
	DCAI R
	STL CLA RTL	/FAST 'RETRN SUBSC'
	TAD	SUBSC
	DCA	SUB3
SUB3,	NOP		/REPLACED BY 'CDF CIF'
	JMPI	SUBSC#

MPYSBA,	MPYSB

	END