Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/cblsrc/accept.mac
There are 7 other files named accept.mac in the archive. Click here to see a list.
; UPD ID= 1227 on 5/31/83 at 4:10 PM by HOFFMAN                         
TITLE ACCEPT			JEF/DMN

	SEARCH COPYRT
	SALL


;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1973, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION

		SEARCH	LBLPRM		;GET PARAMETERS
IFN TOPS20,<	SEARCH	MACSYM,MONSYM>
IFE TOPS20,<	SEARCH	MACTEN,UUOSYM>

;[1041] 20-Aug-82 RLF	Make SIZE ERROR work when ACCEPTed data item
;			is multiplied by a constant.
;[553] 19-FEB-79 DAW  ALLOW NO DIGITS FOLLOWING A DECIMAL POINT	
;[441]  6/25/76  EHM  PUT $ IN FRONT OF ERROR MESAGE SO IT WILL GO 
;		 TO OPR UNDER BATCH.
;**; EDIT 337 ALLOW MORE THAN ONE DATA TO BE ENTERED ON A LINE.

HISEG

	.COPYRIGHT		;Put standard copyright statement in REL file

;CALLING SEQUENCE IS:
;			MOVEI	16,ARG
;			PUSHJ PP, ACEPT.
;
;THE ARG'S EFFECTIVE ADDRESS CONTAINS A PARAMETER WORD.
;
;ALPHA:	  BIT 6 IS ZERO, ACCEPT AN ALPHANUMERIC TERM.
;	  THE PARAMETER WORD IS A MODIFIED BYTE POINTER TO THE
;	  BUFFER AREA. MODIFICATIONS FOLLOW:
;	  IF BIT 7 IS SET THIS IS THE LAST FIELD, SKIP TO A EOL
;	    CHARACTER (LF,VT,FF,CR).
;	  BITS 8-17 CONTAIN THE NUMBER OF CHARACTERS TO ACCEPT.
;
;NUMERIC: BIT 6 IS SET, ACCEPT A NUMERIC TERM.
;	  THE PARAMETER WORD IS INTERPRETED AS FOLLOWS:
;	  IF BIT 7 IS SET THIS IS THE LAST FIELD, SKIP TO AN
;	    EOL CHARACTER.
;	  BITS 8-17 CONTAIN THE FIELD SIZE,THE NUMBER OF DIGITS
;	    TO ACCEPT.
;	  IF BIT 18 IS SET, THEN ITEM IS PIC PPP..99.. AND
;	    HIGH ORDER DIGITS ARE ZEROED OUT.
;	  IF BIT 19 IS SET, THEN ITEM IS COMP-1 OR COMP-2.
;		THEN RETURN AC0 OR AC0 + AC1 = FLOATING POINT NUMBER.
;	  IF BIT 30 IS A ZERO, THEN BITS 31-35 CONTAIN THE NUMBER
;	    OF DECIMAL PLACES IN THE FIELD SIZE.
;	  IF BIT 30 IS SET, THEN BITS 31-35 CONTAIN A SCALE
;	    FACTOR.  THE AMOUNT OF NUMBERS ACCEPTED BECOMES
;	    (FIELD SIZE)+(SCALE FACTOR) AND UPON COMPLETION
;	    (SCALE FACTOR) CHARACTERS ARE TRUNCATED FROM THE
;	    RIGHT.  THE PERIOD BECOMES AN ILLEGAL CHARACTER.
;MODIFIED ACS ARE:	17,15,11,10,7,6,3,2,1,0
PP=	17	;PUSHDOWN LIST POINTER
AC16=	16	;THE CALLING UUO
AC15=	15	;UUO'S OPERAND
C=	AC10+1	;CRARACTER REGISTER
AC10=	10	;FIELD COUNT
FLG=	7	;FLAG REGISTER
AC6=	6	;CHARACTER COUNT

MINUS=	400000	;A MINUS SIGN WAS SEEN
SIGN=	200000	;A PLUS OR MINUS SIGN WAS SEEN
PERIOD=	100000	;A DECIMAL POINT WAS SEEN
NUMBER=	 40000	;A NUMBER WAS SEEN
ASCALE=  20000	;ITEM WAS PICTURE PPP...999 - JUST RETURN LOW ORDER DIGITS.

