fin.asm

Dos6.0

	TITLE	FIN - String and numeric input
;***
; FIN - String and numeric input
;
;	Copyright <C> 1986, Microsoft Corporation
;
;Purpose:
; BASIC Syntax mapping to included runtime entry points:
;
; - VAL Function:
;
;      v = VAL(x$)
;	    |
;	B$FVAL
;
;******************************************************************************
	INCLUDE rmacros.inc	; Runtime Macro Defintions
	INCLUDE switch.inc

	useSeg	_DATA		
	useSeg	_TEXT		
	useSeg	MT_TEXT 	
	useSeg	NH_TEXT 	
	useSeg	_BSS		

	INCLUDE seg.inc 	
	INCLUDE baslibma.inc	; SKIP macro
	INCLUDE rtps.inc	; constants shared with QBI
	INCLUDE const.inc	; Values of Flags for KANJI support
	INCLUDE idmac.inc	
	INCLUDE string.inc	

;
; The following constants are from the mathpack interface to $i8_input
; (Note: s16inv is a flag we synthesize.)
;
l_s16inv=	80h		; 16 bit signed value is invalid
l_ind=		80h		; indefinite
l_inv=		40h		; invalid (no digits or syntax error)
l_s32inv=	20h		; 32 bit signed value is invalid
l_u32inv=	10h		; 32 bit unsigned value is invalid
l_long= 	08h		; l_Dexp or more than 7 digits
l_Dexp= 	04h		; explicit 'D' or 'd' seen
l_Rexp= 	02h		; explicit 'E' or 'e' seen
l_inf=		01h		; DP overflow
h_curr= 	  2		;currency value was valid

sBegin	_DATA			

	externD B$AC		
	externQ B$DAC		
	externB $i8_input_ws   ; white space skipping flag

sEnd	_DATA			

sBegin	_BSS			

	externB b$VTYP		


sEnd	_BSS			

externFP B$LDFS 		; Load fixed length string




sBegin	MT_TEXT

externNP B$STPUTZ		
externNP B$STDALCTMP		
externNP B$ERR_OV		
externNP B$ERR_TM		
externNP B$ftolrnd		; Convert TOS to long integer in DX:AX
externNP B$UPCASE		; Convert AL to an uppercase character



assumes CS,MT_TEXT

	SUBTTL	B$FVAL - VAL function
	PAGE
;***
; B$FVAL - VAL function
;
;Function:
;	Compute numeric equivalent of the string
;
;Inputs:
;	sdNum = Address of string descriptor
;
;Outputs:
;	Double precision result in DAC
;
;******************************************************************************
cProc	B$FVAL,<FAR,PUBLIC>,<SI> 
parmSD	sdNum			
cBegin				
	MOV	BX,sdNum	
	CALL	B$STPUTZ	
	MOV	SI,[BX+2]	;Get address of string data
	PUSH	BX		;Save string descriptor address
	MOV	[B$VTYP],VT_R8	; Force to double precision
	CALL	B$FIN		
	POP	BX
	CALL	B$STDALCTMP	; Delete if temp string
	MOV	AX,OFFSET DGROUP: B$DAC	
cEnd				

	SUBTTL	B$FIN - Floating point and string input

