FORTRAN OTS TAPE 3 INTERPRETIVE ARITHMETIC

/FLOATING POINT ADD AND SUBTRACT
FSUB,	JMS FPKUP
	LAC YS
	XOR (1
	DAC YS
	SKP
FADD,	JMS FPKUP
	JMS FMAG
	JMS CEE
	LAC FSI#GN
	SZA!CLL
	JMS FADCOM
	LAC ACR
	TAD YR
	DAC ACR
	GLK
	TAD ACL
	TAD YL
	DAC ACL
	LAC FSIGN
	SZA
	JMP FADREC
	JMS OVFL
FADA,	JMS I END+43
	LAC YS
	DAC ACS
MAGF,	LAC ACL
	ADD ACR
	SZA
	JMP BACK
	DZM ACX
	DZM ACS
	JMP BACK

FADCOM,	0
	LAC ACR
	CMA!CLL
	TAD (1
	DAC ACR
	LAC ACL
	CMA
	SZL
	TAD (1
	DAC ACL
	CLL
	JMP I FADCOM

OVFL,	0
	LAC ACL
	SMA
	JMP I OVFL
	RCR
	DAC ACL
	LAC ACR
	RAR
	DAC ACR
	ISZ ACX
	OPR
	JMP I OVFL

FADREC,	LAC ACL
	SMA
	JMP FADA
	JMS FADCOM
	LAC YS
	XOR (1
	DAC YS
	JMP FADA

/DOUBLE PRECISION FLOATING POINT DIVISION

FDIV,	JMS FPKUP	/PICKUP ARGUMENT
	JMS FMAG		/TAKE ABSOLUTE VALUES AND SAVE SIGN
	LAC #YR	/SHIFT DIVISOR LEFT
	RCL	/SO AS TO AVOID OVERFLOW
	DAC YR
	LAC YL
	RAL
	DAC YL
	LAC ACL	/PERFORM FIRST DIVIDE:
	JMS I END+46
	LAC ACR	/  -------------
	LAC YL	/       YL
	DAC ACL	/HIGH ORDER QUOTIENT, Q1
	JMS I END+44	/MULTIPLY Q1 * YR
	LAC YR
	DAC ACR	/LOW ORDER PRODUCT TO ACR
	LAC END+10	/TAKE HIGH ORDER PRODUCT
	CMA	/AND SUBTRACT FROM
	TAD END+12	/REMAINDER OF FIRST DIVISION
	CMA
	SZA!CMA
	JMP .+3
	DZM ACR
	JMP FDIV5
	JMS FDIV2
FDIV2,	0		/SAVE LINK, INDICATES FINAL SIGN
	SNL
	JMP FDIV1	/LINK PLUS INDICATES CORECTION FACTOR -
	TAD (1
	DAC T#
	LAC ACR	/ADJUST LEFT HALF FOR OVERFLOW
	CMA
	DAC ACR
	LAC T
	ISZ ACR
	TAD (-0

FDIV3,	JMS I END+46
	LAC ACR	/  R - Q1 * YR (LEFT) - Q1 * YR (RIGHT) * K
	LAC YL	/  ----------------------------------------
	DAC ACR	/                  YL
	LAC FDIV2
	SMA
	JMP FDIV4

FDIV5,	LAC YX
	CMA	/EXPONENT IS DIFFERENCE OF ACX AND YX
	TAD (1
	TAD ACX
	DAC ACX
	JMS OVFL
	JMS I END+43	/IF ZERO CLEAR EXPONENT
	LAC FSIGN
	DAC ACS
	JMP MAGF

FDIV1,	CMA
	SMA
	JMP FDIV3
	DAC T
	CMA
	TAD YL
	CMA
	SPA
	JMP FDIV6
	DAC T
	CLC
	TAD ACL
	DAC ACL
FDIV6,	LAC T
	SZA
	JMP FDIV3
	JMP FDIV2-3

FDIV4,	LAC ACR
	CMA!CLL
	TAD (1
	DAC ACR
	GLK
	ADD ACL
	ADD (-1
	DAC ACL
	JMP FDIV5

FMPY,	JMS FPKUP
	JMS FMAG
	LAC ACR
	JMS I END+44
	LAC YL
	DAC T
	LAC END+10
	DAC T1#
	LAC ACL
	JMS I END+44
	LAC YR
	CLL
	TAD T
	GLK
	TAD END+10
	TAD T1
	DAC T
	GLK
	DAC T1
	LAC ACL
	JMS I END+44
	LAC YL
	CLL
	TAD T
	DAC ACR
	GLK
	TAD T1
	TAD END+10
	DAC ACL
	LAC YX
	TAD ACX
	TAD (1
	DAC ACX
	JMS I END+43
	LAC FSIGN
	DAC ACS
	JMP MAGF



/COMPARE AND EQUALIZE EXPONENTS

CEE,	0
	LAC ACL
	ADD ACR
	SNA
	JMP CEESWA
	LAC YL
	ADD YR
	SNA
	JMP I CEE
	LAC YX
	CMA
	TAD ACX
	TAD (1
	DAC END+11
	SNA
	JMP I CEE
	SPA!CMA
	JMP CEESW
	TAD (1
	DAC END+11
	LAC ACX
	DAC YX
	JMS I END+47
	JMP I CEE

CEESWA,	DZM END+11

CEESW,	LAC YX
	DAC ACX
	LAC ACL
	DAC TEMZER
	LAC YL
	DAC ACL
	LAC TEMZER
	DAC YL
	LAC ACR
	DAC TEMZER
	LAC YR
	DAC ACR
	LAC TEMZER
	DAC YR
	LAC AC#S
	RAR
	LAC Y#S
	DAC ACS
	CLA!RAL
	DAC YS
	JMS I END+47
	JMP I CEE

FLAC,	JMS JLAC
	JMP BACK

JLAC,	0
	JMS JLAC0
	SZA
	JMP JLAC2
	LAC I T
	DAC ACX
	ISZ T
	LAC I T
	DZM ACS
	SPA
	ISZ ACS
	AND (377777
	DAC ACL
	ISZ T
	LAC I T
	DAC ACR
	JMP I JLAC
JLAC2,	LAM -10
	DAC JLACTM
	LAC I T
	AND (777000
JLAC3,	CLL!SPA
	STL
	RAR
	ISZ JLACTM
	JMP JLAC3
	DAC JLACTM
	LAC I T
	AND (777
	DAC ACL
	ISZ T
	DZM ACS
	LAC I T
	SPA!CLL
	ISZ ACS
	RAL
	DAC ACR
	JMS I END+43
	LAC JL#ACTM
	DAC ACX
	JMP I JLAC
JLAC0,	0
	LAC IDRECT
	SZA
	JMP . 3
	LAC MODE
	JMP I JLAC0
	LAC T
	AND (400000
	JMP I JLAC0




FDAC,	JMS JLAC0
	SZA
	JMP FDAC2
	LAC ACX
	DAC I T
	ISZ T
	LAC ACS
	RCR	RAR
	XOR ACL
	JMP SETACS
FDAC2,	LAC T
	DAC FOP
	LAC ACX
	AND (777
	RL6
	RTL	RAL
	DAC JLACTM
	DZM ACX
	JMS UNFLOT
	7
	LAC ACS
	RCR
	LAC ACR
	RAR
	DAC ACR
	LAC ACL
	ADD JLACTM
SETACS,	DAC I T
	ISZ T
	LAC ACR
	DAC I T
	JMS JLAC0
	SNA
	JMP BACK
	LAC FOP
	DAC T
	JMP FLAC

FPKUP,	0
	JMS JLAC0
	RCL
	LAC T
	AND (77777
	SZL
	XOR (400000
	DAC TEM#P2
	LAC EFMTEM
	DAC TEMP#3
	EFM
	DAC TEMP4
	LAC I TEMP2
	LFM
	LAC ACS
	DAC YS
	LAC ACX
	DAC YX
	LAC ACL
	DAC YL
	LAC ACR
	DAC YR
	EFM
	LAC TEMP4
	LFM
	LAC TEMP3
	DAC EFMTEM
	JMP I FPKUP
TEMP4,	0
TEMP4 3/

FMAG,	0
	LAC YS
	XOR ACS
	DAC FSIGN
	JMP I FMAG

UNFLOT,	0
	LAC ACX
	CMA
	ADD I UNFLOT
	CMA
	DAC END+11
	LAC ACL
	DAC YL
	LAC ACR
	DAC YR
	JMS I END+47
	LAC YL
	DAC ACL
	LAC YR
	DAC ACR
	ISZ UNFLOT
	DZM ACX
	JMP I UNFLOT

START