ENTRY	ACEPT.
EXTERN	GETCH.,DOPFS.,FLDCT.,POINT.
EXTERN	DSPL1.,RET.1,RET.2,OUTCH.
MLON
SALL

DEFINE	TYPE(ADDR),<
 IFE TOPS20,<
	OUTSTR	ADDR
 >;TOPS10 STYLE
 IFN TOPS20,<
	PUSH	PP,1
	HRROI	1,ADDR
	PSOUT%
	POP	PP,1
 >;TOPS20 STYLE, BE REALLY CAREFUL
>;END DEFINE "TYPE"

DEFINE $CLRIB,<	;CLEAR INPUT BUFFER ON TTY
REPEAT 0,<		;WHEN NATIVIZED
 IFE TOPS20,<
	CLRBFI		;TOPS10 UUO TO CLEAR TTY BUFFER
 >
 IFN TOPS20,<
	PUSH	PP,T1		;BE REAL CAREFUL
	MOVEI	T1,.PRIIN	;CLEAR PRIMARY INPUT'S BUFFER
	CFIBF%
	POP	PP,T1		;RESTORE SAVED AC
 >
>;END REPEAT 0 FOR WHEN NATIVIZED
REPEAT 1,<
	CLRBFI			;[12B] STILL NOT NATIVE
>
>;END DEFINE $CLRIB
ACEPT.:	MOVE	AC15,(AC16)		;(AC16)=	AC,E
	LDB	AC6,DOPFS.		;001777 000000  FIELD SIZE
	TXNN	AC15,ACP%LF		;SKIP TO END OF LINE?
	AOSA	AC10,FLDCT.		;NO-INCREMENT
	SETZB	AC10,FLDCT.		;YES-LAST FIELD
	TXNN	AC15,ACP%NM		;SKIP IF NUMERIC
	JRST	ALPHA			;JUMP IF ALPHA
	SETZB	0,1			;ANSWER RETURNED IN 0 AND 1
	SETZ	FLG,			;CLEAR THE FLAGS
	TXNE	AC15,ACP%FP		;FLOATING POINT INPUT?
	JRST	.FLIN			;YES
	TXZE	AC15,ACP%P9		;PIC P9?
	TLO	FLG,ASCALE		;YES, REMEMBER TO THROW AWAY HIGH-ORDER
					; DIGITS BEFORE WE RETURN
	TXNN	AC15,ACP%SF		;SKIP IF THERE IS A SCALE FACTOR
	JRST	ACEPT1			;
	ADDI	AC6,-ACP%SF(AC15)	;FIELD SIZE PLUS SCALE FACTOR
	JRST	DISPCH			;
ACEPT1:	SUBI	AC6,(AC15)		;FIELD SIZE MINUS DECIMAL PLACES
	JRST	DISPCH			;

AMINUS:	TLO	FLG,MINUS		;MINUS=	1B0
APLUS:	TLNE	FLG,PERIOD!NUMBER!SIGN
	JRST	ILLFMT			;THE SIGN MUST PRECEDE PERIOD AND NUMBERS
	TLO	FLG,SIGN
	JRST	DISPCH

TERMIN:	TLNE	FLG,NUMBER		;SKIP ON NULL FIELD
	JRST	TERM10			;JUMP IF A NUMBER WAS SEEN.
	TLNE	FLG,SIGN!PERIOD
	JRST	ILLFMT			;NULLS MUST BE UNSIGNED INTEGERS
	CAIL	C,-1			;SKIP IF NOT SPACE OR TAB 
	JRST	DISPCH			;LEADING SPACES AND TABS ARE NOT TERMINATORS

TERM10:	TRZN	AC15,ACP%SF		;SKIP IF SCALE FLAG IS SET
	JRST	TERM11
	HRRZ	AC6,AC15		;DECIMAL PLACES TO AC6
DIV10:	MOVE	2,1	
	IDIVI	0,^D10	
	DIVI	1,^D10	
	SOJG	AC6,DIV10
	JRST	TERM20

TERM11:	TLNN	FLG,PERIOD		;SKIP IF A PERIOD WAS SEEN
	HRRZ	AC6,AC15		;FRACTIONAL PLACES
	JUMPE	AC6,TERM20		;JUMP IF ZERO FILL IS NOT NEEDED
	PUSHJ	PP,MUL10		;GET A ZERO
	SOJG	AC6,.-1			;TILL AC6=0