;***
; B$FIN - Floating point and string input
; Largely rewritten
;
;Purpose:
;	Perform floating point and string input.  The string that
;	is passed must be zero terminated.
;
;
;	If FK_FULLMAP then the calling routine must allocate B$Buf1
;	and B$Buf2 before calling B$FIN and must deallocate them
;	after the call.  The way that these buffers are used in this
;	routine will NOT affect their use in B$INPP to hold data. Right
;	before calling FAR_I8_INPUT, we convert the rest of this data
;	item (up to a termination comma or zero terminator) from double
;	byte to single byte and store it in the buffers.  This will only
;	overwrite data that is no longer needed for INPUT.
;
;Entry:
;	[b$VTYP] = Type of value required
;	[SI]  = Address of character stream to analyze for the value.
;	[ES]  = segment of character stream IF REQUESTED TYPE IS STRING
;		Otherwise the requested segment is DS.
;Exit:
;	AC    = Address of string descriptor ([B$VTYP] = VT_SD)
;	AC    = integer value ([B$VTYP] = VT_I2)
;	AC    = long integer value ([B$VTYP] = VT_I4)
;	AC    = S.P. value ([B$VTYP] = VT_R4)
;	DAC   = D.P. value ([B$VTYP] = VT_R8)
;	DAC   = currency value ([B$VTYP] = VT_CY)
;	[AX]  = Delimiter Character
;	[SI]  = Address to start scanning for next item (if any) in list
;
;Uses:
;	SI is updated [3]
;
;Preserves:
;	None
;
;Exceptions:
;	If a runtime error occurs, this routine doesn't return to caller
;******************************************************************************
cProc	B$FIN,<PUBLIC,NEAR>,<DI,ES,BP>	; Warning!	Alternate entry
cBegin					;		through B$SimpleFin.
;
; If we are evaluating TO a string, call B$STRSCAN to do that, and then just
; assign the result to a string temp.
;
	CMP	[B$VTYP],VT_SD	; Getting a string?
	JNZ	FIN_5		;Jump if not
	CALL	B$STRSCAN	;[ES:DX] = start, [CX]=length [AX]=delimiter
	PUSH	AX		;Save delimiter Character
	cCall	B$LDFS,<ES,DX,CX>	;[AX] = address of string temp
	MOV	[WORD PTR B$AC],AX	; Put address in AC for safekeeping
	POP	AX		;Restore Delimiter Character
	JMP	FIN_Str_Exit	;go exit

FIN_5:
;
; Determine the target base. This is a function of the leading characters:
;	<none>	Decimal
;	&	Octal integer
;	&O	Octal Integer
;	&H	Hex Integer
;
; where integers may be short or long.
;
	PUSH	DS		;If not string,
	POP	ES		;assumed below that ES = DS

	XOR	BX,BX		;[BL] = radix. 0 is default
	MOV	[$i8_input_ws],1       ; skip white space is default
	CALL	B$GETCH 	;[AL] = next char (skipping white space)
	CMP	AL,'&'		;check for special radix constant
	jne	FIN_10		;jump if normal number
;
;	read special radix numbers
;
	MOV	[$i8_input_ws],BL ; reset skip white space for non-decimal
	CALL	B$GETCH_NS	;[AL] = next char (not skipping white space)
	MOV	BX,10H		;assume hex
	CMP	AL,'H'
	JE	FIN_15
	MOV	BL,8H		;assume octal
	CMP	AL,'O'
	JE	FIN_15

FIN_10:
	DEC	SI		; must be octal - move back pointer
;
; At this point, BX contains the desired conversion base, if one was specified,
; or zero for a default.
;
FIN_15:
;
; This odd piece of code ensure that the max length (passed in cx) when added
; to the start address of the string does not overflow the datasegment. The
; length is just a maximum, and we should stop conversion prior to exceding
; that in all cases by virtue of a zero terminator.
;
; We determine if the string start address is in the range FF00 to FFFF. If
; not, the max length is set to 255. If it is in that range, we set the max
; length to 1000H - start address - 1, i.e. the amount of room left in dgroup.
;

	MOV	CX,SI		;[CX] = string start address
	INC	CH		;Zero set if in 0FFxxH range
	JNZ	FIN_16		;Jump if not in that range
	XOR	CX,CX		;[CX] = 0
FIN_16:
	SUB	CX,SI		;[CX] = either 100H, or space left in DGROUP
	DEC	CX		;[CX] = either 0FFH, or space -1


