.TITLE	MC10.. STRING PROCEDURES FOR CORAL IN MACRO
;
	.IDENT /MC10../
;
	.PAGE
	.SBTTL CONVERT CHARACTER STRING TO FLOATING POINT NUMBER (VAL)
;
	FLODEF			;GENERATE FLOATING POINT DEFINITIONS
	BITDEF			;GENERATE BIT SETTING    DEFINITIONS
;
;			ENTRY CONDITIONS
;
;		R5 -> CORAL PARAMETER LIST
;
;			INTERNAL USE OF REGISTERS
;
;		R4	HOLDS NUMBER OF CHARACTERS
;		R3	CHARACTER POINTER
;		R2	WORK REGISTER
;		R1	WORK REPLY REGISTER
;		R0	STATUS REGISTER
;
;		R0	STATUS FLAG SETTINGS
;			BIT 15 = 0	VALUE +VE
;			BIT 15 # 0	VALUE -VE
;			BIT 14 = 0	E VALUE +VE
;			BIT 14 # 0	E VALUE -VE
;			BIT  8 # 0	E MODE OVERFLOW FATAL ERROR
;			BIT  7 # 0	INTEGER READ FATAL ERROR
;			BIT  6 # 0	FRACTION UNDERFLOW NON FATAL ERROR
;			BIT  3 # 0	NON BASE TEN MANIPULATION
;			BIT  2 # 0	E MODE EVALUATION NOW IN PROGRESS
;			BIT  1 # 0	CHARACTER POINTER IN ILEGAL READ AREA
;			BIT  0 = 0	PROCESS AS INTEGER
;			BIT  0 # 0	PROCESS AS FRACTION
;
;
;
	.PAGE
;
VAL::
	SAVE R1,R2,R3,R4
	MOV 2(R5),R0		;CHECK IF ADDRESS VALID
	CALL R$ADDRESS
	IFSUCCESS	10$	;J IF NOT ADDRESS ERROR
5$:	JMP	625$		;J IF ERROR  OR RESULT = 0
10$:	TST @R0			;? ANY CHARACTERS IN STRING
	BEQ	5$		;J IF NO CHARACTERS TO PROCESS
	SETF			;SET FLOATING MODE
	LDFPS #0		;INHIBIT FLOATING ERROR INTERUPTS
;
;			CHECK IF NON BASE TEN VALUE TO READ
;
	MOV #10.,720$		;STORE DEFAULT BASE VALUE
	MOV 2(R5),R1		;HOLD ADDRESS OF INPUT STRING
	MOV #VAL1,R2		;HOLD ADDRESS OF BASE START CHARACTER STRING
	CALL R$POS2		;CHECK IF STRING EXISTS
	IFERROR	30$		;J IF NO START BASE CHARACTER IE DEFAULT REQD
	MOV R0,R3		;HOLD BASE START CHARACTER POSITION
	MOV #VAL2,R2		;HOLD ADDRESS OF BASE END   CHARACTER STRING
	INC R0			;SEARCH START POSITION ONE CHARACTER ON
	CALL R$POS3		;LOOK FOR BASE TERMINATOR
	IFERROR	5$		;J IF ERROR NB NO TERMINATOR
	ADD R1,R3		;LOCATE START ADDRESS OF INITIAL CHARACTER
	ADD #2,R3
	MOV #'),R4		;HOLD BASE DELIMIT CHARACTER
	CALL C$DECINT		;R0 HOLD BASE VALUE
	CMP R0,#1		;IS BASE IN RANGE 2 TO 36
	BLE	5$		;J IF VALUE < 2
	CMP R0,#36.
	BGT	5$		;J IF VALUE > 36
	MOV R0,720$
30$:	CMP 720$,10.		;IS DEFAULT BASE BEING USED
	BEQ	35$		;J IF DEFAULT BASE
	MOV #BIT3,R0		;INDICATE NON BASE TEN DEFAULT
	BR	40$
35$:	CLR R0
40$:	CLRF AC0		;CLEAR ACUM 0
	LDCIF 720$,AC2		;PUT BASE INTO ACUM 2
;
	MOV @2(R5),R4		;R4 HOLD NUMBER OF CHARACTERS TO PROCESS
	MOV 2(R5),R3 		;R3 -> TO STRING START ADDRESS
	ADD #2,R3		;R3 -> TO FIRST CHARACTER IN STRING
;
;
	.PAGE
	.SBTTL	.	PROCESS CHARACTERS IN STRING