TERM20:	JFCL	17,.+1			;[1041] CLEAR ALL FLAGS
	TLNE	FLG,ASCALE		;IF ASCALE IS SET,
	 JRST	TERM22			; RETURN LOW-ORDER DIGITS
TERM21:	JUMPGE	FLG,GETEOL		;JUMP IF SIGN IS POSITIVE
	DMOVN	0,0			;IT'S NEGATIVE SO NEGATE
	TLNE	0,(1B0)			;IF RESULT NON-ZERO,
	TLO	1,(1B0)			;TURN ON SIGN BIT IN LOW-ORDER WORD
	JRST	GETEOL			; AND EXIT
; HERE IN THE CASE WHERE THE PICTURE WAS PPPP...9999.
; WE MUST MAKE SURE ALL DIGITS WHERE THE P'S ARE WILL BE 0'S.
; DIVIDE BY THE FIELD SIZE (# OF 9'S) AND JUST RETURN THE REMAINDER.
;(RESULT - IF PIC P9 AND HE TYPED ".34", RETURN ".04")

TERM22:	LDB	AC15,DOPFS.		;GET FIELD SIZE (# DIGITS TO SAVE)
	CAILE	AC15,^D10		;IS POWER OF 10 ONE WORD?
	 JRST	BIG			;NO - SPLIT
	MOVE	2,1
	IDIV	0,DECTAB##(AC15)	;DECTAB IS DEFINED IN PD.MAC
	DIV	1,DECTAB##(AC15)	; GET FINAL 1 WORD REMAINDER IN 2
	SETZ	0,			;HIGH ORDER WORD WILL BE 0
	MOVE	1,2			;RETURN REMAINDER
	JRST	TERM21			; (DONE)

BIG:	SUBI	AC15,^D10		;GET SOMETHING SMALLER
	MOVE	2,1
	DIV	0,DECTAB+^D10		;DIVIDE NUMBER BY 10**10
	IDIV	1,DECTAB+^D10		;1-WORD REMAINDER IN 2
	MOVE	AC6,2			;SAVE AWAY 1ST REMAINDER
	MOVE	1,0			;FETCH 1-WORD QUOTIENT
	IDIV	1,DECTAB(AC15)		;NOW GET HIGH-ORDER REMAINDER
	MOVE	0,DECTAB+^D10		;GET 10**10
	MUL	0,2			;MULTIPLY BY HIGH ORDER REMAINDER
	TLO	AC6,(1B0)		;DON'T ALLOW OVERFLOW
	ADD	1,AC6			; ADD IN LOW-ORDER REMAINDER
	TLZN	1,(1B0)			;IF BIT WAS CLEARED, SIMULATE OVERFLOW
	 ADDI	0,1
	JRST	TERM21			;THEN DONE
MUL10:	JCRY1	.+1			;CLEAR THE OVERFLOW  FLAG
	DMUL	0,DPTEN			;MULTIPLY THE ANS BY 10
	DMOVE	0,2			;PUT RESULT IN 0 & 1
	POPJ	PP,

DPTEN:	EXP	0,^D10

APERIO:	TRNN	AC15,ACP%SF		;SKIP IF SET, FRACTIONS ARE NOT ALLOWED
	TLOE	FLG,PERIOD		;SKIP IF THIS IS FIRST PERIOD
	JRST	ILLFMT			;ONLY ONE DECIMAL POINT PER NUMBER
	HRRZ	AC6,AC15		;FRACTIONAL PLACES
	JRST	DISPCH			;[553] GO GET NEXT CHARACTER
ANUMBE:	TLO	FLG,NUMBER		;SAW A NUMBER
	PUSHJ	PP,MUL10		;MAKE ROOM FOR NEXT NUMBER
	ANDI	C,17			;CONVERT ASCII TO OCTAL
	ADD	1,C			;ADD IN THE OCTAL NUMBER
	JCRY1	[AOJA 0,.+1]		;AND DON'T LOSE THE CARRY OUT BIT
	SOJL	AC6,TMDFMT		;EXTRA NUMBERS ARE ILLEGAL.

DISPCH:	PUSHJ	PP,GETCH.		;DISPATCH TO ONE OF FIVE ROUTINES
	  JRST	TERMIN			;ALT-MODE, FF, VT OR LF
	MOVE	3,POINT.		;
	CAIN	C,40(3)			;"." OR ","
	JRST	APERIO			;   IS A PERIOD
	CAILE	C,"9"
	JRST	ILLFMT			;ELSE ILLEGAL FORMAT
	CAIL	C,"0"
	JRST	ANUMBE			;"0" THROUGH "9"
	CAIE	C,11
	CAIN	C,40
	AOBJP	C,TERMIN		;TAB OR SPACE
	SUBI	C,53
	JUMPE	C,APLUS			;PLUS
	SOJE	C,TERMIN		;COMMA
	SOJE	C,AMINUS		;MINUS
ILLFMT:	SOS	FLDCT.			;DECREMENT THE FIELD COUNT
	$CLRIB				;EMPTIES THE BUFFER
	TYPE	[ASCIZ/$CBTILF Illegal format, retype /] ;[441] SEND TO OPR IN BATCH
ILLNXT:	JUMPN	AC10,STRTNG		;NOT THE LAST FIELD
	TYPE	[ASCIZ/the last field.
/]
	JRST	ACEPT.			;TRY AGAIN

TMDFMT:	SOS	FLDCT.			;DECREMENT THE FIELD COUNT
	$CLRIB				;EMPTIES THE BUFFER
	TYPE	[ASCIZ/$CBTTMD Too many digits, retype /] ;SEND TO OPR IN BATCH
	JRST	ILLNXT

STRTNG:	TYPE	[ASCIZ/starting with field /]
	PUSHJ	PP,OCTDCI		;OUTPUT THE FIELD NUMBER
	PUSHJ	PP,DSPL1.		;OUTPUT BUFFER "CRLF"
	JRST	ACEPT.			;AND START ALL OVER AGAIN

OCTDCI:	IDIVI	AC10,^D10		;OCTAL TO DECIMAL CONVERSION
	HRLM	C,(PP)			;SAVE REMAINDERS ON PDLIST
	CAIE	AC10,0			;SKIP IF QUOTIENT = 0
	PUSHJ	PP,OCTDCI		;PICK OFF THE NEXT REMAINDER
	HLRZ	C,(PP)			;POP OFF THE LAST REMAINDER
	ADDI	C,"0"			;ASCIIZE IT
	JRST	OUTCH.			;AND TYPE IT
;AC6 HOLDS THE FIELD SIZE
;AC15 HOLDS A MODIFIED BYTE POINTER

ALPHA:	TLZ	AC15,7777
	TLO	AC15,700		;AC15 IS NOW A NORMAL BYTE POINTER
ALPGET:	PUSHJ	PP,GETCH.		;GET NEXT CHARACTER
	  JRST	ALPFIL			;TERMINATOR
	CAIN	C,32			;CONTROL Z?
	JRST	ALPGET			;(CONTROL Z)'S ARE IGNORED
	IDPB	C,AC15			;IT'S OK
	SOJLE	AC6,GETEO1		;[337] JUMP WHEN CHARACTER COUNT GOES TO ZERO
	JRST	ALPGET			;

ALPFIL:	MOVEI	C,40			;FILL OUT THE FIELD WITH SPACES
	IDPB	C,AC15
	SOJG	AC6,.-1
	POPJ	PP,			;EXIT

GETEOL:	JUMPN	AC10,RET.1		;[337] JUMP IF NOT ZERO
GETEO1:	CAIE	C,12			;SKIP IF EOL CHAR
	PUSHJ	PP,GETCH.		;EXIT ON EOL CHAR.
	  POPJ	PP,			;EOL = ALT-MODE, FF, VT OR LF
	JRST	GETEO1			;[337] LOOP
SUBTTL	FLOATING POINT INPUT	D.M.NIXON	6-APR-77

	SALL


	EXTERN	LOTEN$,HITEN$,EXP10$,PTLEN$

;THE SYNTAX ANALYSIS FOR THE SINGLE AND DOUBLE PRECISION INPUT
;IS STATE TABLE DRIVEN. EACH NEW INPUT CHARACTER IS CONVERTED TO
;A CHARACTER TYPE AND COMBINED WITH THE OLD "STATE". THIS RESULT
;IS THEN LOOKED UP IN THE TABLE "NXTSTA" TO GET THE NEW STATE AND
;AN INDEX INTO THE "XCTTAB" TABLE TO DISPATCH FOR THE INPUT
;CHARACTER. THE STATE TABLE LOGIC AND THE DISPATCH ROUTINES BUILD
;THREE RESULTS: A DOUBLE PRECISION INTEGER(IN B,C) FOR THE FRACTIONAL
;PART OF THE RESULT, AN INTEGER(IN XP) FOR THE EXPONENT AFTER
;"D" OR "E", AND A COUNTER(IN "X") TO KEEP TRACK OF THE DECIMAL POINT.
;WHEN A TERMINATING CHARACTER IS FOUND, THE DOUBLE PRECISION INTEGER
;IS NORMALIZED TO THE LEFT TO GIVE A DOUBLE PRECISION FRACTION.
;THE DECIMAL POINT POSITION(FROM "X")OR THE IMPLIED DECIMAL POINT
;POSITION FROM THE FORMAT STATEMENT, THE "D" OR "E" EXPONENT, AND ANY
;SCALING FROM THE FORMAT STATEMENT ARE COMBINED INTO A DECIMAL
;EXPONENT. THIS DECIMAL EXPONENT IS USED AS AN INDEX INTO A POWER
;OF TEN TABLE (KEPT IN DOUBLE PRECISION INTEGER PLUS EXPONENT FORM
;SO INTERMEDIATE RESULTS WILL HAVE 8 MORE BITS OF PRECISION THAN
;FINAL RESULTS) TO MULTIPLY THE DOUBLE PRECISION FRACTION. THIS
;RESULT IS THEN ROUNDED TO GIVE A SINGLE OR DOUBLE PRECISION RESULT.
;OVERFLOWS RETURN THE LARGEST POSSIBLE NUMBER (WITH CORRECT SIGN),
;WHILE UNDERFLOWS RETURN 0.
;NO ERROR MESSAGE IS GIVEN FOR EITHER OVER OR UNDERFLOW.
A=0
B=A+1			;RESULT RETURNED IN A OR A AND B
CC=B+1			;B,CC,D AND E ARE USED AS A MULTIPLE PRECISION
D=CC+1			;  REGISTER FOR DOUBLE PRECISION OPERATIONS
E=D+1
FM=5
XP=6			;EXPONENT AFTER D OR E
ST=13			;STATES
;ST+1			;TEMPORARY
BXP==ST			;BINARY EXPONENT
X=15			;COUNTS DIGITS AFTER POINT
P=17			;PUSHDOWN POINTER


;RIGHT HALF FLAGS IN AC "F"
DOTFL==1		;DOT SEEN
MINFR==2		;NEGATIVE FRACTION
MINEXP==4		;NEGATIVE EXPONENT
EXPFL==10		;EXPONENT SEEN IN DATA (MAY BE 0)
DIGSN==20		;DIGIT SEEN

;INPUT CHARACTER TYPES
CRTYP==1	;CARRIAGE RETURN
DOTTYP==2	;DECIMAL POINT
DIGTYP==3	;DIGITS 0-9
SPCTYP==4	;SPACE OR TAB
EXPTYP==5	;D OR E
PLSTYP==6	;PLUS SIGN (+)
MINTYP==7	;MINUS SIGN (-)
		;ANYTHING ELSE IS TYPE 0

OPDEF	JUMPDP	[JUMPL	FLG,]
.FLIN:	SETZB	FM,FLG		;NO FORMAT WORD
	CAILE	AC6,^D10	;DOUBLE PRECISION?
	JRST	.DFIN		;YES
	PUSHJ	P,FLIRT%
	 JRST	ILLFMT		;ILLEGAL FORMAT
	JRST	GETEOL		;GET EOL IF NECESSARY, THEN EXIT

.DFIN:	MOVSI	FLG,(1B0)	;DOUBLE PRECISION
	PUSHJ	P,FLIRT%
	 JRST	ILLFMT		;ILLEGAL FORMAT
	JRST	GETEOL		;GET EOL IF NECESSARY, THEN EXIT
FLIRT%:				;INPUT
	SETZB	B,CC		;INIT D.P. FRACTION
	SETZB	ST,XP		;INIT STATE AND DECIMAL EXPONENT
	SETZB	X,ST+1		;INIT "DIGITS AFTER POINT" COUNTER
	SETZ	A,

GETNXT:	LSH	ST,-^D30	;MOVE STATE TO BITS 30-32
	PUSHJ	P,GETCH.	;GET NEXT CHARACTER
	  TRN			;EOL CHARACTER (FLIRT% KNOWS ABOUT IT)
	CAIL	C,"0"		;CHECK FOR NUMBER
	CAILE	C,"9"
	JRST	CHRTYP		;NO, TRY OTHER
	SUBI	C,"0"		;CONVERT TO NUMBER
	IORI	ST,DIGTYP	;SET TYPE
GOTST:	LSHC	ST,-2		;DIVIDE BY NUMBER OF BYTES IN WORD
	TLNE	ST+1,(1B0)	;TEST WHICH HALF
	SKIPA	ST,NXTSTA(ST)	;RIGHT HALF (BYTES 2 OR 3)
	HLRZ	ST,NXTSTA(ST)	;UNFORTUNATELY BYTES 0 OR 1
	TLNN	ST+1,(1B1)	;WHICH QUADRANT
	LSH	ST,-9		;BYTES 0 OR 2
	ANDI	ST,777		;LEAVE ONLY RIGHT MOST  QUARTER
	ROT	ST,-3		;PUT DISPATCH ADDRESS IN BITS 32-35
				; AND NEW STATE IN BITS 0-2
	XCT	XCTTAB(ST)	;DISPATCH OR EXECUTE
	JRST	GETNXT		;RETURN FOR NEXT CHAR.

XCTTAB:	JRST	ILLCH		; (00) ILLEGAL CHAR
	JRST	ENDF0		; (01) CR-LF
	IORI	FLG,DOTFL	; (02) PERIOD
	JRST	DIG		; (03) DIGIT BEFORE POINT
	JRST	BLNKIN		; (04) BLANK OR TAB
	JRST	GETNXT		; (05) RETURN FOR NEXT CHAR.
	IORI	FLG,MINFR	; (06) NEGATIVE FRACTION
	IORI	FLG,MINEXP	; (07) NEGATIVE EXP
	SOJA	X,DIG		; (10) DIGIT AFTER POINT
	JRST	DIGEXP		; (11) EXPONENT
	JRST	DELCK		; (12) DELIMITER TO BACK UP OVER
	JRST	ILLFST		; (13) ILLEGAL FIRST CHARACTER

CHRTYP:	CAIN	C,"+"		;CONVERT INPUT CHARS TO CHARACTER TYPE
	IORI	ST,PLSTYP
	CAIN	C,"-"
	IORI	ST,MINTYP
	CAIE	C," "		;SPACE
	CAIN	C,"	"	;TAB
	IORI	ST,SPCTYP
	CAIN	C,"."
	IORI	ST,DOTTYP
	CAIE	C,"D"
	CAIN	C,"E"
	IORI	ST,EXPTYP
	CAIE	C,"d"
	CAIN	C,"e"
	IORI	ST,EXPTYP
	CAIN	C,12		;CARRIAGE-RETURN?
	IORI	ST,CRTYP
	JRST	GOTST		;GO DISPATCH ON OLD STATE AND CHAR TYPE


DIG:	TRO	FLG,DIGSN	;SAW A DIGIT
	JUMPN	B,DPDIG		;NEED D.P. YET?
	CAMLE	CC,MAGIC	;NO, WILL MUL AND ADD CAUSE OVERFLOW?
	JRST	DPDIG		;MAYBE, SO DO IT IN DOUBLE PRECISION
	IMULI	CC,12		;NO, MULTIPLY BY 10 SINGLE PRECISION
	ADD	CC,C		;ADD DIGIT INTO NUMBER
	JRST	GETNXT		;GO GET NEXT CHARACTER

DPDIG:	CAMLE	B,MAGIC		;WILL MULTIPLY AND ADD CAUSE OVERFLOW?
	AOJA	X,GETNXT	;YES
	IMULI	B,12		;MULTIPLY HIGH D.P. FRACTION BY 10
	MULI	CC,12		;MULTIPLY LOW D.P. FRACTION BY 10
	ADD	B,CC		;ADD HI PART OF LO PRODUCT INTO RESULT
	MOVE	CC,D		;GET LO PART OF LO PRODUCT
	TLO	CC,(1B0)	;STOP OVERFLOW IF CARRY INTO HI WORD
	ADD	CC,C		;ADD DIGIT INTO FRACTION
	TLZN	CC,(1B0)	;SKIP IF NO CARRY INTO HI WORD
	ADDI	B,1		;PROPOGATE CARRY INTO HI WORD
	JRST	GETNXT		;GET NEXT CHARACTER

MAGIC:	<377777777777-9>/^D10	;LARGEST NUM PRIOR TO MULTIPLY AND ADD

DIGEXP:	IORI	FLG,EXPFL	;SET FLAG TO SAY WE'VE SEEN EXPONENT
	CAILE	XP,^D100	;SIMPLE TEST FOR LARGNESS
	JRST	GETNXT		;THROW DIGIT AWAY
	IMULI	XP,12		;MULTIPLY BY TEN
	ADD	XP,C		;ADD IN NEXT DIGIT
	JRST	GETNXT		;GET NEXT CHAR


;VERTICAL STATES (LAST 3 BITS) ARE:
;0	NOTHING USEFUL SEEN (BLANKS TABS )
;1	SIGNED DIGITS SEEN
;2	DECIMAL POINT AND DIGITS SEEN
;3	D OR E SEEN
;4	EXPONENT SEEN

;HORIZONTAL STATES (FIRST 6 BITS) ARE:
;	 ? ,CR , . ,0-9,   ,D E, + , - ,
NXTSTA:	BYTE (9)
	130,010,022,031,050,130,051,061,
	000,011,022,031,041,053,000,000,
	000,012,120,102,042,053,000,000,
	000,013,120,114,043,000,054,074,
	000,014,120,114,044,000,120,120
	
BLNKIN:ILLCH: DELCK:

ENDF0:	TRNE	FLG,DOTFL	;HAS DECIMAL POINT BEEN INPUT?
	JRST	ENDF2		;YES
ENDF2:	TRNE	FLG,MINEXP	;WAS D OR E EXPONENT NEGATIVE?
	MOVNS	XP		;YES, SO NEGATE IT
	ADD	X,XP		;ADD EXPONENT FROM D OR E
	MOVEI	BXP,306		;INIT BINARY EXPON FOR D.P. INTEGER
	JUMPN	B,NORM1		;XFER IF AT LEAST ONE 1 IN HIGH HALF
	EXCH	B,CC		;HIGH HALF ZERO, MOVE LOW HALF TO HIGH,
				;AND CLEAR LOW HALF
	SUBI	BXP,^D35	;AND ADJUST EXPONENT FOR 35 SHIFTS
NORM1:	MOVE	A,B		;GET D.P. HIGH HALF INTO A
	JFFO	A,NORM2		;ANY ONES NOW?
	SETZB	A,B		;NO, RESULT IS ZERO
	TRNE	FLG,DIGSN	;ANY DIGITS SEEN?
	JRST	RETURN		;YES, RETURN OK
	JRST	RETRN1		;NO, RETURN ERROR

NORM2:	EXCH	B,CC		;YES, GET D.P. LOW HALF INTO B, AND
				;PUT SHIFT COUNT INTO CC
	ASHC	A,-1(CC)	;NORMALIZE D.P. INTEGER WITH BIN POINT
				;BETWEEN BITS 0 AND 1 IN HIGH WORD
	SUBI	BXP,-1(CC)	;AND ADJUST EXPON TO ALLOW FOR SHIFTING
	JUMPE	X,ENDF6		;IF DECIMAL EXP=0, NO MUL BY 10 NEEDED
ENDF3:	MOVM	D,X		;GET MAGNITUDE OF DECIMAL EXPONENT
	CAILE	D,PTLEN$	;BETWEEN 0 AND MAX. TABLE ENTRY?
	MOVEI	D,PTLEN$	;NO, MAKE IT SO
	SKIPGE	X		;AND RESTORE CORRECT SIGN
	MOVNS	D
	SUB	X,D		;LEAVE ANY EXCESS EXPONENT IN X
	JUMPDP	DPMUL		;DOUBLE PRECISION?
SPMUL:	MUL	A,HITEN$(D)	;NO, MULTIPLY BY POWER OF TEN
ENDF5:	TLNE	A,(1B1)		;NORMALIZED? 1.0 > RESULT >= 0.25
	JRST	ENDF5A		;YES, RESULT >= 0.5
	ASHC	A,1		;NO, SHIFT LEFT ONE PLACE
	SUBI	BXP,1		;AND ADJUST EXPONENT
ENDF5A:	MOVE	D,EXP10$(D)	;GET BINARY EXPONENT
	ADD	BXP,D		;ADJUST BINARY EXPONENT
	JUMPN	X,ENDF3		;ANY MORE DECIMAL EXPONENT LEFT?
ENDF6:	TLO	A,(1B0)		;NO, START ROUNDING (ALLOW FOR OVERFLOW)
	JUMPDP	DPRND		;DOUBLE PRECISION?
SPRND:	ADDI	A,200		;NO, ROUND IN HIGH WORD
	TRZ	A,377		;GET RID OF USELESS (UNUSED) BITS
	MOVEI	B,0		; DITTO
ENDF7:	TLZE	A,(1B0)		;CARRY PROPOGATE TO BIT 0?
	JRST	ENDF7A		;NO
	ASHC	A,-1		;YES, RENORMALIZE TO RIGHT
	ADDI	BXP,1		;AND ADJUST BINARY EXPONENT
	TLO	A,(1B1)		;AND TURN ON HI FRACTION BIT
ENDF7A:	TRNE	BXP,777400	;IS BINARY EXPONENT TOO LARGE
	JRST	BADEXP		;YES, RETURN ZERO OR INFINITY
	ASHC	A,-8		;NO, LEAVE ROOM FOR EXPONENT
	DPB	BXP,[POINT 9,A,8] ;INSERT EXPONENT INTO HI WORD
RETURN:	AOS	(P)		;OK RETURN
RETRN1:	TRNE	FLG,MINFR	;RESULT NEGATIVE?
	DMOVN	A,A		;YES, SO NEGATE RESULT
	POPJ	P,		;RETURN TO CALLER
BADEXP:	HRLOI	A,377777	;SET NUMBER TO LARGEST POSSIBLE
	HRLOI	B,377777
	TRNE	BXP,1B18	;IF EXPONENT IS NEGATIVE
ILLFST:
ZERO:	SETZB	A,B		;SET TO ZERO
	JRST	RETRN1

;HERE FOR DOUBLE PRECISION MULTIPLY, ROUNDING 

DPMUL:	MUL	B,HITEN$(D)	;LO FRAC TIMES HI POWER OF TEN(RESULT IN B,C)
	MOVE	E,B		;GET HI PART OF PREVIOUS PRODUCT OUT OF WAY
	MOVE	B,A		;COPY HI PART OF FRACTION
	MOVE	CC,LOTEN$(D)	;GET LOW POWER OF TEN
	ADDI	CC,1		;BIAS IT - IT IS TRUNCATED
	MUL	B,CC		;HI FRAC TIMES LO POWER OF TEN
	TLO	E,(1B0)
	ADD	E,B		;SUM OF HI PARTS OF CROSS PRODUCTS TO AC T
	MUL	A,HITEN$(D)	;HI FRACTION TIMES HI POWER OF TEN
	TLON	E,(1B0)		;DID CARRY OCCUR?  ALLOW FOR NEXT CARRY
	ADDI	A,1		;CARRY FROM ADDING CROSS PRODUCTS
	ADD	B,E		;ADD CROSS PRODUCTS TO LO PART
				;  OF (HI FRAC TIMES HI POW TEN)
	TLZN	B,(1B0)
	AOJA	A,ENDF5		;AND PROPOGATE A CARRY, IF ANY
	JRST	ENDF5		;GO NORMALIZE RESULT

DPRND:	TLO	B,(1B0)		;START ROUNDING (ALLOW FOR CARRYS)
	ADDI	B,200 		;LOW WORD ROUNDING
	TLZN	B,(1B0)		;DID CARRY PROPOGATE TO SIGN?
	AOJA	A,ENDF7		;YES, ADD CARRY INTO HIGH WORD
	JRST	ENDF7		;AND GO RENORMALIZE IF NECESSARY

	END