;
; Set up for, and call the math-pack's conversion routine.
;
InvokeMathPack:

	MOV	DI,OFFSET DGROUP:B$DAC	;[DI] = location to place R8 result
	XOR	AX,AX			;[AX] = 0 (FORTRAN garbage)
	CWD				;[DX] = 0 (FORTRAN garbage)
	PUSH	BX			; Save radix
	PUSH	SI			; Save starting point
	PUSH	BP			;$i8_input trashes BP
	CALL	FAR PTR FAR_I8_INPUT	;Call math pack via aother seg
	POP	BP
	MOV	[$i8_input_ws],0  ;reset skip white space for C

	POP	DX			; DX = pointer to start location
	CMP	SI,DX			; did we use any characters
	JNE	ParsedNumber		; brif so, compute value

; If the mathpack did not like the first character it saw, it will return
; with l_inv false but l_s32inv and l_u32inv true.  We want to accept the
; number as valid, but 0. So munge the flags and the return value here.
; Note that it will have walked on the 8 byte value (B$DAC) also.

	AND	CL,NOT (l_s32inv OR l_u32inv) ;[42] make the number look valid
	XOR	AX,AX		; Set the number to zero
	XOR	BX,BX
	STOSW			; Store it as an R8 (will be 0 for all
	STOSW			;  possible lengths). DI is return
	STOSW			;  as part of B$FAR_I8_INPUT, and ES=DS.
	STOSW

ParsedNumber:

; After calling the math pack, we have two results. The R8 result is in B$DAC,
; unless a radix was specified. If the result is a valid U2, it is in AX, if
; it is a valid U4, it is in BX:AX. Flags are returned in CX.
; Possible 8-byte CY value is in $i8_input_cy.				    [33]
;
; Create the "16 bit value invalid" flag
;
	CWD			;Sign extend I2 in AX into DX
	CMP	BX,DX		;Same as 32 bite high word?
	JZ	FIN_18		;Jump if 16 bit signed value okay
	OR	CL,l_s16inv	;else 16 bit signed value is in error
FIN_18:
	TEST	CL,l_s32inv	;check if valid 32-bit integer
	JZ	FIN_19		;Jump if it is...
	OR	CL,l_s16inv	;else it's also a bad 16 bit'er
FIN_19:
	XCHG	BX,DX		; [DX:AX] = possible long result
	POP	BX		; [BX] = Originally requested base
	MOV	BH,BL		; [BH] = Originally requested base


;
; Check for a type character following the number. Modify the returned flags
; such that when we try to store the result, overflows will be detected.
;
	XCHG	AX,BX		;[DX:BX] = possible long result, [AH] = base
	CALL	B$GETCH_NS	;see if there's a suffix character
;
; If a non-long constant was specified, and the value falls in the range 32768
; to 65535, convert to a negative short integer.
;
	CMP	AL,'&'		; Z if long const
	JZ	FIN_43		; Long constant, do nothing
	OR	AH,AH		
	JZ	FIN_43		; Not any constant, do nothing
	
	;We also have to test for l_inv, as there is an altmath bug where
	;$I8_INPUT may set l_inv but forget to set l_s32inv or l_u32inv.
	
	TEST	CL,l_s32inv OR l_inv 
	JNZ	FIN_43		; Not a valid int, do nothing
	OR	DX,DX		; In range 0-65535?
	JNZ	FIN_43		; If not, nothing to do
	XCHG	AX,BX		; [DX:AX] = possible long return
FIN_GOT_CONST:
	CWD			; New high order work is value sign extend
	AND	CL,NOT l_s16inv ; result is a valid 16-bit integer
	MOV	[WORD PTR B$DAC],AX ; save low word
	XCHG	AX,BX		; [DX:BX] = possible long return

	FILD	WORD PTR B$DAC	; [ST0] = R8
	FSTP	B$DAC		; Save as R4

FIN_43: 			

	CMP	AL,'#'		;double precision?
	JNE	FIN_20
	OR	CL,l_long+l_s32inv+l_s16inv	;force it double
	JMP	SHORT FIN_40
FIN_20:

	CMP	AL,'!'		;single precision?
	JNE	FIN_25
	AND	CL,NOT l_long	;force it single
	OR	CL,l_s32inv+l_s16inv
	JMP	SHORT FIN_40
FIN_25: