fin.asm

Dos6.0

	CMP	AL,'%'		;integer?
	JNE	FIN_30
	TEST	CL,l_s16inv	;check if valid 16-bit integer
	JNZ	FIN_TM		; no - type character error
	JMP	SHORT FIN_40

FIN_30:
	CMP	AL,'&'		;long?
	JNE	FIN_35
	TEST	CL,l_s32inv	;check if valid 32-bit integer
	JNZ	FIN_TM		;  no - type character error
	OR	CL,l_s16inv	;force it long
	JMP	SHORT FIN_40

FIN_TM: JMP	B$ERR_TM	;invalid type character

FIN_35:

	DEC	SI		;back up

FIN_40:
;
; Since we couldn not parse any number at all, we have to explicitly
; return a zero ($I8_INPUT will return garbage).  We can also just
; return without further tests, which will avoid an altmath bug where
; certain invalid flags are not being set if l_inv is set.
;
; This check could not be done earlier, as we need to do the same type
; character parsing as before this bug fix.
;
	TEST	CL,l_inv	; was the number invalid?
	JNZ	InValidNumber	; yes, zero out our number and return
;
; Now we attempt to store the result, based on the user-requested data type.
;
	XCHG	AX,BX		; [DX:AX] = possible long result
	MOV	BL,[B$VTYP]    
;
; If the result is a valid 16 bit int, and the user wants an int, just store
; the result (in AX) into the fac.
;
	TEST	CL,l_s16inv	;result a valid 16-bit integer?
	JNZ	FIN_45		;Jump if not
	CMP	BL,VT_I2	; User wants an I2?
	JZ	FIN_50		;brif so - same logic as when have I4
;
; If the result is a valid 32 bit int (or a fall through valid 16 bit int), and
; the user want's an I4, then just store the result (in BX:AX) into B$AC.
;
FIN_45:
	TEST	CL,l_s32inv	;result a valid 32 bit int?
	JNZ	FIN_55		;Jump if not
	CMP	BL,VT_I4	; caller wants an I4?
	JNZ	FIN_55		;brif not
	MOV	[WORD PTR B$AC+2],DX	 ; save high word
FIN_50:
	MOV	[WORD PTR B$AC],AX	 ; save low word
	jmp	SHORT FIN_EXIT		 ;done - exit
;
;If the result is a valid currency, and the user wants currency, just
;store the result (at $i8_input_cy) into B$DAC.
;
FIN_55: 			
;
; The number is not a valid int, thus only the R8 in B$DAC is valid. Determine
; what type the user wants, and coerce to that by loading up on the numeric
; stack, and storing as the desired type.
;
	TEST	CL,l_inf	; Waaaayyyyyy too big?
	JNZ	FIN_OV		; then go complain.
	XCHG	BX,DX		; [DL] = valtype
	CMP	DL,VT_R8	;Does the user perhaps want R8?
	JZ	FIN_EXIT	;In that case, we're done!

	FLD	B$DAC		; [ST0] = R8

	CMP	DL,VT_R4	;Does the user want an R4?
	JNZ	FIN_60		;Jump if not, probably wants an int

	FSTP	B$AC		; Save as R4

	JMP	SHORT FIN_EXIT
;
; Here we have an Integer result type, with only an R8 in B$AC. Convert to the
; appropriate type, with rounding, and make sure the result fits.
;
FIN_60:
	CMP	DL,VT_I2
	JZ	FIN_65		;Must be either I2 or I4 or CY at this point
	CMP	DL,VT_I4
	JNZ	FIN_OV		;Jump if error
FIN_65:
	PUSH	DX		;Save the user resuested type
	cCALL	B$ftolrnd	;Round nearest or even & Store it in DX:AX
	MOV	[WORD PTR B$AC],AX	; Store low word
	MOV	[WORD PTR B$AC+2],DX	; Store Hi-word
	MOV	BX,DX		;Get a copy of Hi-word
	CWD			;Needed to check for overflow in SINT
	CMP	DX,BX		;If they are equal, then all is well
	POP	DX		;[DL] = valtype
	JE	FIN_EXIT	;No complaint
	CMP	DL,VT_I4	;User wanted a long integer?
	JE	FIN_EXIT	;Brif so - no error

FIN_OV: JMP	B$ERR_OV	;Overflow error

InValidNumber:
	MOV	DI,OFFSET DGROUP:B$DAC	 
	XOR	AX,AX		; Get a Zero to store
	STOSW			; Store it as an R8 (will be 0 for all
	STOSW			;  possible lengths)
	STOSW			
	STOSW			

FIN_EXIT:
	CALL	B$GETCH 	; provide return value

FIN_Str_Exit:			 
	FWAIT			; Always wait for 87 to complete.
cEnd				



	SUBTTL	B$STRSCAN
	PAGE
;***
;B$STRSCAN
;
;Purpose:
;	This routine will scan a zero terminated string for the
;	presence of a string input by the user.  If the first
;	character of the string is a double quote ("), then the
;	string is composed of all characters from the double quote
;	to the next double quote not including the quotes.  Otherwise
;	the string is composed of all the characters from the first
;	character until the first comma.
;
;	If the double quote or comma does not appear before the terminating
;	zero, then the zero byte is used as a legal terminator. On return,
;	[ES:SI] will point to the byte following the string seperator.	The
;	seperator, which is returned in AL, is determined as follows:
;
;	1.) If the string was terminated by a zero byte, then the
;	    seperator is the zero byte
;	2.) If the string was not quoted, then the seperator is
;	    the comma that ended the string
;	3.) If the string was quoted, then the seperator is the
;	    first non-blank character following the second double quote.
;
;
;Parameters:
;	[ES:SI]       = Pointer to text string to analyze
;
;Returns:
;	[ES:DX]       = updated pointer to start of string
;	[ES:SI]       = updated pointer to char after string seperator.
;	[CX]	      = Length of string (number of bytes in string)
;	[AL]	      = Seperator byte
;****

cProc	B$STRSCAN,<NEAR,PUBLIC>
cBegin

assumes DS,NOTHING		
assumes ES,NOTHING		
	PUSH	DS		
	PUSH	ES		; CAUTION: We switch DS to point to string
	POP	DS		; CAUTION: data references won't work.

	CALL	B$GETCH
	MOV	AH,AL		;In case first char is "
	CMP	AL,'"'		;Is it?
	JZ	COUNTSTR
	MOV	AH,","		;Terminate with comma if not quoted
	DEC	SI		;Scan first char again
COUNTSTR:
	MOV	DX,SI		;Save starting address of string data
	XOR	CX,CX		;Character count
RDSTR:
	LODSB			;get byte from DS:SI and increment SI
	CMP	AL,AH		;End of string?
	JZ	NEGCNT
	OR	AL,AL		;End of line?
	LOOPNZ	RDSTR		;Count char and loop if not EOL
	INC	CX		;Don't count the EOL character
	CMP	AH,','		;Quoted string?
	JE	NEGCNT		;  No
	DEC	SI		;  Yes - point back to 00 terminator
NEGCNT:
	NEG	CX		;Make character count positive
	CMP	AH,','		;Unquoted string?
	JNZ	GETRTN
;Not a quoted string. Trim off trailing blanks.
	DEC	SI		;Point back at termination character
	MOV	DI,SI
	DEC	DI		;Point to last char of string
	MOV	AL," "
	CMP	AL,AL		;Set zero flag in case CX=0
	STD			;Set direction DOWN
	REPE	SCASB		;Scan of blanks backward
	CLD			;Restore direction
	JZ	GETRTN		;If null string, leave zero in CX
	INC	CX		;Last char scanned not blank - count it
GETRTN:
	CALL	B$GETCH 	;Get Delimiter for return
	POP	DS		;Restore Data Segment
cEnd


page

;***
; B$GETCH, B$GETCH_NS - get next byte from buffer
;
;Purpose:
;	These routines will get the next byte from a zero terminated
;	string of characters.  B$GETCH will skip blank spaces, tabs, and
;	linefeeds, B$GETCH_NS will not.  If the character is a letter, it
;	will be converted to upper case.  If FV_DBCS and FK_FULLMAP
;	then any two byte characters will first be converted to their
;	one byte format if at all possible otherwise any double double
;	byte character will be returned one character at a time.
;
;	If FV_DBCS, then b$SISAVE will be set to the offset (from DS)
;	of the character that is being returned.  This is used by other
;	code to back up a single character.  It is possible for this routine
;	to return only the first half of a Double Byte Character.  This
;	will cause no problems, as it will always be invalid for the purpose
;	that it is used (this will desynchronize the character order
;	but everyone who gets a double byte character from here will die
;	with an error at one point or another).
;
;	NOTE: DS may not point to DGROUP!
;
;Entry:
;	DS:SI - points to a zero terminated string
;
;Exit:
;	AL - next legal character in the string
;	DS:SI - points to next character
;
;Uses:
;	SI is used as the index into a string.
;
;Preserves:
;	AH, BX, CX, DX
;
;Exceptions:
;	None.
;****

cProc	B$GETCH_NS,<PUBLIC,NEAR>
cBegin
	LODSB			;get byte from DATA statement segment
	JMP	SHORT UPPER	;continue on with processing in B$GETCH
cEnd	<nogen>

cProc	B$GETCH,<PUBLIC,NEAR>
cBegin

GET_ANOTHER:			
	LODSB			;get byte from DATA statement segment

	CMP	AL," "		;Ignore spaces
	JZ	GET_ANOTHER	
	CMP	AL,9		;Ignore tabs
	JZ	GET_ANOTHER	
	CMP	AL,10		;Ignore linefeeds
	JZ	GET_ANOTHER	
UPPER:
	CALL	B$UPCASE	;Convert to upper case
cEnd



assumes DS,DGROUP		
assumes ES,DGROUP		


sEnd	MT_TEXT

	SUBTTL	FAR_I8_INPUT - Far Interface to $i8_input
	PAGE
;***
;FAR_I8_INPUT - far interface to $i8_input
;
;Purpose:
; This interface routine is required because we can't be sure that the B$FIN
; portion of MT_TEXT will be within 64k of $i8_input in _TEXT, and $i8_input
; must be called NEAR
;
;Entry:
; [AX] = FORTRAN scale factor
; [BX] = Radix desired (1..36), integer only to be returned.
; [CX] = Maximum character count for scanning input stream.
; [DX] = FORTRAN decimal point format factor
; [DI] = DS offset of space for 8 byte result
; [SI] = points to first digit in number to input
; [BX] = radix desired, integer only to be returned (0 is default)
; [ES] = DS
;
;Exit:
; [SI] = DS offset of first byte after decoded string value
; [DI] = DS offset of 8-byte result
; [AX] = low order part of integer value (32-bit integer)
; [BX] = high order part of integer value (32-bit integer)
; [CX] = Return flags - - - defined elsewhere
;
; Outputs:
;
;****
sBegin	_TEXT			; $i8_input must be called NEAR from here
	ASSUMES CS,_TEXT

externNP $i8_input	       


FAR_I8_INPUT PROC    FAR
	CALL	$i8_input      ;mathpack call
	RET
FAR_I8_INPUT	ENDP

sEnd	_TEXT

	END