;
50$:	MOVB (R3)+,R2		;HOLD CHAR TO PROCESS INDEX TO NEXT
	CMP #'),R2		;IS THIS CHARACTER END OF BASE DESCRIPTOR
	BNE	52$		;J IF NOT END CHARACTER
	BIC #BIT1,R0		;CLEAR READING BASE MARKER
	BR	200$		;GET NEXT CHARACTER
;
52$:	BIT #BIT1,R0		;IS CHARACTER POINTER IN BASE 
	BNE	200$		;J IF STILL READ BASE CHARACTERS
;
	CMP #'(,R2		;IS THIS CHARACTER START OF BASE READ
	BNE	53$		;J IF NOT START BASE CHARACTER
	BIS #BIT1,R0		;SET NOW READING BASE MARKER
	BR	200$		;GET NEXT CHARACTER
53$:	CMP #'-,R2		;IS CHARACTER MINUS SIGN
	BNE	60$		;J IF NOT
;
	BIT #BIT2,R0		;IS THIS E MODE
	BEQ	55$		;J IF NOT -E
	BIS #BIT14,R0		;SET E VALUE -VE MARKER
	BR	200$		;GET NEXT CHARACTER
;
55$:	BIS #BIT15,R0		;SET VALUE -VE MARKER
	BR	200$		;GET NEXT CHARACTER
;
60$:	CMP #'+,R2		;IS CHARACTER PLUS SIGN
	BNE	70$		;J IF NOT
;
	BIT #BIT2,R0		;IS THIS E MODE
	BEQ	65$		;J IF NOT +E
	BIC #BIT14,R0		;SET E VALUE +VE MARKER
	BR	200$		;GET NEXT CHARACTER
;
65$:	BIC #BIT15,R0		;SET VALUE +VE MARKER
	BR	200$		;GET NEXT CHARACTER
;
70$:	CMP #'.,R2		;IS CHARACTER INT/FRACTION SEPERATOR
	BNE	75$		;J IN NOT
;
	BIS #BIT0,R0		;SET FRACTION INDICATOR MARKER
	LDF #^F1.0,AC2		;SET NEW MULTIPLIER VALUE
	LDCIF 720$,AC3		;SCALING MULTIPLIER
	BR	200$		;GET NEXT CHARACTER
;
75$:	BIT #BIT3,R0		;IS BASE TEN OPERATION BEING USED
	BNE	90$		;NON BASE TEN OPERATION HENCE NO E MODE
80$:	CMP #'E,R2		;IS INPUT CHARACTER E MODE REQUEST
	BNE	90$		;J IF NOT E MODE
	BIS #BIT2,R0		;SET NOW IN E MODE MARKER
	CLR R1			;CLEAR E COUNTER VALUE
	BR	200$		;GET NEXT CHARACTER
;
90$:
	CMP R2,#64.		;IS CHARACTER NOT A - Z
	BLE	95$		;J IF NOT A - Z
	CMP R2,#133		;IS CHARACTER STILL IN RANGE A - Z
	BGE	200$		;J IF NOT A - Z
	SUB #55.,R2		;ALPHA NOW BCD VALS 10 - 35
	BR	100$		;CHECK DIGIT IN LEGAL RANGE
;
95$:	SUB #48.,R2		;REDUCE TO NUMERIC
	BLT	200$		;J IF VALUE NOT NUMERIC
	CMP R2,#9.		;IS VALUE >= 10
	BGT	200$		;J IF VALUE NOT NUMERIC
100$:	CMP R2,720$		;IS VALUE IN LEGAL RANGE
	BGE	200$		;J IF ILEGAL RANGE
;
	BIT #BIT2,R0		;IS E MODE MARKER SET
	BNE	500$		;IF E MODE PROCESS E VALUE
	BIT #BIT0,R0		;IS INTEGER SECTION BEING PROCESSED
	BEQ	350$		;J IF INTEGER SECTION
	BR	450$		;PROCESS FRACTION
;
200$:	DEC R4		;LOOP THROUGH ALL CHARACTERS
	BNE	50$
	BR	600$		;GOTO OUTLOAD SECTION
;
;
	.PAGE
	.SBTTL	.	INTEGER PROCESSING SECTION
;
350$:
;		INTEGER SECTION PROCESSING
;
;
	BIT #BIT7,R0		;HAS INTEGER ERROR OCCURED
	BNE	200$		;J IF ERROR HAS OCCURED
	MULF AC2,AC0		;MULTIPLY ACUMULATOR BY MULTIPLIER
	CFCC			;GET FLOATING POINT CONDITION CODES
	BVS	370$		;J IF OVER FLOW
	LDCIF R2,AC1		;PUT CHAR VALUE IN ACUM 1
	ADDF AC1,AC0		;ADD IN LS DIGIT
	BR	200$		;GO FOR NEXT CHARACTER
