;<FOONEX>MFLIN.MAC;3 18-Mar-81 20:20:38, Edit by MMCM
;SUMEX ERJMP/ERCAL CHANGES
;<134-TENEX>MFLIN.MAC;2    24-Jun-79 19:51:53    EDIT BY PETERS
;<134-TENEX>MFLIN.MAC;4    27-AUG-75 12:13:19    EDIT BY CLEMENTS
; Fix two bugs in rounding exit from flin (courtesy Taft)
;<TENEX-130>MFLIN.MAC;3     2-NOV-72 13:34:31	EDIT BY TOMLINSON

;6 APR 72, 1341:
;D. MURPHY

	SEARCH	STENEX,PROLOG
	TITLE MFLIN
;DOUBLE PRECISION FLOATING INPUT ROUTINE FOR TENEX

	USE	SWAPPC

	IFNDEF MONFLG,<MONFLG==1>
	ENTRY .FLIN,.DFIN

;FLIN IS ASSEMBLED FOR MONITOR OR USER DEPENDING ON STATE
; OF MONFLG, 1 FOR MONITOR

	IFG MONFLG,<EXTERN MENTR,MRETN,MRTNE1,BIN1>

;.FLIN IS CALLED BY:
;      PUSHJ P,.FLIN
;	ERROR RETURN
;      NORMAL RETURN

	ENTRY .FLIN,.DFIN
	EXTERN EDFMP.,GETEXP,PUTEXP,EDFAD.

;0 CANNOT BE CHANGED

A=12
B=14
W=1		;SAVED CHAR PTR
CH=3		;CHARACTER UNDER TEST
D=4     
DIG=5
F=6
;7 IS CHARACTER POINTER

M=10		;MEMORY OPERAND POINTER FOR EDFMP.
T=10		;T+1 ALSO USED
AC=12		;AC+1 ALSO USED
;15,16 CANNOT BE CHANGED

P=17		;CONTROL PUSHDOWN

;FLAGS IN LEFT HALF OF AC F

FLDIG=1		;ON - DIGIT SEEN
FLPER=2		;ON - PERIOD SEEN
FLIGN=4		;ON - IGNORE SUBSEQUENT DIGITS
FLMSGN=10		;ON - MANTISSA IS NEGATIVE
FLXSGN=20		;ON - EXPONENT IS NEGATIVE
FLSGN=40		;ON - PLUS OR MINUS SEEN
;EXPONENT INDICATOR IN B35 OF F IS USED AS INDEX, MUST BE ONLY BIT IN RH

;MACRO TO LOAD A CHARACTER INTO 1ST ARG USING CHAR PTR IN 2ND ARG
;CHAR PTR IS NUMBER OF CHARACTERS FROM BEG OF CORE. CLOBBERS 2,3.

	DEFINE LCH
<	PUSHJ P,LCH1>

;SHORTENED PDP-10 OP CODES

	OPDEF CALL [PUSHJ P,]
	OPDEF RET [POPJ P,]

;DOUBLE PRECISION INPUT ROUTINE

DIRT.:	SETZ F,		;FLAGS AND EXPONENT INDICATOR
	SETZB AC,AC+1		;CHAR BY CHAR ASSEMBLY
	SETZ DIG,		;DIGIT COUNTER
	MOVEI D,276		;PRESUMED EXPONENT

;PROCESS MANTISSA

MMORE:	PUSHJ P,GETCH		;GET ANOTHER CHARACTER
	SOJA 7,OVTILC		;SPECIAL CHARACTER BEFORE DIGIT
		;UNSTEP CHAR PTR, GIVE RETURN 1.
		;SPECIAL CHARACTER AFTER DIGIT SKIPS INTO MPSCHA
;SPECIAL CHARACTER AFTER A MANTISSA DIGIT

MSPCHA:	MOVE W,7		;SAVE IR7
	CAIN CH,"E"		;ASCII "E"?
	JRST LFEL		;YES, LOOK FOR EXPONENT
	CAIN CH,"D"
	JRST LFEL		;D PREFIX TO EXPONENT OK TOO
		;CAIE CH,"*"		;ASCII "*"?
; *10^ EXPONENT FEATURE DISABLED 7/1/69 BECAUSE EXPRESSIONS SUCH AS
;  "2/3*10^4" WERE EVALUATED WRONG.

		;JRST SPLASH		;NO, ILLEGAL CHARACTER...END INPUT
		;LCH		;GET NEXT CHARACTER
		;CAIE CH,"1"		;ASCII "1"?
		;JRST LFEI		;NO ILLEGAL CHARACTER...END INPUT
		;LCH		;GET NEXT CHARACTER
		;CAIE CH,"0"		;ASCII "0"?
		;JRST LFEI		;NO ILLEGAL CHARACTER...END INPUT
		;LCH		;GET NEXT CHARACTER
		; CAIN CH,"^"		;ASCII "^"?
		;JRST LFEL		;YES, LOOK FOR EXPONENT
LFEI:	MOVE 7,W		;RESTORE IR7
	JRST SPLASH		;ILLEGAL CHARACTER FOUND...END INPUT

;PROCESS EXPONENT

LFEL:	TLZ F,FLIGN!FLDIG!FLSGN		;RESET GETCH FLAGS AND "SIGN SEEN" FLAG
	TRO F,1		;INDICATE EXPONENT
	MOVEI T,0		;INITIAL EXPONENT = 0
XMORE:	PUSHJ P,GETCH		;GET THE NEXT CHARACTER
	JRST XSPCHI		;SPECIAL CHARACTER BEFORE DIGIT
		;SPEC CHAR AFTER DIGIT GOES SPLASH.

;COMPLETE PROCESSING OF FLOATING POINT NUMBER

SPLASH:	TRNN F,1		;WAS EXPONENT SEEN?
	JRST NORMAL		;NO.
	TLNE F,FLXSGN		;SHOULD EXP BE NEGATIVE?
	MOVNS T		;YES, MAKE IT SO
	ADD DIG,T		;COMBINE WITH DIGIT COUNT
NORMAL:	JUMPN AC,GOOF		;HI MANTISSA = 0?
	JUMPE AC+1,SIGN		;YES, REST = 0?
GOOF:	TLNE AC,400		;NO, BIT 9 = 1?
	JRST SIGN		;YES, DONE
	ASHC AC,1		;LEFT MARCH
	SOJA D,GOOF		;MINUS ONE THE EXP

SIGN:	DPB D,[POINT 9,AC,8]		;DEPOSIT EXP. IN HI ORDER WORD
	SUBI D,^D27		;TO OBTAIN LOW ORDER EXP.
	LSH AC+1,-10		;MAKE ROOM FOR LO ORDER EXP.
	DPB D,[POINT 9,AC+1,8]		;DEPOSIT EXP. IN LOW ORDER WORD
	FADL AC,AC+1		;NORMALIZE RESULTS
	TLNE F,FLMSGN		;SHOULD ANS BE NEGATIVE?
	DFN AC,AC+1		;YES, NEGATE RESULTS
	JUMPG DIG,POSMUL		;DEC EXP IS +
NEGMUL:	MOVNS DIG		;DEC EXP IS -, MAKE IT +
	MOVEI F,TAB.M1		;BASE ADR FOR NEG EXP TABLE
	SKIPA		;GO STORE IT
