
FORTRAN OTS TAPE 2
/DECIMAL FLOATING TO BINARY
/JMS DFSET	/SETUP ENTRY
/JMS DFETCH	/CHARACTER ENTRY(CONCISE
	/TERM. CHAR. IF LINK=0 THEN ACL,R,X HOLD NUMBER
		/IF LINK=1, THEN DFCHAR HOLDS SIGNED NUMBER


ACS,	0
ACX,	0
ACL,	0
ACR,	0
YS,	0
YX,	0
YL,	0
YR,	0

DFEXSW,	0	/EXPONENT ENTRY
DFFLSW,	0	/FLOATING SWITCH
DFDPSW,	0	/DECIMAL PT. SWITCH
DFDPCT,	0	/COUNT OF DIGITS
DFOVSW,	0	/OVERFLOW SWITCH
DFSGSW,	0	/SIGN SWITCH
DFCHAR,	0	/CHARACTER STORAGE
	0
DFSUM,	0	/DOUBLE PRECISION SUM
	0
	
DFSET,	0	/CLEAR TEMPORARY-READY ENTRY
	DZM DFCHAR
	DZM DFEXSW
	DZM DFFLSW
	DZM DFDPCT
	DZM DFSGSW
	DZM DFSUM
	DZM DFDPSW
	DZM DFOVSW
	DZM DFCHAR+1
	DZM DFSUM+1
	JMP I DFSET
ANELEX
	
DFETCH,	0	/CHARACTER ENTRIES
	CMA
	SNA!CMA
	JMP DFTERM	/CLC=C.R
	SAD (CHAR R0	/MODIFY 0
		JMP CLRAC
	SAD (CHAR R+	/IGNOR SIGN
	JMP I DFETCH
	SAD (CHAR R 	/SPACE IGNORED
	JMP I DFETCH
	SAD (CHAR R-	/-SIGN
	JMP DFSIGN
	SAD (CHAR RE	/EXPONENT
	JMP DFEX
	SAD (CHAR R.	/DECIMAL PT.
	JMP DFPOIN
	SAD (13
	JMP DFTERM
TAKENO,	DAC DFCHAR+1
	ADD (-12


	SPA
	JMP .+3
	JMS DFSET	/ILLEGAL CHARACTER-RESET TYPE X
	JMP I DFETCH
/BEGIN UPDATE SUM
	LAC DFOVSW	/IF OVERFLOW DONOT ADD IN
	SZA
	JMP DFINDX
/10*SUM+DFCHAR=SUM
	LAC DFSUM
	DAC DBAC
	LAC DFSUM+1
	DAC DBAC+1
	JMS DFSHL1
	JMS DFSHL1
	JMS DBADD
	DFSUM
	JMS DFSHL1
	JMS DBADD
	DFCHAR
	LAC DFOVSW
	SZA
	JMP .+5
	LAC DBAC
	DAC DFSUM
	LAC DBAC+1
	DAC DFSUM+1
	LAC DFDPSW
	SZA
	ISZ DFDPCT
	JMP I DFETCH
	
/END NUMBER INPUT
DFINDX,	LAC DFDPSW	/INDEX DECIMAL PT. IF OVERFLOW
	SNA
	ISZ DFDPCT
	JMP I DFETCH
	
/EXPONENT
DFEX,	ISZ DFEXSW
	JMS DFMOVE
	DZM DFSGSW
	DZM DFOVSW
	JMP DFPOIN+1
	
/DECIMAL POINT
DFPOIN,	ISZ DFDPSW	/SET POINT SWITCH AND FLOAT SWITCH
	ISZ DFFLSW
	JMP I DFETCH
	
DFSIGN,	ISZ DFSGSW	/SIGN SWITCH
	JMP I DFETCH
	
DFMOVE,	0	/MOVE SUM TO AC, CLEAR SUM, HOLD SIGN
	LAC DFSUM
	DAC ACL
	LAC DFSUM+1
	DAC ACR
	DZM DFSUM
	DZM DFSUM+1
	LAC DFSGSW
	DAC FSIGN
	LAC DFDPCT
	DAC PONDIG#
	JMP I DFMOVE
	
DFTERM,	ISZ DFETCH
	LAC DFSGSW	/SIGNED DFSUM GOES TO DFCHAR
	RAR
	LAC DFSUM+1
	SZL
	CMA
	DAC DFCHAR
	LAC DFFLSW	/TEST FOR FLOATING NUMBER
	SZA!STL
	JMP .+2
	JMP I DFETCH
	LAC DFEXSW	/FIX EXPONENT
	SZA
	JMP DFL
	JMS DFMOVE	/NO EXPONENT PART
	DZM DFCHAR
DFL,	LAC (43
	DAC ACX	/FLOAT
	LAC ACL
	SZA
	JMP .+13
	LAC ACR
	SMA
	JMP .+10
	RCL
	DAC ACR
	CLA!RAL
	DAC ACL
	LAC ACX
	ADD (-1
	DAC ACX
	JMS I END+43
	LAC FSIGN	/FIX SIGN OF FLOAT PART
	DAC ACS
	LAC PONDIG
	CMA
	ADD DFCHAR
	SPA!CLL	/EXPONENT-OR +
	CMA!STL
	DAC DFSUM
	LAC (FMP FLTEND	/MULTIPLY
	SPL
	LAC (FDV FLTEND	/DIVIDE
	DAC DFTER4
DFTER1,	LAC DFSUM
	SNA
	JMP DFTER3	/DONE
	ADD (-12
	SPA
	JMP DFTER2	/AT LEAST 10 TO 10
	DAC DFSUM
	EFM
DFTER4,	0	/MULT OR DIVIDE BY 10 TO 10
	LFM
	JMP DFTER1
	
DFTER2,	CMA
	DAC DFSUM+1
	CLL!RAL
	ADD DFSUM+1	/3*DFSUM+1
	CMA
	DAC DFTER5
	LAC DFTER4
	AND (740000
	ADD DFTER5
	ADD (FLTEND
	DAC DFTER5
	EFM
DFTER5,	0
	LFM
DFTER3,	CLL
	JMP I DFETCH	/EXIT

DBAC,	0	/AC
	0
DBOR,	0	/OPERAND
	0
	
/ADD
DBADD,	0
	LAC I DBADD	/FETCH OPERAND
	DAC DBOR+1
	LAC I DBOR+1
	DAC DBOR
	ISZ DBOR+1
	LAC I DBOR+1
	CLL
	TAD DBAC+1
	DAC DBAC+1
	CLA!RAL
	TAD DBOR
	TAD DBAC
	DAC DBAC
	SPA
	ISZ DFOVSW
	ISZ DBADD
	JMP I DBADD

/SHIFT LEFT
DFSHL1,	0	/LEFT 1
	LAC DBAC+1
	RCL
	
	DAC DBAC+1
	LAC DBAC
	RAL
	DAC DBAC
	SPA
	ISZ DFOVSW
	JMP I DFSHL1

FLTENS,	4	/10 TO 1
	240000
	0
	7	/10 TO 2
	310000
	0
	12	/10 TO 3
	372000
	0
	16	/10 TO 4
	234200
	0
	21	/10 TO 5
	303240
	0
	24	/10 TO 6
	364110
	0
	30	/10 TO 7
	230455
	0
	33	/10 TO 8
	276570
	200000
	36	/10 TO 9
	356326
	240000
FLTEND,	42
	225005
	744000	/10 TO 10
CLRAC,	CLA
	JMP TAKENO


FOP,FDOUT,	0
	DZM DEXP
	DZM A
	DZM EXSGN
	LAC ACL
	SZA
	JMP .+3
	SAD ACR
	JMP FD2
	JMS FDCONV
	JMS UNFLOT
	0
	GLK
	DAC LINK
FDDIT,	CLL
	LAC (1
	TAD ACR
	DAC ACR
	GLK
	TAD ACL
	SAD (400000
	JMP FIXONE

FD1,	DAC ACL
	LAC LINK
	RCR
	LAC ACR
	RAL
	DAC YR
	DAC ACR
	LAC ACL
	RAL
	DAC ACL
	DAC YL
	JMS PUTDIG
	SAD (20
	JMP ADJUST
	LAC YR
	DAC ACR
	LAC YL
	DAC ACL
FD2,	JMP I FOP

ADJUST,	LAC EXSGN
	SZA!CLC
	LAC (1
	TAD DEXP
	DAC DEXP
	JMP FD2

FDCONV,	0
	LAC ACX
	SPA
	JMS FDESGN
	DAC #B
	LAC EXSGN
	CLL!RAR
	LAC (FDV FLTEND	/DIVIDE
	SPL
	LAC (FMP FLTEND	/MULTIPLY
	DAC FDCOV4

FDCOV1,	LAM -42
	ADD B
	SPA
	JMP FDCOV2
	DAC B	/AT LEAST 10 TO 10
	EFM
FDCOV4,	XX		/FMP OR FDV FLTEND
	LFM
	LAC (12
	ADD DEXP
	DAC DEXP
	JMP FDCOV1
FDCOV2,	LAC ACX
	SZA!SMA
	JMP . 4
	ADD (3
	SMA
	JMP AA.
	LAC FDCOV4
	ADD (FLTENS-FLTEND
	DAC FDCOV5
	EFM
FDCOV5,	XX		/FMP OR FDV FLTENS
	LFM
	ISZ A
	JMP FDCOV2

AA.,	LAC DEXP
	ADD A
	DAC DEXP
	LAC ACX
	TAD (3
	SZA!SMA
	JMP I FDCONV
	LAC ONEOVTEN
	TAD ACL
	SMA
	JMP I FDCONV
	EFM
	FMP FLTENS
	LFM
	LAC EXSGN
	RCR
	LAC DEXP
	SML
	JMP .+3
	ADD (1
	SML!CLL
	TAD (777777
	DAC DEXP
	JMP I FDCONV

FIXONE,	ISZ DEXP
	LAC (146315
	DAC ACR
	LAC (31463
	JMP FD1

FDESGN,	0
	ISZ EXSGN
	CMA
	JMP I FDESGN




PUTDIG,	0
	LAC ACL
	JMS I END+44
	LAC (12
	DAC ACL
	LAC END+10
	DAC DIGIT
	LAC ACR
	JMS I END+44
	LAC (12
	DAC ACR
	LAC END+10
	TAD ACL
	DAC ACL
	CLA!RAL
	TAD DIGIT
	DAC DIGIT
	SAD (11
	JMP PUTULT
	LAC OLDMOD
	SMA
	JMP PUTULT
	LAC ACL
	SAD (777777
	JMP PUTPEN
PUTULT,	LAC DIGIT
	SNA
	LAC (20
	JMP I PUTDIG
PUTPEN,	LAC ACR
	SMA
	JMP PUTULT
	DZM ACL
	DZM ACR
	LAC DIGIT
	ADD (1
	JMP I PUTDIG
DIGIT,	0


DEXP,	0
A,	0
ONEOVTEN,	-314630		/0.1
NOSIGT=-10
DECIMAL
DCPTAB,	100000
	10000
	1000
	100
	10
	1
OCTAL

/FLOAT AND FIX

TFLO,	0		/FLOAT A FIXED NUMBER
	LAC DFCHAR	/PUT DFCHAR IN ACR
	SPA
	CMA
	DAC ACR
	LAC (43		/START WITH 43 FOR EXPONENT
	DAC ACX
	DZM ACL
	JMS I END+43	/NORMALIZE
	DZM ACS
	LAC DFCHAR
	SPA
	ISZ ACS
	JMP I TFLO

TFXA,	0
	LAC ACS
	DAC FSIGN
	DZM LI#NK
TFXA1,	LAC ACX
	SAD (43		/IS EXPONENT 43 YET?
	JMP DONET		/YES, DONE
	ADD (-43
	SMA
	JMP UNPOS	/YES, SHIFT LEFT
	JMS ROTR
	LAC LINK
	RAL
	DAC LINK
	ISZ ACX
	NOP
	JMP TFXA1

DONET,	LAC FSIGN
	RCR
	LAC ACR
	SZL
	CMA
	JMP I TFXA

UNPOS,	JMS ROTL
	JMP UNPOSA
UNPOSR,	DAC ACX
	SAD (43		/43 YET?
	JMP DONET	/YES, DONE
	JMP UNPOS

ROTR,	0
	LAC ACL
	RCR
	DAC ACL
	LAC ACR
	RAR
	DAC ACR
	JMP I ROTR

ROTL,	0
	LAC ACR
	RCL
	DAC ACR
	LAC ACL
	RAL
	DAC ACL
	JMP I ROTL

FLO=JMS .	0
	DAC DFCHAR
	JMS TFLO
	LAC FLO-JMS
	DAC EFMTEM
	JMP EFMTEM+1

FXA=JMS .	0
	LFM
	JMS TFXA
	JMP I FXA-JMS

/DECIMAL INTEGER PRINT  INTEGER IN AC ON ENTRANCE

DECPNT,	CLL!SMA
	CMA!CML
	DAC COM
	LAC (CLA
	SNL
	LAC (LAC MINU
	DAC LINKA
	LAC (ADD DCPTAB
	DAC DCPLOP 2
	LAC (SZA
	DAC DCPMOD
DCPGDC,	DZM CO#M1
	LAC C#OM
	JMP .+3

DCPLOP,	DAC COM
	ISZ COM1
	XX	/ADD DCPTAB
	SPA
	JMP DCPLOP
	ISZ DCPLOP 2
	LAC COM1
DCPMOD,	XX	/SZA
	JMP DCMRA
	JMS I DECALL
	JMP DCPGDC
LINKA,	XX	/CLA IF POSITIVE INTEGER; LAC MINU IF NEG.
DCPR,	LAC COM1
	SNA
	LAC (20	/ZERO
	JMS I DECALL
	LAC (JMP DCPR
	JMP DCPGDC-1
MINU,	54

	NOP	/TO PREVENT
	NOP	/SYMBOL-ABSOLUTE
	NOP	/ADDRESS RELATIONSHIP
	NOP	/CHANGES
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
DCMRA,	XCT LINKA
	JMS I DECALL
	JMP DCPR
START