;
;
;		INTEGER ERROR SECTION
;
;	
370$:
	BIS #BIT7,R0		;SET ERROR MARKER IN STATUS WORD
	BR	200$		;GET NEXT CHARACTER
;
;
	.PAGE
	.SBTTL	.	FRACTIONAL PROCESSING SECTION
;
450$:
;		FRACTIONAL SECTION PROCESSING
;
	BIT #BIT6,R0		;HAS FRACTION OCCURED
	BNE	200$		;J IF ERROR HAS OCCURED
	DIVF AC3,AC2		;REDUCE MULTIPLIER SIZE
	CFCC			;GET FLOATING POINT CONDITION CODES
	BLE	470$		;J IF ACUM 2 <= 0
	BVS	470$		;J IF OVERFLOW
	LDCIF R2,AC1		;STORE LS DIGIT IN ACUM 1
	MULF  AC2,AC1		;CORRECT POSITION OF FRACTION
	ADDF  AC1,AC0		;ADD LS DIGIT TO ACUM 0
	BR 	200$		;GOTO LOOP COUNTER
;
;		FRACTION ERROR SECTION
470$:
	BIS #BIT6,R0		;SET ERROR MARKER IN STATUS WORD
	BR	200$		;GET NEXT CHARACTER
;
;
;
	.PAGE
	.SBTTL	.	E MODE PROCESSING SECTION
;
;
;
500$:
;		E MODE PROCESSING SECTION
;
	BIT #BIT8,R0		;HAS THERE BEEN AN E MODE ERROR
	BNE	200$		;J IF ERROR HAS OCCURED
	MUL #10.,R1		;SHIFT VALUE 1 DECIMAL PLACE LEFT
	BVS	550$		;J IF OVERFLOW
	ADD R2,R1		;ADD IN LS DIGIT
	BVS	550$		;J IF OVERFLOW
	BR	200$		;GET NEXT CHARACTER
;
;		E MODE ERROR SECTION (FATAL ERROR)
550$:	BIS #BIT8,R0		;SET E MODE ERROR MARKER
	BR	200$		;GET NEXT CHARACTER
;
;
;
;
;
	.PAGE
	.SBTTL	.	OUTPUT SECTION
;
;		OUT LOADING OF CONVERTED STRING
;
;
600$:
	BIT #BIT2,R0		;WAS VALUE WITH E MODE MULT USED
	BEQ	610$		;J IF NOT
	TST R1			;IS THIS SPECIAL CASE E+0 OR E-0
	BEQ	610$		;J IF E+0 OR E-0
	LDF #^F10,AC2		;PLACE 10 IN ACUM 2
	BIT #BIT14,R0		;WAS E MULTIPLIER -VE
	BEQ	605$		;J IF +VE MULTIPLIER
	LDF #^F0.1,AC2		;PLACE DIVISION FACTOR IN ACUM 2
;
605$:	MULF AC2,AC0		;SHIFT ACUMULATOR VALUE R0 DIGITS
				;DECIMAL LEFT OR RIGHT
	CFCC			;GET CONDITION CODES
	BVS	607$		;J IF VALUE OVER/UNDER FLOW OCCURED
	SOB R1,605$		;LOOP REQUESTED NUMBER OF PLACES
	BR	610$		;EXIT
;
607$:	BIS #BIT8,R0		;SET FLOATING UNDER/OVERFLOW 
				;FATAL ERROR MARKER
;
610$:	TST R0		;WAS - SIGN READ
	BGE	620$		;J IF VALUE IS POSITIVE
	NEGF AC0		;NEGATE ACUM 0
620$:	BIT #BIT7!BIT8,R0	;HAS FATAL ERROR OCCURED
	BEQ	630$		;J IF NO ERROR
625$:				;ERROR EXIT LABEL
	CLRF AC0		;CLEAR ACUMULATOR ZERO
;
630$:
	UNSAVE R1,R2,R3,R4
	STF AC0,700$		;STORE FINAL RESULT IN R0 AND R1
	MOV 700$,R0
	MOV 701$,R1
;
;
;
	RETURN			;EXIT
;
;
	.PAGE
	.SBTTL	.	DATA AREA
;
;
700$:	.WORD
701$:	.WORD			;STORE AREA
720$:	.WORD	10.		;EVALUATION BASE DEFAULT = 10
	STRING "(",VAL1
	STRING ")",VAL2
;
;
	.END
;
;