POSMUL:	MOVEI F,TAB.P1		;BASE ADR FOR POS EXP TABLE
MULOOP:	MOVEI M,0(F)		;TABLE PICKUP
	TRZE DIG,1		;MULTIPLY THIS TIME?
	PUSHJ P,EDFMP.		;YES, GO EAT TIME C(AC,AC+1)*C(C(M),"+1).
	JUMPE DIG,OVT		;JUMP IF NO MORE MULTIPLY
	ASH DIG,-1		;LOOK AT NEXT BIT
	ADDI F,2		;NEXT ENTRY IN TABLE
	JRST MULOOP		;LOOK FOR NEXT MULTIPLY


;SPECIAL CHARACTER BEFORE 1ST EXPONENT DIGIT

XSPCHI:	TLOE F,FLSGN		;HAS A SIGN BEEN ENCOUNTERED?
	JRST LFEI		;YES, ADDITIONAL SIGNS ILLEGAL
	CAIN CH,"+"		;ASCII "+"?
	JRST XMORE		;IGNORE
	CAIN CH," "		;ASCII " "?
	JRST XMORE		;IGNORE
	CAIN CH,"-"		;ASCII "-"?
	TLOE F,FLXSGN		;INDICATE FIRST AND ONLY MINUS
	JRST LFEI		;NOT SIGN
	JRST XMORE		;GET MORE EXPONENT

;RETURN TO MAIN PROGRAM

OVT:	AOS (P)		;NORMAL RETURN 3,4
OUT:	MOVE 2,AC		;RETURN ANSWER IN 2&3
	MOVE 3,AC+1
	POPJ P,
NOTNUM:	MOVEI D,FLINX1
	JRST OUT
ILLNUM:	MOVEI D,FLINX4
	JRST OUT
TOOBIG:	MOVEI D,FLINX3
	MOVE AC,[377777777777]
	MOVE AC+1,[344777777777]
	TLNE F,FLMSGN
	DFN AC,AC+1
	JRST OUT
OVTILC:	CAIN CH,"+"		;PLUS IN MANTISSA FIELD
	JRST MMORE
	CAIE CH,"-"		;CHECK FOR MINUS IN MANTISSA FIELD
	JRST NOTNUM
	TLOE F,FLMSGN		;ONLY ONE ALLOWED
	JRST ILLNUM		;ELSE ILLFORMED NUMBER
	JRST MMORE

.DFIN:	IFG MONFLG,<JSYS MENTR>
	PUSHJ P,DIRT.
	JRST DFINX
	AOS (P)
.DFIN1:	IFG MONFLG,<
	UMOVEM 2,2
	UMOVEM 3,3
	JRST MRETN>
	IFLE MONFLG,<
	POPJ P,>
DFINX:	IFG MONFLG,<
	UMOVEM 2,2
	UMOVEM 3,3
	UMOVEM D,4>
	JRST mrtne1

.FLIN:	IFG MONFLG,<JSYS MENTR>
	PUSHJ P,DIRT.
	JRST FLINX
	TLNE 3,400000
	JRST FLINXX		;NUMBER OUT OF RANGE
FLINXG:	SKIPN A
	JRST FLING
	SKIPG A
	DFN 2,3
	TLNN 3,400		;SEE IF ROUNDING NECESSARY
	JRST NORND		;NO
	PUSH P,A		;YES. SAVE ORIGINAL SIGN BEFORE ROUNDING
	PUSHJ P,GETEXP		;DO A DOUBLE PRECISION EXTENDED ROUND
	SUBI B,^D27
	SETZ A+1,0
	HRLZI A,400
	PUSHJ P,PUTEXP
	MOVEI M,2
	PUSHJ P,EDFAD.
	POP P,2			;RECOVER SIGN BEFORE ROUNDING
	SKIPGE 2		;WAS IT NEGATIVE?
	MOVNS A			;YES. NEGATE HIGH-ORDER RESULT
	MOVE 2,A		;PUT IN RESULT AC
				;DON'T NEED LOW ORDER HALF ANY MORE
	TLNN A,377000
	JRST FLINXR		;SUPER BAD, NUMBER OUT OF RANGE AFTER ROUNDING
FLING:	AOS (P)
.FLIN1:	IFG MONFLG,<
	UMOVEM 2,2
	JRST MRETN>
	IFLE MONFLG,<
	POPJ P,>

FLINX:	IFG MONFLG,<
	UMOVEM 2,2
	UMOVEM D,3>
	JRST mrtne1
NORND:	SETZ 3,		;FOR PROPER ROUNDING
	SKIPG A
	DFN 2,3
	JRST FLING		;NORMAL RETURN
FLINXX:	TLNN A+1,377000		;ANY EXP BITS ON IN WORD 2?
	JRST FLINXG		;NO, UNNECESSARY EXTENSION
FLINXR:	PUSHJ P,GETEXP
	JUMPGE B,FLINXB
	SETZ 2,
	MOVEI D,FLINX2
	JRST FLINX
FLINXB:	MOVEI D,FLINX3
	MOVE 2,[377777777777]
	TLNE A,400000
	MOVE 2,[400000000000]
	JRST FLINX

;GET A CHARACTER AND EXAMINE IT

GETCH:	LCH		;GET NEXT CHARACTER
	CAIL CH,7
	CAILE CH,15
	JRST .+2
	JRST BLNKIN		;FORMATTING
	CAILE CH,37		;EOL?
	CAIN CH," "		;ASCII " "?
	JRST BLNKIN		;YES, PROCESS IT
	CAIN CH,"."		;ASCII "."?
	JRST PERIN		;YES, PROCESS IT
	CAIL CH,"0"		;DIGIT?
	CAILE CH,"9"		;...
	POPJ P,		;NO, RETURN 1,4 OR 2,4
BLNK0:	TLNE F,FLIGN		;IGNORE FLAG ON?
	JRST EXDIG		;YES
	TLON F,FLDIG		;DIGIT SEEN?
	AOS (P)		;NO, FIRST DIGIT
	SUBI CH,"0"		;CAN'T DO INDEXING ON AC0
	XCT PJ(F)		;GO CONVERT DIGIT
	JRST GETCH		;GET ANOTHER CHARACTER

;DIGIT SEEN BEYOND MAXIMUM NUMBER THAT PRECISION WILL HANDLE

EXDIG:		;JUMPN X,GETCH		;IGNORE EXTRA DIGITS IN EXPONENT
		;4/15/69:	CANT HAPPEN IN EXPONENT
	TLNE F,FLPER		;SKIP IF POINT NOT SEEN YET
	JRST GETCH
	AOJA DIG,GETCH		;INDEX EXPONENT FOR EXTRA DIGIT BEFORE POINT

;BLANK SEEN

BLNKIN:	TLNN F,FLDIG		;DIGIT SEEN?
	XCT BLNO(F)		;NO
	POPJ P,		;ILC

;PERIOD SEEN

PERIN:	XCT TLO(F)		;FIRST PERIOD SEEN?
	JRST GETCH		;YES, GET ANOTHER CHARACTER
CPOPJ:	POPJ P,		;ILC

;THE INSTRUCTION PAIRS BELOW CONSIST OF:
;      AN INSTRUCTION EXECUTED WHILE COMPILING THE MANTISSA
;      AN INSTRUCTION EXECUTED WHILE COMPILING THE EXPONENT

TLO:	TLON F,FLPER		;IS THIS FIRST PERIOD?
	POPJ P,		;PERIOD ILLEGAL IN EXPONENT

PJ:	PUSHJ P,MADD		;MANTISSA ADD IN CHARACTER
	PUSHJ P,XADD		;EXPONENT ADD IN CHARACTER

BLNO:	JRST GETCH		;IGNORE BLANK IN MANTISSA
	POPJ P,		;TREAT BLANK AS "+" IN EXPONENT

;ADD A CHARACTER TO THE MANTISSA

MADD:	TLNE F,FLPER		;PERIOD SEEN?
	SOS DIG		;YES, COUNT DIGIT AFTER PERIOD
	MOVE T,AC		;MULTIPLY Y BY 10.
	MOVE T+1,AC+1		;...
	ASHC AC,2		;AC=4*Y
	JCRY1 .+1		;AC=5*Y
	ADD AC+1,T+1		;...
	JCRY1 [AOJA AC,.+1]		;...
	ADD AC,T		;...
	ASHC AC,1		;AC=10.*Y
	JCRY1 .+1		;AC=10.*Y+CHAR
	ADD AC+1,CH		;...
	JCRY1 [AOJA AC,.+1]		;...
	TLNN AC,-1		;AC TOO BIG? (LEAVE 18 EXPONENT AND SIGN BITS)
	POPJ P,		;NO, RETURN
	TLO F,FLIGN		;YES, IGNORE FURTHER DIGITS
	AOS DIG		;ADJUST EXPONENT FOR SKIPPED DIGIT
	MOVE AC,T		;AC=Y
	MOVE AC+1,T+1		;...
	CAIGE CH,5		;ATTEMPT CARRY?
	POPJ P,		;NO, RETURN
	AOJG AC+1,CPOPJ		;CARRY SUCCESSFUL IF NO OVERFLOW INTO SIGN
	AOS AC		;KEEP TRYING
	TLNN AC,-1		;OVERFLOW?
	POPJ P,		;NO, SUCCESSFUL CARRY
	ASHC AC,-1		;AT ANY COST
	AOJA D,CPOPJ		;NOTIFY EXP

;ADD A CHARACTER TO THE EXPONENT

XADD:	IMULI T,^D10		;EXPONENT SO FOR *10
	ADD T,CH		;PLUS NEW DIGIT
	CAIG T,^D99		;BIGGER THAN TENEX LIMIT?
	POPJ P,		;NO, RETURN
	SUB P,[XWD 2,2]		;YES, GREATER THAN 99,
	MOVEI 10,-1(7)		;10 IS TEXT PTR USED BY ERROR ROUTINE
	TLNN F,FLXSGN
	JRST TOOBIG		;...GIVE IMMEDIATE ERROR RETURN
TOOSML:	MOVEI D,FLINX2
	SETZB AC,AC+1
	JRST OUT

	IFLE MONFLG,<
LCH1:	PUSH P,1
	PBIN
	MOVEM 1,CH
	POP P,1
	POPJ P,>

IFG MONFLG,<
LCH1:	PUSH P,1
	UMOVE 1,1		;SOURCE DESIG'RET GOES IN 1
	EXCH 2,CH		;CHARACTER WILL BE RETURNED IN 2
	PUSHJ P,BIN1		;BIN WITHOUT CHANGING CLLFMMON FLG
	EXCH 2,CH		;PUT CHAR IN CH, RESTORE 2
	POP P,1		;RESTORE 1
	POPJ P,
>

;TABMP -- TABLES FOR DOUBLE PRECISION PDP-10 INPUT CONVERSION

TAB.M1:	OCT 175631463146		;1.0E-1
	OCT 142314631463		;...
	OCT 172507534121,137727024365		;1.0E-2
	OCT 163643334272,130616103131		;1.0E-4
	OCT 146527461670,113430214163		;1.0E-8
	OCT 113715126245,060754211570		;1.0E-16
	OCT 026637304365,400324247140		;1.0E-32
	OCT 254520777521,777172247164		;1.0E-64
		;OCT 327673501063,776706227450		;1.0E-128
		;OCT 056600305031,775126157140		;1.0E-256

TAB.P1:	OCT 204500000000,0		;1.0E+1
	OCT 207620000000,0		;1.0E+2
	OCT 216470400000,0		;1.0E+4
	OCT 233575360400,0		;1.0E+8
	OCT 266434157115,233760200000		;1.0E+16
	OCT 353473426555,320202556050		;1.0E+32
	OCT 125604740372,401237771734		;1.0E+64
		;OCT 52447351076,402230235124		;1.0E+128
		;OCT 323524773537,403671677120		;1.0E+256

		END

